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

Update jose to 0.6 (#997)

Browse Source
This commit is contained in:
Pi3r
2017-10-15 10:49:25 -04:00
committed by Joe Nelson
parent d1a8c3a6f8
commit 2b5ae34c5a
6 changed files with 117 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files
main/Main.hs
+4 -3
View File
@@ -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
postgrest.cabal
+3 -2
View File
@@ -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
src/PostgREST/Auth.hs
+15 -20
View File
@@ -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))
src/PostgREST/Config.hs
+92 -75
View File
@@ -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 =
stack.yaml
+1 -3
View File
@@ -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:
test/SpecHelper.hs
+2 -2
View File
@@ -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