WaiSpec.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}

module Katip.WaiSpec (spec) where

import Data.Foldable (for_)
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.UUID as Uuid
import DebugApplication (withDebugApplication)
import qualified DebugApplication
import qualified Katip
import LogEntry (LogEntry (LogEntry))
import qualified LogEntry
import qualified Network.HTTP.Client as Http
import Test.Hspec (Spec, describe, it, runIO, shouldBe, shouldSatisfy)

allSeverities :: [Katip.Severity]
allSeverities = [minBound ..]

spec :: Spec
spec = describe "middleware" $ do
  manager <- runIO $ Http.newManager Http.defaultManagerSettings

  for_ allSeverities $ \severity -> do
    let prettySeverity = Text.unpack . Text.toLower $ Katip.renderSeverity severity

    it ("logs as " <> prettySeverity <> " and adds the request information to the context") $ do
      let message = "Context should be added when severity is " <> Text.pack prettySeverity

      logs <- withDebugApplication severity $ \debugApp ->
        DebugApplication.sendLogRequest manager debugApp "GET" message

      [log1, log2, log3] <- traverse LogEntry.toLogEntry logs

      let expectedRequest =
            LogEntry.Request
              { id = Uuid.nil
              , httpVersion = "HTTP/1.1"
              , remoteHost = "127.0.0.1:1234"
              , isSecure = False
              , method = "GET"
              , path = "log"
              , queryString = [("message", Just message)]
              , bodyLength = "KnownLength 0"
              , headers =
                  LogEntry.Headers
                    { host = Just "localhost:1234"
                    , referer = Nothing
                    , userAgent = Nothing
                    , range = Nothing
                    }
              }

      let expectedLog1 =
            LogEntry
              { logMessage = "Request received"
              , logData =
                  LogEntry.LogData
                    { response = Nothing
                    , request = Just expectedRequest
                    }
              , logSeverity = severity
              }
          expectedLog2 =
            LogEntry
              { logMessage = message
              , logData =
                  LogEntry.LogData
                    { response = Nothing
                    , request = Just expectedRequest
                    }
              , logSeverity = severity
              }
          expectedLog3 =
            LogEntry
              { logMessage = "Response sent"
              , logData =
                  LogEntry.LogData
                    { response =
                        Just $
                          LogEntry.Response
                            { elapsedTimeInNanoSeconds = 123
                            , status = 202
                            }
                    , LogEntry.request = Just expectedRequest
                    }
              , logSeverity = severity
              }

      log1 `shouldSatisfy` LogEntry.isMostlySameAs expectedLog1
      log2 `shouldSatisfy` LogEntry.isMostlySameAs expectedLog2
      log3 `shouldSatisfy` LogEntry.isMostlySameAs expectedLog3

    it ("logs as " <> prettySeverity <> " and uses a different requestId for every request") $ do
      logs <- withDebugApplication severity $ \debugApp ->
        for_ ["GET", "POST", "PATCH", "PUT", "DELETE"] $ \method -> do
          DebugApplication.sendNoContentRequest manager debugApp method
          DebugApplication.sendNotFoundRequest manager debugApp method
          DebugApplication.sendLogRequest manager debugApp method "Some example log message"

      parsedLogs <- traverse LogEntry.toLogEntry logs

      let requestIds =
            flip Maybe.mapMaybe parsedLogs $ \entry -> do
              _response <- LogEntry.response $ LogEntry.logData entry
              request <- LogEntry.request $ LogEntry.logData entry
              pure $ LogEntry.id request

          originalLength = length requestIds

          uniqueLength = Set.size $ Set.fromList requestIds

      originalLength `shouldBe` 15

      uniqueLength `shouldBe` originalLength

    it ("logs as " <> prettySeverity <> " and has non zero elapsed time") $ do
      logs <- withDebugApplication severity $ \debugApp ->
        for_ ["GET", "POST", "PATCH", "PUT", "DELETE"] $ \method -> do
          DebugApplication.sendNoContentRequest manager debugApp method
          DebugApplication.sendNotFoundRequest manager debugApp method
          DebugApplication.sendLogRequest manager debugApp method "Some example log message"

      parsedLogs <- traverse LogEntry.toLogEntry logs

      let elapsedTimes =
            flip Maybe.mapMaybe parsedLogs $ \entry -> do
              response <- LogEntry.response $ LogEntry.logData entry
              pure $ LogEntry.elapsedTimeInNanoSeconds response

      length elapsedTimes `shouldBe` 15

      elapsedTimes `shouldSatisfy` all (> 0)