-------------------------------------------------------------------------
-- |
-- Module : Network.Wai.Middleware.HmacAuth.Client
-- Description : Wai HMAC Auth Middleware Client
-- Copyright : (c) 2015 Christopher Reichert
-- License : BSD3
-- Maintainer : Christopher Reichert <creichert07@gmail.com>
-- Stability : experimental
-- Portability : POSIX
--
-- Compatible with HTTP Client
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.Wai.Middleware.HmacAuth.Client
(
-- * Sign a 'Request' with HMAC
applyHmacAuth
-- * Settings
--
-- These correspond to the 'HmacAuthSettings' found
-- in 'Network.WAI.Middleware.HmacAuth' with slightly
-- less options. These should correlate when deploying.
-- The 'defaultHmacAuthSettings' in both modules should
-- be ready-to-use together.
, defaultHmacAuthSettings
, HmacAuthSettings (..)
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Crypto.Hash
import Crypto.Hash.MD5 as MD5
import Data.Byteable (toBytes)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64 as BS64
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as B
import Data.CaseInsensitive (CI)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Time
import Network.HTTP.Client
import qualified Network.HTTP.Types as Http
import System.Locale
-- | Various control settings for HMAC authentication
data HmacAuthSettings alg = HmacAuthSettings
{
authKeyHeader :: !(CI ByteString)
, authTimestampHeader :: !(CI ByteString)
-- | HMAC signing algorithm
--
-- MD5, SHA1, SHA256, and SHA512 supported
, authAlgorithm :: alg
-- | Realm provider.
--
-- e.g. Authorization: API key:signature
, authRealm :: !ByteString
-- | Use Header or QueryParam spec.
--
-- Currently, only the @Header@ @Strategy@ is supported
, authSpec :: !Strategy
}
data Strategy = Header
-- ^ Use HTTP Header to authorize clients
--- | Query
--- ^ TODO Use query parameters (not yet supported)
type Secret = ByteString
type Key = ByteString
-- | default HMAC client settings
defaultHmacAuthSettings :: HmacAuthSettings SHA512
defaultHmacAuthSettings = HmacAuthSettings
{ authRealm = "Hmac"
, authKeyHeader = "X-auth-key"
, authTimestampHeader = "X-auth-timestamp"
, authSpec = Header
, authAlgorithm = SHA512
}
-- | Add an Hmac auth header, signed with the specified secret, to the
-- given Request. Ignore error handling:
--
-- > applyHmacAuth defaultHmacSettings "secret" $ fromJust $ parseUrl url
--
-- Since 0.1.0
applyHmacAuth :: forall m alg .
(
MonadIO m
, HashAlgorithm alg )
=> HmacAuthSettings alg
-> Key
-> Secret
-> Request
-> m Request
applyHmacAuth cfg@HmacAuthSettings{..} key secret req = do
now <- liftIO getCurrentTime
let date = timefmt now
contentmd5 = MD5.hash $ B.toStrict body
res = canonicalizedResource req
payload = buildMessage verb contentmd5 (ctype req) date res
HMAC hashed = signPayload secret payload
digest = BS64.encode (toBytes hashed)
return $ req { requestHeaders =
[ (authTimestampHeader, date)
, (authKeyHeader, key)
, authHeader cfg key digest
] <> requestHeaders req
}
where
signPayload :: Secret -> ByteString -> HMAC alg
signPayload = hmac
timefmt = BS.pack . formatTime defaultTimeLocale "%FT%T"
verb = method req
ctype = fromMaybe "" . lookup Http.hContentType . requestHeaders
body = case requestBody req of
RequestBodyLBS lbs -> lbs
RequestBodyBS bs -> B.fromStrict bs
_ -> error "RequestBody type Not Supported"
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-- | Create HTTP Authorization header for the give key and signature.
authHeader :: HmacAuthSettings alg
-> Key
-> Secret
-> (CI ByteString, ByteString)
authHeader HmacAuthSettings{..} key sig =
let auth = BS.concat [ authRealm, " ", key, ":", sig ]
in ("Authorization", auth)
-- | Prepare a string to be HMAC signed.
--
-- @
-- stringtosign = http-method + "\n" +
-- content md5 + "\n" +
-- content-type + "\n" +
-- date + "\n" +
-- canonicalizedUri;
-- @
--
buildMessage
:: Http.Method -- ^ HTTP Method
-> ByteString -- ^ md5 Checksum of the request body
-> ByteString -- ^ Content-Type
-> ByteString -- ^ Date header of the HTTP request
-> ByteString -- ^ Canonicalized request location
-> ByteString -- ^ Return the unencoded string to sign
buildMessage verb contentmd5 ctype date resource =
BS.concat [ verb, "\n"
, contentmd5, "\n"
, ctype, "\n"
, date, "\n"
, resource
]
-- | Canonicalization of the request uri
--
-- http-request uri from the protocol name up to the query string.
-- TODO add the query string to the canonicalized resource?
canonicalizedResource :: Request -> ByteString
canonicalizedResource = path