{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}

-- | Handlers for the UTxO RPC @SyncService@ - synchronising chain data
-- (fetching blocks, dumping history, following the tip).
module Cardano.Rpc.Server.Internal.UtxoRpc.Sync
  ( fetchBlockMethod
  )
where

import Cardano.Api
import Cardano.Rpc.Proto.Api.UtxoRpc.Sync qualified as U5c
import Cardano.Rpc.Server.Internal.Error
import Cardano.Rpc.Server.Internal.Monad
import Cardano.Rpc.Server.Internal.Tracing ()
import Cardano.Rpc.Server.NodeKernelAccess

import RIO

import Data.ByteString qualified as BS
import Data.ProtoLens (defMessage)
import Network.GRPC.Spec (GrpcError (GrpcInvalidArgument, GrpcNotFound), Proto)

-- | Handle the @FetchBlock@ SyncService RPC method.
-- Fetches a block from ChainDB by slot and header hash.
-- Returns @NOT_FOUND@ if the requested block is missing.
-- Returns @INVALID_ARGUMENT@ if the block reference has an invalid hash.
fetchBlockMethod
  :: MonadRpc e m
  => Proto U5c.FetchBlockRequest
  -- ^ Request containing a block reference (slot + hash)
  -> m (Proto U5c.FetchBlockResponse)
  -- ^ Response containing the fetched block with raw CBOR and cardano header
fetchBlockMethod :: forall e (m :: * -> *).
MonadRpc e m =>
Proto FetchBlockRequest -> m (Proto FetchBlockResponse)
fetchBlockMethod Proto FetchBlockRequest
request = do
  nodeKernelAccess <- m NodeKernelAccess
forall e (m :: * -> *). MonadRpc e m => m NodeKernelAccess
grabNodeKernelAccess
  let blockRef = Proto FetchBlockRequest
request Proto FetchBlockRequest
-> Getting
     (Proto BlockRef) (Proto FetchBlockRequest) (Proto BlockRef)
-> Proto BlockRef
forall s a. s -> Getting a s a -> a
^. Getting (Proto BlockRef) (Proto FetchBlockRequest) (Proto BlockRef)
forall (f :: * -> *) s a.
(Functor f, HasField s "ref" a) =>
LensLike' f s a
U5c.ref
      slot = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Proto BlockRef
blockRef Proto BlockRef -> Getting Word64 (Proto BlockRef) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 (Proto BlockRef) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "slot" a) =>
LensLike' f s a
U5c.slot
      hashBytes = Proto BlockRef
blockRef Proto BlockRef
-> Getting ByteString (Proto BlockRef) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto BlockRef) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "hash" a) =>
LensLike' f s a
U5c.hash
      throwInvalidHash =
        GrpcError -> Text -> m a
forall (m :: * -> *) a. MonadIO m => GrpcError -> Text -> m a
throwGrpcErrorWithMessage GrpcError
GrpcInvalidArgument (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$
          Text
"invalid block header hash (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (ByteString -> Int
BS.length ByteString
hashBytes) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes)"
      throwNotFound =
        GrpcError -> Text -> m a
forall (m :: * -> *) a. MonadIO m => GrpcError -> Text -> m a
throwGrpcErrorWithMessage GrpcError
GrpcNotFound (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$
          Text
"block not found at slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow (SlotNo -> Word64
unSlotNo SlotNo
slot)
  headerHash <-
    deserialiseFromRawBytes (proxyToAsType (Proxy @(Hash BlockHeader))) hashBytes
      & either (const throwInvalidHash) pure
  (rawBytes, BlockNo height) <-
    fetchBlock nodeKernelAccess slot headerHash >>= maybe throwNotFound pure
  let 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
.~ ByteString
hashBytes
          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
  -- TODO: timestamp - needs EraHistory from ledger state (snapshot migration)
  pure $
    defMessage
      & U5c.block
        .~ ( defMessage
               & U5c.nativeBytes .~ rawBytes
               & U5c.cardano . U5c.header .~ blockHeader
           )

-- TODO: cardano.body.tx - needs full block deserialisation + UTxO RPC tx mapping