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