refactor: Use jose-jwt instead of hs-jose

This removes one more dependency on Template Haskell.

nix/overlays/haskell-packages.nix

@@ -59,6 +59,8 @@ let
 
       hasql-pool = lib.dontCheck prev.hasql-pool_1_0_1;
 
+      jose-jwt = prev.jose-jwt_0_10_0;
+
       postgresql-libpq = lib.dontCheck
         (prev.postgresql-libpq.override {
           postgresql = super.libpq;

postgrest.cabal

@@ -115,7 +115,7 @@ library
                     , heredoc                   >= 0.2 && < 0.3
                     , http-types                >= 0.12.2 && < 0.13
                     , insert-ordered-containers >= 0.2.2 && < 0.3
-                    , jose                      >= 0.8.5.1 && < 0.12
+                    , jose-jwt                  >= 0.9.6 && < 0.11
                     , lens                      >= 4.14 && < 5.3
                     , lens-aeson                >= 1.0.1 && < 1.3
                     , mtl                       >= 2.2.2 && < 2.4

src/PostgREST/Auth.hs

@@ -19,7 +19,6 @@ module PostgREST.Auth
   , middleware
   ) where
 
-import qualified Crypto.JWT                      as JWT
 import qualified Data.Aeson                      as JSON
 import qualified Data.Aeson.Key                  as K
 import qualified Data.Aeson.KeyMap               as KM
@@ -30,11 +29,12 @@ import qualified Data.Cache                      as C
 import qualified Data.Scientific                 as Sci
 import qualified Data.Vault.Lazy                 as Vault
 import qualified Data.Vector                     as V
+import qualified Jose.Jwk                        as JWT
+import qualified Jose.Jwt                        as JWT
 import qualified Network.HTTP.Types.Header       as HTTP
 import qualified Network.Wai                     as Wai
 import qualified Network.Wai.Middleware.HttpAuth as Wai
 
-import Control.Lens            (set)
 import Control.Monad.Except    (liftEither)
 import Data.Either.Combinators (mapLeft)
 import Data.List               (lookup)
@@ -54,25 +54,57 @@ import Protolude
 
 -- | Receives the JWT secret and audience (from config) and a JWT and returns a
 -- JSON object of JWT claims.
-parseToken :: Monad m =>
+parseToken :: AppConfig -> ByteString -> UTCTime -> ExceptT Error IO JSON.Value
-  AppConfig -> LByteString -> UTCTime -> ExceptT Error m JSON.Value
 parseToken _ "" _ = return JSON.emptyObject
 parseToken AppConfig{..} token time = do
   secret <- liftEither . maybeToRight JwtTokenMissing $ configJWKS
-  eitherClaims <-
+  eitherContent <- liftIO $ JWT.decode (JWT.keys secret) Nothing token
-    lift . runExceptT $
+  content <- liftEither . mapLeft jwtDecodeError $ eitherContent
-      JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact token
+  liftEither $ verifyClaims content
-  liftEither . mapLeft jwtClaimsError $ JSON.toJSON <$> eitherClaims
   where
-    validation =
+      -- TODO: Improve errors, those were just taken as-is from hs-jose to avoid
-      JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 30
+      -- breaking changes.
+      jwtDecodeError :: JWT.JwtError -> Error
+      jwtDecodeError (JWT.KeyError _)     = JwtTokenInvalid "JWSError JWSInvalidSignature"
+      jwtDecodeError JWT.BadCrypto        = JwtTokenInvalid "JWSError (CompactDecodeError Invalid number of parts: Expected 3 parts; got 2)"
+      jwtDecodeError (JWT.BadAlgorithm _) = JwtTokenInvalid "JWSError JWSNoSignatures"
+      jwtDecodeError e                    = JwtTokenInvalid $ show e
 
-    audienceCheck :: JWT.StringOrURI -> Bool
+      verifyClaims :: JWT.JwtContent -> Either Error JSON.Value
-    audienceCheck = maybe (const True) (==) configJwtAudience
+      verifyClaims (JWT.Jws (_, claims)) = case JSON.decodeStrict claims of
+        Nothing                    -> Left $ JwtTokenInvalid "Parsing claims failed"
+        Just (JSON.Object mclaims)
+          | failedExpClaim mclaims -> Left $ JwtTokenInvalid "JWT expired"
+          | failedNbfClaim mclaims -> Left $ JwtTokenInvalid "JWTNotYetValid"
+          | failedIatClaim mclaims -> Left $ JwtTokenInvalid "JWTIssuedAtFuture"
+          | failedAudClaim mclaims -> Left $ JwtTokenInvalid "JWTNotInAudience"
+        Just jclaims               -> Right jclaims
+      -- TODO: We could enable JWE support here (encrypted tokens)
+      verifyClaims _                = Left $ JwtTokenInvalid "Unsupported token type"
 
-    jwtClaimsError :: JWT.JWTError -> Error
+      allowedSkewSeconds = 30 :: Int64
-    jwtClaimsError JWT.JWTExpired = JwtTokenInvalid "JWT expired"
+      now = floor . nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time
-    jwtClaimsError e              = JwtTokenInvalid $ show e
+      sciToInt = fromMaybe 0 . Sci.toBoundedInteger
+
+      failedExpClaim :: KM.KeyMap JSON.Value -> Bool
+      failedExpClaim mclaims = case KM.lookup "exp" mclaims of
+        Just (JSON.Number secs) -> now > (sciToInt secs + allowedSkewSeconds)
+        _                       -> False
+
+      failedNbfClaim :: KM.KeyMap JSON.Value -> Bool
+      failedNbfClaim mclaims = case KM.lookup "nbf" mclaims of
+        Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds)
+        _                       -> False
+
+      failedIatClaim :: KM.KeyMap JSON.Value -> Bool
+      failedIatClaim mclaims = case KM.lookup "iat" mclaims of
+        Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds)
+        _                       -> False
+
+      failedAudClaim :: KM.KeyMap JSON.Value -> Bool
+      failedAudClaim mclaims = case KM.lookup "aud" mclaims of
+        Just (JSON.String str) -> maybe (const False) (/=) configJwtAudience str
+        _                      -> False
 
 parseClaims :: Monad m =>
   AppConfig -> JSON.Value -> ExceptT Error m AuthResult
