Support servant-0.20 and GHC 9.6

.github/workflows/haskell-ci.yml

@@ -14,12 +14,13 @@ jobs:
       matrix:
         os:
           - ubuntu-latest
-        cabal: [3.8]
+        cabal: 
+          - '3.10.2.0'
         ghc:
-          - 8.10.7
           - 9.0.2
-          - 9.2.5
-          - 9.4.4
+          - 9.2.8
+          - 9.4.8
+          - 9.6.3
     steps:
       - uses: actions/checkout@v3
         if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
@@ -49,12 +50,12 @@ jobs:
     strategy:
       matrix:
         stack:
-          - 2.9.3
+          - 2.13.1
         stack-yaml:
-          - stack-8.10.7.yaml
           - stack-9.0.2.yaml
-          - stack-9.2.5.yaml
-
+          - stack-9.2.8.yaml
+          - stack-9.4.8.yaml
+          - stack-9.6.3.yaml
     steps:
       - uses: actions/checkout@v3
         if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'

servant-hmac-auth.cabal

@@ -14,17 +14,17 @@ category:            Web, Cryptography
 build-type:          Simple
 extra-source-files:  README.md
                    , CHANGELOG.md
-tested-with:         GHC == 8.10.7
-                     GHC == 9.0.2
-                     GHC == 9.2.5
-                     GHC == 9.4.4
+tested-with:         GHC == 9.0.2
+                     GHC == 9.2.8
+                     GHC == 9.4.8
+                     GHC == 9.6.3
 
 source-repository head
   type:                git
   location:            https://github.com/holmusk/servant-hmac-auth.git
 
 common common-options
-  build-depends:       base >= 4.11.1.0 && < 4.18
+  build-depends:       base >= 4.11.1.0 && < 4.19
 
   ghc-options:         -Wall
                        -Wincomplete-uni-patterns
@@ -74,12 +74,12 @@ library
                      , http-types ^>= 0.12
                      , http-client >= 0.6.4 && < 0.8
                      , memory >= 0.15 && < 0.19
-                     , mtl ^>= 2.2.2
-                     , servant ^>= 0.18 || ^>= 0.19
-                     , servant-client ^>= 0.18 || ^>= 0.19
-                     , servant-client-core ^>= 0.18 || ^>= 0.19
-                     , servant-server ^>= 0.18 || ^>= 0.19
-                     , transformers ^>= 0.5
+                     , mtl ^>= 2.2.2 || ^>= 2.3
+                     , servant ^>= 0.18 || ^>= 0.19 || ^>= 0.20
+                     , servant-client ^>= 0.19 || ^>= 0.20
+                     , servant-client-core ^>= 0.18 || ^>= 0.19 || ^>= 0.20
+                     , servant-server ^>= 0.18 || ^>= 0.19 || ^>= 0.20
+                     , transformers ^>= 0.5 || ^>= 0.6
                      , wai ^>= 3.2.2.1
 
 test-suite servant-hmac-auth-test
@@ -95,8 +95,8 @@ test-suite servant-hmac-auth-test
                      , hspec-golden ^>= 0.2
                      , http-client >= 0.6.4 && < 0.8
                      , http-types ^>= 0.12
-                     , servant-client ^>= 0.18 || ^>= 0.19
-                     , servant-server ^>= 0.18 || ^>= 0.19
+                     , servant-client ^>= 0.19 || ^>= 0.20
+                     , servant-server ^>= 0.18 || ^>= 0.19 || ^>= 0.20
                      , text
                      , warp ^>= 3.3
   other-modules:       Servant.Auth.Hmac.CryptoSpec

src/Servant/Auth/Hmac/Client.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE CPP #-}
 
 -- | Servant client authentication.
 module Servant.Auth.Hmac.Client (
@@ -90,7 +91,7 @@ hmacClientSign :: Servant.Request -> HmacClientM Servant.Request
 hmacClientSign req = HmacClientM $ do
     HmacSettings{..} <- ask
     url <- lift $ asks baseUrl
-    let signedRequest = signRequestHmac hmacSigner hmacSecretKey url req
+    signedRequest <- liftIO $ signRequestHmac hmacSigner hmacSecretKey url req
     case hmacRequestHook of
         Nothing -> pure ()
         Just hook -> lift $ hook signedRequest
@@ -118,9 +119,29 @@ hmacClient = Proxy @api `clientIn` Proxy @HmacClientM
 -- Internals
 ----------------------------------------------------------------------------
 
-servantRequestToPayload :: BaseUrl -> Servant.Request -> RequestPayload
-servantRequestToPayload url sreq =
-    RequestPayload
+servantRequestToPayload :: BaseUrl -> Servant.Request -> IO RequestPayload
+servantRequestToPayload url sreq = do
+#if MIN_VERSION_servant_client(0,20,0)
+    req <- -- servant-client 0.20: defaultMakeClientRequest :: BaseUrl -> Request -> IO Request
+#else
+    let req = -- servant-client 0.12: defaultMakeClientRequest :: BaseUrl -> Request -> Request
+#endif
+            defaultMakeClientRequest url sreq
+                { Servant.requestQueryString =
+                    fromList $ sort $ toList $ Servant.requestQueryString sreq
+                }
+
+    let
+        hostAndPort :: ByteString
+        hostAndPort = case lookup (mk "Host") (Client.requestHeaders req) of
+            Just hp -> hp
+            Nothing ->
+                case (Client.secure req, Client.port req) of
+                    (True, 443) -> Client.host req
+                    (False, 80) -> Client.host req
+                    (_, p) -> Client.host req <> ":" <> fromString (show p)
+
+    return RequestPayload
         { rpMethod = Client.method req
         , rpContent = "" -- toBsBody $ Client.requestBody req
         , rpHeaders =
@@ -130,24 +151,6 @@ servantRequestToPayload url sreq =
                 Client.requestHeaders req
         , rpRawUrl = hostAndPort <> Client.path req <> Client.queryString req
         }
-  where
-    req :: Client.Request
-    req =
-        defaultMakeClientRequest
-            url
-            sreq
-                { Servant.requestQueryString =
-                    fromList $ sort $ toList $ Servant.requestQueryString sreq
-                }
-
-    hostAndPort :: ByteString
-    hostAndPort = case lookup (mk "Host") (Client.requestHeaders req) of
-        Just hp -> hp
-        Nothing ->
-            case (Client.secure req, Client.port req) of
-                (True, 443) -> Client.host req
-                (False, 80) -> Client.host req
-                (_, p) -> Client.host req <> ":" <> fromString (show p)
 
 --    toBsBody :: RequestBody -> ByteString
 --    toBsBody (RequestBodyBS bs)       = bs
@@ -171,9 +174,9 @@ signRequestHmac ::
     -- | Original request
     Servant.Request ->
     -- | Signed request
-    Servant.Request
+    IO Servant.Request
 signRequestHmac signer sk url req = do
-    let payload = servantRequestToPayload url req
+    payload <- servantRequestToPayload url req
     let signature = requestSignature signer sk payload
     let authHead = (authHeaderName, "HMAC " <> unSignature signature)
-    req{Servant.requestHeaders = authHead <| Servant.requestHeaders req}
+    return req{Servant.requestHeaders = authHead <| Servant.requestHeaders req}

stack-9.2.8.yaml

@@ -0,0 +1 @@
+resolver: lts-20.26

stack-9.4.8.yaml

@@ -0,0 +1 @@
+resolver: lts-21.23

stack-9.6.3.yaml

@@ -0,0 +1 @@
+resolver: nightly-2023-12-07