From 3006e90126c3bed740ef2aa368586837f18b459f Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Thu, 14 Apr 2022 11:03:03 +0200
Subject: [PATCH] Allow IO in JWTSettings' validationKeys

---
 .../src/Servant/Auth/Server/Internal/ConfigTypes.hs        | 4 ++--
 .../src/Servant/Auth/Server/Internal/JWT.hs                | 7 ++++---
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs
index 83e5784d..61e6f33a 100644
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs
+++ b/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.
diff --git a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs
index 57c0630c..0c8c3c54 100644
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs
+++ b/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'
\ No newline at end of file
+      Right v' -> Just v'