Port code to use version 0.10 of the jose package

Required changes for jose 0.10.

CHANGES.md

@@ -2,6 +2,14 @@
 
 ## Version 0.2.0 (February 17, 2023)
 
+  * Due to breaking changes in the `jose` package:
+
+    - Versions before 0.10 are no longer supported
+
+    - Orphan instances of `MonadRandom` were removed from `jose` so
+      you may need to create your own `Monad` that implements
+      `MonadRandom`
+
   * Tolerate non-standard client authentication methods in discovery
     documents via a new constructor (@ondrap)
 

flake.nix

@@ -14,7 +14,9 @@
       packageName = "openid-connect";
 
       # Haskell package overrides:
-      packageOverrides = haskell: { };
+      packageOverrides = haskell: {
+        jose = haskell.jose_0_10;
+      };
 
       # List of supported compilers:
       supportedCompilers = [
@@ -53,6 +55,23 @@
           packageName
           (haskellSourceFilter ./.)
           (packageOverrides haskell);
+
+      # Development environment:
+      shell = pkgs: haskell:
+        haskell.shellFor {
+          NIX_PATH = "nixpkgs=${pkgs.path}";
+
+          packages = _: [ self.packages.${pkgs.system}.${packageName} ];
+          withHoogle = true;
+          buildInputs = [
+            haskell.cabal-fmt
+            haskell.cabal-install
+            haskell.haskell-language-server
+            haskell.hlint
+            haskell.ormolu
+            inputs.haskellrc.packages.${pkgs.system}.default
+          ];
+        };
     in
     {
       packages = forAllSystems (system:
@@ -70,21 +89,14 @@
           })
           supportedCompilers));
 
-      devShells = forAllSystems (system: {
-        default = nixpkgsFor.${system}.haskellPackages.shellFor {
-          NIX_PATH = "nixpkgs=${nixpkgsFor.${system}.path}";
-
-          packages = _: [ self.packages.${system}.${packageName} ];
-          withHoogle = true;
-          buildInputs = with nixpkgsFor.${system}; [
-            haskellPackages.cabal-fmt
-            haskellPackages.cabal-install
-            haskellPackages.haskell-language-server
-            haskellPackages.hlint
-            haskellPackages.ormolu
-            inputs.haskellrc.packages.${system}.default
-          ];
-        };
-      });
+      devShells = forAllSystems (system:
+        let pkgs = nixpkgsFor.${system}; in {
+          default = shell pkgs pkgs.haskellPackages;
+        } // builtins.listToAttrs (map
+          (compiler: {
+            name = "shell-${compiler}";
+            value = shell pkgs pkgs.haskell.packages.${compiler};
+          })
+          supportedCompilers));
     };
 }

openid-connect.cabal

@@ -79,22 +79,22 @@ common extensions
 --------------------------------------------------------------------------------
 common dependencies
   build-depends:
-    , aeson                 >=1.3  && <2.2
-    , base                  >=4.9  && <5.0
-    , bytestring            >=0.10 && <0.12
+    , aeson                 >=1.3   && <2.2
+    , base                  >=4.9   && <5.0
+    , bytestring            >=0.10  && <0.12
     , case-insensitive      ^>=1.2
     , containers            ^>=0.6
     , cookie                ^>=0.4
-    , cryptonite            >=0.25 && <1.0
-    , http-client           >=0.6  && <0.8
+    , cryptonite            >=0.25  && <1.0
+    , http-client           >=0.6   && <0.8
     , http-types            ^>=0.12
-    , jose                  >=0.8  && <0.11
-    , lens                  >=4.0  && <5.3
-    , memory                >=0.14 && <1.0
-    , mtl                   >=2.2  && <2.4
-    , network-uri           >=2.6  && <2.8
-    , text                  >=1.2  && <2.1
-    , time                  >=1.8  && <2.0
+    , jose                  >=0.10  && <0.11
+    , lens                  >=4.0   && <5.3
+    , memory                >=0.14  && <1.0
+    , mtl                   >=2.2   && <2.4
+    , network-uri           >=2.6   && <2.8
+    , text                  >=1.2   && <2.1
+    , time                  >=1.8   && <2.0
     , unordered-containers  ^>=0.2
 
 --------------------------------------------------------------------------------
@@ -151,7 +151,7 @@ test-suite test
   main-is:        Main.hs
   build-depends:
     , openid-connect
-    , tasty           >=1.1  && <1.5
+    , tasty           >=1.1   && <1.5
     , tasty-hunit     ^>=0.10
 
   other-modules:

src/OpenID/Connect/Client/Authentication.hs

