{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# 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 !(TxSeq era)
deriving (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
$cto :: forall h era x. Rep (Block h era) x -> Block h era
$cfrom :: forall h era x. Block h era -> Rep (Block h era) x
Generic)
deriving stock instance
(Era era, Show (TxSeq era), Show h) =>
Show (Block h era)
deriving stock instance
(Era era, Eq (TxSeq era), Eq h) =>
Eq (Block h era)
deriving anyclass instance
( Era era
, NoThunks (TxSeq era)
, NoThunks h
) =>
NoThunks (Block h era)
instance
forall era h.
( Era era
, EncCBORGroup (TxSeq era)
, EncCBOR h
) =>
EncCBOR (Block h era)
where
encCBOR :: Block h era -> Encoding
encCBOR (Block h
h TxSeq era
txns) =
Word -> Encoding
encodeListLen (Word
1 forall a. Num a => a -> a -> a
+ forall a. EncCBORGroup a => a -> Word
listLen TxSeq era
txns) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR h
h forall a. Semigroup a => a -> a -> a
<> forall a. EncCBORGroup a => a -> Encoding
encCBORGroup TxSeq era
txns
instance
forall era h.
( Era era
, EncCBORGroup (TxSeq 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => a -> Encoding
encCBOR
instance
( EraSegWits era
, DecCBOR h
, DecCBOR (TxSeq era)
) =>
DecCBOR (Block h era)
where
decCBOR :: forall s. Decoder s (Block h era)
decCBOR =
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Block" (forall a b. a -> b -> a
const Int
blockSize) forall a b. (a -> b) -> a -> b
$ do
h
header <- forall a s. DecCBOR a => Decoder s a
decCBOR
TxSeq era
txns <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall h era. h -> TxSeq era -> Block h era
Block h
header TxSeq era
txns
where
blockSize :: Int
blockSize = Int
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall era. EraSegWits era => Word64
numSegComponents @era)
instance
( EraSegWits era
, DecCBOR (Annotator h)
, Typeable h
) =>
DecCBOR (Annotator (Block h era))
where
decCBOR :: forall s. Decoder s (Annotator (Block h era))
decCBOR = forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Block" (forall a b. a -> b -> a
const Int
blockSize) forall a b. (a -> b) -> a -> b
$ do
Annotator h
header <- forall a s. DecCBOR a => Decoder s a
decCBOR
Annotator (TxSeq era)
txns <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall h era. h -> TxSeq era -> Block h era
Block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator h
header forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator (TxSeq era)
txns
where
blockSize :: Int
blockSize = Int
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall era. EraSegWits era => Word64
numSegComponents @era)
bheader ::
Block h era ->
h
(Block h
bh TxSeq era
_) = h
bh
bbody :: Block h era -> TxSeq era
bbody :: forall h era. Block h era -> TxSeq era
bbody (Block h
_ TxSeq era
txs) = TxSeq era
txs
neededTxInsForBlock ::
forall h era.
EraSegWits era =>
Block h era ->
Set TxIn
neededTxInsForBlock :: forall h era. EraSegWits era => Block h era -> Set TxIn
neededTxInsForBlock (Block h
_ TxSeq era
txsSeq) = forall a. (a -> Bool) -> Set a -> Set a
Set.filter TxIn -> Bool
isNotNewInput Set TxIn
allTxIns
where
txBodies :: [TxBody era]
txBodies = forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall era. EraSegWits era => TxSeq era -> StrictSeq (Tx era)
fromTxSeq TxSeq era
txsSeq
allTxIns :: Set TxIn
allTxIns = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
allInputsTxBodyF) [TxBody era]
txBodies
newTxIds :: Set TxId
newTxIds = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody [TxBody era]
txBodies
isNotNewInput :: TxIn -> Bool
isNotNewInput (TxIn TxId
txID TxIx
_) = TxId
txID forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set TxId
newTxIds