packages feed

servant-hmac-auth 0.1.5 → 0.1.6

raw patch · 3 files changed

+47/−40 lines, 3 filesdep ~basedep ~mtldep ~servantPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, mtl, servant, servant-client, servant-client-core, servant-server, transformers

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -3,6 +3,10 @@ `servant-hmac-auth` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +## 0.1.6 - Dec 7, 2023+* Bump dependency upper bounds to allow building with GHC `9.0`, `9.2`, `9.4` and `9.6`.+* Allow building with `servant-0.20`+ ## 0.1.5 - Jan 27, 2023 * Bump dependency upper bounds, allow building with `GHC 9.0`, `9.2` and `9.4` 
servant-hmac-auth.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                servant-hmac-auth-version:             0.1.5+version:             0.1.6 synopsis:            Servant authentication with HMAC description:         Servant authentication with HMAC. See README.md for usage example. homepage:            https://github.com/holmusk/servant-hmac-auth@@ -12,19 +12,19 @@ copyright:           2018 Holmusk category:            Web, Cryptography build-type:          Simple-extra-source-files:  README.md+extra-doc-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 @@                      , 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.19 || ^>= 0.20+                     , servant-client ^>= 0.19 || ^>= 0.20+                     , servant-client-core ^>= 0.19 || ^>= 0.20+                     , servant-server ^>= 0.19 || ^>= 0.20+                     , transformers ^>= 0.5 || ^>= 0.6                      , wai ^>= 3.2.2.1  test-suite servant-hmac-auth-test@@ -95,8 +95,8 @@                      , 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.19 || ^>= 0.20                      , text                      , warp ^>= 3.3   other-modules:       Servant.Auth.Hmac.CryptoSpec
src/Servant/Auth/Hmac/Client.hs view
@@ -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 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 @@ -- 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.19: 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,25 +151,7 @@                 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 --    toBsBody (RequestBodyLBS bs)      = LBS.toStrict bs@@ -171,9 +174,9 @@     -- | 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}