{-# 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 $bBody :: TxPayload -> SscPayload -> Payload -> Payload -> Body
$mBody :: forall {r}.
Body
-> (TxPayload -> SscPayload -> Payload -> Payload -> r)
-> ((# #) -> r)
-> r
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
forall a. Eq a => ABody a -> ABody a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABody a -> ABody a -> Bool
$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
Eq, Int -> ABody a -> ShowS
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
showList :: [ABody a] -> ShowS
$cshowList :: forall a. Show a => [ABody a] -> ShowS
show :: ABody a -> String
$cshow :: forall a. Show a => ABody a -> String
showsPrec :: Int -> ABody a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABody a -> ShowS
Show, 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
$cto :: forall a x. Rep (ABody a) x -> ABody a
$cfrom :: forall a x. ABody a -> Rep (ABody a) x
Generic, 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
<$ :: forall a b. a -> ABody b -> ABody a
$c<$ :: forall a b. a -> ABody b -> ABody a
fmap :: forall a b. (a -> b) -> ABody a -> ABody b
$cfmap :: forall a b. (a -> b) -> ABody a -> ABody b
Functor, forall a. NFData a => ABody a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ABody a -> ()
$crnf :: forall a. NFData a => ABody a -> ()
NFData)

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

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

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

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

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

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

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

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