-- | A module for creating great logs in code that send or receive HTTP
-- requests.
module Log.HttpRequest
  ( Details,
    Incoming (Incoming),
    Outgoing (Outgoing),
    emptyDetails,
    method,
    host,
    path,
    queryString,
    headers,
    httpVersion,
    endpoint,
    status,
  )
where

import qualified Data.Aeson as Aeson
import qualified Dict

-- | A type describing an http request.
--
-- > emptyDetails
-- >   { method = Just "GET"
-- >   , host = Just "https://noredink.com"
-- >   }
data Details = Details
  { -- | The method of the http request.
    Details -> Maybe Text
method :: Maybe Text,
    -- | The host the http request is made to.
    Details -> Maybe Text
host :: Maybe Text,
    -- | The path portion of the request URI.
    Details -> Maybe Text
path :: Maybe Text,
    -- | The query string portion of the request URI.
    Details -> Maybe Text
queryString :: Maybe Text,
    -- | The headers on the request. Do not pass headers with sensitive
    -- information in there, filter them out first!
    Details -> Dict Text Text
headers :: Dict.Dict Text Text,
    -- | The version of the http protocol used.
    Details -> Maybe Text
httpVersion :: Maybe Text,
    -- | The endpoint called. This is like the path, but with the dynamic parts
    -- of the path replaced with arguments.
    --
    -- For example:
    -- > path     /teeth/upperleft/12
    -- > endpoint /teeth/:quadrant/:number
    Details -> Maybe Text
endpoint :: Maybe Text,
    -- | The response status of the request.
    Details -> Maybe Int
status :: Maybe Int
  }
  deriving ((forall x. Details -> Rep Details x)
-> (forall x. Rep Details x -> Details) -> Generic Details
forall x. Rep Details x -> Details
forall x. Details -> Rep Details x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Details x -> Details
$cfrom :: forall x. Details -> Rep Details x
Generic)

-- | An empty details value to be modified by you.
emptyDetails :: Details
emptyDetails :: Details
emptyDetails = Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Dict Text Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Details
Details Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Dict Text Text
forall k v. Dict k v
Dict.empty Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

instance Aeson.ToJSON Details where
  toJSON :: Details -> Value
toJSON = Options -> Details -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
infoEncodingOptions
  toEncoding :: Details -> Encoding
toEncoding = Options -> Details -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
infoEncodingOptions

infoEncodingOptions :: Aeson.Options
infoEncodingOptions :: Options
infoEncodingOptions =
  Options
Aeson.defaultOptions
    { fieldLabelModifier :: String -> String
Aeson.fieldLabelModifier = Char -> String -> String
Aeson.camelTo2 Char
' ',
      omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True
    }

newtype Incoming = Incoming Details
  deriving ([Incoming] -> Encoding
[Incoming] -> Value
Incoming -> Encoding
Incoming -> Value
(Incoming -> Value)
-> (Incoming -> Encoding)
-> ([Incoming] -> Value)
-> ([Incoming] -> Encoding)
-> ToJSON Incoming
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Incoming] -> Encoding
$ctoEncodingList :: [Incoming] -> Encoding
toJSONList :: [Incoming] -> Value
$ctoJSONList :: [Incoming] -> Value
toEncoding :: Incoming -> Encoding
$ctoEncoding :: Incoming -> Encoding
toJSON :: Incoming -> Value
$ctoJSON :: Incoming -> Value
Aeson.ToJSON)

instance Platform.TracingSpanDetails Incoming

newtype Outgoing = Outgoing Details
  deriving ([Outgoing] -> Encoding
[Outgoing] -> Value
Outgoing -> Encoding
Outgoing -> Value
(Outgoing -> Value)
-> (Outgoing -> Encoding)
-> ([Outgoing] -> Value)
-> ([Outgoing] -> Encoding)
-> ToJSON Outgoing
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Outgoing] -> Encoding
$ctoEncodingList :: [Outgoing] -> Encoding
toJSONList :: [Outgoing] -> Value
$ctoJSONList :: [Outgoing] -> Value
toEncoding :: Outgoing -> Encoding
$ctoEncoding :: Outgoing -> Encoding
toJSON :: Outgoing -> Value
$ctoJSON :: Outgoing -> Value
Aeson.ToJSON)

instance Platform.TracingSpanDetails Outgoing