{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Tracing.Render
  ( renderBlockOrEBB
  , renderChunkNo
  , renderHeaderHash
  , renderHeaderHashForVerbosity
  , renderChainHash
  , renderTipBlockNo
  , renderTipHash
  , renderPoint
  , renderPointAsPhrase
  , renderPointForVerbosity
  , renderRealPoint
  , renderRealPointAsPhrase
  , renderSlotNo
  , renderTip
  , renderTipForVerbosity
  , renderTxId
  , renderTxIdForVerbosity
  , renderWithOrigin
  ) where

import           Cardano.Prelude
import           Prelude (id)

import qualified Data.ByteString.Base16 as B16
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import           Cardano.BM.Tracing (TracingVerbosity (..))
import           Cardano.Slotting.Slot (EpochNo (..), SlotNo (..), WithOrigin (..))
import           Cardano.Tracing.ConvertTxId (ConvertTxId (..))
import           Ouroboros.Consensus.Block (BlockNo (..), ConvertRawHash (..), RealPoint (..))
import           Ouroboros.Consensus.Block.Abstract (Point (..))
import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, TxId)
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (ChunkNo (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types (BlockOrEBB (..))
import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB
import           Ouroboros.Network.Block (ChainHash (..), HeaderHash, StandardHash, Tip, getTipPoint)

renderBlockOrEBB :: BlockOrEBB -> Text
renderBlockOrEBB :: BlockOrEBB -> Text
renderBlockOrEBB (Block SlotNo
slotNo) = Text
"Block at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
renderSlotNo SlotNo
slotNo
renderBlockOrEBB (EBB EpochNo
epochNo) = Text
"Epoch boundary block at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Text
renderEpochNo EpochNo
epochNo

renderChunkNo :: ChunkNo -> Text
renderChunkNo :: ChunkNo -> Text
renderChunkNo = String -> Text
Text.pack (String -> Text) -> (ChunkNo -> String) -> ChunkNo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (Word64 -> String) -> (ChunkNo -> Word64) -> ChunkNo -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ChunkNo -> Word64
unChunkNo

renderEpochNo :: EpochNo -> Text
renderEpochNo :: EpochNo -> Text
renderEpochNo = String -> Text
Text.pack (String -> Text) -> (EpochNo -> String) -> EpochNo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (Word64 -> String) -> (EpochNo -> Word64) -> EpochNo -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochNo -> Word64
unEpochNo

renderTipBlockNo :: ImmDB.Tip blk -> Text
renderTipBlockNo :: Tip blk -> Text
renderTipBlockNo = String -> Text
Text.pack (String -> Text) -> (Tip blk -> String) -> Tip blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (Word64 -> String) -> (Tip blk -> Word64) -> Tip blk -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockNo -> Word64
unBlockNo (BlockNo -> Word64) -> (Tip blk -> BlockNo) -> Tip blk -> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tip blk -> BlockNo
forall blk. Tip blk -> BlockNo
ImmDB.tipBlockNo

renderTipHash :: StandardHash blk => ImmDB.Tip blk -> Text
renderTipHash :: Tip blk -> Text
renderTipHash Tip blk
tInfo = String -> Text
Text.pack (String -> Text)
-> (HeaderHash blk -> String) -> HeaderHash blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HeaderHash blk -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (HeaderHash blk -> Text) -> HeaderHash blk -> Text
forall a b. (a -> b) -> a -> b
$ Tip blk -> HeaderHash blk
forall blk. Tip blk -> HeaderHash blk
ImmDB.tipHash Tip blk
tInfo

renderTxIdForVerbosity
  :: ConvertTxId blk
  => TracingVerbosity
  -> TxId (GenTx blk)
  -> Text
renderTxIdForVerbosity :: TracingVerbosity -> TxId (GenTx blk) -> Text
renderTxIdForVerbosity TracingVerbosity
verb = TracingVerbosity -> Text -> Text
trimHashTextForVerbosity TracingVerbosity
verb (Text -> Text)
-> (TxId (GenTx blk) -> Text) -> TxId (GenTx blk) -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId (GenTx blk) -> Text
forall blk. ConvertTxId blk => TxId (GenTx blk) -> Text
renderTxId

renderTxId :: ConvertTxId blk => TxId (GenTx blk) -> Text
renderTxId :: TxId (GenTx blk) -> Text
renderTxId = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (TxId (GenTx blk) -> ByteString) -> TxId (GenTx blk) -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (TxId (GenTx blk) -> ByteString)
-> TxId (GenTx blk)
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId (GenTx blk) -> ByteString
forall blk. ConvertTxId blk => TxId (GenTx blk) -> ByteString
txIdToRawBytes

renderWithOrigin :: (a -> Text) -> WithOrigin a -> Text
renderWithOrigin :: (a -> Text) -> WithOrigin a -> Text
renderWithOrigin a -> Text
_ WithOrigin a
Origin = Text
"origin"
renderWithOrigin a -> Text
render (At a
a) = a -> Text
render a
a

renderSlotNo :: SlotNo -> Text
renderSlotNo :: SlotNo -> Text
renderSlotNo = String -> Text
Text.pack (String -> Text) -> (SlotNo -> String) -> SlotNo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (Word64 -> String) -> (SlotNo -> Word64) -> SlotNo -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlotNo -> Word64
unSlotNo

renderRealPoint
  :: forall blk.
     ConvertRawHash blk
  => RealPoint blk
  -> Text
renderRealPoint :: RealPoint blk -> Text
renderRealPoint (RealPoint SlotNo
slotNo HeaderHash blk
headerHash) =
  Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) HeaderHash blk
headerHash
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
renderSlotNo SlotNo
slotNo

-- | Render a short phrase describing a 'RealPoint'.
-- e.g. "62292d753b2ee7e903095bc5f10b03cf4209f456ea08f55308e0aaab4350dda4 at
-- slot 39920"
renderRealPointAsPhrase
  :: forall blk.
     ConvertRawHash blk
  => RealPoint blk
  -> Text
renderRealPointAsPhrase :: RealPoint blk -> Text
renderRealPointAsPhrase (RealPoint SlotNo
slotNo HeaderHash blk
headerHash) =
  Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) HeaderHash blk
