{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.BlockChain (
  ShelleyTxSeq (ShelleyTxSeq, txSeqTxns', TxSeq'),
  auxDataSeqDecoder,
  txSeqTxns,
  bbHash,
  bBodySize,
  slotToNonce,
  --
  incrBlocks,
  coreAuxDataBytes,
) where

import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  Nonce (..),
  StrictMaybe (..),
  mkNonceFromNumber,
  strictMaybeToMaybe,
 )
import Cardano.Ledger.Binary (
  Annotated (..),
  DecCBOR (decCBOR),
  Decoder,
  EncCBOR (..),
  EncCBORGroup (..),
  decodeAnnotated,
  encodeFoldableEncoder,
  encodeFoldableMapEncoder,
  encodePreEncoded,
  serialize,
 )
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.Tx (ShelleyTx, segWitTx)
import Cardano.Ledger.Slot (SlotNo (..))
import Control.Monad (unless)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity (..))
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.Map.Strict as Map
import Data.Monoid (All (..))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Typeable
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))

data ShelleyTxSeq era = TxSeq'
  { forall era. ShelleyTxSeq era -> StrictSeq (ShelleyTx era)
txSeqTxns' :: !(StrictSeq (ShelleyTx era))
  , forall era. ShelleyTxSeq era -> ByteString
txSeqBodyBytes :: BSL.ByteString
  , forall era. ShelleyTxSeq era -> ByteString
txSeqWitsBytes :: BSL.ByteString
  , forall era. ShelleyTxSeq era -> ByteString
txSeqMetadataBytes :: BSL.ByteString
  -- bytes representing a (Map index metadata). Missing indices have SNothing for metadata
  }
  deriving ((forall x. ShelleyTxSeq era -> Rep (ShelleyTxSeq era) x)
-> (forall x. Rep (ShelleyTxSeq era) x -> ShelleyTxSeq era)
-> Generic (ShelleyTxSeq era)
forall x. Rep (ShelleyTxSeq era) x -> ShelleyTxSeq era
forall x. ShelleyTxSeq era -> Rep (ShelleyTxSeq era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTxSeq era) x -> ShelleyTxSeq era
forall era x. ShelleyTxSeq era -> Rep (ShelleyTxSeq era) x
$cfrom :: forall era x. ShelleyTxSeq era -> Rep (ShelleyTxSeq era) x
from :: forall x. ShelleyTxSeq era -> Rep (ShelleyTxSeq era) x
$cto :: forall era x. Rep (ShelleyTxSeq era) x -> ShelleyTxSeq era
to :: forall x. Rep (ShelleyTxSeq era) x -> ShelleyTxSeq era
Generic)

instance EraSegWits ShelleyEra where
  type TxSeq ShelleyEra = ShelleyTxSeq ShelleyEra
  fromTxSeq :: TxSeq ShelleyEra -> StrictSeq (Tx ShelleyEra)
fromTxSeq = TxSeq ShelleyEra -> StrictSeq (Tx ShelleyEra)
ShelleyTxSeq ShelleyEra -> StrictSeq (ShelleyTx ShelleyEra)
forall era. ShelleyTxSeq era -> StrictSeq (ShelleyTx era)
txSeqTxns
  toTxSeq :: StrictSeq (Tx ShelleyEra) -> TxSeq ShelleyEra
toTxSeq = StrictSeq (Tx ShelleyEra) -> TxSeq ShelleyEra
StrictSeq (Tx ShelleyEra) -> ShelleyTxSeq ShelleyEra
forall era.
(EraTx era, Tx era ~ ShelleyTx era, SafeToHash (TxWits era)) =>
StrictSeq (Tx era) -> ShelleyTxSeq era
ShelleyTxSeq
  hashTxSeq :: TxSeq ShelleyEra -> Hash HASH EraIndependentBlockBody
hashTxSeq = TxSeq ShelleyEra -> Hash HASH EraIndependentBlockBody
ShelleyTxSeq ShelleyEra -> Hash HASH EraIndependentBlockBody
forall era. ShelleyTxSeq era -> Hash HASH EraIndependentBlockBody
bbHash
  numSegComponents :: Word64
numSegComponents = Word64
3

deriving via
  AllowThunksIn
    '[ "txSeqBodyBytes"
     , "txSeqWitsBytes"
     , "txSeqMetadataBytes"
     ]
    (ShelleyTxSeq era)
  instance
    (Typeable era, NoThunks (ShelleyTx era)) => NoThunks (ShelleyTxSeq era)

