{-# 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 (
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 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 (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
$ forall h era. h -> TxSeq era -> Block h era
Block 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
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