Skip to content

Commit

Permalink
Support servant-0.20 and GHC 9.6 (#65)
Browse files Browse the repository at this point in the history
  • Loading branch information
jhrcek authored Dec 7, 2023
1 parent 72a6da8 commit 7f8d04b
Show file tree
Hide file tree
Showing 9 changed files with 59 additions and 59 deletions.
17 changes: 9 additions & 8 deletions .github/workflows/haskell-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand Down Expand Up @@ -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'
Expand Down
4 changes: 4 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -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`

Expand Down
30 changes: 15 additions & 15 deletions servant-hmac-auth.cabal
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -12,19 +12,19 @@ maintainer: [email protected]
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
Expand Down Expand Up @@ -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.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
Expand All @@ -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.19 || ^>= 0.20
, text
, warp ^>= 3.3
other-modules: Servant.Auth.Hmac.CryptoSpec
Expand Down
53 changes: 28 additions & 25 deletions src/Servant/Auth/Hmac/Client.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE CPP #-}

-- | Servant client authentication.
module Servant.Auth.Hmac.Client (
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.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 =
Expand All @@ -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
Expand All @@ -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}
10 changes: 0 additions & 10 deletions stack-8.10.7.yaml

This file was deleted.

1 change: 0 additions & 1 deletion stack-9.2.5.yaml

This file was deleted.

1 change: 1 addition & 0 deletions stack-9.2.8.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
resolver: lts-20.26
1 change: 1 addition & 0 deletions stack-9.4.8.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
resolver: lts-21.23
1 change: 1 addition & 0 deletions stack-9.6.3.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
resolver: nightly-2023-12-07

0 comments on commit 7f8d04b

Please sign in to comment.