{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.Block.Body (
  Body,
  pattern Body,
  ABody (..),
  bodyTxs,
  bodyWitnesses,
) where

import qualified Cardano.Chain.Delegation.Payload as Delegation
import Cardano.Chain.Ssc (SscPayload (..))
import Cardano.Chain.UTxO.Tx (Tx)
import Cardano.Chain.UTxO.TxPayload (ATxPayload, TxPayload, txpTxs, txpWitnesses)
import Cardano.Chain.UTxO.TxWitness (TxWitness)
import qualified Cardano.Chain.Update.Payload as Update
import Cardano.Ledger.Binary (
  ByteSpan,
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Data.Aeson (ToJSON)

-- | 'Body' consists of payloads of all block components
type Body = ABody ()

-- | Constructor for 'Body'
pattern Body :: TxPayload -> SscPayload -> Delegation.Payload -> Update.Payload -> Body
pattern $mBody :: forall {r}.
Body
-> (TxPayload -> SscPayload -> Payload -> Payload -> r)
-> ((# #) -> r)
-> r
$bBody :: TxPayload -> SscPayload -> Payload -> Payload -> Body
Body tx ssc dlg upd = ABody tx ssc dlg upd

-- | 'Body' consists of payloads of all block components
data ABody a = ABody
  { forall a. ABody a -> ATxPayload a
bodyTxPayload :: !(ATxPayload a)
  -- ^ UTxO payload
  , forall a. ABody a -> SscPayload
bodySscPayload :: !SscPayload
  -- ^ Ssc payload
  , forall a. ABody a -> APayload a
bodyDlgPayload :: !(Delegation.APayload a)
  -- ^ Heavyweight delegation payload (no-ttl certificates)
  , forall a. ABody a -> APayload a
bodyUpdatePayload :: !(Update.APayload a)
  -- ^ Additional update information for the update system
  }
  deriving (ABody a -> ABody a -> Bool
(ABody a -> ABody a -> Bool)
-> (ABody a -> ABody a -> Bool) -> Eq (ABody a)
forall a. Eq a => ABody a -> ABody a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ABody a -> ABody a -> Bool
== :: ABody a -> ABody a -> Bool
$c/= :: forall a. Eq a => ABody a -> ABody a -> Bool
/= :: ABody a -> ABody a -> Bool
Eq, Int -> ABody a -> ShowS
[ABody a] -> ShowS
ABody a -> String
(Int -> ABody a -> ShowS)
-> (ABody a -> String) -> ([ABody a] -> ShowS) -> Show (ABody a)
forall a. Show a => Int -> ABody a -> ShowS
forall a. Show a => [ABody a] -> ShowS
forall a. Show a => ABody a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ABody a -> ShowS
showsPrec :: Int -> ABody a -> ShowS
$cshow :: forall a. Show a => ABody a -> String
show :: ABody a -> String
$cshowList :: forall a. Show a => [ABody a] -> ShowS
showList :: [ABody a] -> ShowS
Show, (forall x. ABody a -> Rep (ABody a) x)
-> (forall x. Rep (ABody a) x -> ABody a) -> Generic (ABody a)
forall x. Rep (ABody a) x -> ABody a
forall x. ABody a -> Rep (ABody a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABody a) x -> ABody a
forall a x. ABody a -> Rep (ABody a) x
$cfrom :: forall a x. ABody a -> Rep (ABody a) x
from :: forall x. ABody a -> Rep (ABody a) x
$cto :: forall a x. Rep (ABody a) x -> ABody a
to :: forall x. Rep (ABody a) x -> ABody a
Generic, (forall a b. (a -> b) -> ABody a -> ABody b)
-> (forall a b. a -> ABody b -> ABody a) -> Functor ABody
forall a b. a -> ABody b -> ABody a
forall a b. (a -> b) -> ABody a -> ABody b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ABody a -> ABody b
fmap :: forall a b. (a -> b) -> ABody a -> ABody b
$c<$ :: forall a b. a -> ABody b -> ABody a
<$ :: forall a b. a -> ABody b -> ABody a
Functor, ABody a -> ()
(ABody a -> ()) -> NFData (ABody a)
forall a. NFData a => ABody a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => ABody a -> ()
rnf :: ABody a -> ()
NFData)

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ABody a)

instance ToCBOR Body where
  toCBOR :: Body -> Encoding
toCBOR = Body -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Body where
  fromCBOR :: forall s. Decoder s Body
fromCBOR = Decoder s Body
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance FromCBOR (ABody ByteSpan) where
  fromCBOR :: forall s. Decoder s (ABody ByteSpan)
fromCBOR = Decoder s (ABody ByteSpan)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR Body where
  encCBOR :: Body -> Encoding
encCBOR Body
bc =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxPayload -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Body -> TxPayload
forall a. ABody a -> ATxPayload a
bodyTxPayload Body
bc)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SscPayload -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Body -> SscPayload
forall a. ABody a -> SscPayload
bodySscPayload Body
bc)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Payload -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Body -> Payload
forall a. ABody a -> APayload a
bodyDlgPayload Body
bc)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Payload -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Body -> Payload
forall a. ABody a -> APayload a
bodyUpdatePayload Body
bc)

