HmacSpec.hs

module Servant.Auth.HmacSpec (spec) where

import Data.Text (Text)
import qualified Data.Text as Text
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Network.HTTP.Types (Status, unauthorized401)
import qualified Network.Wai.Handler.Warp as Warp
import Servant (
    Application,
    Handler,
    MimeRender,
    MimeUnrender,
    PlainText,
    Post,
    Proxy (Proxy),
    ReqBody,
    Server,
    serve,
    serveWithContext,
    type (:>),
 )
import Servant.Auth.Hmac (
    HmacAuth,
    SecretKey (SecretKey),
    defaultHmacSettings,
    hmacAuthServerContext,
    hmacClient,
    runHmacClient,
    signSHA256,
 )
import Servant.Client (
    BaseUrl (baseUrlPort),
    ClientError (..),
    ResponseF (responseStatusCode),
    client,
    mkClientEnv,
    parseBaseUrl,
    runClientM,
 )
import Test.Hspec (
    Expectation,
    Spec,
    around,
    context,
    describe,
    expectationFailure,
    it,
    runIO,
    shouldBe,
 )

newtype EchoMessage = EchoMessage
    {emContent :: Text}
    deriving stock (Eq, Show)
    deriving (MimeRender PlainText, MimeUnrender PlainText) via Text

type EchoApi =
    HmacAuth :> UnprotectedEchoApi

type UnprotectedEchoApi =
    -- Echo back a reversed message.
    "echo" :> ReqBody '[PlainText] EchoMessage :> Post '[PlainText] EchoMessage

echoBack :: EchoMessage -> Handler EchoMessage
echoBack (EchoMessage msg) = pure $ EchoMessage (Text.reverse msg)

unsecuredEchoServer :: Server UnprotectedEchoApi
unsecuredEchoServer = echoBack

unsecuredEchoApp :: Application
unsecuredEchoApp = serve (Proxy @UnprotectedEchoApi) unsecuredEchoServer

withUnsecuredEchoApp :: (Warp.Port -> IO ()) -> IO ()
withUnsecuredEchoApp = Warp.testWithApplication (pure unsecuredEchoApp)

securedEchoServer :: Server EchoApi
securedEchoServer = const echoBack

securedEchoApp :: SecretKey -> Application
securedEchoApp sk = serveWithContext (Proxy @EchoApi) (hmacAuthServerContext signSHA256 sk) securedEchoServer

withSecuredEchoApp :: SecretKey -> (Warp.Port -> IO ()) -> IO ()
withSecuredEchoApp sk = Warp.testWithApplication (pure $ securedEchoApp sk)

shouldBeASuccessWith :: (Show a, Eq a) => Either ClientError a -> a -> Expectation
errA `shouldBeASuccessWith` a = errA `shouldBe` Right a

shouldBeAFailureWithStatus :: (Show a) => Either ClientError a -> Status -> Expectation
Left (FailureResponse _ resp) `shouldBeAFailureWithStatus` status = responseStatusCode resp `shouldBe` status
Left (DecodeFailure _ resp) `shouldBeAFailureWithStatus` status = responseStatusCode resp `shouldBe` status
Left (UnsupportedContentType _ resp) `shouldBeAFailureWithStatus` status = responseStatusCode resp `shouldBe` status
Left (InvalidContentTypeHeader resp) `shouldBeAFailureWithStatus` status = responseStatusCode resp `shouldBe` status
Left (ConnectionError e) `shouldBeAFailureWithStatus` status = expectationFailure $ "Expected '" <> show status <> "', got this instead: " <> show e
Right a `shouldBeAFailureWithStatus` status = expectationFailure $ "Expected '" <> show status <> "', got this instead: " <> show a

spec :: Spec
spec =
    describe "Hmac" $ do
        let sk = SecretKey "not-so-secret-secret-key!"
        let anotherSk = SecretKey "some-other-key!!"

        context "with a secured server" $ do
            around (withSecuredEchoApp sk) $ do
                let securedEchoBack = hmacClient @UnprotectedEchoApi
                let unsecuredEchoBack = client (Proxy @UnprotectedEchoApi)

                baseUrl <- runIO $ parseBaseUrl "http://localhost"
                manager <- runIO $ newManager defaultManagerSettings
                let clientEnv port = mkClientEnv manager (baseUrl{baseUrlPort = port})

                it "should have the server authenticate the client's secured request with the same secret" $ \port -> do
                    result <- runHmacClient (defaultHmacSettings sk) (clientEnv port) (securedEchoBack $ EchoMessage "abcdef123789")
                    result `shouldBeASuccessWith` EchoMessage "987321fedcba"

                it "should have the server reject the client's secured request with a different secret and respond with a 401 status code" $ \port -> do
                    result <- runHmacClient (defaultHmacSettings anotherSk) (clientEnv port) (securedEchoBack $ EchoMessage "very sensitive message")
                    result `shouldBeAFailureWithStatus` unauthorized401

                it "should have the server reject the client's insecured request and respond with a 401 status code" $ \port -> do
                    result <- runClientM (unsecuredEchoBack $ EchoMessage "very sensitive message") (clientEnv port)
                    result `shouldBeAFailureWithStatus` unauthorized401

        context "with an unsecured server" $ do
            around withUnsecuredEchoApp $ do
                let securedEchoBack = hmacClient @UnprotectedEchoApi

                baseUrl <- runIO $ parseBaseUrl "http://localhost"
                manager <- runIO $ newManager defaultManagerSettings
                let clientEnv port = mkClientEnv manager (baseUrl{baseUrlPort = port})

                it "should have the server respond to the client and ignore the client request's HMAC signature" $ \port -> do
                    result <- runHmacClient (defaultHmacSettings sk) (clientEnv port) (securedEchoBack $ EchoMessage "abcdef123789")
                    result `shouldBeASuccessWith` EchoMessage "987321fedcba"