wai-middleware-hmac (empty) → 0.1.0.0
raw patch · 9 files changed
+793/−0 lines, 9 filesdep +Globdep +HUnitdep +basesetup-changed
Dependencies added: Glob, HUnit, base, base64-bytestring, byteable, bytestring, case-insensitive, cryptohash, doctest, hlint, hspec, http-types, process, regex-compat, transformers, wai, wai-extra, wai-middleware-hmac, word8
Files
- LICENSE +30/−0
- Network/Wai/Middleware/HmacAuth.hs +369/−0
- Setup.hs +2/−0
- test/DocTest.hs +23/−0
- test/HLint.hs +36/−0
- test/Haddock.hs +55/−0
- test/Spec.hs +1/−0
- test/WaiMiddlewareHmacAuthSpec.hs +183/−0
- wai-middleware-hmac.cabal +94/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Christopher Reichert++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Christopher Reichert nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Wai/Middleware/HmacAuth.hs view
@@ -0,0 +1,369 @@+-----------------------------------------------------------------------------+-- |+-- Module : Network.Wai.Middleware.HmacAuth+-- Description : WAI HMAC Authentication Middleware+-- Copyright : (c) 2015 Christopher Reichert+-- License : BSD3+-- Maintainer : Christopher Reichert <creichert07@gmail.com>+-- Stability : experimental+-- Portability : POSIX+--++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+++module Network.Wai.Middleware.HmacAuth (++ -- * Middleware functionality+ hmacAuth++ -- * Crypto+ , signRequest++ -- ** Supported Hashing Algorithms+ , HashAlgorithm+ , SHA512, SHA256, SHA1, MD5++ -- * Hmac and Middleware Configuration+ , HmacAuthSettings (..)+ , HmacStrategy (..)+ , defaultHmacAuthSettings++ , Secret (..)+ , Key (..)+ ) where+++import Control.Monad (when)+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 as BS+import qualified Data.ByteString.Base64 as BS64+import Data.CaseInsensitive (CI)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Word8 (isSpace, toLower, _colon)+import qualified Network.HTTP.Types as Http+import Network.Wai++++-- | Various settings for HMAC authentication+data HmacAuthSettings alg = HmacAuthSettings+ {+ -- | Name of the header which carries the auth key+ authKeyHeader :: !(CI ByteString)++ -- | Name of the HTTP Header which carries the timestamp+ , authTimestampHeader :: !(CI ByteString)++ -- | Determines whether the request needs authentication+ , authIsProtected :: !(Request -> IO Bool)++ -- | Function to run when authentication is unsuccessful+ , authOnNoAuth :: !(HmacAuthException -> Application)++ -- | HMAC signing algorithm+ --+ -- MD5, SHA1, SHA256, and SHA512 supported+ , authAlgorithm :: alg++ -- | Realm provider.+ , authRealm :: !ByteString++ -- | Use Header or Query spec.+ --+ -- Query spec is useful for sharing encoded URLs+ --+ , authSpec :: !HmacStrategy++ -- | Print debug output+ , authDebug :: !Bool+ }++++-- | HMAC Public Key+newtype Key = Key ByteString+ deriving (Eq, Show)++++-- | HMAC Secret Key+newtype Secret = Secret ByteString+ deriving (Eq, Show)++++-- | Hmac requests can be accepted through GET params+-- or Http headers.+data HmacStrategy = Header+ -- ^ Look for auth info in HTTP Headers+ --- | Query+ --- ^ Look for auth info in Query params+ --- Useful for encoding and sharing requests+ --- without the need for a specific client+ deriving Show+++++-- | Possibilities for Error during an Hmac Authentication Session+data HmacAuthException+ = NoSecret+ -- ^ No secret could be found for the key+ -- in the request+ | NoAuthHeader+ -- ^ No specified Auth header found+ | InvalidSignature+ -- ^ Signature could not be decoded properly+ | SignatureMismatch+ -- ^ Valid signature which does not match+ -- server generated sig+ deriving Show+++++-- | Lookup the Secret for a Given Key+--+-- This is essentially a credentials provider so that the+-- middleware can generate a request signature for a given+-- request.+--+-- TODO this is a HACK up front but should be changed to not+-- expose the secret to the middleware.+type LookupSecret m = Key -> m (Maybe Secret)++++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++++-- | Perform Hmac authentication.+--+-- Uses a lookup function to retrieve the secret used to sign+-- the incoming request.+--+-- > let lookupSecret key = case key of+-- > "client" -> Just (Secret "secretkey")+-- > _ -> Nothing+-- > authware = hmacAuth lookupSecret defaultHmacAuth+-- > Warp.run (read port) $ authware $ app+--+hmacAuth :: forall alg .+ HashAlgorithm alg+ => LookupSecret IO+ -> HmacAuthSettings alg+ -> Middleware+hmacAuth lookupSecret cfg@HmacAuthSettings {..} app req respond = do++ isProtected <- authIsProtected req++ allowed <- if isProtected+ then check+ else return $ Right ()++ case allowed of+ Left e -> authOnNoAuth e req respond+ Right _ -> app req respond++ where+ check =+ case lookup "Authorization" $ requestHeaders req of+ Nothing -> return $ Left NoAuthHeader+ Just bs ->+ let (d, rest) = BS.break isSpace bs+ isColon = (==) _colon+ (key, signature) = BS.break isColon rest+ in if BS.map toLower d == BS.map toLower authRealm+ then checkB64 key signature+ else return $ Left InvalidSignature++ checkB64 key sig' = case BS.uncons sig' of+ Nothing -> return $ Left InvalidSignature+ Just (_, signature) -> do++ moursecret <- lookupSecret $ Key $ BS.tail key++ case moursecret of+ Nothing -> return $ Left NoSecret+ Just oursecret -> do++ ourreq <- signRequest cfg oursecret req++ let headers = requestHeaders ourreq+ oursig = getBase64DecodedSignature cfg authRealm headers++ when authDebug $ sequence_+ [+ print ("Server Key: " <> show key)+ , print ("Server Sig: " <> show oursig)+ , print ("Client Sig: " <> show signature)+ ]++ case oursig of+ Left e -> return $ Left e+ Right sig -> return $ checkSig sig signature++ -- TODO effects of timing attack on string comparison?+ -- TODO Compare encoded or decoded signature+ -- sigs must match+ checkSig oursig theirsig = if oursig == theirsig+ then Right ()+ else Left SignatureMismatch++++-- | Default HMAC authentication settings+--+-- Uses SHA512 as default signing algorithm+--+-- @authOnNoAuth@ responds with:+-- @+-- WWW-Authenticate: Realm="" HMAC-MD5;HMAC-SHA1;HMAC-SHA256;HMAC-SHA512"+-- [...]+-- Provide valid credentials+-- @+--+defaultHmacAuthSettings :: HmacAuthSettings SHA512+defaultHmacAuthSettings = HmacAuthSettings+ { authRealm = "Hmac"+ , authKeyHeader = "X-auth-key"+ , authTimestampHeader = "X-auth-timestamp"+ , authOnNoAuth = defUnauthorized+ , authIsProtected = const $ return True+ , authSpec = Header+ , authAlgorithm = SHA512+ , authDebug = True+ }+ where+ defNoAuthHeader =+ ("WWW-Authenticate", BS.concat+ [ "Realm=\"\" " -- TODO default realm+ , "HMAC-MD5;HMAC-SHA1;HMAC-SHA256;HMAC-SHA512"+ ])+ -- TODO negotiate the alg+ defUnauthorized _ _req f = f $ responseLBS+ Http.status401+ (defNoAuthHeader : requestHeaders _req)+ "Provide valid credentials"++++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++++-- | Decode the signature in the Authorization header.+--+getBase64DecodedSignature+ :: HmacAuthSettings alg+ -> ByteString+ -> [(CI ByteString, ByteString)] -- ^ headers to search for sig+ -> Either HmacAuthException ByteString+getBase64DecodedSignature HmacAuthSettings{..} realm headers =+ case lookup "Authorization" headers of+ Nothing -> Left InvalidSignature+ Just bs ->+ let (r, rest) = BS.break isSpace bs+ isColon = (==) _colon+ (_, sig') = BS.break isColon rest+ in if BS.map toLower r == BS.map toLower realm+ then case BS.uncons sig' of+ Nothing -> Left InvalidSignature+ Just (_, sig'') -> Right sig''+ else Left InvalidSignature++++-- | Sign a request using HMAC+--+-- signature = base64( hmac-sha1 (key, utf8( stringtosign ) ) )+--+-- TODO hash contents throught MonadState using a type to make+-- sure all the components are there or err.+signRequest :: forall m alg .+ (+ MonadIO m+ , HashAlgorithm alg )+ => HmacAuthSettings alg+ -> Secret+ -> Request+ -> m Request+signRequest cfg@HmacAuthSettings{..} (Secret secret) req = do++ body <- liftIO $ requestBody req++ let contentmd5 = MD5.hash body+ res = canonicalizedResource req+ payload = buildMessage verb contentmd5 ctype date res+ HMAC hashed = hmac secret payload :: HMAC alg+ digest = BS64.encode (toBytes hashed)++ return $ req { requestHeaders =+ authHeader cfg (Key key) (Secret digest)+ : requestHeaders req+ }+ where+ -- peices of signature+ maybeHeader = fromMaybe "" . flip lookup (requestHeaders req)+ verb = requestMethod req+ ctype = maybeHeader Http.hContentType+ -- TODO use real timestamp and test difference+ date = maybeHeader authTimestampHeader+ -- BUG taking entire header instead of just key+ key = maybeHeader authKeyHeader++++-- | TODO readert+authHeader :: HmacAuthSettings alg+ -> Key+ -> Secret+ -> (CI ByteString, ByteString)+authHeader HmacAuthSettings{..} (Key key) (Secret sig) =+ let auth = BS.concat [ authRealm, " ", key, ":", sig ]+ in ("Authorization", auth)++++-- | Build the 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.+canonicalizedResource :: Request -> ByteString+canonicalizedResource = rawPathInfo
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ test/DocTest.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module : DocTest.hs+-- Description : Documentation Testing+-- Copyright : (c) 2015 Christopher Reichert+-- License : AllRightsReserved+-- Maintainer : Christopher Reichert <creichert07@gmail.com>+-- Stability : testing+-- Portability : POSIX+++module Main (main) where+++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)+++main :: IO ()+main = glob "Network/**/[A-Z]*.hs"+ >>= doctest+ -- ; glob "client/**/[A-Z]*.hs"+ -- >>= doctest
+ test/HLint.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module : HLint+-- Description : Lint Testing Coverage+-- Copyright : (c) 2015 Christopher Reichert+-- License : BSD3+-- Maintainer : Christopher Reichert <creichert07@gmail.com>+-- Stability : testing+-- Portability : POSIX+++module Main (main) where+++import Language.Haskell.HLint (hlint)+import System.Exit (exitFailure, exitSuccess)++++main :: IO ()+main = do+ hints <- hlint arguments+ print hints+ if null hints+ then exitSuccess+ else exitFailure++++arguments :: [String]+arguments =+ [+ "Network"+ , "test"+ , "client"+ ]
+ test/Haddock.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------+-- |+-- Module : Haddock+-- Description : Haddock Test Coverage+-- Copyright : (c) 2015 Christopher Reichert+-- License : BSD3+-- Maintainer : Christopher Reichert <creichert07@gmail.com>+-- Stability : testing+-- Portability : POSIX++module Main (main) where++++import Data.List (genericLength)+import Data.Maybe (catMaybes)+import System.Exit (exitFailure, exitSuccess)+import System.Process (readProcess)+import Text.Regex (matchRegex, mkRegex)++++main :: IO ()+main = do+ output <- readProcess "cabal"+ [+ "haddock"+ , "-v"+ , "--hoogle"+ , "--html"+ , "--internal"+ ] ""++ if average (match output) >= expected+ then exitSuccess+ else putStr output >> exitFailure++++-- | Expected percentage of documentation to pass+-- the test+expected :: Double+expected = 50.0++++average :: (Fractional a, Real b) => [b] -> a+average xs = realToFrac (sum xs) / genericLength xs++++match :: String -> [Int]+match = fmap read . concat . catMaybes . fmap (matchRegex pattern) . lines+ where+ pattern = mkRegex "^ *([0-9]*)% "
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/WaiMiddlewareHmacAuthSpec.hs view
@@ -0,0 +1,183 @@+------------------------------------------------------------------------+-- |+-- Module : WaiMiddlewareHmacAuthSpec+-- Description : Wai HMAC Auth Middleware Spec+-- Copyright : (c) 2015 Christopher Reichert+-- License : BSD3+-- Maintainer : Christopher Reichert <creichert07@gmail.com>+-- Stability : unstable+-- Portability : POSIX+--+--+-- TODO test corner clases+-- - test expired timestamp (set skew in settings)+-- - test missing headers+-- - timestamp modified+-- - resource modified+-- - changing up hashing algorithm somehow+++{-# LANGUAGE OverloadedStrings #-}++module WaiMiddlewareHmacAuthSpec (+ spec+ ) where+++import Data.ByteString (ByteString)+import Network.HTTP.Types (status200, HeaderName)+import Network.Wai+import Network.Wai.Test+import Test.Hspec+import Test.HUnit hiding (Test)++import Network.Wai.Middleware.HmacAuth++++-- | Simple Hmac Authentication Spec+spec :: Spec+spec = describe "Network.Wai.Middleware.HmacAuth" $ do+ it "authenticates valid signatures" caseHmacAuth+ it "rejects invalid secrets" caseHmacInvalidSecret+ it "rejects invalid signatures" caseHmacInvalidSignature+ it "rejects invalid headers" caseHmacInvalidHeader+ it "rejects method modificatied" caseHmacMethodModified+ it "rejects request path modified" caseHmacPathModified++++-- | Simple Hmac Middleware App+--+-- This app has preloaded api keys to simulate+-- some database or service which can access the+-- private keys.+hmacAuthApp :: HashAlgorithm alg => HmacAuthSettings alg -> Application+hmacAuthApp stgs = hmacAuth lookupSecret stgs+ $ \_ f -> f response+ where+ payload = "{ \"api\", \"return data\" }"+ response = responseLBS status200 [] payload+ -- Server-Side Api Credentials+ lookupSecret key = return $ case lookup key creds of+ Nothing -> Nothing+ Just s -> Just (Secret s)+ creds = [ (Key "key1", "secret1")+ , (Key "key2", "secret2")+ ]+++-- defaults+key1, key2 :: ByteString+key1 = "key1"+key2 = "key2"++sec1 :: Secret+sec1 = Secret "secret1"++-- api key and secret shared in advance++timestamp :: ByteString+timestamp = "2015-01-01T00:00:00Z"+++cfg :: HmacAuthSettings SHA512+cfg = defaultHmacAuthSettings+++headers :: [(HeaderName, ByteString)]+headers = [ ("Content-Type", "application/json")+ , ("x-auth-timestamp", timestamp)+ ]++hmacReq :: Request+hmacReq = defaultRequest+ { requestMethod = "GET"+ , rawPathInfo = "/resource"+ , requestHeaders = headers+ }++++-- | Test Hmac Authentication+caseHmacAuth :: Assertion+caseHmacAuth = do++ -- valid signature+ validSignatureReq <- signRequest cfg (Secret "secret1") hmacReq+ { requestHeaders = ("x-auth-key", key1)+ : headers+ }+++ -- test hmac authenticaation+ flip runSession (hmacAuthApp defaultHmacAuthSettings) $ do++ res <- request validSignatureReq++ -- Succesful verification+ assertStatus 200 res++ -- succesfully authentication request+ assertBody "{ \"api\", \"return data\" }" res++++-- |+caseHmacInvalidSecret :: Assertion+caseHmacInvalidSecret = do+ invalidSecretReq <- signRequest cfg sec1 hmacReq+ { requestHeaders = ("x-auth-key", key2)+ : headers+ }++ flip runSession (hmacAuthApp defaultHmacAuthSettings) $+ request invalidSecretReq+ >>= assertStatus 401++++-- | Invalid signatures are rejected+caseHmacInvalidSignature :: Assertion+caseHmacInvalidSignature = do+ -- test hmac authenticaation+ -- invalid secret+ invalidSignatureReq <- signRequest cfg (Secret "wJalrXUtnFEMI") hmacReq+ { requestHeaders = ("x-auth-key", key1)+ : headers+ }++ flip runSession (hmacAuthApp defaultHmacAuthSettings) $+ request invalidSignatureReq+ >>= assertStatus 401+++caseHmacInvalidHeader :: Assertion+caseHmacInvalidHeader = do+ -- invalid headers+ invalidHeaderReq <- signRequest cfg sec1 hmacReq+ -- test hmac authenticaation+ flip runSession (hmacAuthApp defaultHmacAuthSettings) $+ request invalidHeaderReq+ >>= assertStatus 401++++caseHmacMethodModified :: Assertion+caseHmacMethodModified = do+ req <- signRequest cfg sec1 hmacReq+ flip runSession (hmacAuthApp defaultHmacAuthSettings) $+ -- reject request path modified after signature+ request req { rawPathInfo = "/etc/passwd" }+ >>= assertStatus 401++++caseHmacPathModified :: Assertion+caseHmacPathModified = do+ req <- signRequest cfg sec1 hmacReq+ -- test hmac authenticaation+ flip runSession (hmacAuthApp defaultHmacAuthSettings) $+ -- reject request path modified after signature+ request req { rawPathInfo = "/etc/passwd" }+ >>= assertStatus 401
+ wai-middleware-hmac.cabal view
@@ -0,0 +1,94 @@++name: wai-middleware-hmac+version: 0.1.0.0+license: BSD3+license-file: LICENSE+author: Christopher Reichert+maintainer: creichert07@gmail.com+copyright: (c) 2015, Christopher Reichert+category: Web+build-type: Simple+cabal-version: >=1.10+synopsis: HMAC Authentication Middleware for WAI+homepage: https://github.com/creichert/wai-middleware-hmac+description:+ Wai HMAC Authentication Middleware implementation.+ .+ This middleware closely models the Amazon AWS Authentication scheme.+ By default, this middleware will also default to using the HTTP+ Authorization header.+ .+ See @wai-middleware-hmac-client@ for ready-to-use client module.++++source-repository head+ type: git+ location: git://github.com/creichert/wai-middleware-hmac.git++++library+ exposed-modules: Network.Wai.Middleware.HmacAuth+ ghc-options: -Wall+ default-language: Haskell2010+ build-depends: base == 4.*+ , base64-bytestring >= 1.0+ , byteable+ , bytestring+ , case-insensitive+ , cryptohash+ , http-types >= 0.8+ , transformers+ , wai >= 3.0+ , word8 >= 0.1++++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test/+ other-modules: WaiMiddlewareHmacAuthSpec+ ghc-options: -Wall -Werror -threaded+ default-language: Haskell2010+ build-depends: base == 4.*+ , bytestring+ , wai-middleware-hmac+ , wai+ , wai-extra+ , hspec >= 1.3+ , http-types+ , HUnit++++test-suite doctest+ default-language: Haskell2010+ ghc-options: -Wall -Werror -threaded+ main-is: test/DocTest.hs+ type: exitcode-stdio-1.0+ build-depends: base+ , doctest == 0.9.*+ , Glob == 0.7.*++++test-suite haddock+ main-is: test/Haddock.hs+ ghc-options: -Wall -Werror -threaded+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ build-depends: base+ , process+ , regex-compat++++test-suite hlint+ main-is: test/HLint.hs+ ghc-options: -Wall -Werror -threaded+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ build-depends: base+ , hlint == 1.8.*