{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Ledger.Block (
Block (Block),
bheader,
bbody,
neededTxInsForBlock,
) where
import Cardano.Ledger.Binary (
Annotator,
DecCBOR (decCBOR),
EncCBOR (..),
EncCBORGroup (..),
decodeRecordNamed,
encodeListLen,
toPlainEncoding,
)
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Core
import Cardano.Ledger.TxIn (TxIn (..))
import Data.Foldable (toList)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import NoThunks.Class (NoThunks (..))
data Block h era
= Block !h !(BlockBody era)
deriving ((forall x. Block h era -> Rep (Block h era) x)
-> (forall x. Rep (Block h era) x -> Block h era)
-> Generic (Block h era)
forall x. Rep (Block h era) x -> Block h era
forall x. Block h era -> Rep (Block h era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h era x. Rep (Block h era) x -> Block h era
forall h era x. Block h era -> Rep (Block h era) x
$cfrom :: forall h era x. Block h era -> Rep (Block h era) x
from :: forall x. Block h era -> Rep (Block h era) x
$cto :: forall h era x. Rep (Block h era) x -> Block h era
to :: forall x. Rep (Block h era) x -> Block h era
Generic)
deriving stock instance
(Era era, Show (BlockBody era), Show h) =>
Show (Block h era)
deriving stock instance
(Era era, Eq (BlockBody era), Eq h) =>
Eq (Block h era)
deriving anyclass instance
( Era era
, NoThunks (BlockBody era)
, NoThunks h
) =>
NoThunks (Block h era)
instance
forall era h.
( Era era
, EncCBORGroup (BlockBody era)
, EncCBOR h
) =>
EncCBOR (Block h era)
where
encCBOR :: Block h era -> Encoding
encCBOR (Block h
h BlockBody era
txns) =
Word -> Encoding
encodeListLen (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ BlockBody era -> Word
forall a. EncCBORGroup a => a -> Word
listLen BlockBody era
txns) 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
<> BlockBody era -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup BlockBody era
txns
instance
forall era h.
( Era era
, EncCBORGroup (BlockBody era)
, EncCBOR h
) =>
Plain.ToCBOR (Block h era)
where
toCBOR :: Block h era -> Encoding
toCBOR = Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
eraProtVerLow @era) (Encoding -> Encoding)
-> (Block h era -> Encoding) -> Block h era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block h era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR
instance
( EraBlockBody era
, DecCBOR (Annotator h)
, Typeable h
) =>
DecCBOR (Annotator (Block h era))
where
decCBOR :: forall s. Decoder s (Annotator (Block h era))
decCBOR = Text
-> (Annotator (Block h era) -> Int)
-> Decoder s (Annotator (Block h era))
-> Decoder s (Annotator (Block h era))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Block" (Int -> Annotator (Block h era) -> Int
forall a b. a -> b -> a
const Int
blockSize) (Decoder s (Annotator (Block h era))
-> Decoder s (Annotator (Block h era)))
-> Decoder s (Annotator (Block h era))
-> Decoder s (Annotator (Block h era))
forall a b. (a -> b) -> a -> b
$ do
Annotator h
header <- Decoder s (Annotator h)
forall s. Decoder s (Annotator h)
forall a s. DecCBOR a => Decoder s a
decCBOR
Annotator (BlockBody era)
txns <- Decoder s (Annotator (BlockBody era))
forall s. Decoder s (Annotator (BlockBody era))
forall a s. DecCBOR a => Decoder s a
decCBOR
Annotator (Block h era) -> Decoder s (Annotator (Block h era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (Block h era) -> Decoder s (Annotator (Block h era)))
-> Annotator (Block h era) -> Decoder s (Annotator (Block h era))
forall a b. (a -> b) -> a -> b
$ h -> BlockBody era -> Block h era
forall h era. h -> BlockBody era -> Block h era
Block (h -> BlockBody era -> Block h era)
-> Annotator h -> Annotator (BlockBody era -> Block h era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator h
header Annotator (BlockBody era -> Block h era)
-> Annotator (BlockBody era) -> Annotator (Block h era)
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator (BlockBody era)
txns
where
blockSize :: Int
blockSize = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall era. EraBlockBody era => Word64
numSegComponents @era)
bheader ::
Block h era ->
h
(Block h
bh BlockBody era
_) = h
bh
bbody :: Block h era -> BlockBody era
bbody :: forall h era. Block h era -> BlockBody era
bbody (Block h
_ BlockBody era
txs) = BlockBody era
txs
neededTxInsForBlock ::
forall h era.
EraBlockBody era =>
Block h era ->
Set TxIn
neededTxInsForBlock :: forall h era. EraBlockBody era => Block h era -> Set TxIn
neededTxInsForBlock (Block h
_ BlockBody era
blockBody) = (TxIn -> Bool) -> Set TxIn -> Set TxIn
forall a. (a -> Bool) -> Set a -> Set a
Set.filter TxIn -> Bool
isNotNewInput Set TxIn
allTxIns
where
txBodies :: [TxBody era]
txBodies = (Tx era -> TxBody era) -> [Tx era] -> [TxBody era]
forall a b. (a -> b) -> [a] -> [b]
map (Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL) ([Tx era] -> [TxBody era]) -> [Tx era] -> [TxBody era]
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx era) -> [Tx era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (Tx era) -> [Tx era]) -> StrictSeq (Tx era) -> [Tx era]
forall a b. (a -> b) -> a -> b
$ BlockBody era
blockBody BlockBody era
-> Getting
(StrictSeq (Tx era)) (BlockBody era) (StrictSeq (Tx era))
-> StrictSeq (Tx era)
forall s a. s -> Getting a s a -> a
^. Getting (StrictSeq (Tx era)) (BlockBody era) (StrictSeq (Tx era))
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx era))
Lens' (BlockBody era) (StrictSeq (Tx era))
txSeqBlockBodyL
allTxIns :: Set TxIn
allTxIns = [Set TxIn] -> Set TxIn
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set TxIn] -> Set TxIn) -> [Set TxIn] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ (TxBody era -> Set TxIn) -> [TxBody era] -> [Set TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody era) (Set TxIn)
allInputsTxBodyF) [TxBody era]
txBodies
newTxIds :: Set TxId
newTxIds = [TxId] -> Set TxId
forall a. Ord a => [a] -> Set a
Set.fromList ([TxId] -> Set TxId) -> [TxId] -> Set TxId
forall a b. (a -> b) -> a -> b
$ (TxBody era -> TxId) -> [TxBody era] -> [TxId]
forall a b. (a -> b) -> [a] -> [b]
map TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody [TxBody era]
txBodies
isNotNewInput :: TxIn -> Bool
isNotNewInput (TxIn TxId
txID TxIx
_) = TxId
txID TxId -> Set TxId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set TxId
newTxIds