{-# LANGUAGE GADTs #-}

-- | Conversion of a fetched or streamed chain block to the UTxO RPC
-- @AnyChainBlock@ message.
module Cardano.Rpc.Server.Internal.UtxoRpc.Type.Block
  ( mkAnyChainBlock
  )
where

import Cardano.Api.Block
import Cardano.Api.Consensus (byronBlockRaw)
import Cardano.Api.Serialise.Raw
import Cardano.Api.Tx
import Cardano.Rpc.Proto.Api.UtxoRpc.Sync qualified as U5c
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.Byron (byronBlockTxs)
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.ChainPoint (utcTimeToMs)
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.Tx (anyEraTxConstraints, txToUtxoRpcTx)

import RIO

import Data.ProtoLens (defMessage)
import Data.Time.Clock (UTCTime)
import Network.GRPC.Spec

-- | Assemble the @AnyChainBlock@ proto message: raw CBOR bytes, the cardano
-- header (slot, hash, height - derived from the block itself) and the parsed
-- transactions (all eras), plus the given slot timestamp.
mkAnyChainBlock
  :: ByteString
  -- ^ Raw CBOR bytes of the block, exactly as stored on chain
  -> BlockInMode
  -- ^ The same block, parsed and placed in its era context
  -> UTCTime
  -- ^ Slot wall-clock time; encoded as milliseconds since the Unix epoch
  -> Proto U5c.AnyChainBlock
  -- ^ Message carrying the native bytes, the parsed cardano block and the timestamp
mkAnyChainBlock :: ByteString -> BlockInMode -> UTCTime -> Proto AnyChainBlock
mkAnyChainBlock ByteString
rawBytes (BlockInMode CardanoEra era
_ Block era
block) UTCTime
timestamp =
  let BlockHeader SlotNo
slot Hash BlockHeader
headerHash (BlockNo Word64
height) = Block era -> BlockHeader
forall era. Block era -> BlockHeader
getBlockHeader Block era
block
      -- Byron transactions are not representable as cardano-api's 'Tx era',
      -- so they are converted straight from the Byron ledger types
      txs :: [Proto Tx]
txs = case Block era
block of
        ByronBlock ByronBlock
consensusBlock ->
          ABlockOrBoundary ByteString -> [Proto Tx]
byronBlockTxs (ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw ByronBlock
consensusBlock)
        ShelleyBlock ShelleyBasedEra era
sbe ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
_ ->
          ShelleyBasedEra era
-> ((IsShelleyBasedEra era, AnyEraTx (ShelleyLedgerEra era)) =>
    [Proto Tx])
-> [Proto Tx]
forall era a.
ShelleyBasedEra era
-> ((IsShelleyBasedEra era, AnyEraTx (ShelleyLedgerEra era)) => a)
-> a
anyEraTxConstraints ShelleyBasedEra era
sbe (((IsShelleyBasedEra era, AnyEraTx (ShelleyLedgerEra era)) =>
  [Proto Tx])
 -> [Proto Tx])
-> ((IsShelleyBasedEra era, AnyEraTx (ShelleyLedgerEra era)) =>
    [Proto Tx])
-> [Proto Tx]
forall a b. (a -> b) -> a -> b
$
            Block era -> [Tx era]
forall era. Block era -> [Tx era]
getBlockTxs Block era
block [Tx era] -> (Tx era -> Proto Tx) -> [Proto Tx]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ShelleyTx ShelleyBasedEra era
_ Tx TopTx (ShelleyLedgerEra era)
ledgerTx) -> Tx TopTx (ShelleyLedgerEra era) -> Proto Tx
forall era.
IsShelleyBasedEra era =>
Tx TopTx (ShelleyLedgerEra era) -> Proto Tx
txToUtxoRpcTx Tx TopTx (ShelleyLedgerEra era)
ledgerTx
      blockHeader :: Proto BlockHeader
blockHeader =
        Proto BlockHeader
forall msg. Message msg => msg
defMessage
          Proto BlockHeader
-> (Proto BlockHeader -> Proto BlockHeader) -> Proto BlockHeader
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto BlockHeader) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "slot" a) =>
LensLike' f s a
U5c.slot LensLike' Identity (Proto BlockHeader) Word64
-> Word64 -> Proto BlockHeader -> Proto BlockHeader
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SlotNo -> Word64
unSlotNo SlotNo
slot
          Proto BlockHeader
-> (Proto BlockHeader -> Proto BlockHeader) -> Proto BlockHeader
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto BlockHeader) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "hash" a) =>
LensLike' f s a
U5c.hash LensLike' Identity (Proto BlockHeader) ByteString
-> ByteString -> Proto BlockHeader -> Proto BlockHeader
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash BlockHeader -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash BlockHeader
headerHash
          Proto BlockHeader
