katip-wai-0.1.2.0: test/LogEntry.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module LogEntry (
  Headers (..),
  Request (..),
  Response (..),
  LogData (..),
  LogEntry (..),
  toLogEntry,
  isMostlySameAs,
) where

import Data.Aeson ((.:))
import qualified Data.Aeson as Aeson
import Data.Function (on)
import Data.Text (Text)
import Data.UUID (UUID)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import qualified Katip

data Headers = Headers
  { host :: Maybe Text
  , referer :: Maybe Text
  , userAgent :: Maybe Text
  , range :: Maybe Text
  }
  deriving (Show, Generic, Eq)

instance Aeson.FromJSON Headers

data Request = Request
  { id :: UUID
  , httpVersion :: Text
  , remoteHost :: Text
  , isSecure :: Bool
  , method :: Text
  , path :: Text
  , queryString :: [(Text, Maybe Text)]
  , bodyLength :: Text
  , headers :: Headers
  }
  deriving (Show, Generic)

instance Aeson.FromJSON Request

data Response = Response
  { elapsedTimeInNanoSeconds :: Natural
  , status :: Int
  }
  deriving (Show, Generic)

instance Aeson.FromJSON Response

data LogData = LogData
  { request :: Maybe Request
  , response :: Maybe Response
  }
  deriving (Generic, Show)

instance Aeson.FromJSON LogData

data LogEntry = LogEntry
  { logMessage :: Text
  , logData :: LogData
  , logSeverity :: Katip.Severity
  }
  deriving (Show)

instance Aeson.FromJSON LogEntry where
  parseJSON = Aeson.withObject "LogEntry" $ \obj ->
    LogEntry <$> (obj .: "msg") <*> (obj .: "data") <*> (obj .: "sev")

toLogEntry :: Aeson.Value -> IO LogEntry
toLogEntry value =
  case Aeson.fromJSON value of
    Aeson.Success entry -> pure entry
    Aeson.Error reason -> fail reason

isMostlySameAs :: LogEntry -> LogEntry -> Bool
isMostlySameAs log1 log2 =
  let compareResponse =
        on (==) (fmap status)
      compareHeaders head1 head2 =
        on (==) (fmap referer) head1 head2
          && on (==) (fmap userAgent) head1 head2
          && on (==) (fmap range) head1 head2
      compareRequest req1 req2 =
        on (==) (fmap httpVersion) req1 req2
          && on (==) (fmap isSecure) req1 req2
          && on (==) (fmap method) req1 req2
          && on (==) (fmap path) req1 req2
          && on (==) (fmap queryString) req1 req2
          && on (==) (fmap bodyLength) req1 req2
          && on compareHeaders (fmap headers) req1 req2
   in on (==) logMessage log1 log2
        && on compareRequest (request . logData) log1 log2
        && on compareResponse (response . logData) log1 log2

instance Eq LogEntry where
  (==) = isMostlySameAs