refactor: config validation inside readAppConfig

Remove Either from configJwtRoleClaimKey/configServerUnixSocketMode
and remove whenLefts.
This commit is contained in:
steve-chavez
2021-01-22 15:56:08 -05:00
committed by Steve Chavez
parent 4344cc9202
commit 17af56adb1
8 changed files with 38 additions and 41 deletions
+5 -5
View File
@@ -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
+1 -1
View File
@@ -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
+3 -3
View File
@@ -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
+24 -25
View File
@@ -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
+1 -1
View File
@@ -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'
+2 -3
View File
@@ -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
+2 -2
View File
@@ -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
}
-1
View File
@@ -173,5 +173,4 @@ invalidroleclaimkeys:
- '.role##'
- '.my_role;;domain'
- '.#$$%&$%/'
- ''
- '1234'