-> (Proto BlockHeader -> Proto BlockHeader) -> Proto BlockHeader
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto BlockHeader) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "height" a) =>
LensLike' f s a
U5c.height LensLike' Identity (Proto BlockHeader) Word64
-> Word64 -> Proto BlockHeader -> Proto BlockHeader
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
height
   in Proto AnyChainBlock
forall msg. Message msg => msg
defMessage
        Proto AnyChainBlock
-> (Proto AnyChainBlock -> Proto AnyChainBlock)
-> Proto AnyChainBlock
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyChainBlock) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "nativeBytes" a) =>
LensLike' f s a
U5c.nativeBytes LensLike' Identity (Proto AnyChainBlock) ByteString
-> ByteString -> Proto AnyChainBlock -> Proto AnyChainBlock
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
rawBytes
        Proto AnyChainBlock
-> (Proto AnyChainBlock -> Proto AnyChainBlock)
-> Proto AnyChainBlock
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyChainBlock) (Proto Block)
forall (f :: * -> *) s a.
(Functor f, HasField s "cardano" a) =>
LensLike' f s a
U5c.cardano LensLike' Identity (Proto AnyChainBlock) (Proto Block)
-> ((Proto BlockHeader -> Identity (Proto BlockHeader))
    -> Proto Block -> Identity (Proto Block))
-> (Proto BlockHeader -> Identity (Proto BlockHeader))
-> Proto AnyChainBlock
-> Identity (Proto AnyChainBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto BlockHeader -> Identity (Proto BlockHeader))
-> Proto Block -> Identity (Proto Block)
forall (f :: * -> *) s a.
(Functor f, HasField s "header" a) =>
LensLike' f s a
U5c.header ((Proto BlockHeader -> Identity (Proto BlockHeader))
 -> Proto AnyChainBlock -> Identity (Proto AnyChainBlock))
-> Proto BlockHeader -> Proto AnyChainBlock -> Proto AnyChainBlock
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto BlockHeader
blockHeader
        Proto AnyChainBlock
-> (Proto AnyChainBlock -> Proto AnyChainBlock)
-> Proto AnyChainBlock
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyChainBlock) (Proto Block)
forall (f :: * -> *) s a.
(Functor f, HasField s "cardano" a) =>
LensLike' f s a
U5c.cardano LensLike' Identity (Proto AnyChainBlock) (Proto Block)
-> (([Proto Tx] -> Identity [Proto Tx])
    -> Proto Block -> Identity (Proto Block))
-> ([Proto Tx] -> Identity [Proto Tx])
-> Proto AnyChainBlock
-> Identity (Proto AnyChainBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' Identity (Proto Block) (Proto BlockBody)
forall (f :: * -> *) s a.
(Functor f, HasField s "body" a) =>
LensLike' f s a
U5c.body LensLike' Identity (Proto Block) (Proto BlockBody)
-> (([Proto Tx] -> Identity [Proto Tx])
    -> Proto BlockBody -> Identity (Proto BlockBody))
-> ([Proto Tx] -> Identity [Proto Tx])
-> Proto Block
-> Identity (Proto Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto Tx] -> Identity [Proto Tx])
-> Proto BlockBody -> Identity (Proto BlockBody)
forall (f :: * -> *) s a.
(Functor f, HasField s "tx" a) =>
LensLike' f s a
U5c.tx (([Proto Tx] -> Identity [Proto Tx])
 -> Proto AnyChainBlock -> Identity (Proto AnyChainBlock))
-> [Proto Tx] -> Proto AnyChainBlock -> Proto AnyChainBlock
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto Tx]
txs
        Proto AnyChainBlock
-> (Proto AnyChainBlock -> Proto AnyChainBlock)
-> Proto AnyChainBlock
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto AnyChainBlock) (Proto Block)
forall (f :: * -> *) s a.
(Functor f, HasField s "cardano" a) =>
LensLike' f s a
U5c.cardano LensLike' Identity (Proto AnyChainBlock) (Proto Block)
-> ((Word64 -> Identity Word64)
    -> Proto Block -> Identity (Proto Block))
-> (Word64 -> Identity Word64)
-> Proto AnyChainBlock
-> Identity (Proto AnyChainBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Identity Word64)
-> Proto Block -> Identity (Proto Block)
forall (f :: * -> *) s a.
(Functor f, HasField s "timestamp" a) =>
LensLike' f s a
U5c.timestamp ((Word64 -> Identity Word64)
 -> Proto AnyChainBlock -> Identity (Proto AnyChainBlock))
-> Word64 -> Proto AnyChainBlock -> Proto AnyChainBlock
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTCTime -> Word64
utcTimeToMs UTCTime
timestamp