module Plutus.ChainIndex.Compatibility where

import Cardano.Api (AsType (..), Block (..), BlockHeader (..), BlockInMode (..), BlockNo (..), CardanoMode,
                    ChainPoint (..), ChainTip (..), Hash, SlotNo (..), deserialiseFromRawBytes, proxyToAsType,
                    serialiseToRawBytes)
import Data.Proxy (Proxy (..))
import Ledger (BlockId (..), Slot (..))
import Plutus.ChainIndex.Tx (ChainIndexTx (..))
import Plutus.ChainIndex.Types (BlockNumber (..), Point (..), Tip (..))
import Plutus.Contract.CardanoAPI qualified as C

fromCardanoTip :: ChainTip -> Tip
fromCardanoTip :: ChainTip -> Tip
fromCardanoTip (ChainTip SlotNo
slotNo Hash BlockHeader
hash BlockNo
blockNo) =
    Tip :: Slot -> BlockId -> BlockNumber -> Tip
Tip { tipSlot :: Slot
tipSlot = SlotNo -> Slot
fromCardanoSlot SlotNo
slotNo
        , tipBlockId :: BlockId
tipBlockId = Hash BlockHeader -> BlockId
fromCardanoBlockId Hash BlockHeader
hash
        , tipBlockNo :: BlockNumber
tipBlockNo = BlockNo -> BlockNumber
fromCardanoBlockNo BlockNo
blockNo
        }
fromCardanoTip ChainTip
ChainTipAtGenesis = Tip
TipAtGenesis

fromCardanoPoint :: ChainPoint -> Point
fromCardanoPoint :: ChainPoint -> Point
fromCardanoPoint ChainPoint
ChainPointAtGenesis = Point
PointAtGenesis
fromCardanoPoint (ChainPoint SlotNo
slot Hash BlockHeader
hash) =
    Point :: Slot -> BlockId -> Point
Point { pointSlot :: Slot
pointSlot = SlotNo -> Slot
fromCardanoSlot SlotNo
slot
          , pointBlockId :: BlockId
pointBlockId = Hash BlockHeader -> BlockId
fromCardanoBlockId Hash BlockHeader
hash
          }

toCardanoPoint :: Point -> Maybe ChainPoint
toCardanoPoint :: Point -> Maybe ChainPoint
toCardanoPoint Point
PointAtGenesis = ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just ChainPoint
ChainPointAtGenesis
toCardanoPoint (Point Slot
slot BlockId
blockId) =
    SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint (Slot -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Slot
slot) (Hash BlockHeader -> ChainPoint)
-> Maybe (Hash BlockHeader) -> Maybe ChainPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockId -> Maybe (Hash BlockHeader)
toCardanoBlockId BlockId
blockId

tipFromCardanoBlock
  :: BlockInMode CardanoMode
  -> Tip
tipFromCardanoBlock :: BlockInMode CardanoMode -> Tip
tipFromCardanoBlock (BlockInMode (Block (BlockHeader SlotNo
slot Hash BlockHeader
hash BlockNo
block) [Tx era]
_) EraInMode era CardanoMode
_) =
    ChainTip -> Tip
fromCardanoTip (ChainTip -> Tip) -> ChainTip -> Tip
forall a b. (a -> b) -> a -> b
$ SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip SlotNo
slot Hash BlockHeader
hash BlockNo
block

fromCardanoSlot :: SlotNo -> Slot
fromCardanoSlot :: SlotNo -> Slot
fromCardanoSlot (SlotNo Word64
slotNo) = Integer -> Slot
Slot (Integer -> Slot) -> Integer -> Slot
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
slotNo

fromCardanoBlockId :: Hash BlockHeader -> BlockId
fromCardanoBlockId :: Hash BlockHeader -> BlockId
fromCardanoBlockId Hash BlockHeader
hash =
    ByteString -> BlockId
BlockId (ByteString -> BlockId) -> ByteString -> BlockId
forall a b. (a -> b) -> a -> b
$ Hash BlockHeader -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash BlockHeader
hash

toCardanoBlockId :: BlockId -> Maybe (Hash BlockHeader)
toCardanoBlockId :: BlockId -> Maybe (Hash BlockHeader)
toCardanoBlockId (BlockId ByteString
bs) =
    AsType (Hash BlockHeader) -> ByteString -> Maybe (Hash BlockHeader)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes (AsType BlockHeader -> AsType (Hash BlockHeader)
forall a. AsType a -> AsType (Hash a)
AsHash (Proxy BlockHeader -> AsType BlockHeader
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy BlockHeader
forall k (t :: k). Proxy t
Proxy :: Proxy BlockHeader))) ByteString
bs

fromCardanoBlockHeader :: BlockHeader -> Tip
fromCardanoBlockHeader :: BlockHeader -> Tip
fromCardanoBlockHeader (BlockHeader SlotNo
slotNo Hash BlockHeader
hash BlockNo
blockNo) =
    Tip :: Slot -> BlockId -> BlockNumber -> Tip
Tip { tipSlot :: Slot
tipSlot = SlotNo -> Slot
fromCardanoSlot SlotNo
slotNo
        , tipBlockId :: BlockId
tipBlockId = Hash BlockHeader -> BlockId
fromCardanoBlockId Hash BlockHeader
hash
        , tipBlockNo :: BlockNumber
tipBlockNo = BlockNo -> BlockNumber
fromCardanoBlockNo BlockNo
blockNo
        }

fromCardanoBlockNo :: BlockNo -> BlockNumber
fromCardanoBlockNo :: BlockNo -> BlockNumber
fromCardanoBlockNo (BlockNo Word64
blockNo) = Word64 -> BlockNumber
BlockNumber Word64
blockNo

fromCardanoBlock
    :: BlockInMode CardanoMode
    -> [ChainIndexTx]
fromCardanoBlock :: BlockInMode CardanoMode -> [ChainIndexTx]
fromCardanoBlock = BlockInMode CardanoMode -> [ChainIndexTx]
C.fromCardanoBlock