diff --git a/CHANGES.md b/CHANGES.md index d4e6abf..b29b5f5 100644 --- a/CHANGES.md +++ b/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) diff --git a/flake.nix b/flake.nix index ffe9b6f..db010ef 100644 --- a/flake.nix +++ b/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)); }; } diff --git a/openid-connect.cabal b/openid-connect.cabal index 6cb421e..5cad9cf 100644 --- a/openid-connect.cabal +++ b/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: diff --git a/src/OpenID/Connect/Client/Authentication.hs b/src/OpenID/Connect/Client/Authentication.hs index ae349d2..dbfcd94 100644 --- a/src/OpenID/Connect/Client/Authentication.hs +++ b/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 diff --git a/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs b/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs index 3ba3cfe..3e8db7e 100644 --- a/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs +++ b/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 diff --git a/test/Client/AuthorizationCodeTest.hs b/test/Client/AuthorizationCodeTest.hs index 36f52d4..208e066 100644 --- a/test/Client/AuthorizationCodeTest.hs +++ b/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 diff --git a/test/HttpHelper.hs b/test/HttpHelper.hs index 320cb4b..3e045cb 100644 --- a/test/HttpHelper.hs +++ b/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" })