deriving stock instance
  Show (ShelleyTx era) =>
  Show (ShelleyTxSeq era)

deriving stock instance
  Eq (ShelleyTx era) =>
  Eq (ShelleyTxSeq era)

-- ===========================
-- Getting bytes from pieces of a Tx

coreWitnessBytes ::
  (EraTx era, SafeToHash (TxWits era)) =>
  Tx era ->
  ByteString
coreWitnessBytes :: forall era.
(EraTx era, SafeToHash (TxWits era)) =>
Tx era -> ByteString
coreWitnessBytes Tx era
tx = TxWits era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (TxWits era -> ByteString) -> TxWits era -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL

coreBodyBytes :: EraTx era => Tx era -> ByteString
coreBodyBytes :: forall era. EraTx era => Tx era -> ByteString
coreBodyBytes Tx era
tx = TxBody era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (TxBody era -> ByteString) -> TxBody era -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx era
tx 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

coreAuxDataBytes :: EraTx era => Tx era -> StrictMaybe ByteString
coreAuxDataBytes :: forall era. EraTx era => Tx era -> StrictMaybe ByteString
coreAuxDataBytes Tx era
tx = TxAuxData era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (TxAuxData era -> ByteString)
-> StrictMaybe (TxAuxData era) -> StrictMaybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx era
tx Tx era
-> Getting
     (StrictMaybe (TxAuxData era))
     (Tx era)
     (StrictMaybe (TxAuxData era))
-> StrictMaybe (TxAuxData era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData era))
  (Tx era)
  (StrictMaybe (TxAuxData era))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL

-- ===========================

-- | Constuct a TxSeq (with all it bytes) from just Tx's
pattern ShelleyTxSeq ::
  forall era.
  ( EraTx era
  , Tx era ~ ShelleyTx era
  , SafeToHash (TxWits era)
  ) =>
  StrictSeq (Tx era) ->
  ShelleyTxSeq era
