Merge pull request #603 from diogob/refactor-jwtClaims
jwtClaims should always return Left for invalid JWT
This commit is contained in:
+12
-14
@@ -25,7 +25,7 @@ import Data.Aeson.Types (parseMaybe, emptyObject, emptyArray)
|
|||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as M
|
||||||
import Data.Maybe (fromMaybe, maybeToList)
|
import Data.Maybe (fromMaybe, maybeToList, fromJust)
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
@@ -52,22 +52,20 @@ claimsToSQL claims = roleStmts <> varStmts
|
|||||||
{-|
|
{-|
|
||||||
Receives the JWT secret (from config) and a JWT and
|
Receives the JWT secret (from config) and a JWT and
|
||||||
returns a map of JWT claims
|
returns a map of JWT claims
|
||||||
In case there is any problem decoding the JWT it returns Nothing.
|
In case there is any problem decoding the JWT it returns an error Text
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
|
||||||
jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value)
|
jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value)
|
||||||
jwtClaims secret input time =
|
jwtClaims _ "" _ = Right M.empty
|
||||||
case mClaims of
|
jwtClaims secret jwt time =
|
||||||
Nothing -> Right M.empty
|
case isExpired <$> mClaims of
|
||||||
Just claims -> do
|
Just True -> Left "JWT expired"
|
||||||
let mExp = claims ^? key "exp" . _Integer
|
Nothing -> Left "Invalid JWT"
|
||||||
expired = fromMaybe False $ (<= time) . fromInteger <$> mExp
|
Just False -> Right $ value2map $ fromJust mClaims
|
||||||
if expired
|
|
||||||
then Left "JWT expired"
|
|
||||||
else Right (value2map claims)
|
|
||||||
where
|
where
|
||||||
mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret input
|
isExpired claims =
|
||||||
|
let mExp = claims ^? key "exp" . _Integer
|
||||||
|
in fromMaybe False $ (<= time) . fromInteger <$> mExp
|
||||||
|
mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret jwt
|
||||||
value2map (Object o) = o
|
value2map (Object o) = o
|
||||||
value2map _ = M.empty
|
value2map _ = M.empty
|
||||||
|
|
||||||
|
|||||||
@@ -30,10 +30,7 @@ runWithClaims :: AppConfig -> Either Text (M.HashMap Text Value) ->
|
|||||||
runWithClaims conf eClaims app req =
|
runWithClaims conf eClaims app req =
|
||||||
case eClaims of
|
case eClaims of
|
||||||
Left e -> clientErr e
|
Left e -> clientErr e
|
||||||
Right claims ->
|
Right claims -> do
|
||||||
if M.null claims && not (null $ iJWT req)
|
|
||||||
then clientErr "Invalid JWT"
|
|
||||||
else do
|
|
||||||
-- role claim defaults to anon if not specified in jwt
|
-- role claim defaults to anon if not specified in jwt
|
||||||
H.sql . mconcat . claimsToSQL $ M.union claims (M.singleton "role" anon)
|
H.sql . mconcat . claimsToSQL $ M.union claims (M.singleton "role" anon)
|
||||||
app req
|
app req
|
||||||
|
|||||||
Reference in New Issue
Block a user