{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage.BlockBody where

import Cardano.Ledger.Alonzo.BlockBody
import Cardano.Ledger.Babbage.Era
import Cardano.Ledger.Babbage.Tx ()
import Cardano.Ledger.BaseTypes (ProtVer (..))
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (decCBOR),
  EncCBOR (..),
  EncCBORGroup (..),
  decodeRecordNamed,
  encodeListLen,
  serialize',
  toPlainEncoding,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Block (Block (..), PraosEraBlockHeader)
import Cardano.Ledger.Core
import qualified Data.ByteString as BS
import Data.Typeable (Typeable)

instance EraBlockBody BabbageEra where
  type BlockBody BabbageEra = AlonzoBlockBody BabbageEra
  type ProtocolEraBlockHeader h BabbageEra = PraosEraBlockHeader h BabbageEra
  mkBasicBlockBody :: BlockBody BabbageEra
mkBasicBlockBody = BlockBody BabbageEra
forall era.
(SafeToHash (TxWits era), BlockBody era ~ AlonzoBlockBody era,
 AlonzoEraTx era) =>
BlockBody era
mkBasicBlockBodyAlonzo
  txSeqBlockBodyL :: Lens' (BlockBody BabbageEra) (StrictSeq (Tx TopTx BabbageEra))
txSeqBlockBodyL = (StrictSeq (Tx TopTx BabbageEra)
 -> f (StrictSeq (Tx TopTx BabbageEra)))
-> BlockBody BabbageEra -> f (BlockBody BabbageEra)
forall era.
(SafeToHash (TxWits era), BlockBody era ~ AlonzoBlockBody era,
 AlonzoEraTx era) =>
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Lens' (BlockBody BabbageEra) (StrictSeq (Tx TopTx BabbageEra))
txSeqBlockBodyAlonzoL
  hashBlockBody :: BlockBody BabbageEra -> Hash HASH EraIndependentBlockBody
hashBlockBody = BlockBody BabbageEra -> Hash HASH EraIndependentBlockBody
AlonzoBlockBody BabbageEra -> Hash HASH EraIndependentBlockBody
forall era.
AlonzoBlockBody era -> Hash HASH EraIndependentBlockBody
alonzoBlockBodyHash
  blockBodySize :: ProtVer -> BlockBody BabbageEra -> Int
blockBodySize (ProtVer Version
v Word32
_) = ByteString -> Int
BS.length (ByteString -> Int)
-> (AlonzoBlockBody BabbageEra -> ByteString)
-> AlonzoBlockBody BabbageEra
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
v (Encoding -> ByteString)
-> (AlonzoBlockBody BabbageEra -> Encoding)
-> AlonzoBlockBody BabbageEra
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoBlockBody BabbageEra -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup

instance EncCBOR h => EncCBOR (Block h BabbageEra) where
  encCBOR :: Block h BabbageEra -> Encoding
encCBOR (Block h
h BlockBody BabbageEra
txns) =
    Word -> Encoding
encodeListLen Word
5 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> h -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR h
h Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AlonzoBlockBody BabbageEra -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup BlockBody BabbageEra
AlonzoBlockBody BabbageEra
txns

instance (EncCBOR h, Typeable h) => Plain.ToCBOR (Block h BabbageEra) where
  toCBOR :: Block h BabbageEra -> Encoding
toCBOR = Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
eraProtVerLow @BabbageEra) (Encoding -> Encoding)
-> (Block h BabbageEra -> Encoding)
-> Block h BabbageEra
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block h BabbageEra -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR

instance
  (DecCBOR (Annotator h), Typeable h) =>
  DecCBOR (Annotator (Block h BabbageEra))
  where
  decCBOR :: forall s. Decoder s (Annotator (Block h BabbageEra))
decCBOR =
    Text
-> (Annotator (Block h BabbageEra) -> Int)
-> Decoder s (Annotator (Block h BabbageEra))
-> Decoder s (Annotator (Block h BabbageEra))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Block" (Int -> Annotator (Block h BabbageEra) -> Int
forall a b. a -> b -> a
const Int
5) (Decoder s (Annotator (Block h BabbageEra))
 -> Decoder s (Annotator (Block h BabbageEra)))
-> Decoder s (Annotator (Block h BabbageEra))
-> Decoder s (Annotator (Block h BabbageEra))
forall a b. (a -> b) -> a -> b
$ do
      header <- Decoder s (Annotator h)
forall s. Decoder s (Annotator h)
forall a s. DecCBOR a => Decoder s a
decCBOR
      txns <- decCBOR
      pure $ Block <$> header <*> txns