headerHash
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at slot "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
renderSlotNo SlotNo
slotNo

renderPointForVerbosity
  :: forall blk.
     ConvertRawHash blk
  => TracingVerbosity
  -> Point blk
  -> Text
renderPointForVerbosity :: TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
point =
  case Point blk
point of
    Point blk
GenesisPoint -> Text
"genesis (origin)"
    BlockPoint SlotNo
slot HeaderHash blk
h ->
      Proxy blk -> TracingVerbosity -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> TracingVerbosity -> HeaderHash blk -> Text
renderHeaderHashForVerbosity (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) TracingVerbosity
verb HeaderHash blk
h
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
renderSlotNo SlotNo
slot

renderPoint :: ConvertRawHash blk => Point blk -> Text
renderPoint :: Point blk -> Text
renderPoint = TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
MaximalVerbosity

-- | Render a short phrase describing a 'Point'.
-- e.g. "62292d753b2ee7e903095bc5f10b03cf4209f456ea08f55308e0aaab4350dda4 at
-- slot 39920" or "genesis (origin)" in the case of a genesis point.
renderPointAsPhrase :: forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase :: Point blk -> Text
renderPointAsPhrase Point blk
point =
  case Point blk
point of
    Point blk
GenesisPoint -> Text
"genesis (origin)"
    BlockPoint SlotNo
slot HeaderHash blk
h ->
      Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) HeaderHash blk
h
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at slot "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
renderSlotNo SlotNo
slot

renderTipForVerbosity
  :: ConvertRawHash blk
  => TracingVerbosity
  -> Tip blk
  -> Text
renderTipForVerbosity :: TracingVerbosity -> Tip blk -> Text
renderTipForVerbosity TracingVerbosity
verb = TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Point blk -> Text) -> (Tip blk -> Point blk) -> Tip blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tip blk -> Point blk
forall b. Tip b -> Point b
getTipPoint

renderTip :: ConvertRawHash blk => Tip blk -> Text
renderTip :: Tip blk -> Text
renderTip = TracingVerbosity -> Tip blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Tip blk -> Text
renderTipForVerbosity TracingVerbosity
MaximalVerbosity

renderHeaderHashForVerbosity
  :: ConvertRawHash blk
  => proxy blk
  -> TracingVerbosity
  -> HeaderHash blk
  -> Text
renderHeaderHashForVerbosity :: proxy blk -> TracingVerbosity -> HeaderHash blk -> Text
renderHeaderHashForVerbosity proxy blk
p TracingVerbosity
verb =
  TracingVerbosity -> Text -> Text
trimHashTextForVerbosity TracingVerbosity
verb (Text -> Text)
-> (HeaderHash blk -> Text) -> HeaderHash blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash proxy blk
p

-- | Hex encode and render a 'HeaderHash' as text.
renderHeaderHash :: ConvertRawHash blk => proxy blk -> HeaderHash blk -> Text
renderHeaderHash :: proxy blk -> HeaderHash blk -> Text
renderHeaderHash proxy blk
p = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
toRawHash proxy blk
p

renderChainHash :: (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash :: (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash HeaderHash blk -> Text
_ ChainHash blk
GenesisHash = Text
"GenesisHash"
renderChainHash HeaderHash blk -> Text
p (BlockHash HeaderHash blk
hash) = HeaderHash blk -> Text
p HeaderHash blk
hash

trimHashTextForVerbosity :: TracingVerbosity -> Text -> Text
trimHashTextForVerbosity :: TracingVerbosity -> Text -> Text
trimHashTextForVerbosity TracingVerbosity
verb =
  case TracingVerbosity
verb of
    TracingVerbosity
MinimalVerbosity -> Int -> Text -> Text
Text.take Int
7
    TracingVerbosity
NormalVerbosity -> Text -> Text
forall a. a -> a
id
    TracingVerbosity
MaximalVerbosity -> Text -> Text
forall a. a -> a
id