{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Scalar text rendering helpers for Consensus types, shared by the Consensus
-- tracing instances.
--
-- Moved here from @Cardano.Node.Tracing.Render@ in @cardano-node@. The
-- @cardano-api@-dependent helpers (script hashes, plutus purposes, missing
-- redeemers, incomplete withdrawals) were left behind in @cardano-node@, as
-- @cardano-api@ sits downstream of Consensus.
module Ouroboros.Consensus.Tracing.Render
  ( renderChunkNo
  , renderHeaderHash
  , renderHeaderHashForDetails
  , renderChainHash
  , renderTipBlockNo
  , renderTipHash
  , condenseT
  , renderPoint
  , renderPointAsPhrase
  , renderPointForDetails
  , renderRealPoint
  , renderRealPointAsPhrase
  , renderTxId
  , renderTxIdForDetails
  , renderWithOrigin
  ) where

import Cardano.Logging (DetailLevel (..))
import Cardano.Slotting.Slot (SlotNo (..), WithOrigin (..))
import qualified Data.ByteString.Base16 as B16
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Ouroboros.Consensus.Block (BlockNo (..), ConvertRawHash (..), RealPoint (..))
import Ouroboros.Consensus.Block.Abstract (Point (..))
import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, TxId)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (ChunkNo (..))
import Ouroboros.Consensus.Tracing.ConvertTxId (ConvertTxId (..))
import Ouroboros.Consensus.Util.Condense (Condense, condense)
import Ouroboros.Network.Block (ChainHash (..), HeaderHash, StandardHash)

condenseT :: Condense a => a -> Text
condenseT :: forall a. Condense a => a -> Text
condenseT = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Condense a => a -> String
condense

renderChunkNo :: ChunkNo -> Text
renderChunkNo :: ChunkNo -> Text
renderChunkNo = String -> Text
Text.pack (String -> Text) -> (ChunkNo -> String) -> ChunkNo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> (ChunkNo -> Word64) -> ChunkNo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkNo -> Word64
unChunkNo

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

renderTipHash :: StandardHash blk => ImmDB.Tip blk -> Text
renderTipHash :: forall blk. StandardHash blk => Tip blk -> Text
renderTipHash Tip blk
tInfo = String -> Text
Text.pack (String -> Text)
-> (HeaderHash blk -> String) -> HeaderHash blk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderHash blk -> String
forall a. Show a => a -> String
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

renderTxIdForDetails ::
  ConvertTxId blk =>
  DetailLevel ->
  TxId (GenTx blk) ->
  Text
renderTxIdForDetails :: forall blk.
ConvertTxId blk =>
DetailLevel -> TxId (GenTx blk) -> Text
renderTxIdForDetails DetailLevel
dtal = DetailLevel -> Text -> Text
trimHashTextForDetails DetailLevel
dtal (Text -> Text)
-> (TxId (GenTx blk) -> Text) -> TxId (GenTx blk) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId (GenTx blk) -> Text
forall blk. ConvertTxId blk => TxId (GenTx blk) -> Text
renderTxId

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

renderWithOrigin :: (a -> Text) -> WithOrigin a -> Text
renderWithOrigin :: forall a. (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 b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> (SlotNo -> Word64) -> SlotNo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Word64
unSlotNo

renderRealPoint ::
  forall blk.
  ConvertRawHash blk =>
  RealPoint blk ->
  Text
renderRealPoint :: forall blk. ConvertRawHash blk => 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 (forall t. Proxy t
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 :: forall blk. ConvertRawHash blk => 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 (forall t. Proxy t
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

renderPointForDetails ::
  forall blk.
  ConvertRawHash blk =>
  DetailLevel ->
  Point blk ->
  Text
renderPointForDetails :: forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
point =
  case Point blk
point of
    Point blk
GenesisPoint -> Text
"genesis (origin)"
    BlockPoint SlotNo
slot HeaderHash blk
h ->
      Proxy blk -> DetailLevel -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> DetailLevel -> HeaderHash blk -> Text
renderHeaderHashForDetails (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) DetailLevel
dtal 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 :: forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint = DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
DDetailed

-- | 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 :: forall blk. ConvertRawHash blk => 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 (forall t. Proxy t
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

renderHeaderHashForDetails ::
  ConvertRawHash blk =>
  proxy blk ->
  DetailLevel ->
  HeaderHash blk ->
  Text
renderHeaderHashForDetails :: forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> DetailLevel -> HeaderHash blk -> Text
renderHeaderHashForDetails proxy blk
p DetailLevel
dtal =
  DetailLevel -> Text -> Text
trimHashTextForDetails DetailLevel
dtal (Text -> Text)
-> (HeaderHash blk -> Text) -> HeaderHash blk -> Text
forall b c a. (b -> c) -> (a -> b) -> 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 :: forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash proxy blk
p = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
forall (proxy :: * -> *). proxy blk -> HeaderHash blk -> ByteString
toRawHash proxy blk
p

renderChainHash :: (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash :: forall blk. (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

trimHashTextForDetails :: DetailLevel -> Text -> Text
trimHashTextForDetails :: DetailLevel -> Text -> Text
trimHashTextForDetails DetailLevel
dtal =
  case DetailLevel
dtal of
    DetailLevel
DMinimal -> Int -> Text -> Text
Text.take Int
7
    DetailLevel
_ -> Text -> Text
forall a. a -> a
id