|
| 1 | +{-| |
| 2 | +Module : PostgREST.Client |
| 3 | +Description : PostgREST HTTP client |
| 4 | +-} |
| 5 | +{-# LANGUAGE NamedFieldPuns #-} |
| 6 | +module PostgREST.Client |
| 7 | + ( ready |
| 8 | + ) where |
| 9 | + |
| 10 | +import qualified Data.Text as T |
| 11 | +import qualified Network.HTTP.Client as HC |
| 12 | +import qualified Network.HTTP.Types.Status as HTTP |
| 13 | + |
| 14 | +import Network.HTTP.Client (HttpException (..)) |
| 15 | +import System.IO (hFlush) |
| 16 | + |
| 17 | +import PostgREST.Config (AppConfig (..)) |
| 18 | +import PostgREST.Network (isSpecialHostName) |
| 19 | + |
| 20 | +import Protolude |
| 21 | + |
| 22 | +data PgrstClientError |
| 23 | + = NoAdminServer |
| 24 | + | NoSpecialHostNamesAllowed Text |
| 25 | + | PostgRESTNotReady Text |
| 26 | + | HTTPConnectionRefused Text |
| 27 | + | HTTPExceptionInvalidURL Text |
| 28 | + |
| 29 | +-- | This is invoked by the CLI "--ready" flag. |
| 30 | +-- The http-client sends and a request to /ready endpoint |
| 31 | +-- and exits with success or failure. |
| 32 | +ready :: AppConfig -> IO () |
| 33 | +ready AppConfig{configAdminServerHost, configAdminServerPort} = do |
| 34 | + |
| 35 | + client <- HC.newManager HC.defaultManagerSettings |
| 36 | + readyURL <- getURL |
| 37 | + req <- HC.parseRequest (T.unpack readyURL) `catch` handleHttpException |
| 38 | + resp <- HC.httpLbs req client `catch` handleHttpException |
| 39 | + |
| 40 | + let status = HC.responseStatus resp |
| 41 | + |
| 42 | + if status >= HTTP.status200 && status < HTTP.status300 |
| 43 | + then printAndExitWithSuccess $ "OK: " <> readyURL |
| 44 | + else printAndExitWithFailure $ clientErrorMsg (PostgRESTNotReady readyURL) |
| 45 | + where |
| 46 | + getURL :: IO Text |
| 47 | + getURL = |
| 48 | + -- Here, we have three cases: |
| 49 | + -- 1. If the admin port config is not defined, we exit |
| 50 | + -- with "no admin server error" |
| 51 | + -- 2. Otherwise, if admin server is running, then we check if |
| 52 | + -- postgrest server-host is configured with special hostname like "*4", |
| 53 | + -- if it is, we fail with "no special hostname allowed with "--ready". |
| 54 | + -- The reason for this is that we can't know the actual address. |
| 55 | + -- 3. Finally, if we know the "actual" hostname and the port, then we |
| 56 | + -- construct the URL and return it. |
| 57 | + case configAdminServerPort of |
| 58 | + Nothing -> printAndExitWithFailure $ clientErrorMsg NoAdminServer |
| 59 | + Just port -> |
| 60 | + if isSpecialHostName configAdminServerHost |
| 61 | + then printAndExitWithFailure $ clientErrorMsg (NoSpecialHostNamesAllowed configAdminServerHost) |
| 62 | + else return $ makeReadyUrl port |
| 63 | + |
| 64 | + -- NOTE: http-client automatically resolves hostnames |
| 65 | + makeReadyUrl :: Int -> Text |
| 66 | + makeReadyUrl p = "http://" <> wrapIfIpv6 configAdminServerHost <> ":" <> (T.pack . show) p <> "/ready" |
| 67 | + where |
| 68 | + -- IPv6 needs to wrapped in [], it has ':' as separator |
| 69 | + wrapIfIpv6 :: Text -> Text |
| 70 | + wrapIfIpv6 s |
| 71 | + | T.any (== ':') s = "[" <> s <> "]" |
| 72 | + | otherwise = s |
| 73 | + |
| 74 | +-- | Handle HTTP exception for "http-client" requests |
| 75 | +handleHttpException :: HttpException -> IO a |
| 76 | +handleHttpException (HttpExceptionRequest req _) = do |
| 77 | + let url = show (HC.getUri req) |
| 78 | + printAndExitWithFailure $ clientErrorMsg (HTTPConnectionRefused $ T.pack url) |
| 79 | +handleHttpException (InvalidUrlException url _) = do |
| 80 | + printAndExitWithFailure $ clientErrorMsg (HTTPExceptionInvalidURL $ T.pack url) |
| 81 | + |
| 82 | +-- | Print the message on stdout and exit with success |
| 83 | +printAndExitWithSuccess :: Text -> IO a |
| 84 | +printAndExitWithSuccess msg = putStrLn (T.unpack msg) >> hFlush stdout >> exitSuccess |
| 85 | + |
| 86 | +-- | Print the message on stderr and exit with failure |
| 87 | +printAndExitWithFailure :: Text -> IO a |
| 88 | +printAndExitWithFailure msg = hPutStrLn stderr (T.unpack msg) >> hFlush stderr >> exitWith (ExitFailure 1) |
| 89 | + |
| 90 | +-- | Pgrst client error to error message |
| 91 | +clientErrorMsg :: PgrstClientError -> Text |
| 92 | +clientErrorMsg err = "ERROR: " <> |
| 93 | + case err of |
| 94 | + NoAdminServer -> "Admin server is not running. Please check admin-server-port config." |
| 95 | + NoSpecialHostNamesAllowed host -> |
| 96 | + "The `--ready` flag cannot be used when server-host is configured as \"" <> host <> "\". " |
| 97 | + <> "Please update your server-host config to \"localhost\"." |
| 98 | + PostgRESTNotReady url -> url |
| 99 | + HTTPConnectionRefused url -> "connection refused to " <> url |
| 100 | + HTTPExceptionInvalidURL url -> "invalid url - " <> url |
0 commit comments