-- | A module for creating great logs in code that sends commands to Redis.
module Log.RedisCommands
  ( Details,
    emptyDetails,
    commands,
    host,
    port,
  )
where

import qualified Data.Aeson as Aeson

-- | A type describing redis commands.
--
-- > emptyDetails
-- >   { commands = [ "GET weather" ]
-- >   , host = Just "my-redis-host"
-- >   }
data Details = Details
  { -- | The commands that were sent to redis. Because Redis support for
    -- pipelining and transactions it's possible for one logical operation from
    -- the application perspective to contain multiple commands.
    --
    -- These commands are expected not to contain any sensitive information.
    -- Make sure sensitive values are mocked out, for example by replacing them
    -- with *****.
    Details -> List Text
commands :: List Text,
    -- | The host the redis commands are sent too.
    Details -> Maybe Text
host :: Maybe Text,
    -- | The port redis is running on.
    Details -> Maybe Int
port :: 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 = List Text -> Maybe Text -> Maybe Int -> Details
Details [] 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
    }

instance Platform.TracingSpanDetails Details