module PostgREST.Auth (
containsRole
, jwtClaims
, JWTAttempt(..)
, parseJWK
) where
import Control.Lens.Operators
import Data.Aeson (Value (..), decode, toJSON)
import qualified Data.HashMap.Strict as M
import Protolude
import qualified Crypto.JOSE.Types as JOSE.Types
import Crypto.JWT
data JWTAttempt = JWTInvalid JWTError
| JWTMissingSecret
| JWTClaims (M.HashMap Text Value)
deriving (Eq, Show)
jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> IO JWTAttempt
jwtClaims _ _ "" = return $ JWTClaims M.empty
jwtClaims secret audience payload =
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
return $ case eJwt of
Left e -> JWTInvalid e
Right jwt -> JWTClaims . claims2map $ jwt
containsRole :: JWTAttempt -> Bool
containsRole (JWTClaims claims) = M.member "role" claims
containsRole _ = False
claims2map :: ClaimsSet -> M.HashMap Text Value
claims2map = val2map . toJSON
where
val2map (Object o) = o
val2map _ = M.empty
parseJWK :: ByteString -> JWK
parseJWK str =
fromMaybe (hs256jwk str) (decode (toS str) :: Maybe JWK)
hs256jwk :: ByteString -> JWK
hs256jwk key =
fromKeyMaterial km
& jwkUse .~ Just Sig
& jwkAlg .~ (Just $ JWSAlg HS256)
where
km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))