@@ -24,7 +24,6 @@ module OpenID.Connect.Client.Authentication
 --------------------------------------------------------------------------------
 -- Imports:
 import Control.Lens ((&), (?~), (.~), (^?), (#))
-import Control.Monad.Except
 import qualified Crypto.JOSE.Compact as JOSE
 import qualified Crypto.JOSE.Error as JOSE
 import Crypto.JOSE.JWK (JWK)
@@ -97,7 +96,7 @@ applyRequestAuthentication creds methods uri now body =
     signWithKey :: JWK -> HTTP.Request -> m (Maybe HTTP.Request)
     signWithKey key req = do
       claims <- makeClaims <$> makeJti
-      res <- runExceptT $ do
+      res <- JWT.runJOSE $ do
         alg <- JWK.bestJWSAlg key
         JWT.signClaims key (JWT.newJWSHeader ((), alg)) claims
       case res of

src/OpenID/Connect/Client/Flow/AuthorizationCode.hs

@@ -417,10 +417,9 @@ exchangeCodeForIdentityToken https now disco creds user = do
       req <- maybe
         (throwError (InvalidProviderTokenEndpointError (uriToText (getURI uri)))) pure
         (requestFromURI (Right (getURI uri)))
-      applyRequestAuthentication creds authMethods
-        uri now body req >>= \case
-          Nothing -> throwError NoAuthenticationMethodsAvailableError
-          Just r  -> lift (https r)
+      lift (applyRequestAuthentication creds authMethods uri now body req) >>= \case
+        Nothing -> throwError NoAuthenticationMethodsAvailableError
+        Just r  -> lift (https r)
 
     processResponse
       :: HTTP.Response LByteString.ByteString

test/Client/AuthorizationCodeTest.hs

@@ -24,7 +24,7 @@ module Client.AuthorizationCodeTest
 --------------------------------------------------------------------------------
 -- Imports:
 import Control.Lens ((&), (?~), (#), (.~), (^?))
-import Control.Monad.Except
+import Control.Monad (join)
 import Crypto.JOSE (JWK, JWKSet(..))
 import Crypto.JOSE.Compact
 import Crypto.JWT (ClaimsSet)
@@ -211,7 +211,7 @@ testTokenExchange = do
       -> UserReturnFromRedirect
       -> IO (Either FlowError (TokenResponse ClaimsSet), HTTP.Request)
     makeRequest_ time disco key claims keyset browser = do
-      claims' <- runExceptT
+      claims' <- JWT.runJOSE
         (do algo <- JWT.bestJWSAlg key
             JWT.signClaims key (JWT.newJWSHeader ((), algo)) claims)
         >>= \case

test/HttpHelper.hs

@@ -26,6 +26,8 @@ module HttpHelper
 
 --------------------------------------------------------------------------------
 import Control.Monad.State.Strict
+import Crypto.JWT (MonadRandom(..))
+import GHC.Generics (Generic)
 import qualified Data.ByteString.Lazy.Char8 as LChar8
 import qualified Network.HTTP.Client.Internal as HTTP
 import qualified Network.HTTP.Types as HTTP
@@ -65,13 +67,22 @@ defaultFakeHTTPS' rdata =
       , (HTTP.hContentType,  "application/json")
       ]
 
+--------------------------------------------------------------------------------
+newtype HttpSt m a = HttpSt
+  { _unHttpSt :: StateT HTTP.Request m a }
+  deriving stock (Generic)
+  deriving newtype (Functor, Applicative, Monad, MonadTrans)
+
+instance MonadRandom m => MonadRandom (HttpSt m) where
+  getRandomBytes = lift . getRandomBytes
+
 --------------------------------------------------------------------------------
 mkHTTPS
   :: MonadIO m
   => FakeHTTPS
   -> HTTP.Request
-  -> StateT HTTP.Request m (HTTP.Response LChar8.ByteString)
-mkHTTPS FakeHTTPS{..} request = do
+  -> HttpSt m (HTTP.Response LChar8.ByteString)
+mkHTTPS FakeHTTPS{..} request = HttpSt $ do
   put request
   body <- liftIO fakeData
 
@@ -89,6 +100,6 @@ mkHTTPS FakeHTTPS{..} request = do
 
 --------------------------------------------------------------------------------
 runHTTPS
-  :: StateT HTTP.Request m a
+  :: HttpSt m a
   -> m (a, HTTP.Request)
-runHTTPS = (`runStateT` (HTTP.defaultRequest { HTTP.method = "NONE" }))
+runHTTPS (HttpSt s) = runStateT s (HTTP.defaultRequest { HTTP.method = "NONE" })