@@ -19,6 +19,9 @@ module PostgREST.Config
1919 , LogLevel (.. )
2020 , OpenAPIMode (.. )
2121 , Proxy (.. )
22+ , CfgAud
23+ , audMatchesCfg
24+ , parseCfgAud
2225 , toText
2326 , isMalformedProxyUri
2427 , readAppConfig
@@ -28,6 +31,7 @@ module PostgREST.Config
2831 , addFallbackAppName
2932 , addTargetSessionAttrs
3033 , exampleConfigFile
34+ , defaultCfgAud
3135 ) where
3236
3337import qualified Data.Aeson as JSON
@@ -49,7 +53,7 @@ import Data.List.NonEmpty (fromList, toList)
4953import Data.Maybe (fromJust )
5054import Data.Scientific (floatingOrInteger )
5155import Jose.Jwk (Jwk , JwkSet )
52- import Network.URI (escapeURIString , isURI ,
56+ import Network.URI (escapeURIString ,
5357 isUnescapedInURIComponent )
5458import Numeric (readOct , showOct )
5559import System.Environment (getEnvironment )
@@ -65,8 +69,24 @@ import PostgREST.Config.Proxy (Proxy (..),
6569import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier , dumpQi ,
6670 toQi )
6771
68- import Protolude hiding (Proxy , toList )
72+ import Protolude hiding (Proxy , toList )
73+ import qualified Text.Regex.TDFA as R
6974
75+ data ParsedValue a = ParsedValue {
76+ sourceValue :: Text ,
77+ parsedValue :: a
78+ }
79+
80+ newtype CfgAud = CfgAud { unCfgAud :: ParsedValue R. Regex }
81+
82+ parseCfgAud :: Text -> CfgAud
83+ parseCfgAud = CfgAud . (ParsedValue <*> (R. makeRegex . (" \\ `(" <> ) . (<> " \\ ')" )))
84+
85+ defaultCfgAud :: CfgAud
86+ defaultCfgAud = parseCfgAud " "
87+
88+ audMatchesCfg :: CfgAud -> Text -> Bool
89+ audMatchesCfg = R. matchTest . parsedValue . unCfgAud
7090
7191data AppConfig = AppConfig
7292 { configAppSettings :: [(Text , Text )]
@@ -94,7 +114,7 @@ data AppConfig = AppConfig
94114 , configDbUri :: Text
95115 , configFilePath :: Maybe FilePath
96116 , configJWKS :: Maybe JwkSet
97- , configJwtAudience :: Maybe Text
117+ , configJwtAudience :: CfgAud
98118 , configJwtRoleClaimKey :: JSPath
99119 , configJwtSecret :: Maybe BS. ByteString
100120 , configJwtSecretIsBase64 :: Bool
@@ -166,7 +186,7 @@ toText conf =
166186 ,(" db-pre-config" , q . maybe mempty dumpQi . configDbPreConfig)
167187 ,(" db-tx-end" , q . showTxEnd)
168188 ,(" db-uri" , q . configDbUri)
169- ,(" jwt-aud" , q . fromMaybe mempty . configJwtAudience)
189+ ,(" jwt-aud" , q . sourceValue . unCfgAud . configJwtAudience)
170190 ,(" jwt-role-claim-key" , q . T. intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
171191 ,(" jwt-secret" , q . T. decodeUtf8 . showJwtSecret)
172192 ,(" jwt-secret-is-base64" , T. toLower . show . configJwtSecretIsBase64)
@@ -274,7 +294,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
274294 <*> (fromMaybe " postgresql://" <$> optString " db-uri" )
275295 <*> pure optPath
276296 <*> pure Nothing
277- <*> optStringOrURI " jwt-aud"
297+ <*> ( maybe defaultCfgAud parseCfgAud <$> optString " jwt-aud" )
278298 <*> parseRoleClaimKey " jwt-role-claim-key" " role-claim-key"
279299 <*> (fmap encodeUtf8 <$> optString " jwt-secret" )
280300 <*> (fromMaybe False <$> optWithAlias
@@ -392,20 +412,6 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
392412 optStringEmptyable :: C. Key -> C. Parser C. Config (Maybe Text )
393413 optStringEmptyable k = overrideFromDbOrEnvironment C. optional k coerceText
394414
395- optStringOrURI :: C. Key -> C. Parser C. Config (Maybe Text )
396- optStringOrURI k = do
397- stringOrURI <- mfilter (/= " " ) <$> overrideFromDbOrEnvironment C. optional k coerceText
398- -- If the string contains ':' then it should
399- -- be a valid URI according to RFC 3986
400- case stringOrURI of
401- Just s -> if T. isInfixOf " :" s then validateURI s else return (Just s)
402- Nothing -> return Nothing
403- where
404- validateURI :: Text -> C. Parser C. Config (Maybe Text )
405- validateURI s = if isURI (T. unpack s)
406- then return $ Just s
407- else fail " jwt-aud should be a string or a valid URI"
408-
409415 optInt :: (Read i , Integral i ) => C. Key -> C. Parser C. Config (Maybe i )
410416 optInt k = join <$> overrideFromDbOrEnvironment C. optional k coerceInt
411417
0 commit comments