diff --git a/main/Main.hs b/main/Main.hs index 161ae8887..180f93f42 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -2,6 +2,7 @@ module Main where + import PostgREST.App (postgrest) import PostgREST.Config (AppConfig (..), PgVersion (..), @@ -11,19 +12,19 @@ import PostgREST.DbStructure (getDbStructure) import PostgREST.Error (encodeError) import PostgREST.OpenAPI (isMalformedProxyUri) import PostgREST.Types (DbStructure, Schema) -import Protolude hiding (replace, hPutStrLn) +import Protolude hiding (hPutStrLn, replace) import Control.Retry (RetryStatus, capDelay, exponentialBackoff, retrying, rsPreviousDelay) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef) import Data.String (IsString (..)) import Data.Text (pack, replace, stripPrefix, strip) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.IO (hPutStrLn) -import qualified Data.ByteString.Base64 as B64 -import qualified Data.ByteString as BS import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE import qualified Hasql.Pool as P diff --git a/postgrest.cabal b/postgrest.cabal index d847f6f80..0d43cad06 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -66,7 +66,7 @@ library , http-types , insert-ordered-containers , interpolatedstring-perl6 - , jose < 0.6 + , jose >= 0.6 , lens , lens-aeson , network-uri @@ -110,7 +110,8 @@ Test-Suite spec ghc-options: -threaded -rtsopts -with-rtsopts=-N Hs-Source-Dirs: test Main-Is: Main.hs - Other-Modules: Feature.AuthSpec + Other-Modules: Feature.AudienceJwtSecretSpec + , Feature.AuthSpec , Feature.AsymmetricJwtSpec , Feature.BinaryJwtSecretSpec , Feature.ConcurrentSpec diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 775ba38b6..dd93adb81 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -18,16 +18,12 @@ module PostgREST.Auth ( , parseJWK ) where -import Protolude hiding ((&)) -import Control.Lens -import Data.Aeson (Value (..), decode, toJSON) -import qualified Data.ByteString.Lazy as BL -import qualified Data.HashMap.Strict as M +import Control.Lens.Operators +import Data.Aeson (Value (..), decode, toJSON) +import qualified Data.HashMap.Strict as M +import Protolude -import Crypto.JOSE.Compact -import Crypto.JOSE.JWK -import Crypto.JOSE.JWS -import Crypto.JOSE.Types +import qualified Crypto.JOSE.Types as JOSE.Types import Crypto.JWT {-| @@ -42,27 +38,26 @@ data JWTAttempt = JWTInvalid JWTError Receives the JWT secret and audience (from config) and a JWT and returns a map of JWT claims. -} -jwtClaims :: Maybe JWK -> Text -> BL.ByteString -> IO JWTAttempt -jwtClaims _ "" "" = return $ JWTClaims M.empty +jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> IO JWTAttempt +jwtClaims _ Nothing "" = return $ JWTClaims M.empty jwtClaims secret audience payload = case secret of Nothing -> return JWTMissingSecret - Just jwk -> do - let validation = set audiencePredicate (== fromString audience) defaultJWTValidationSettings + Just s -> do + let validation = defaultJWTValidationSettings (maybe (const True) (==) audience) eJwt <- runExceptT $ do jwt <- decodeCompact payload - validateJWSJWT validation jwk jwt - return jwt + verifyClaims validation s jwt return $ case eJwt of - Left e -> JWTInvalid e - Right jwt -> JWTClaims . claims2map . jwtClaimsSet $ jwt + Left e -> JWTInvalid e + Right jwt -> JWTClaims . claims2map $ jwt {-| Whether a response from jwtClaims contains a role claim -} containsRole :: JWTAttempt -> Bool containsRole (JWTClaims claims) = M.member "role" claims -containsRole _ = False +containsRole _ = False {-| Internal helper used to turn JWT ClaimSet into something @@ -72,7 +67,7 @@ claims2map :: ClaimsSet -> M.HashMap Text Value claims2map = val2map . toJSON where val2map (Object o) = o - val2map _ = M.empty + val2map _ = M.empty parseJWK :: ByteString -> JWK parseJWK str = @@ -89,4 +84,4 @@ hs256jwk key = & jwkUse .~ Just Sig & jwkAlg .~ (Just $ JWSAlg HS256) where - km = OctKeyMaterial (OctKeyParameters Oct (Base64Octets key)) + km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key)) diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index b16393d2d..5f67cd60f 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-| Module : PostgREST.Config @@ -23,30 +24,38 @@ module PostgREST.Config ( prettyVersion ) where -import System.IO.Error (IOError) import Control.Applicative -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BS -import qualified Data.CaseInsensitive as CI -import qualified Data.Configurator as C -import qualified Data.Configurator.Parser as C -import Data.Configurator.Types (Value(..)) -import Data.List (lookup) +import Control.Monad (fail) +import Control.Lens (preview) +import Crypto.JWT (StringOrURI, + stringOrUri) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI +import qualified Data.Configurator as C +import qualified Data.Configurator.Parser as C +import Data.Configurator.Types as C +import Data.List (lookup) import Data.Monoid -import Data.Scientific (floatingOrInteger) -import Data.Text (strip, intercalate, lines, dropAround) -import Data.Text.Encoding (encodeUtf8) -import Data.Text.IO (hPutStrLn) -import Data.Version (versionBranch) +import Data.Scientific (floatingOrInteger) +import Data.String (String) +import Data.Text (dropAround, + intercalate, lines, + strip) +import Data.Text.Encoding (encodeUtf8) +import Data.Text.IO (hPutStrLn) +import Data.Version (versionBranch) import Network.Wai -import Network.Wai.Middleware.Cors (CorsResourcePolicy (..)) -import Options.Applicative hiding (str) -import Paths_postgrest (version) -import System.IO (hPrint) +import Network.Wai.Middleware.Cors (CorsResourcePolicy (..)) +import Options.Applicative hiding (str) +import Paths_postgrest (version) +import Protolude hiding (hPutStrLn, + intercalate, (<>)) +import System.IO (hPrint) +import System.IO.Error (IOError) import Text.Heredoc -import Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>)) +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>)) import qualified Text.PrettyPrint.ANSI.Leijen as L -import Protolude hiding (intercalate, (<>), hPutStrLn) -- | Config file settings for the server data AppConfig = AppConfig { @@ -59,7 +68,7 @@ data AppConfig = AppConfig { , configJwtSecret :: Maybe B.ByteString , configJwtSecretIsBase64 :: Bool - , configJwtAudience :: Text + , configJwtAudience :: Maybe StringOrURI , configPool :: Int , configMaxRows :: Maybe Integer @@ -108,9 +117,9 @@ readOptions = do (C.readConfig =<< C.load [C.Required cfgPath]) configNotfoundHint - let (mAppConf, errs) = flip C.runParserA conf $ - AppConfig <$> - C.key "db-uri" + let (mAppConf, errs) = flip C.runParserM conf $ + AppConfig + <$> C.key "db-uri" <*> C.key "db-anon-role" <*> (mfilter (/= "") <$> C.key "server-proxy-uri") <*> C.key "db-schema" @@ -118,7 +127,7 @@ readOptions = do <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port") <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret") <*> (fromMaybe False . join . fmap coerceBool <$> C.key "secret-is-base64") - <*> (fromMaybe "" <$> C.key "jwt-aud") + <*> parseJwtAudience "jwt-aud" <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool") <*> (join . fmap coerceInt <$> C.key "max-rows") <*> (mfilter (/= "") <$> C.key "pre-request") @@ -131,62 +140,70 @@ readOptions = do Just appConf -> return appConf - where - coerceInt :: (Read i, Integral i) => Value -> Maybe i - coerceInt (Number x) = rightToMaybe $ floatingOrInteger x - coerceInt (String x) = readMaybe $ toS x - coerceInt _ = Nothing + where + parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI) + parseJwtAudience k = + C.key k >>= \case + Nothing -> pure Nothing -- no audience in config file + Just aud -> case preview stringOrUri (aud :: String) of + Nothing -> fail "Invalid Jwt audience. Check your configuration." + aud' -> pure aud' - coerceBool :: Value -> Maybe Bool - coerceBool (Bool b) = Just b - coerceBool (String x) = readMaybe $ toS x - coerceBool _ = Nothing + coerceInt :: (Read i, Integral i) => Value -> Maybe i + coerceInt (Number x) = rightToMaybe $ floatingOrInteger x + coerceInt (String x) = readMaybe $ toS x + coerceInt _ = Nothing - opts = info (helper <*> pathParser) $ - fullDesc - <> progDesc ( - "PostgREST " - <> toS prettyVersion - <> " / create a REST API to an existing Postgres database" - ) - <> footerDoc (Just $ - text "Example Config File:" - L.<> nest 2 (hardline L.<> exampleCfg) - ) + coerceBool :: Value -> Maybe Bool + coerceBool (Bool b) = Just b + coerceBool (String x) = readMaybe $ toS x + coerceBool _ = Nothing - parserPrefs = prefs showHelpOnError + opts = info (helper <*> pathParser) $ + fullDesc + <> progDesc ( + "PostgREST " + <> toS prettyVersion + <> " / create a REST API to an existing Postgres database" + ) + <> footerDoc (Just $ + text "Example Config File:" + L.<> nest 2 (hardline L.<> exampleCfg) + ) - configNotfoundHint :: IOError -> IO a - configNotfoundHint e = do - hPutStrLn stderr $ - "Cannot open config file:\n\t" <> show e - exitFailure + parserPrefs = prefs showHelpOnError - exampleCfg :: Doc - exampleCfg = vsep . map (text . toS) . lines $ - [str|db-uri = "postgres://user:pass@localhost:5432/dbname" - |db-schema = "public" - |db-anon-role = "postgres" - |db-pool = 10 - | - |server-host = "*4" - |server-port = 3000 - | - |## base url for swagger output - |# server-proxy-uri = "" - | - |## choose a secret to enable JWT auth - |## (use "@filename" to load from separate file) - |# jwt-secret = "foo" - |# secret-is-base64 = false - |# jwt-aud = "your_audience_claim" - | - |## limit rows in response - |# max-rows = 1000 - | - |## stored proc to exec immediately after auth - |# pre-request = "stored_proc_name" - |] + configNotfoundHint :: IOError -> IO a + configNotfoundHint e = do + hPutStrLn stderr $ + "Cannot open config file:\n\t" <> show e + exitFailure + + exampleCfg :: Doc + exampleCfg = vsep . map (text . toS) . lines $ + [str|db-uri = "postgres://user:pass@localhost:5432/dbname" + |db-schema = "public" + |db-anon-role = "postgres" + |db-pool = 10 + | + |server-host = "*4" + |server-port = 3000 + | + |## base url for swagger output + |# server-proxy-uri = "" + | + |## choose a secret to enable JWT auth + |## (use "@filename" to load from separate file) + |# jwt-secret = "foo" + |# secret-is-base64 = false + |# jwt-aud = "your_audience_claim" + | + |## limit rows in response + |# max-rows = 1000 + | + |## stored proc to exec immediately after auth + |# pre-request = "stored_proc_name" + |] pathParser :: Parser FilePath pathParser = diff --git a/stack.yaml b/stack.yaml index 3665baf1e..22c3bf7c3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,11 +1,9 @@ -resolver: lts-9.0 +resolver: lts-9.6 extra-deps: - configurator-ng-0.0.0.1 - critbit-0.2.0.0 - - hasql-pool-0.4.1 - hjsonpointer-1.1.1 - hjsonschema-1.5.0.1 - - jose-0.5.0.3 - Ranged-sets-0.3.0 - protolude-0.2 ghc-options: diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 59d0f69c7..095a44e9c 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -68,7 +68,7 @@ _baseCfg :: AppConfig _baseCfg = -- Connection Settings AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000 -- Jwt settings - (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False "" + (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False Nothing -- Connection Modifiers 10 Nothing (Just "test.switch_role") -- Debug Settings @@ -99,7 +99,7 @@ testCfgAudienceJWT :: Text -> AppConfig testCfgAudienceJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Just . B64.decodeLenient $ "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=", - configJwtAudience = "youraudience" + configJwtAudience = Just "youraudience" } testCfgAsymJWK :: Text -> AppConfig