{-# LANGUAGE LambdaCase #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Logging types specific to the pool database.
--
module Cardano.Pool.DB.Log
    ( PoolDbLog (..)
    , ParseFailure (..)
    ) where

import Prelude

import Cardano.BM.Data.Severity
    ( Severity (..) )
import Cardano.BM.Data.Tracer
    ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
import Cardano.DB.Sqlite
    ( DBLog (..) )
import Cardano.Wallet.Logging
    ( BracketLog )
import Cardano.Wallet.Primitive.Types
    ( EpochNo, PoolId, PoolRetirementCertificate )
import Data.Text
    ( Text )
import Data.Text.Class
    ( ToText (..), toText )
import Fmt
    ( pretty )

import qualified Data.Text as T

data PoolDbLog
    = MsgGeneric DBLog
    | MsgParseFailure ParseFailure
    | MsgRemovingPool PoolId
    | MsgRemovingRetiredPools [PoolRetirementCertificate]
    | MsgRemovingRetiredPoolsForEpoch EpochNo BracketLog
    deriving (PoolDbLog -> PoolDbLog -> Bool
(PoolDbLog -> PoolDbLog -> Bool)
-> (PoolDbLog -> PoolDbLog -> Bool) -> Eq PoolDbLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolDbLog -> PoolDbLog -> Bool
$c/= :: PoolDbLog -> PoolDbLog -> Bool
== :: PoolDbLog -> PoolDbLog -> Bool
$c== :: PoolDbLog -> PoolDbLog -> Bool
Eq, Int -> PoolDbLog -> ShowS
[PoolDbLog] -> ShowS
PoolDbLog -> String
(Int -> PoolDbLog -> ShowS)
-> (PoolDbLog -> String)
-> ([PoolDbLog] -> ShowS)
-> Show PoolDbLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolDbLog] -> ShowS
$cshowList :: [PoolDbLog] -> ShowS
show :: PoolDbLog -> String
$cshow :: PoolDbLog -> String
showsPrec :: Int -> PoolDbLog -> ShowS
$cshowsPrec :: Int -> PoolDbLog -> ShowS
Show)

data ParseFailure = ParseFailure
    { ParseFailure -> Text
parseFailureOperationName
        :: Text
      -- ^ The name of the operation in which the parse failure occurred.
    , ParseFailure -> Text
parseFailure
        :: Text
      -- ^ A description of the parse failure.
    }
    deriving (ParseFailure -> ParseFailure -> Bool
(ParseFailure -> ParseFailure -> Bool)
-> (ParseFailure -> ParseFailure -> Bool) -> Eq ParseFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseFailure -> ParseFailure -> Bool
$c/= :: ParseFailure -> ParseFailure -> Bool
== :: ParseFailure -> ParseFailure -> Bool
$c== :: ParseFailure -> ParseFailure -> Bool
Eq, Int -> ParseFailure -> ShowS
[ParseFailure] -> ShowS
ParseFailure -> String
(Int -> ParseFailure -> ShowS)
-> (ParseFailure -> String)
-> ([ParseFailure] -> ShowS)
-> Show ParseFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseFailure] -> ShowS
$cshowList :: [ParseFailure] -> ShowS
show :: ParseFailure -> String
$cshow :: ParseFailure -> String
showsPrec :: Int -> ParseFailure -> ShowS
$cshowsPrec :: Int -> ParseFailure -> ShowS
Show)

instance HasPrivacyAnnotation PoolDbLog

instance HasSeverityAnnotation PoolDbLog where
    getSeverityAnnotation :: PoolDbLog -> Severity
getSeverityAnnotation = \case
        MsgGeneric DBLog
e -> DBLog -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation DBLog
e
        MsgParseFailure {} -> Severity
Error
        MsgRemovingPool {} -> Severity
Notice
        MsgRemovingRetiredPools {} -> Severity
Debug
        MsgRemovingRetiredPoolsForEpoch {} -> Severity
Debug

instance ToText PoolDbLog where
    toText :: PoolDbLog -> Text
toText = \case
        MsgGeneric DBLog
e -> DBLog -> Text
forall a. ToText a => a -> Text
toText DBLog
e
        MsgParseFailure ParseFailure
e -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Unexpected parse failure in '"
            , ParseFailure -> Text
parseFailureOperationName ParseFailure
e
            , Text
"'. Description of error: "
            , ParseFailure -> Text
parseFailure ParseFailure
e
            ]
        MsgRemovingPool PoolId
p -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Removing the following pool from the database: "
            , PoolId -> Text
forall a. ToText a => a -> Text
toText PoolId
p
            , Text
"."
            ]
        MsgRemovingRetiredPools [] ->
            Text
"There are no retired pools to remove."
        MsgRemovingRetiredPools [PoolRetirementCertificate]
poolRetirementCerts -> [Text] -> Text
T.unlines
            [ Text
"Removing the following retired pools:"
            , [Text] -> Text
T.unlines (PoolRetirementCertificate -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (PoolRetirementCertificate -> Text)
-> [PoolRetirementCertificate] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PoolRetirementCertificate]
poolRetirementCerts)
            ]
        MsgRemovingRetiredPoolsForEpoch EpochNo
epoch BracketLog
nestedMessage -> [Text] -> Text
T.concat
            [ Text
"Removing pools that retired in or before epoch "
            , EpochNo -> Text
forall a. ToText a => a -> Text
toText EpochNo
epoch
            , Text
": "
            , BracketLog -> Text
forall a. ToText a => a -> Text
toText BracketLog
nestedMessage
            ]