@@ -105,7 +137,7 @@ middleware appState app req respond = do
   time <- getTime appState
 
   let token  = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
-      parseJwt = runExceptT $ parseToken conf (LBS.fromStrict token) time >>= parseClaims conf
+      parseJwt = runExceptT $ parseToken conf token time >>= parseClaims conf
 
 -- If DbPlanEnabled       -> calculate JWT validation time
 -- If JwtCacheMaxLifetime -> cache JWT validation result

src/PostgREST/Config.hs

@@ -28,27 +28,24 @@ module PostgREST.Config
   , addTargetSessionAttrs
   ) where
 
-import qualified Crypto.JOSE.Types      as JOSE
-import qualified Crypto.JWT             as JWT
 import qualified Data.Aeson             as JSON
 import qualified Data.ByteString        as BS
 import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Lazy   as LBS
 import qualified Data.CaseInsensitive   as CI
 import qualified Data.Configurator      as C
 import qualified Data.Map.Strict        as M
 import qualified Data.Text              as T
 import qualified Data.Text.Encoding     as T
+import qualified Jose.Jwa               as JWT
+import qualified Jose.Jwk               as JWT
 
-import Control.Lens            (preview)
 import Control.Monad           (fail)
-import Crypto.JWT              (JWK, JWKSet, StringOrURI, stringOrUri)
-import Data.Aeson              (toJSON)
 import Data.Either.Combinators (mapLeft)
 import Data.List               (lookup)
 import Data.List.NonEmpty      (fromList, toList)
 import Data.Maybe              (fromJust)
 import Data.Scientific         (floatingOrInteger)
+import Jose.Jwk                (Jwk, JwkSet)
 import Network.URI             (escapeURIString,
                                 isUnescapedInURIComponent)
 import Numeric                 (readOct, showOct)
