From 17af56adb122bbb4a6dd42da51a527e9a7a5484e Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Wed, 20 Jan 2021 14:11:02 -0500 Subject: [PATCH] refactor: config validation inside readAppConfig Remove Either from configJwtRoleClaimKey/configServerUnixSocketMode and remove whenLefts. --- main/UnixSocket.hs | 10 +++---- src/PostgREST/App.hs | 2 +- src/PostgREST/Auth.hs | 6 ++-- src/PostgREST/Config.hs | 49 +++++++++++++++---------------- src/PostgREST/OpenAPI.hs | 2 +- src/PostgREST/Private/ProxyUri.hs | 5 ++-- test/SpecHelper.hs | 4 +-- test/io-tests/fixtures.yaml | 1 - 8 files changed, 38 insertions(+), 41 deletions(-) diff --git a/main/UnixSocket.hs b/main/UnixSocket.hs index 772f080fd..36359bc55 100644 --- a/main/UnixSocket.hs +++ b/main/UnixSocket.hs @@ -16,12 +16,12 @@ import System.Posix.Types (FileMode) import Protolude -createAndBindSocket :: FilePath -> Maybe FileMode -> IO Socket -createAndBindSocket socketFilePath maybeSocketFileMode = do +createAndBindSocket :: FilePath -> FileMode -> IO Socket +createAndBindSocket socketFilePath socketFileMode = do deleteSocketFileIfExist socketFilePath sock <- socket AF_UNIX Stream defaultProtocol bind sock $ SockAddrUnix socketFilePath - mapM_ (setFileMode socketFilePath) maybeSocketFileMode + setFileMode socketFilePath socketFileMode return sock where deleteSocketFileIfExist path = removeFile path `catch` handleDoesNotExist @@ -30,9 +30,9 @@ createAndBindSocket socketFilePath maybeSocketFileMode = do | otherwise = throwIO e -- run the postgrest application with user defined socket. -runAppInSocket :: Settings -> Application -> Either Text FileMode -> FilePath -> IO () +runAppInSocket :: Settings -> Application -> FileMode -> FilePath -> IO () runAppInSocket settings app socketFileMode sockPath = do - sock <- createAndBindSocket sockPath (rightToMaybe socketFileMode) + sock <- createAndBindSocket sockPath socketFileMode putStrLn $ ("Listening on unix socket " :: Text) <> show sockPath listen sock maxListenQueue runSettingsSocket settings sock app diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index ae62ebe6a..adb26b7c3 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -80,7 +80,7 @@ postgrest logLev refConf refDbStructure pool getTime connWorker = Left err -> return . errorResponseFor $ err Right apiRequest -> do -- The jwt must be checked before touching the db. - attempt <- attemptJwtClaims (configJWKS conf) (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configJwtRoleClaimKey conf) + attempt <- attemptJwtClaims (configJWKS conf) (configJwtAudience conf) (toS $ iJWT apiRequest) time (configJwtRoleClaimKey conf) case jwtClaims attempt of Left errJwt -> return . errorResponseFor $ errJwt Right claims -> do diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 1841f2786..98d728fb9 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -54,7 +54,7 @@ jwtClaims attempt = Receives the JWT secret and audience (from config) and a JWT and returns a map of JWT claims. -} -attemptJwtClaims :: Maybe JWKSet -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt +attemptJwtClaims :: Maybe JWKSet -> Maybe StringOrURI -> LByteString -> UTCTime -> JSPath -> IO JWTAttempt attemptJwtClaims _ _ "" _ _ = return $ JWTClaims M.empty attemptJwtClaims maybeSecret audience payload time jspath = case maybeSecret of @@ -72,11 +72,11 @@ attemptJwtClaims maybeSecret audience payload time jspath = Turn JWT ClaimSet into something easier to work with, also here the jspath is applied to put the "role" in the map -} -claims2map :: ClaimsSet -> Maybe JSPath -> M.HashMap Text JSON.Value +claims2map :: ClaimsSet -> JSPath -> M.HashMap Text JSON.Value claims2map claims jspath = (\case val@(JSON.Object o) -> let role = maybe M.empty (M.singleton "role") $ - walkJSPath (Just val) =<< jspath in + walkJSPath (Just val) jspath in M.delete "role" o `M.union` role -- mutating the map _ -> M.empty ) $ JSON.toJSON claims diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index f43542ec8..ce588a588 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -44,7 +44,6 @@ import Control.Lens (preview) import Control.Monad (fail) import Crypto.JWT (JWKSet, StringOrURI, stringOrUri) import Data.Aeson (encode, toJSON) -import Data.Either.Combinators (fromRight', whenLeft) import Data.List (lookup) import Data.List.NonEmpty (fromList, toList) import Data.Maybe (fromJust) @@ -108,7 +107,7 @@ data AppConfig = AppConfig { , configDbUri :: Text , configJWKS :: Maybe JWKSet , configJwtAudience :: Maybe StringOrURI - , configJwtRoleClaimKey :: Either Text JSPath + , configJwtRoleClaimKey :: JSPath , configJwtSecret :: Maybe B.ByteString , configJwtSecretIsBase64 :: Bool , configLogLevel :: LogLevel @@ -117,7 +116,7 @@ data AppConfig = AppConfig { , configServerHost :: Text , configServerPort :: Int , configServerUnixSocket :: Maybe FilePath - , configServerUnixSocketMode :: Either Text FileMode + , configServerUnixSocketMode :: FileMode } configDbPoolTimeout' :: (Fractional a) => AppConfig -> a @@ -289,7 +288,7 @@ dumpAppConfig conf = ,("db-tx-end", q . showTxEnd) ,("db-uri", q . configDbUri) ,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience) - ,("jwt-role-claim-key", q . intercalate mempty . fmap show . fromRight' . configJwtRoleClaimKey) + ,("jwt-role-claim-key", q . intercalate mempty . fmap show . configJwtRoleClaimKey) ,("jwt-secret", q . toS . showJwtSecret) ,("jwt-secret-is-base64", toLower . show . configJwtSecretIsBase64) ,("log-level", q . show . configLogLevel) @@ -317,7 +316,7 @@ dumpAppConfig conf = | otherwise = toS secret where secret = fromMaybe mempty $ configJwtSecret c - showSocketMode c = showOct (fromRight' $ configServerUnixSocketMode c) "" + showSocketMode c = showOct (configServerUnixSocketMode c) mempty -- This class is needed for the polymorphism of overrideFromDbOrEnvironment -- because C.required and C.optional have different signatures @@ -374,13 +373,12 @@ readAppConfig dbSettings env optPath = do <*> reqString "db-uri" <*> pure Nothing <*> parseJwtAudience "jwt-aud" - <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optWithAlias (optValue "jwt-role-claim-key") - (optValue "role-claim-key")) + <*> parseRoleClaimKey "jwt-role-claim-key" "role-claim-key" <*> (fmap encodeUtf8 <$> optString "jwt-secret") <*> (fromMaybe False <$> optWithAlias (optBool "jwt-secret-is-base64") (optBool "secret-is-base64")) <*> parseLogLevel "log-level" - <*> optString "openapi-server-proxy-uri" + <*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri" <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types") <*> (fromMaybe "!4" <$> optString "server-host") <*> (fromMaybe 3000 <$> optInt "server-port") @@ -394,18 +392,25 @@ readAppConfig dbSettings env optPath = do fromEnv = M.mapKeys fromJust $ M.filterWithKey (\k _ -> isJust k) $ M.mapKeys normalize env normalize k = ("app.settings." <>) <$> stripPrefix "PGRST_APP_SETTINGS_" (toS k) - parseSocketFileMode :: C.Key -> C.Parser C.Config (Either Text FileMode) + parseSocketFileMode :: C.Key -> C.Parser C.Config FileMode parseSocketFileMode k = optString k >>= \case - Nothing -> pure $ Right 432 -- return default 660 mode if no value was provided + Nothing -> pure $ 432 -- return default 660 mode if no value was provided Just fileModeText -> case (readOct . unpack) fileModeText of [] -> - pure $ Left "Invalid server-unix-socket-mode: not an octal" + fail "Invalid server-unix-socket-mode: not an octal" (fileMode, _):_ -> if fileMode < 384 || fileMode > 511 - then pure $ Left "Invalid server-unix-socket-mode: needs to be between 600 and 777" - else pure $ Right fileMode + then fail "Invalid server-unix-socket-mode: needs to be between 600 and 777" + else pure fileMode + + parseOpenAPIServerProxyURI :: C.Key -> C.Parser C.Config (Maybe Text) + parseOpenAPIServerProxyURI k = + optString k >>= \case + Nothing -> pure Nothing + Just val | isMalformedProxyUri val -> fail "Malformed proxy uri, a correct example: https://example.com:8443/basePath" + | otherwise -> pure $ Just val parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI) parseJwtAudience k = @@ -436,6 +441,12 @@ readAppConfig dbSettings env optPath = do Just "rollback-allow-override" -> pure $ f (True, True) Just _ -> fail "Invalid transaction termination. Check your configuration." + parseRoleClaimKey :: C.Key -> C.Key -> C.Parser C.Config JSPath + parseRoleClaimKey k al = + optWithAlias (optString k) (optString al) >>= \case + Nothing -> pure [JSPKey "role"] + Just rck -> either (fail . show) pure $ pRoleClaimKey rck + reqWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> [Char] -> C.Parser C.Config a reqWithAlias orig alias err = orig >>= \case @@ -503,10 +514,6 @@ readAppConfig dbSettings env optPath = do Nothing -> (> 0) <$> (readMaybe $ toS s :: Maybe Integer) coerceBool _ = Nothing - parseRoleClaimKey :: C.Value -> Either Text JSPath - parseRoleClaimKey (C.String s) = pRoleClaimKey s - parseRoleClaimKey v = pRoleClaimKey $ show v - splitOnCommas :: C.Value -> [Text] splitOnCommas (C.String s) = strip <$> splitOn "," s splitOnCommas _ = [] @@ -520,14 +527,6 @@ readAppConfig dbSettings env optPath = do readValidateConfig :: [(Text, Text)] -> Environment -> Maybe FilePath -> IO AppConfig readValidateConfig dbSettings env path = do conf <- loadDbUriFile =<< loadSecretFile =<< readAppConfig dbSettings env path - -- Checks that the provided proxy uri is formated correctly - when (isMalformedProxyUri $ toS <$> configOpenApiServerProxyUri conf) $ - panic - "Malformed proxy uri, a correct example: https://example.com:8443/basePath" - -- Checks that the provided jspath is valid - whenLeft (configJwtRoleClaimKey conf) panic - -- Check the file mode is valid - whenLeft (configServerUnixSocketMode conf) panic return $ conf { configJWKS = parseSecret <$> configJwtSecret conf} type Environment = M.Map [Char] Text diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index 2719c2b3a..c11b33165 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -312,7 +312,7 @@ pickProxy proxy -- should never happen -- since the request would have been rejected by the middleware if proxy uri -- is malformed - | isMalformedProxyUri proxy = Nothing + | isMalformedProxyUri $ fromMaybe mempty proxy = Nothing | otherwise = Just Proxy { proxyScheme = scheme , proxyHost = host' diff --git a/src/PostgREST/Private/ProxyUri.hs b/src/PostgREST/Private/ProxyUri.hs index 2a2311a99..3b33f9906 100644 --- a/src/PostgREST/Private/ProxyUri.hs +++ b/src/PostgREST/Private/ProxyUri.hs @@ -25,9 +25,8 @@ import Protolude.Conv (toS) http://postgrest.com/openapi.json https://postgrest.com:8080/openapi.json -} -isMalformedProxyUri :: Maybe Text -> Bool -isMalformedProxyUri Nothing = False -isMalformedProxyUri (Just uri) +isMalformedProxyUri :: Text -> Bool +isMalformedProxyUri uri | isAbsoluteURI (toS uri) = not $ isUriValid $ toURI uri | otherwise = True diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index b5475160b..4f92ab23e 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -82,7 +82,7 @@ _baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configDbUri = mempty , configJWKS = parseSecret <$> secret , configJwtAudience = Nothing - , configJwtRoleClaimKey = Right [JSPKey "role"] + , configJwtRoleClaimKey = [JSPKey "role"] , configJwtSecret = secret , configJwtSecretIsBase64 = False , configLogLevel = LogCrit @@ -91,7 +91,7 @@ _baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configServerHost = "localhost" , configServerPort = 3000 , configServerUnixSocket = Nothing - , configServerUnixSocketMode = Right 432 + , configServerUnixSocketMode = 432 , configDbTxAllowOverride = True , configDbTxRollbackAll = True } diff --git a/test/io-tests/fixtures.yaml b/test/io-tests/fixtures.yaml index 42e77e966..838943b7d 100644 --- a/test/io-tests/fixtures.yaml +++ b/test/io-tests/fixtures.yaml @@ -173,5 +173,4 @@ invalidroleclaimkeys: - '.role##' - '.my_role;;domain' - '.#$$%&$%/' - - '' - '1234'