pattern $mShelleyTxSeq :: forall {r} {era}.
(EraTx era, Tx era ~ ShelleyTx era, SafeToHash (TxWits era)) =>
ShelleyTxSeq era -> (StrictSeq (Tx era) -> r) -> ((# #) -> r) -> r
$bShelleyTxSeq :: forall era.
(EraTx era, Tx era ~ ShelleyTx era, SafeToHash (TxWits era)) =>
StrictSeq (Tx era) -> ShelleyTxSeq era
ShelleyTxSeq xs <-
  TxSeq' xs _ _ _
  where
    ShelleyTxSeq StrictSeq (Tx era)
txns =
      let version :: Version
version = forall era. Era era => Version
eraProtVerLow @era
          serializeFoldable :: StrictSeq ByteString -> ByteString
serializeFoldable StrictSeq ByteString
x =
            Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
              (ByteString -> Encoding) -> StrictSeq ByteString -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder ByteString -> Encoding
encodePreEncoded StrictSeq ByteString
x
          metaChunk :: a -> StrictMaybe ByteString -> Maybe Encoding
metaChunk a
index StrictMaybe ByteString
m = ByteString -> Encoding
encodePair (ByteString -> Encoding) -> Maybe ByteString -> Maybe Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe ByteString -> Maybe ByteString
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ByteString
m
            where
              encodePair :: ByteString -> Encoding
encodePair ByteString
metadata = a -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR a
index Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded ByteString
metadata
       in TxSeq'
            { txSeqTxns' :: StrictSeq (ShelleyTx era)
txSeqTxns' = StrictSeq (Tx era)
StrictSeq (ShelleyTx era)
txns
            , -- bytes encoding "Seq (TxBody era)"
              txSeqBodyBytes :: ByteString
txSeqBodyBytes = StrictSeq ByteString -> ByteString
serializeFoldable (StrictSeq ByteString -> ByteString)
-> StrictSeq ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ forall era. EraTx era => Tx era -> ByteString
coreBodyBytes @era (ShelleyTx era -> ByteString)
-> StrictSeq (ShelleyTx era) -> StrictSeq ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
StrictSeq (ShelleyTx era)
txns
            , -- bytes encoding "Seq (TxWits era)"
              txSeqWitsBytes :: ByteString
txSeqWitsBytes = StrictSeq ByteString -> ByteString
serializeFoldable (StrictSeq ByteString -> ByteString)
-> StrictSeq ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ forall era.
(EraTx era, SafeToHash (TxWits era)) =>
Tx era -> ByteString
coreWitnessBytes @era (ShelleyTx era -> ByteString)
-> StrictSeq (ShelleyTx era) -> StrictSeq ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
StrictSeq (ShelleyTx era)
txns
            , -- bytes encoding a "Map Int TxAuxData"
              txSeqMetadataBytes :: ByteString
txSeqMetadataBytes =
                Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version (Encoding -> ByteString)
-> (StrictSeq (StrictMaybe ByteString) -> Encoding)
-> StrictSeq (StrictMaybe ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> StrictMaybe ByteString -> Maybe Encoding)
-> StrictSeq (StrictMaybe ByteString) -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(Word -> a -> Maybe Encoding) -> f a -> Encoding
encodeFoldableMapEncoder Word -> StrictMaybe ByteString -> Maybe Encoding
forall {a}.
EncCBOR a =>
a -> StrictMaybe ByteString -> Maybe Encoding
metaChunk (StrictSeq (StrictMaybe ByteString) -> ByteString)
-> StrictSeq (StrictMaybe ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$
                  forall era. EraTx era => Tx era -> StrictMaybe ByteString
coreAuxDataBytes @era (ShelleyTx era -> StrictMaybe ByteString)
-> StrictSeq (ShelleyTx era) -> StrictSeq (StrictMaybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
StrictSeq (ShelleyTx era)
txns
            }

{-# COMPLETE ShelleyTxSeq #-}

txSeqTxns :: ShelleyTxSeq era -> StrictSeq (ShelleyTx era)
txSeqTxns :: forall era. ShelleyTxSeq era -> StrictSeq (ShelleyTx era)
txSeqTxns (TxSeq' StrictSeq (ShelleyTx era)
ts ByteString
_ ByteString
_ ByteString
_) = StrictSeq (ShelleyTx era)
ts

instance
  forall era.
  Era era =>
  EncCBORGroup (ShelleyTxSeq era)
  where
  encCBORGroup :: ShelleyTxSeq era -> Encoding
encCBORGroup (TxSeq' StrictSeq (ShelleyTx era)
_ ByteString
bodyBytes ByteString
witsBytes ByteString
metadataBytes) =
    ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$
      ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
        ByteString
bodyBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
witsBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
metadataBytes
  encodedGroupSizeExpr :: (forall x. EncCBOR x => Proxy x -> Size)
-> Proxy (ShelleyTxSeq era) -> Size
encodedGroupSizeExpr forall x. EncCBOR x => Proxy x -> Size
size Proxy (ShelleyTxSeq era)
_proxy =
    (forall x. EncCBOR x => Proxy x -> Size)
-> Proxy ByteString -> Size
forall a.
EncCBOR a =>
(forall x. EncCBOR x => Proxy x -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall x. EncCBOR x => Proxy x -> Size
size (Proxy ByteString
forall {k} (t :: k). Proxy t
Proxy :: Proxy ByteString)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall x. EncCBOR x => Proxy x -> Size)
-> Proxy ByteString -> Size
forall a.
EncCBOR a =>
(forall x. EncCBOR x => Proxy x -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall x. EncCBOR x => Proxy x -> Size
size (Proxy ByteString
forall {k} (t :: k). Proxy t
Proxy :: Proxy ByteString)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall x. EncCBOR x => Proxy x -> Size)
-> Proxy ByteString -> Size
forall a.
EncCBOR a =>
(forall x. EncCBOR x => Proxy x -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall x. EncCBOR x => Proxy x -> Size
size (Proxy ByteString
forall {k} (t :: k). Proxy t
Proxy :: Proxy ByteString)
  listLen :: ShelleyTxSeq era -> Word
listLen ShelleyTxSeq era
_ = Word
3
  listLenBound :: Proxy (ShelleyTxSeq era) -> Word
listLenBound Proxy (ShelleyTxSeq era)
_ = Word
3

-- | Hash a given block body
bbHash :: ShelleyTxSeq era -> Hash HASH EraIndependentBlockBody
bbHash :: forall era. ShelleyTxSeq era -> Hash HASH EraIndependentBlockBody
bbHash (TxSeq' StrictSeq (ShelleyTx era)
_ ByteString
bodies ByteString
wits ByteString
md) =
  Hash HASH ByteString -> Hash HASH EraIndependentBlockBody
forall a b. Coercible a b => a -> b
coerce (Hash HASH ByteString -> Hash HASH EraIndependentBlockBody)
-> Hash HASH ByteString -> Hash HASH EraIndependentBlockBody
forall a b. (a -> b) -> a -> b
$
    ByteString -> Hash HASH ByteString
hashStrict
      ( ByteString -> ByteString
hashPart ByteString
bodies
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
hashPart ByteString
wits
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
hashPart ByteString
md
      )
  where
    hashStrict :: ByteString -> Hash HASH ByteString
    hashStrict :: ByteString -> Hash HASH ByteString
hashStrict = (ByteString -> ByteString) -> ByteString -> Hash HASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id
    hashPart :: ByteString -> ByteString
hashPart = Hash HASH ByteString -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes (Hash HASH ByteString -> ByteString)
-> (ByteString -> Hash HASH ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash HASH ByteString
hashStrict (ByteString -> Hash HASH ByteString)
-> (ByteString -> ByteString) -> ByteString -> Hash HASH ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict

auxDataSeqDecoder ::
  Int -> IntMap a -> Bool -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder :: forall a s. Int -> IntMap a -> Bool -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder Int
bodiesLength IntMap a
auxDataMap Bool
lax = do
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (Bool
lax Bool -> Bool -> Bool
|| All -> Bool
getAll ((Int -> a -> All) -> IntMap a -> All
forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
IntMap.foldMapWithKey (\Int
k a
_ -> Bool -> All
All (Int -> Bool
inRange Int
k)) IntMap a
auxDataMap))
    (String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Some Auxiliarydata index is not in the range: 0 .. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
bodiesLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
  Seq (Maybe a) -> Decoder s (Seq (Maybe a))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap a -> Seq (Maybe a)
forall a. Int -> IntMap a -> Seq (Maybe a)
indexLookupSeq Int
bodiesLength IntMap a
auxDataMap)
  where
    inRange :: Int -> Bool
inRange Int
x = (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x) Bool -> Bool -> Bool
&& (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
bodiesLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
    -- Given a size and a mapping from indices to maybe values,
    -- return a sequence whose size is the size parameter and
    -- whose non-Nothing values correspond to the values in the mapping.
    indexLookupSeq :: Int -> IntMap a -> Seq (Maybe a)
    indexLookupSeq :: forall a. Int -> IntMap a -> Seq (Maybe a)
indexLookupSeq Int
n IntMap a
ixMap = [Maybe a] -> Seq (Maybe a)
forall a. [a] -> Seq a
Seq.fromList [Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
ix IntMap a
ixMap | Int
ix <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

instance EraTx era => DecCBOR (ShelleyTxSeq era) where
  decCBOR :: forall s. Decoder s (ShelleyTxSeq era)
decCBOR = do
    Annotated Seq (TxBody era)
bodies ByteString
bodiesBytes <- Decoder s (Seq (TxBody era))
-> Decoder s (Annotated (Seq (TxBody era)) ByteString)
forall s a. Decoder s a -> Decoder s (Annotated a ByteString)
decodeAnnotated Decoder s (Seq (TxBody era))
forall s. Decoder s (Seq (TxBody era))
forall a s. DecCBOR a => Decoder s a
decCBOR
    Annotated Seq (TxWits era)
wits ByteString
witsBytes <- Decoder s (Seq (TxWits era))
-> Decoder s (Annotated (Seq (TxWits era)) ByteString)
forall s a. Decoder s a -> Decoder s (Annotated a ByteString)
decodeAnnotated Decoder s (Seq (TxWits era))
forall s. Decoder s (Seq (TxWits era))
forall a s. DecCBOR a => Decoder s a
decCBOR
    Annotated (IntMap (TxAuxData era)
auxDataMap :: IntMap (TxAuxData era)) ByteString
auxDataBytes <- Decoder s (IntMap (TxAuxData era))
-> Decoder s (Annotated (IntMap (TxAuxData era)) ByteString)
forall s a. Decoder s a -> Decoder s (Annotated a ByteString)
decodeAnnotated Decoder s (IntMap (TxAuxData era))
forall s. Decoder s (IntMap (TxAuxData era))
forall a s. DecCBOR a => Decoder s a
decCBOR
    let bodiesLength :: Int
bodiesLength = Seq (TxBody era) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (TxBody era)
bodies
    Seq (Maybe (TxAuxData era))
auxData <-
      (Maybe (Identity (TxAuxData era)) -> Maybe (TxAuxData era))
-> Seq (Maybe (Identity (TxAuxData era)))
-> Seq (Maybe (TxAuxData era))
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Identity (TxAuxData era) -> TxAuxData era)
-> Maybe (Identity (TxAuxData era)) -> Maybe (TxAuxData era)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity (TxAuxData era) -> TxAuxData era
forall a. Identity a -> a
runIdentity)
        (Seq (Maybe (Identity (TxAuxData era)))
 -> Seq (Maybe (TxAuxData era)))
-> Decoder s (Seq (Maybe (Identity (TxAuxData era))))
-> Decoder s (Seq (Maybe (TxAuxData era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> IntMap (Identity (TxAuxData era))
-> Bool
-> Decoder s (Seq (Maybe (Identity (TxAuxData era))))
forall a s. Int -> IntMap a -> Bool -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder Int
bodiesLength ((TxAuxData era -> Identity (TxAuxData era))
-> IntMap (TxAuxData era) -> IntMap (Identity (TxAuxData era))
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData era -> Identity (TxAuxData era)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap (TxAuxData era)
auxDataMap) Bool
False

    let witsLength :: Int
witsLength = Seq (TxWits era) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (TxWits era)
wits
    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
      (Int
bodiesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
witsLength)
      ( String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
          String
"different number of transaction bodies ("
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
bodiesLength
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") and witness sets ("
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
witsLength
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
      )
    let txs :: StrictSeq (ShelleyTx era)
txs =
          Seq (ShelleyTx era) -> StrictSeq (ShelleyTx era)
forall a. Seq a -> StrictSeq a
StrictSeq.forceToStrict (Seq (ShelleyTx era) -> StrictSeq (ShelleyTx era))
-> Seq (ShelleyTx era) -> StrictSeq (ShelleyTx era)
forall a b. (a -> b) -> a -> b
$
            (TxBody era
 -> TxWits era -> Maybe (TxAuxData era) -> ShelleyTx era)
-> Seq (TxBody era)
-> Seq (TxWits era)
-> Seq (Maybe (TxAuxData era))
-> Seq (ShelleyTx era)
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
Seq.zipWith3 TxBody era -> TxWits era -> Maybe (TxAuxData era) -> ShelleyTx era
forall era.
EraTx era =>
TxBody era -> TxWits era -> Maybe (TxAuxData era) -> ShelleyTx era
segWitTx Seq (TxBody era)
bodies Seq (TxWits era)
wits Seq (Maybe (TxAuxData era))
auxData
    ShelleyTxSeq era -> Decoder s (ShelleyTxSeq era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyTxSeq era -> Decoder s (ShelleyTxSeq era))
-> ShelleyTxSeq era -> Decoder s (ShelleyTxSeq era)
forall a b. (a -> b) -> a -> b
$ StrictSeq (ShelleyTx era)
-> ByteString -> ByteString -> ByteString -> ShelleyTxSeq era
forall era.
StrictSeq (ShelleyTx era)
-> ByteString -> ByteString -> ByteString -> ShelleyTxSeq era
TxSeq' StrictSeq (ShelleyTx era)
txs ByteString
bodiesBytes ByteString
witsBytes ByteString
auxDataBytes

slotToNonce :: SlotNo -> Nonce
slotToNonce :: SlotNo -> Nonce
slotToNonce (SlotNo Word64
s) = Word64 -> Nonce
mkNonceFromNumber Word64
s

incrBlocks ::
  Bool ->
  KeyHash 'StakePool ->
  BlocksMade ->
  BlocksMade
incrBlocks :: Bool -> KeyHash 'StakePool -> BlocksMade -> BlocksMade
incrBlocks Bool
isOverlay KeyHash 'StakePool
hk b' :: BlocksMade
b'@(BlocksMade Map (KeyHash 'StakePool) Natural
b)
  | Bool
isOverlay = BlocksMade
b'
  | Bool
otherwise = Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (Map (KeyHash 'StakePool) Natural -> BlocksMade)
-> Map (KeyHash 'StakePool) Natural -> BlocksMade
forall a b. (a -> b) -> a -> b
$ case Maybe Natural
hkVal of
      Maybe Natural
Nothing -> KeyHash 'StakePool
-> Natural
-> Map (KeyHash 'StakePool) Natural
-> Map (KeyHash 'StakePool) Natural
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool
hk Natural
1 Map (KeyHash 'StakePool) Natural
b
      Just Natural
n -> KeyHash 'StakePool
-> Natural
-> Map (KeyHash 'StakePool) Natural
-> Map (KeyHash 'StakePool) Natural
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool
hk (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) Map (KeyHash 'StakePool) Natural
b
  where
    hkVal :: Maybe Natural
hkVal = KeyHash 'StakePool
-> Map (KeyHash 'StakePool) Natural -> Maybe Natural
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
hk Map (KeyHash 'StakePool) Natural
b