@@ -92,8 +89,8 @@ data AppConfig = AppConfig
   , configDbTxRollbackAll          :: Bool
   , configDbUri                    :: Text
   , configFilePath                 :: Maybe FilePath
-  , configJWKS                     :: Maybe JWKSet
+  , configJWKS                     :: Maybe JwkSet
-  , configJwtAudience              :: Maybe StringOrURI
+  , configJwtAudience              :: Maybe Text
   , configJwtRoleClaimKey          :: JSPath
   , configJwtSecret                :: Maybe BS.ByteString
   , configJwtSecretIsBase64        :: Bool
@@ -163,7 +160,7 @@ toText conf =
       ,("db-pre-config",             q . maybe mempty dumpQi . configDbPreConfig)
       ,("db-tx-end",                 q . showTxEnd)
       ,("db-uri",                    q . configDbUri)
-      ,("jwt-aud",                       T.decodeUtf8 . LBS.toStrict . JSON.encode . maybe "" toJSON . configJwtAudience)
+      ,("jwt-aud",                   q . fromMaybe mempty . configJwtAudience)
       ,("jwt-role-claim-key",        q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
       ,("jwt-secret",                q . T.decodeUtf8 . showJwtSecret)
       ,("jwt-secret-is-base64",          T.toLower . show . configJwtSecretIsBase64)
@@ -267,7 +264,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     <*> (fromMaybe "postgresql://" <$> optString "db-uri")
     <*> pure optPath
     <*> pure Nothing
-    <*> parseJwtAudience "jwt-aud"
+    <*> optString "jwt-aud"
     <*> parseRoleClaimKey "jwt-role-claim-key" "role-claim-key"
     <*> (fmap encodeUtf8 <$> optString "jwt-secret")
     <*> (fromMaybe False <$> optWithAlias
@@ -326,14 +323,6 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
         Just val | isMalformedProxyUri val -> fail "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
                  | otherwise               -> pure $ Just val
 
-    parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
-    parseJwtAudience k =
-      optString k >>= \case
-        Nothing -> pure Nothing -- no audience in config file
-        Just aud -> case preview stringOrUri (T.unpack aud) of
-          Nothing -> fail "Invalid Jwt audience. Check your configuration."
-          aud' -> pure aud'
-
     parseLogLevel :: C.Key -> C.Parser C.Config LogLevel
     parseLogLevel k =
       optString k >>= \case
@@ -447,24 +436,23 @@ decodeSecret conf@AppConfig{..} =
     decodeB64 = B64.decode . encodeUtf8 . T.strip . replaceUrlChars . decodeUtf8
     replaceUrlChars = T.replace "_" "/" . T.replace "-" "+" . T.replace "." "="
 
--- | Parse `jwt-secret` configuration option and turn into a JWKSet.
+-- | Parse `jwt-secret` configuration option and turn into a JWKS.
 --
 -- There are three ways to specify `jwt-secret`: text secret, JSON Web Key
--- (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JWKSet
+-- (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JwkSet
 -- with one key and the last is converted as is.
 decodeJWKS :: AppConfig -> AppConfig
 decodeJWKS conf =
   conf { configJWKS = parseSecret <$> configJwtSecret conf }
 
-parseSecret :: ByteString -> JWKSet
+parseSecret :: ByteString -> JwkSet
 parseSecret bytes =
-  fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK)
+  fromMaybe (maybe secret (\jwk' -> JWT.JwkSet [jwk']) maybeJWK)
     maybeJWKSet
   where
-    maybeJWKSet = JSON.decodeStrict bytes :: Maybe JWKSet
+    maybeJWKSet = JSON.decodeStrict bytes :: Maybe JwkSet
-    maybeJWK = JSON.decodeStrict bytes :: Maybe JWK
+    maybeJWK = JSON.decodeStrict bytes :: Maybe Jwk
-    secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial]
+    secret = JWT.JwkSet [JWT.SymmetricJwk bytes Nothing (Just JWT.Sig) (Just $ JWT.Signed JWT.HS256)]
-    keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes
 
 -- | Read database uri from a separate file if `db-uri` is a filepath.
 readDbUriFile :: Maybe Text -> AppConfig -> IO AppConfig