jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: Remove Protolude.Conv from Config

Browse Source
This commit is contained in:
monacoremo
2021-11-12 20:25:22 +01:00
committed by Remo
parent 2b22f889bd
commit a2c2544271
1 changed files with 10 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/Config.hs
+10 -9
View File
@@ -30,15 +30,17 @@ import qualified Crypto.JOSE.Types as JOSE
import qualified Crypto.JWT as JWT import qualified Crypto.JWT as JWT
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64 as B64
import qualified Data.Configurator as C import qualified Data.Configurator as C
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Control.Lens (preview) import Control.Lens (preview)
import Control.Monad (fail) import Control.Monad (fail)
import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri) import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)
import Data.Aeson (encode, toJSON) import Data.Aeson (toJSON)
import Data.Either.Combinators (mapLeft) import Data.Either.Combinators (mapLeft)
import Data.List (lookup) import Data.List (lookup)
import Data.List.NonEmpty (fromList, toList) import Data.List.NonEmpty (fromList, toList)
@@ -57,8 +59,7 @@ import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
toQi) toQi)
import PostgREST.Request.Types (JoinType (..)) import PostgREST.Request.Types (JoinType (..))
import Protolude hiding (Proxy, toList, toS) import Protolude hiding (Proxy, toList)
import Protolude.Conv (toS)
data AppConfig = AppConfig data AppConfig = AppConfig
@@ -137,14 +138,14 @@ toText conf =
,("db-uri", q . configDbUri) ,("db-uri", q . configDbUri)
,("db-embed-default-join", q . dumpJoin . configDbEmbedDefaultJoin) ,("db-embed-default-join", q . dumpJoin . configDbEmbedDefaultJoin)
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs) ,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience) ,("jwt-aud", T.decodeUtf8 . LBS.toStrict . JSON.encode . maybe "" toJSON . configJwtAudience)
,("jwt-role-claim-key", q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey) ,("jwt-role-claim-key", q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
,("jwt-secret", q . toS . showJwtSecret) ,("jwt-secret", q . T.decodeUtf8 . showJwtSecret)
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64) ,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
,("log-level", q . dumpLogLevel . configLogLevel) ,("log-level", q . dumpLogLevel . configLogLevel)
,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode) ,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode)
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri) ,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
,("raw-media-types", q . toS . BS.intercalate "," . configRawMediaTypes) ,("raw-media-types", q . T.decodeUtf8 . BS.intercalate "," . configRawMediaTypes)
,("server-host", q . configServerHost) ,("server-host", q . configServerHost)
,("server-port", show . configServerPort) ,("server-port", show . configServerPort)
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket) ,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
@@ -164,7 +165,7 @@ toText conf =
( True , True ) -> "rollback-allow-override" ( True , True ) -> "rollback-allow-override"
showJwtSecret c showJwtSecret c
| configJwtSecretIsBase64 c = B64.encode secret | configJwtSecretIsBase64 c = B64.encode secret
| otherwise = toS secret | otherwise = secret
where where
secret = fromMaybe mempty $ configJwtSecret c secret = fromMaybe mempty $ configJwtSecret c
showSocketMode c = showOct (configServerUnixSocketMode c) mempty showSocketMode c = showOct (configServerUnixSocketMode c) mempty
@@ -438,8 +439,8 @@ parseSecret bytes =
fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK) fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK)
maybeJWKSet maybeJWKSet
where where
maybeJWKSet = JSON.decode (toS bytes) :: Maybe JWKSet maybeJWKSet = JSON.decodeStrict bytes :: Maybe JWKSet
maybeJWK = JSON.decode (toS bytes) :: Maybe JWK maybeJWK = JSON.decodeStrict bytes :: Maybe JWK
secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial] secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial]
keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes