Introduce HmacAuthed with secured request's content

CHANGELOG.md

@@ -3,6 +3,12 @@
 `servant-hmac-auth` uses [PVP Versioning][1].
 The change log is available [on GitHub][2].
 
+## Unrelease: x.y.z
+
+* Authenticate against the request's body. The HMAC signature is influenced by
+  the HTTP method, the request's body, some HTTP headers and the requested URL
+  (except for the scheme).
+
 
 ## 0.1.3 - Nov 29, 2021
 * Bump `servant-*` libraries' version to `0.18-*`

README.md

@@ -7,19 +7,42 @@
 
 Servant authentication with HMAC
 
+## New experimental API notice
+
+A new experimental API is being tested with the following features:
+
+- Include the MD5 hashing of the request's content into the signature algorithm.
+- Identify the user in the request and pick the appropriate secret key for
+  authentication.
+
+The previous API is still available but may be deprecated and remove in future
+versions.
+
+### Note on large requests and streaming
+
+The authentication relies on various information about the request such as its
+body, more specifically the MD5 hash of the entire body. As a consequence, the
+library will consume the request's content in its entirety before transfering it
+to the underlying client or server. Thus, very large requests will be buffered
+in-memory while hashing, and streaming won't work as expected as all the chunks
+will be transfered at once only after signing. This is true whether the client /
+server actually consumes the content or not. This library is therefore not
+suited for those use cases.
+
+Note that this also comes with a DoS risk as very large requests will be stored
+in memory for signature and consumption. Users need to keep that in mind and
+take the necessary precautions to prevent those.
+
 ## Example
 
 In this section, we will introduce the client-server example.
 To run it locally you can:
 
 ```shell
-$ cabal new-build
-$ cabal new-exec readme
+cabal run readme
 ```
 
-So,it will run this on your machine.
-
-### Setting up
+## Setting up
 
 Since this tutorial is written using Literate Haskell, first, let's write all necessary pragmas and imports.
 

examples/client/Main.hs

@@ -0,0 +1,46 @@
+module Main (main) where
+
+import Data.Proxy
+import Network.HTTP.Client (defaultManagerSettings, newManager)
+import Servant.API
+import Servant.Auth.Hmac.Crypto
+import Servant.Auth.Hmac.Secure
+import Servant.Client
+import qualified Servant.Client.Core as Client
+
+data MyUser
+    = UserA
+    | UserB
+    deriving stock (Show)
+
+type MyApi =
+    HmacAuthed MyUser :> "messages" :> ReqBody '[PlainText] String :> Post '[PlainText] String
+        :<|> HmacAuthed MyUser :> "messages" :> Get '[PlainText] String
+
+myApi :: Proxy MyApi
+myApi = Proxy
+
+postMessage :: String -> HmacClientM MyUser String
+getMessages :: HmacClientM MyUser String
+(postMessage :<|> getMessages) = hmacClient myApi
+
+clientSideAuth :: HmacClientSideAuth MyUser
+clientSideAuth =
+    HmacClientSideAuth
+        { hcsaSign = signSHA256
+        , hcsaUserRequest = \case
+            UserA -> pure . Client.addHeader "X-User" ("user-a" :: String)
+            UserB -> pure . Client.addHeader "X-User" ("user-b" :: String)
+        , hcsaSecretKey = \case
+            UserA -> SecretKey "User-A-Secret"
+            UserB -> SecretKey "Secret-from-User-B"
+        }
+
+main :: IO ()
+main = do
+    manager <- newManager defaultManagerSettings
+    let clientEnv = mkClientEnv manager (BaseUrl Http "localhost" 8080 "")
+    postResponse <- runHmacClient (postMessage "Hello!") clientEnv clientSideAuth UserA
+    print postResponse
+    getResponse <- runHmacClient getMessages clientEnv clientSideAuth UserB
+    print getResponse

examples/server/Main.hs

@@ -0,0 +1,54 @@
+module Main (main) where
+
+import Control.Monad.IO.Class
+import qualified Network.Wai as Wai
+import Network.Wai.Handler.Warp (run)
+import Servant
+import Servant.Auth.Hmac.Crypto
+import Servant.Auth.Hmac.Secure
+
+data MyUser
+    = UserA
+    | UserB
+    deriving stock (Show)
+
+type MyApi =
+    HmacAuthed MyUser :> "messages" :> ReqBody '[PlainText] String :> Post '[PlainText] String
+        :<|> HmacAuthed MyUser :> "messages" :> Get '[PlainText] String
+
+myApi :: Proxy MyApi
+myApi = Proxy
+
+postMessage :: MyUser -> String -> Handler String
+postMessage usr msg = do
+    liftIO . putStrLn $ "Message from " <> show usr <> ": " <> msg
+    pure "Message printed!"
+
+getMessages :: MyUser -> Handler String
+getMessages usr = pure $ "Nothing else for " <> show usr
+
+myServer :: Server MyApi
+myServer = postMessage :<|> getMessages
+
+serverSideAuth :: HmacServerSideAuth MyUser
+serverSideAuth =
+    HmacServerSideAuth
+        { hssaSign = signSHA256
+        , hssaIdentifyUser = \req -> case lookup "X-User" (Wai.requestHeaders req) of
+            Just "user-a" -> pure $ Just UserA
+            Just "user-b" -> pure $ Just UserB
+            _ -> pure Nothing
+        , hssaSecretKey = \case
+            UserA -> SecretKey "User-A-Secret"
+            UserB -> SecretKey "Secret-from-User-B"
+        }
+
+myApp :: Application
+myApp =
+    serveWithContext
+        myApi
+        (serverSideAuth :. EmptyContext)
+        myServer
+
+main :: IO ()
+main = run 8080 myApp

servant-hmac-auth.cabal

@@ -23,6 +23,16 @@ source-repository head
   type:                git
   location:            https://github.com/holmusk/servant-hmac-auth.git
 
+flag build-readme
+  description:         Build the example in the README.md file.
+  default:             False
+  manual:              True
+
+flag build-examples
+  description:         Build the examples in the examples directory.
+  default:             False
+  manual:              True
+
 common common-options
   build-depends:       base >= 4.11.1.0 && < 4.16
 
@@ -64,10 +74,11 @@ library
   exposed-modules:     Servant.Auth.Hmac
                            Servant.Auth.Hmac.Crypto
                            Servant.Auth.Hmac.Client
+                           Servant.Auth.Hmac.Secure
                            Servant.Auth.Hmac.Server
+  other-modules:       Servant.Auth.Hmac.Internal
 
   build-depends:       base64-bytestring >= 1.0 && <= 2
-                     , binary ^>= 0.8
                      , bytestring ^>= 0.10
                      , case-insensitive ^>= 1.2
                      , containers >= 0.5.7 && < 0.7
@@ -76,12 +87,51 @@ library
                      , http-client >= 0.6.4 && < 0.8
                      , memory >= 0.15 && < 0.17
                      , 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
+                     , servant >= 0.18 && < 0.20
+                     , servant-client >= 0.18 && < 0.20
+                     , servant-client-core >= 0.18 && < 0.20
+                     , servant-server >= 0.18 && < 0.20
                      , transformers ^>= 0.5
                      , wai ^>= 3.2.2.1
+executable readme
+  import:              common-options
+  if !flag(build-readme)
+    buildable:         False
+  main-is:             README.lhs
+  build-depends:       aeson >= 1.4 && < 1.6
+                     , http-client >= 0.6.4 && < 0.8
+                     , servant >= 0.18 && < 0.20
+                     , servant-hmac-auth
+                     , servant-client >= 0.18 && < 0.20
+                     , servant-server >= 0.18 && < 0.20
+                     , warp ^>= 3.3.5
+  build-tool-depends:  markdown-unlit:markdown-unlit
+  ghc-options:         -pgmL markdown-unlit
+
+executable examples-client
+  import:              common-options
+  if !flag(build-examples)
+    buildable:         False
+  main-is:             Main.hs
+  hs-source-dirs:      examples/client
+  build-depends:       http-client >= 0.6.4 && < 0.8
+                     , servant >= 0.18 && < 0.20
+                     , servant-hmac-auth
+                     , servant-client >= 0.18 && < 0.20
+                     , servant-client-core >= 0.18 && < 0.20
+
+executable examples-server
+  import:              common-options
+  if !flag(build-examples)
+    buildable:         False
+  main-is:             Main.hs
+  hs-source-dirs:      examples/server
+  build-depends:       http-client >= 0.6.4 && < 0.8
+                     , servant >= 0.18 && < 0.20
+                     , servant-hmac-auth
+                     , servant-server
+                     , wai ^>= 3.2.2.1
+                     , warp ^>= 3.3
 
 test-suite servant-hmac-auth-test
   import:              common-options
@@ -96,10 +146,15 @@ 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 >= 0.18 && < 0.20
+                     , servant-client >= 0.18 && < 0.20
+                     , servant-client-core >= 0.18 && < 0.20
+                     , servant-server >= 0.18 && < 0.20
                      , text
+                     , transformers ^>= 0.5
+                     , wai ^>= 3.2.2.1
                      , warp ^>= 3.3
   other-modules:       Servant.Auth.Hmac.CryptoSpec
+                       Servant.Auth.Hmac.SecureSpec
                        Servant.Auth.HmacSpec
   build-tool-depends:  hspec-discover:hspec-discover == 2.*

src/Servant/Auth/Hmac/Client.hs

@@ -25,6 +25,16 @@ import Data.List (sort)
 import Data.Proxy (Proxy (..))
 import Data.Sequence (fromList, (<|))
 import Data.String (fromString)
+import qualified Network.HTTP.Client as Client
+import Servant.Auth.Hmac.Crypto (
+    RequestPayload (..),
+    SecretKey,
+    Signature (..),
+    authHeaderName,
+    keepWhitelistedHeaders,
+    requestSignature,
+    signSHA256,
+ )
 import Servant.Client (
     BaseUrl,
     Client,
@@ -35,20 +45,8 @@ import Servant.Client (
     runClientM,
  )
 import Servant.Client.Core (RunClient (..), clientIn)
-import Servant.Client.Internal.HttpClient (defaultMakeClientRequest)
-
-import Servant.Auth.Hmac.Crypto (
-    RequestPayload (..),
-    SecretKey,
-    Signature (..),
-    authHeaderName,
-    keepWhitelistedHeaders,
-    requestSignature,
-    signSHA256,
- )
-
-import qualified Network.HTTP.Client as Client
 import qualified Servant.Client.Core as Servant
+import Servant.Client.Internal.HttpClient (defaultMakeClientRequest)
 
 -- | Environment for 'HmacClientM'. Contains all required settings for hmac client.
 data HmacSettings = HmacSettings
@@ -122,11 +120,12 @@ servantRequestToPayload :: BaseUrl -> Servant.Request -> RequestPayload
 servantRequestToPayload url sreq =
     RequestPayload
         { rpMethod = Client.method req
-        , rpContent = "" -- toBsBody $ Client.requestBody req
+        , rpContent = "" -- Deprecation notice: this version doesn't use the request body for authentication. Use the new 'HmacAuthed' API for that.
         , rpHeaders =
             keepWhitelistedHeaders $
+                -- FIXME we shouldn't add the 'Host' port ourselves. The client is responsible for that.
                 ("Host", hostAndPort) :
-                ("Accept-Encoding", "gzip") :
+                -- ("Accept-Encoding", "gzip") :
                 Client.requestHeaders req
         , rpRawUrl = hostAndPort <> Client.path req <> Client.queryString req
         }
@@ -149,12 +148,6 @@ servantRequestToPayload url sreq =
                 (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
---    toBsBody (RequestBodyBuilder _ b) = LBS.toStrict $ toLazyByteString b
---    toBsBody _                        = ""  -- heh
-
 {- | Adds signed header to the request.
 
 @
@@ -172,8 +165,8 @@ signRequestHmac ::
     Servant.Request ->
     -- | Signed request
     Servant.Request
-signRequestHmac signer sk url req = do
+signRequestHmac signer sk url req =
     let payload = servantRequestToPayload url req
-    let signature = requestSignature signer sk payload
-    let authHead = (authHeaderName, "HMAC " <> unSignature signature)
-    req{Servant.requestHeaders = authHead <| Servant.requestHeaders req}
+        signature = requestSignature signer sk payload
+        authHead = (authHeaderName, "HMAC " <> unSignature signature)
+     in req{Servant.requestHeaders = authHead <| Servant.requestHeaders req}

src/Servant/Auth/Hmac/Crypto.hs

@@ -151,7 +151,8 @@ whitelistHeaders :: [HeaderName]
 whitelistHeaders =
     [ authHeaderName
     , "Host"
-    , "Accept-Encoding"
+    -- FIXME Encoding should be transparent to the Servant HMAC handler. Is there another reason why it is required for the signature?
+    -- , "Accept-Encoding"
     ]
 
 -- | Keeps only headers from 'whitelistHeaders'.