refactor: config validation inside readAppConfig
Remove Either from configJwtRoleClaimKey/configServerUnixSocketMode and remove whenLefts.
This commit is contained in:
committed by
Steve Chavez
parent
4344cc9202
commit
17af56adb1
+5
-5
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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'
|
||||
|
||||
@@ -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
@@ -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
|
||||
}
|
||||
|
||||
@@ -173,5 +173,4 @@ invalidroleclaimkeys:
|
||||
- '.role##'
|
||||
- '.my_role;;domain'
|
||||
- '.#$$%&$%/'
|
||||
- ''
|
||||
- '1234'
|
||||
|
||||
Reference in New Issue
Block a user