{-# 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 Cardano.Binary
  ( ByteSpan,
    FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
    enforceSize,
  )
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.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)
-> (Void# -> r)
-> r
Body tx ssc dlg upd = ABody tx ssc dlg upd

-- | 'Body' consists of payloads of all block components
data ABody a = ABody
  { -- | UTxO payload
    ABody a -> ATxPayload a
bodyTxPayload :: !(ATxPayload a),
    -- | Ssc payload
    ABody a -> SscPayload
bodySscPayload :: !SscPayload,
    -- | Heavyweight delegation payload (no-ttl certificates)
    ABody a -> APayload a
bodyDlgPayload :: !(Delegation.APayload a),
    -- | Additional update information for the update system
    ABody a -> APayload a
bodyUpdatePayload :: !(Update.APayload a)
  }
  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
/= :: 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
[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
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 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
$cto :: forall a x. Rep (ABody a) x -> ABody a
$cfrom :: forall a x. ABody a -> Rep (ABody a) x
Generic, a -> ABody b -> ABody a
(a -> b) -> ABody a -> ABody b
(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
<$ :: a -> ABody b -> ABody a
$c<$ :: forall a b. a -> ABody b -> ABody a
fmap :: (a -> b) -> ABody a -> ABody b
$cfmap :: forall a b. (a -> b) -> ABody a -> ABody b
Functor, ABody a -> ()
(ABody a -> ()) -> NFData (ABody a)
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 Body
bc =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxPayload -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (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. ToCBOR a => a -> Encoding
toCBOR (Body -> SscPayload
forall a. ABody a -> SscPayload
bodySscPayload Body
bc)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Payload -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (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. ToCBOR a => a -> Encoding
toCBOR (Body -> Payload
forall a. ABody a -> APayload a
bodyUpdatePayload Body
bc)

instance FromCBOR Body where
  fromCBOR :: Decoder s Body
fromCBOR = 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 s. FromCBOR (ABody ByteSpan) => Decoder s (ABody ByteSpan)
forall a s. FromCBOR a => Decoder s a
fromCBOR @(ABody ByteSpan)

instance FromCBOR (ABody ByteSpan) where
  fromCBOR :: Decoder s (ABody ByteSpan)
fromCBOR = 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 a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (SscPayload
   -> APayload ByteSpan -> APayload ByteSpan -> ABody ByteSpan)
-> Decoder s SscPayload
-> Decoder
     s (APayload ByteSpan -> APayload ByteSpan -> ABody ByteSpan)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SscPayload
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s (APayload ByteSpan -> APayload ByteSpan -> ABody ByteSpan)
-> Decoder s (APayload ByteSpan)
-> Decoder s (APayload ByteSpan -> ABody ByteSpan)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (APayload ByteSpan)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (APayload ByteSpan -> ABody ByteSpan)
-> Decoder s (APayload ByteSpan) -> Decoder s (ABody ByteSpan)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (APayload ByteSpan)
forall a s. FromCBOR a => Decoder s a
fromCBOR

bodyTxs :: Body -> [Tx]
bodyTxs :: Body -> [Tx]
bodyTxs = TxPayload -> [Tx]
forall a. ATxPayload a -> [Tx]
txpTxs (TxPayload -> [Tx]) -> (Body -> TxPayload) -> Body -> [Tx]
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 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