Merge pull request #1580 from haskell-servant/jkarni/servant-auth-io-keyset

Allow IO in JWTSettings' validationKeys

Author: jkarni

changelog.d/1580

@@ -0,0 +1,12 @@
+synopsis: Allow IO in validationKeys
+prs: #1580
+issues: #1579
+
+description: {
+
+Currently validationKeys are a fixed JWKSet. This does not work with OIDC
+providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to
+discover new and expired keys.
+
+This change alters the type of validationKeys from JWKSet to IO JWKSet.
+}

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs

@@ -33,7 +33,7 @@ data JWTSettings = JWTSettings
   -- | Algorithm used to sign JWT.
   , jwtAlg          :: Maybe Jose.Alg
   -- | Keys used to validate JWT.
-  , validationKeys  :: Jose.JWKSet
+  , validationKeys  :: IO Jose.JWKSet
   -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
   -- intended recipient of the JWT.
   , audienceMatches :: Jose.StringOrURI -> IsMatch
@@ -44,7 +44,7 @@ defaultJWTSettings :: Jose.JWK -> JWTSettings
 defaultJWTSettings k = JWTSettings
    { signingKey = k
    , jwtAlg = Nothing
-   , validationKeys = Jose.JWKSet [k]
+   , validationKeys = pure $ Jose.JWKSet [k]
    , audienceMatches = const Matches }
 
 -- | The policies to use when generating cookies.

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs

@@ -58,14 +58,15 @@ makeJWT v cfg expiry = runExceptT $ do
 
 verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
 verifyJWT jwtCfg input = do
-  verifiedJWT <- liftIO $ runExceptT $ do
+  keys <- validationKeys jwtCfg
+  verifiedJWT <- runExceptT $ do
     unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
     Jose.verifyClaims
       (jwtSettingsToJwtValidationSettings jwtCfg)
-      (validationKeys jwtCfg)
+      keys
       unverifiedJWT
   return $ case verifiedJWT of
     Left (_ :: Jose.JWTError) -> Nothing
     Right v -> case decodeJWT v of
       Left _ -> Nothing
-      Right v' -> Just v'
+      Right v' -> Just v'