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

module Cardano.Ledger.Conway.BlockBody where

import Cardano.Ledger.Alonzo.BlockBody
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.Conway.Era
import Cardano.Ledger.Conway.Tx ()
import Cardano.Ledger.Core
import qualified Data.ByteString as BS
import Data.Typeable (Typeable)

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

instance EncCBOR h => EncCBOR (Block h ConwayEra) where
  encCBOR :: Block h ConwayEra -> Encoding
encCBOR (Block h
h BlockBody ConwayEra
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 ConwayEra -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup BlockBody ConwayEra
AlonzoBlockBody ConwayEra
txns

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

instance
  (DecCBOR (Annotator h), Typeable h) =>
  DecCBOR (Annotator (Block h ConwayEra))
  where
  decCBOR :: forall s. Decoder s (Annotator (Block h ConwayEra))
decCBOR =
    Text
-> (Annotator (Block h ConwayEra) -> Int)
-> Decoder s (Annotator (Block h ConwayEra))
-> Decoder s (Annotator (Block h ConwayEra))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Block" (Int -> Annotator (Block h ConwayEra) -> Int
forall a b. a -> b -> a
const Int
5) (Decoder s (Annotator (Block h ConwayEra))
 -> Decoder s (Annotator (Block h ConwayEra)))
-> Decoder s (Annotator (Block h ConwayEra))
-> Decoder s (Annotator (Block h ConwayEra))
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