diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Network/Wai/Middleware/HmacAuth.hs b/Network/Wai/Middleware/HmacAuth.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Middleware/HmacAuth.hs @@ -0,0 +1,369 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Network.Wai.Middleware.HmacAuth +-- Description : WAI HMAC Authentication Middleware +-- Copyright : (c) 2015 Christopher Reichert +-- License : BSD3 +-- Maintainer : Christopher Reichert +-- 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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/DocTest.hs b/test/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/DocTest.hs @@ -0,0 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- Module : DocTest.hs +-- Description : Documentation Testing +-- Copyright : (c) 2015 Christopher Reichert +-- License : AllRightsReserved +-- Maintainer : Christopher Reichert +-- 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 diff --git a/test/HLint.hs b/test/HLint.hs new file mode 100644 --- /dev/null +++ b/test/HLint.hs @@ -0,0 +1,36 @@ +----------------------------------------------------------------------------- +-- | +-- Module : HLint +-- Description : Lint Testing Coverage +-- Copyright : (c) 2015 Christopher Reichert +-- License : BSD3 +-- Maintainer : Christopher Reichert +-- 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" + ] diff --git a/test/Haddock.hs b/test/Haddock.hs new file mode 100644 --- /dev/null +++ b/test/Haddock.hs @@ -0,0 +1,55 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Haddock +-- Description : Haddock Test Coverage +-- Copyright : (c) 2015 Christopher Reichert +-- License : BSD3 +-- Maintainer : Christopher Reichert +-- 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]*)% " diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/WaiMiddlewareHmacAuthSpec.hs b/test/WaiMiddlewareHmacAuthSpec.hs new file mode 100644 --- /dev/null +++ b/test/WaiMiddlewareHmacAuthSpec.hs @@ -0,0 +1,183 @@ +------------------------------------------------------------------------ +-- | +-- Module : WaiMiddlewareHmacAuthSpec +-- Description : Wai HMAC Auth Middleware Spec +-- Copyright : (c) 2015 Christopher Reichert +-- License : BSD3 +-- Maintainer : Christopher Reichert +-- 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 diff --git a/wai-middleware-hmac.cabal b/wai-middleware-hmac.cabal new file mode 100644 --- /dev/null +++ b/wai-middleware-hmac.cabal @@ -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.*