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


module Cardano.Node.Tracing.Render
  ( renderChunkNo
  , renderHeaderHash
  , renderHeaderHashForDetails
  , renderChainHash
  , renderTipBlockNo
  , renderTipHash
  , condenseT
  , showT
  , renderPoint
  , renderPointAsPhrase
  , renderPointForDetails
  , renderRealPoint
  , renderRealPointAsPhrase
  , renderSlotNo
  , renderTip
  , renderTipForDetails
  , renderTxId
  , renderTxIdForDetails
  , 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.Logging
import           Cardano.Node.Queries (ConvertTxId (..))
import           Cardano.Slotting.Slot (SlotNo (..), WithOrigin (..))
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.Util.Condense (Condense, condense)
import           Ouroboros.Network.Block (ChainHash (..), HeaderHash, StandardHash, Tip,
                   getTipPoint)

condenseT :: Condense a => a -> Text
condenseT :: a -> Text
condenseT = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 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

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

renderTxIdForDetails
  :: ConvertTxId blk
  => DetailLevel
  -> TxId (GenTx blk)
  -> Text
renderTxIdForDetails :: 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 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

renderPointForDetails
  :: forall blk.
     ConvertRawHash blk
  => DetailLevel
  -> Point blk
  -> Text
renderPointForDetails :: 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 (Proxy blk
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 :: 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 :: 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

renderTipForDetails
  :: ConvertRawHash blk
  => DetailLevel
  -> Tip blk
  -> Text
renderTipForDetails :: DetailLevel -> Tip blk -> Text
renderTipForDetails DetailLevel
dtal = DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (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 = DetailLevel -> Tip blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Tip blk -> Text
renderTipForDetails DetailLevel
DDetailed

renderHeaderHashForDetails
  :: ConvertRawHash blk
  => proxy blk
  -> DetailLevel
  -> HeaderHash blk
  -> Text
renderHeaderHashForDetails :: 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 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

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