{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Tracing.Peras () where

import Cardano.Logging (LogFormatting (..))
import Data.Aeson (Value (..), (.=))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Void (absurd)
import Ouroboros.Consensus.Block.SupportsPeras (PerasVotingCommitteeError)
import Ouroboros.Consensus.Committee.WFA (SeatIndex (..))
import qualified Ouroboros.Consensus.Peras.Error.V1 as V1
import Ouroboros.Consensus.Peras.Types (PerasCertSize (..), VoteWeight (..))
import Ouroboros.Consensus.Peras.Void (VoidPerasError (..))
import Ouroboros.Consensus.Peras.Voting.Adapter (PerasConversionError (..))
import Ouroboros.Consensus.Tracing.Committee ()

--
-- instances for PerasError
--

instance LogFormatting (VoidPerasError blk) where
  forMachine :: DetailLevel -> VoidPerasError blk -> Object
forMachine DetailLevel
_dtal = Void -> Object
forall a. Void -> a
absurd (Void -> Object)
-> (VoidPerasError blk -> Void) -> VoidPerasError blk -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VoidPerasError blk -> Void
forall blk. VoidPerasError blk -> Void
unVoidPerasError

instance
  LogFormatting (PerasVotingCommitteeError blk) =>
  LogFormatting (V1.PerasError blk)
  where
  forMachine :: DetailLevel -> PerasError blk -> Object
forMachine DetailLevel
dtal (V1.PerasVotingWFAError WFAError
e) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasVotingWFAError"
      , DetailLevel -> WFAError -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal WFAError
e
      ]
  forMachine DetailLevel
dtal (V1.PerasVotingCommitteeError PerasVotingCommitteeError blk
e) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasVotingCommitteeError"
      , DetailLevel -> PerasVotingCommitteeError blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal PerasVotingCommitteeError blk
e
      ]
  forMachine DetailLevel
dtal (V1.PerasVotingConversionError PerasConversionError
e) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasVotingConversionError"
      , DetailLevel -> PerasConversionError -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal PerasConversionError
e
      ]
  forMachine DetailLevel
_dtal (V1.PerasQuorumNotReachedError VoteWeight
e) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasQuorumNotReachedError"
      , Key
"voteWeight" Key -> Ratio Integer -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VoteWeight -> Ratio Integer
unVoteWeight VoteWeight
e
      ]
  forMachine DetailLevel
_dtal (V1.PerasCertTooLargeError PerasCertSize
limit PerasCertSize
actual) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasCertTooLargeError"
      , Key
"limit" Key -> Word32 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasCertSize -> Word32
unPerasCertSize PerasCertSize
limit
      , Key
"actual" Key -> Word32 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasCertSize -> Word32
unPerasCertSize PerasCertSize
actual
      ]

instance LogFormatting PerasConversionError where
  forMachine :: DetailLevel -> PerasConversionError -> Object
forMachine DetailLevel
_dtal (EveryoneVotesButFoundNonPersistentVoterInVote SeatIndex
seatIndex) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"EveryoneVotesButFoundNonPersistentVoterInVote"
      , Key
"seatIndex" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SeatIndex -> Word64
unSeatIndex SeatIndex
seatIndex
      ]
  forMachine DetailLevel
_dtal (EveryoneVotesButFoundNonPersistentVotersInCert NE [SeatIndex]
seatIndices) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"EveryoneVotesButFoundNonPersistentVotersInCert"
      , Key
"seatIndices" Key -> [Word64] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (SeatIndex -> Word64) -> [SeatIndex] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SeatIndex -> Word64
unSeatIndex (NonEmpty SeatIndex -> [SeatIndex]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty SeatIndex
NE [SeatIndex]
seatIndices)
      ]
  forMachine DetailLevel
_dtal (SeatIndexOverflowError Word64
word64) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"SeatIndexOverflowError"
      , Key
"seatIndex" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
word64
      ]
  forMachine DetailLevel
_dtal (CryptoError String
msg) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CryptoError"
      , Key
"message" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
msg
      ]