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

Add getCurrentTime cache for jwt validation

Browse Source
This commit is contained in:
steve-chavez
2018-04-30 11:31:06 -05:00
committed by Steve Chávez
parent 58f4b4bc33
commit 5c87fe2704
6 changed files with 40 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files
main/Main.hs
+9 -1
View File
@@ -14,6 +14,9 @@ import PostgREST.OpenAPI (isMalformedProxyUri)
import PostgREST.Types (DbStructure, Schema, PgVersion(..)) import PostgREST.Types (DbStructure, Schema, PgVersion(..))
import Protolude hiding (hPutStrLn, replace) import Protolude hiding (hPutStrLn, replace)
import Control.AutoUpdate (defaultUpdateSettings,
mkAutoUpdate, updateAction)
import Control.Retry (RetryStatus, capDelay, import Control.Retry (RetryStatus, capDelay,
exponentialBackoff, exponentialBackoff,
retrying, rsPreviousDelay) retrying, rsPreviousDelay)
@@ -25,6 +28,7 @@ import Data.String (IsString (..))
import Data.Text (pack, replace, stripPrefix, strip) import Data.Text (pack, replace, stripPrefix, strip)
import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.IO (hPutStrLn) import Data.Text.IO (hPutStrLn)
import Data.Time.Clock (getCurrentTime)
import qualified Hasql.Pool as P import qualified Hasql.Pool as P
import qualified Hasql.Session as H import qualified Hasql.Session as H
import Network.Wai.Handler.Warp (defaultSettings, import Network.Wai.Handler.Warp (defaultSettings,
@@ -206,13 +210,17 @@ main = do
) Nothing ) Nothing
#endif #endif
--
-- ask for the OS time at most once per second
getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime}
-- run the postgrest application -- run the postgrest application
runSettings appSettings $ runSettings appSettings $
postgrest postgrest
conf conf
refDbStructure refDbStructure
pool pool
getTime
(connectionWorker (connectionWorker
mainTid mainTid
pool pool
postgrest.cabal
+7 -2
View File
@@ -29,12 +29,14 @@ executable postgrest
-rtsopts -rtsopts
"-with-rtsopts=-N -I2" "-with-rtsopts=-N -I2"
default-language: Haskell2010 default-language: Haskell2010
build-depends: base build-depends: auto-update
, base
, hasql , hasql
, hasql-pool , hasql-pool
, postgrest , postgrest
, protolude , protolude
, text , text
, time
, warp , warp
, bytestring , bytestring
, base64-bytestring , base64-bytestring
@@ -68,7 +70,7 @@ library
, http-types , http-types
, insert-ordered-containers , insert-ordered-containers
, interpolatedstring-perl6 , interpolatedstring-perl6
, jose >= 0.6 , jose
, lens , lens
, lens-aeson , lens-aeson
, network-uri , network-uri
@@ -81,6 +83,7 @@ library
, scientific , scientific
, swagger2 , swagger2
, text , text
, time
, unordered-containers , unordered-containers
, vector , vector
, wai , wai
@@ -138,6 +141,7 @@ Test-Suite spec
Build-Depends: aeson Build-Depends: aeson
, aeson-qq , aeson-qq
, async , async
, auto-update
, base , base
, bytestring , bytestring
, base64-bytestring , base64-bytestring
@@ -160,6 +164,7 @@ Test-Suite spec
, process , process
, protolude , protolude
, regex-tdfa , regex-tdfa
, time
, transformers-base , transformers-base
, wai , wai
, wai-extra , wai-extra
src/PostgREST/App.hs
+5 -3
View File
@@ -12,6 +12,7 @@ import qualified Data.ByteString.Char8 as BS
import Data.Maybe import Data.Maybe
import Data.IORef (IORef, readIORef) import Data.IORef (IORef, readIORef)
import Data.Text (intercalate) import Data.Text (intercalate)
import Data.Time.Clock (UTCTime)
import qualified Data.Set as S import qualified Data.Set as S
import qualified Hasql.Pool as P import qualified Hasql.Pool as P
@@ -62,12 +63,13 @@ import Data.Function (id)
import Protolude hiding (intercalate, Proxy) import Protolude hiding (intercalate, Proxy)
import Safe (headMay) import Safe (headMay)
postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO () -> Application postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
postgrest conf refDbStructure pool worker = postgrest conf refDbStructure pool getTime worker =
let middle = (if configQuiet conf then id else logStdout) . defaultMiddle let middle = (if configQuiet conf then id else logStdout) . defaultMiddle
jwtSecret = parseJWK <$> configJwtSecret conf in jwtSecret = parseJWK <$> configJwtSecret conf in
middle $ \ req respond -> do middle $ \ req respond -> do
time <- getTime
body <- strictRequestBody req body <- strictRequestBody req
maybeDbStructure <- readIORef refDbStructure maybeDbStructure <- readIORef refDbStructure
case maybeDbStructure of case maybeDbStructure of
@@ -76,7 +78,7 @@ postgrest conf refDbStructure pool worker =
response <- case userApiRequest (configSchema conf) req body of response <- case userApiRequest (configSchema conf) req body of
Left err -> return $ apiRequestError err Left err -> return $ apiRequestError err
Right apiRequest -> do Right apiRequest -> do
eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time
let authed = containsRole eClaims let authed = containsRole eClaims
proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of
src/PostgREST/Auth.hs
+5 -4
View File
@@ -21,6 +21,7 @@ module PostgREST.Auth (
import Control.Lens.Operators import Control.Lens.Operators
import Data.Aeson (Value (..), decode, toJSON) import Data.Aeson (Value (..), decode, toJSON)
import qualified Data.HashMap.Strict as M import qualified Data.HashMap.Strict as M
import Data.Time.Clock (UTCTime)
import Protolude import Protolude
import qualified Crypto.JOSE.Types as JOSE.Types import qualified Crypto.JOSE.Types as JOSE.Types
@@ -38,16 +39,16 @@ data JWTAttempt = JWTInvalid JWTError
Receives the JWT secret and audience (from config) and a JWT and returns a map Receives the JWT secret and audience (from config) and a JWT and returns a map
of JWT claims. of JWT claims.
-} -}
jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> IO JWTAttempt jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> UTCTime -> IO JWTAttempt
jwtClaims _ _ "" = return $ JWTClaims M.empty jwtClaims _ _ "" _ = return $ JWTClaims M.empty
jwtClaims secret audience payload = jwtClaims secret audience payload time =
case secret of case secret of
Nothing -> return JWTMissingSecret Nothing -> return JWTMissingSecret
Just s -> do Just s -> do
let validation = defaultJWTValidationSettings (maybe (const True) (==) audience) let validation = defaultJWTValidationSettings (maybe (const True) (==) audience)
eJwt <- runExceptT $ do eJwt <- runExceptT $ do
jwt <- decodeCompact payload jwt <- decodeCompact payload
verifyClaims validation s jwt verifyClaimsAt validation s time jwt
return $ case eJwt of return $ case eJwt of
Left e -> JWTInvalid e Left e -> JWTInvalid e
Right jwt -> JWTClaims . claims2map $ jwt Right jwt -> JWTClaims . claims2map $ jwt
stack.yaml
+1
View File
@@ -9,6 +9,7 @@ extra-deps:
- hasql-1.1 - hasql-1.1
- hasql-pool-0.4.3 - hasql-pool-0.4.3
- hasql-transaction-0.5.2 - hasql-transaction-0.5.2
- jose-0.7.0.0
ghc-options: ghc-options:
postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
nix: nix:
test/Main.hs
+13 -9
View File
@@ -9,8 +9,10 @@ import PostgREST.App (postgrest)
import PostgREST.Config (pgVersion95, pgVersion96, configSettings) import PostgREST.Config (pgVersion95, pgVersion96, configSettings)
import PostgREST.DbStructure (getDbStructure, getPgVersion, fillSessionWithSettings) import PostgREST.DbStructure (getDbStructure, getPgVersion, fillSessionWithSettings)
import PostgREST.Types (DbStructure(..)) import PostgREST.Types (DbStructure(..))
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction)
import Data.Function (id) import Data.Function (id)
import Data.IORef import Data.IORef
import Data.Time.Clock (getCurrentTime)
import qualified Feature.AuthSpec import qualified Feature.AuthSpec
import qualified Feature.AsymmetricJwtSpec import qualified Feature.AsymmetricJwtSpec
@@ -47,17 +49,19 @@ main = do
dbStructure <- pure $ either (panic.show) id result dbStructure <- pure $ either (panic.show) id result
getTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
refDbStructure <- newIORef $ Just dbStructure refDbStructure <- newIORef $ Just dbStructure
let withApp = return $ postgrest (testCfg testDbConn) refDbStructure pool $ pure () let withApp = return $ postgrest (testCfg testDbConn) refDbStructure pool getTime $ pure ()
ltdApp = return $ postgrest (testLtdRowsCfg testDbConn) refDbStructure pool $ pure () ltdApp = return $ postgrest (testLtdRowsCfg testDbConn) refDbStructure pool getTime $ pure ()
unicodeApp = return $ postgrest (testUnicodeCfg testDbConn) refDbStructure pool $ pure () unicodeApp = return $ postgrest (testUnicodeCfg testDbConn) refDbStructure pool getTime $ pure ()
proxyApp = return $ postgrest (testProxyCfg testDbConn) refDbStructure pool $ pure () proxyApp = return $ postgrest (testProxyCfg testDbConn) refDbStructure pool getTime $ pure ()
noJwtApp = return $ postgrest (testCfgNoJWT testDbConn) refDbStructure pool $ pure () noJwtApp = return $ postgrest (testCfgNoJWT testDbConn) refDbStructure pool getTime $ pure ()
binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool $ pure () binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool getTime $ pure ()
audJwtApp = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool $ pure () audJwtApp = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool getTime $ pure ()
asymJwkApp = return $ postgrest (testCfgAsymJWK testDbConn) refDbStructure pool $ pure () asymJwkApp = return $ postgrest (testCfgAsymJWK testDbConn) refDbStructure pool getTime $ pure ()
nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool $ pure () nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure ()
let reset :: IO () let reset :: IO ()
reset = P.use pool (fillSessionWithSettings (configSettings $ testCfg testDbConn)) >> resetDb testDbConn reset = P.use pool (fillSessionWithSettings (configSettings $ testCfg testDbConn)) >> resetDb testDbConn