{-# LANGUAGE RecordWildCards #-} module Network.Hawk.Tests (tests) where import Data.Either (isRight) import Data.Default import Data.ByteString (ByteString) import Network.Wai (Request(..), defaultRequest) import Network.HTTP.Client (Response(..)) import Network.HTTP.Client.Internal (Response(..)) import Network.HTTP.Types.Status (ok200) import Data.Text.Encoding (decodeUtf8) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Test.HUnit (Assertion, (@?=), (@?)) import Network.Hawk import Network.Hawk.Server.Types (HawkReq(..), AuthSuccess(..)) import qualified Network.Hawk.Client as Client import qualified Network.Hawk.Server as Server import qualified Network.Hawk.Client.Types as Client (HeaderArtifacts(..)) import qualified Network.Hawk.Server.Types as Server (HeaderArtifacts(..)) tests :: TestTree tests = testGroup "Network.Hawk" [ testCase "generates a header then successfully parses it" test01 --, testCase "generates a header then successfully parses it (WAI request)" test02 , testCase "generates a header then successfully parses it (absolute request uri)" test03 ] makeCreds :: Client.ClientId -> (Client.Credentials, Server.CredentialsFunc IO String) makeCreds i = (cc, \i -> return sc) where cc = Client.Credentials i key algo sc = Right (Server.Credentials key algo, user) key = "werxhqb98rpaxn39848xrunpaw3489ruxnpa98w4rxn" algo = if i == "1" then HawkAlgo SHA1 else HawkAlgo SHA256 user = "steve" test01 :: Assertion test01 = do let (creds, credsFunc) = makeCreds "123456" ext = Just "some-app-data" hdr <- Client.header "http://example.com:8080/resource/4?filter=a" "GET" creds Nothing ext let hrq = def { hrqUrl = "/resource/4?filter=a" , hrqHost = "example.com" , hrqPort = Just 8080 , hrqAuthorization = Client.hdrField hdr } r <- Server.authenticate def credsFunc hrq isRight r @?= True let Right (Server.AuthSuccess creds' arts user) = r user @?= "steve" Server.shaExt arts @?= Just "some-app-data" -- generates a header then successfully parse it (WAI request) test02 :: Assertion test02 = do -- Generate client header let (creds, credsFunc) = makeCreds "123456" ext = Just "some-app-data" payload = PayloadInfo "text/plain;x=y" "some not so random text" hdr <- Client.header "http://example.com:8080/resource/4?filter=a" "POST" creds (Just payload) ext -- Server verifies client request let req = defaultRequest { requestMethod = "POST" , rawPathInfo = "/resource/4" , rawQueryString = "?filter=a" , requestHeaders = [("host", "example.com:8080"), ("content-type", "text/plain;x=y"), ("authorization", Client.hdrField hdr)] } r <- Server.authenticateRequest def credsFunc req (Just (payloadData payload)) -- fixme: Left "Bad mac" isRight r @? "Expected auth success, got: " ++ show r let Right s@(Server.AuthSuccess creds2 arts user) = r user @?= "steve" Server.shaExt arts @?= Just "some-app-data" Server.authenticatePayload s payload @?= Right () -- Client verifies server response let payload2 = PayloadInfo "text/plain" "Some reply" hdr2 = Server.header creds2 arts (Just payload2) res = Response { responseStatus = ok200 , responseHeaders = [hdr2, ("content-type", payloadContentType payload2)] , responseBody = payloadData payload2 , responseVersion = undefined , responseCookieJar = undefined , responseClose' = undefined } creds2' = clientCreds "" creds2 arts' = clientHeaderArtifacts arts r2 <- Client.authenticate res creds2' arts' (Just (payloadData payload2)) Client.ServerAuthorizationRequired r2 @?= Right () clientCreds :: ClientId -> Server.Credentials -> Client.Credentials clientCreds i (Server.Credentials k a) = Client.Credentials i k a -- fixme: there's possibly a case for merging these two types -- server artifacts have header mac and client id -- dlg is text/bytestring clientHeaderArtifacts :: Server.HeaderArtifacts -> Client.HeaderArtifacts clientHeaderArtifacts Server.HeaderArtifacts{..} = Client.HeaderArtifacts { chaTimestamp = shaTimestamp , chaNonce = shaNonce , chaMethod = shaMethod , chaHost = shaHost , chaPort = shaPort , chaResource = shaResource , chaHash = shaHash , chaExt = shaExt , chaApp = shaApp , chaDlg = decodeUtf8 <$> shaDlg -- , shaId :: ClientId -- , shaMac :: ByteString } -- generates a header then successfully parse it (absolute request uri) test03 :: Assertion test03 = do let (creds, credsFunc) = makeCreds "123456" ext = Just "some-app-data" payload = PayloadInfo "text/plain;x=y" "some not so random text" hdr <- Client.header "http://example.com:8080/resource/4?filter=a" "POST" creds (Just payload) ext let hrq = def { hrqMethod = "POST" , hrqUrl = "/resource/4?filter=a" -- fixme: not absolute , hrqHost = "example.com" , hrqPort = Just 8080 , hrqAuthorization = Client.hdrField hdr , hrqPayload = Nothing } r <- Server.authenticate def credsFunc hrq isRight r @? "Expected auth success, got: " ++ show r let Right s@(Server.AuthSuccess creds' arts user) = r user @?= "steve" Server.shaExt arts @?= Just "some-app-data" Server.authenticatePayload s payload @?= Right ()