instance DecCBOR Body where
  decCBOR :: forall s. Decoder s Body
decCBOR = ABody ByteSpan -> Body
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ABody ByteSpan -> Body)
-> Decoder s (ABody ByteSpan) -> Decoder s Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @(ABody ByteSpan)

instance DecCBOR (ABody ByteSpan) where
  decCBOR :: forall s. Decoder s (ABody ByteSpan)
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Body" Int
4
    ATxPayload ByteSpan
-> SscPayload
-> APayload ByteSpan
-> APayload ByteSpan
-> ABody ByteSpan
forall a.
ATxPayload a -> SscPayload -> APayload a -> APayload a -> ABody a
ABody
      (ATxPayload ByteSpan
 -> SscPayload
 -> APayload ByteSpan
 -> APayload ByteSpan
 -> ABody ByteSpan)
-> Decoder s (ATxPayload ByteSpan)
-> Decoder
     s
     (SscPayload
      -> APayload ByteSpan -> APayload ByteSpan -> ABody ByteSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ATxPayload ByteSpan)
forall s. Decoder s (ATxPayload ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (SscPayload
   -> APayload ByteSpan -> APayload ByteSpan -> ABody ByteSpan)
-> Decoder s SscPayload
-> Decoder
     s (APayload ByteSpan -> APayload ByteSpan -> ABody ByteSpan)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SscPayload
forall s. Decoder s SscPayload
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s (APayload ByteSpan -> APayload ByteSpan -> ABody ByteSpan)
-> Decoder s (APayload ByteSpan)
-> Decoder s (APayload ByteSpan -> ABody ByteSpan)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (APayload ByteSpan)
forall s. Decoder s (APayload ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (APayload ByteSpan -> ABody ByteSpan)
-> Decoder s (APayload ByteSpan) -> Decoder s (ABody ByteSpan)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (APayload ByteSpan)
forall s. Decoder s (APayload ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR

bodyTxs :: Body -> [Tx]
bodyTxs :: Body -> [Tx]
bodyTxs = TxPayload -> [Tx]
forall a. ATxPayload a -> [Tx]
txpTxs (TxPayload -> [Tx]) -> (Body -> TxPayload) -> Body -> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body -> TxPayload
forall a. ABody a -> ATxPayload a
bodyTxPayload

bodyWitnesses :: Body -> [TxWitness]
bodyWitnesses :: Body -> [TxWitness]
bodyWitnesses = TxPayload -> [TxWitness]
txpWitnesses (TxPayload -> [TxWitness])
-> (Body -> TxPayload) -> Body -> [TxWitness]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body -> TxPayload
forall a. ABody a -> ATxPayload a
bodyTxPayload