{-# 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 UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Provides BlockBody internals
--
-- = Warning
--
-- This module is considered __internal__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
module Cardano.Ledger.Shelley.BlockBody.Internal (
  ShelleyBlockBody (ShelleyBlockBody, ..),
  auxDataSeqDecoder,
  hashShelleySegWits,
  bBodySize,
  slotToNonce,
  --
  incrBlocks,
  coreAuxDataBytes,
) where

import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  Nonce (..),
  StrictMaybe (..),
  maybeToStrictMaybe,
  mkNonceFromNumber,
  strictMaybeToMaybe,
 )
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (decCBOR),
  Decoder,
  EncCBOR (..),
  EncCBORGroup (..),
  encodeFoldableEncoder,
  encodeFoldableMapEncoder,
  encodePreEncoded,
  serialize,
  withSlice,
 )
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.Tx ()
import Cardano.Ledger.Slot (SlotNo (..))
import Control.Monad (unless)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder, shortByteString, toLazyByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Coerce (coerce)
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 (lens, (&), (.~), (^.))
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))

data ShelleyBlockBody era = ShelleyBlockBodyInternal
  { forall era. ShelleyBlockBody era -> StrictSeq (Tx era)
sbbTxs :: !(StrictSeq (Tx era))
  , forall era.
ShelleyBlockBody era -> Hash HASH EraIndependentBlockBody
sbbHash :: Hash.Hash HASH EraIndependentBlockBody
  -- ^ Memoized hash to avoid recomputation. Lazy on purpose.
  , forall era. ShelleyBlockBody era -> ByteString
sbbTxsBodyBytes :: BSL.ByteString
  -- ^ Bytes encoding @Seq ('TxBody' era)@
  , forall era. ShelleyBlockBody era -> ByteString
sbbTxsWitsBytes :: BSL.ByteString
  -- ^ Bytes encoding @Seq ('TxWits' era)@
  , forall era. ShelleyBlockBody era -> ByteString
sbbTxsAuxDataBytes :: BSL.ByteString
  -- ^ Bytes encoding a @Seq ('TxAuxData' era)@. Missing indices have
  -- 'SNothing' for metadata
  }
  deriving ((forall x. ShelleyBlockBody era -> Rep (ShelleyBlockBody era) x)
-> (forall x. Rep (ShelleyBlockBody era) x -> ShelleyBlockBody era)
-> Generic (ShelleyBlockBody era)
forall x. Rep (ShelleyBlockBody era) x -> ShelleyBlockBody era
forall x. ShelleyBlockBody era -> Rep (ShelleyBlockBody era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyBlockBody era) x -> ShelleyBlockBody era
forall era x. ShelleyBlockBody era -> Rep (ShelleyBlockBody era) x
$cfrom :: forall era x. ShelleyBlockBody era -> Rep (ShelleyBlockBody era) x
from :: forall x. ShelleyBlockBody era -> Rep (ShelleyBlockBody era) x
$cto :: forall era x. Rep (ShelleyBlockBody era) x -> ShelleyBlockBody era
to :: forall x. Rep (ShelleyBlockBody era) x -> ShelleyBlockBody era
Generic)

instance EraBlockBody ShelleyEra where
  type BlockBody ShelleyEra = ShelleyBlockBody ShelleyEra
  mkBasicBlockBody :: BlockBody ShelleyEra
mkBasicBlockBody = StrictSeq (Tx ShelleyEra) -> ShelleyBlockBody ShelleyEra
forall era.
(EraTx era, SafeToHash (TxWits era)) =>
StrictSeq (Tx era) -> ShelleyBlockBody era
ShelleyBlockBody StrictSeq (Tx ShelleyEra)
forall a. Monoid a => a
mempty
  txSeqBlockBodyL :: Lens' (BlockBody ShelleyEra) (StrictSeq (Tx ShelleyEra))
txSeqBlockBodyL = (ShelleyBlockBody ShelleyEra -> StrictSeq (Tx ShelleyEra))
-> (ShelleyBlockBody ShelleyEra
    -> StrictSeq (Tx ShelleyEra) -> ShelleyBlockBody ShelleyEra)
-> Lens
     (ShelleyBlockBody ShelleyEra)
     (ShelleyBlockBody ShelleyEra)
     (StrictSeq (Tx ShelleyEra))
     (StrictSeq (Tx ShelleyEra))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ShelleyBlockBody ShelleyEra -> StrictSeq (Tx ShelleyEra)
forall era. ShelleyBlockBody era -> StrictSeq (Tx era)
sbbTxs (\ShelleyBlockBody ShelleyEra
_ StrictSeq (Tx ShelleyEra)
s -> StrictSeq (Tx ShelleyEra) -> ShelleyBlockBody ShelleyEra
forall era.
(EraTx era, SafeToHash (TxWits era)) =>
StrictSeq (Tx era) -> ShelleyBlockBody era
ShelleyBlockBody StrictSeq (Tx ShelleyEra)
s)
  hashBlockBody :: BlockBody ShelleyEra -> Hash HASH EraIndependentBlockBody
hashBlockBody = BlockBody ShelleyEra -> Hash HASH EraIndependentBlockBody
ShelleyBlockBody ShelleyEra -> Hash HASH EraIndependentBlockBody
forall era.
ShelleyBlockBody era -> Hash HASH EraIndependentBlockBody
sbbHash
  numSegComponents :: Word64
numSegComponents = Word64
3

deriving via
  AllowThunksIn
    '[ "sbbHash"
     , "sbbTxsBodyBytes"
     , "sbbTxsWitsBytes"
     , "sbbTxsAuxDataBytes"
     ]
    (ShelleyBlockBody era)
  instance
    (Typeable era, NoThunks (Tx era)) => NoThunks (ShelleyBlockBody era)

deriving stock instance
  Show (Tx era) =>
  Show (ShelleyBlockBody era)

deriving stock instance
  Eq (Tx era) =>
  Eq (ShelleyBlockBody 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 BlockBody (with all it bytes) from just Tx's
pattern ShelleyBlockBody ::
  forall era.
  ( EraTx era
  , SafeToHash (TxWits era)
  ) =>
  StrictSeq (Tx era) ->
  ShelleyBlockBody era
pattern $mShelleyBlockBody :: forall {r} {era}.
(EraTx era, SafeToHash (TxWits era)) =>
ShelleyBlockBody era
-> (StrictSeq (Tx era) -> r) -> ((# #) -> r) -> r
$bShelleyBlockBody :: forall era.
(EraTx era, SafeToHash (TxWits era)) =>
StrictSeq (Tx era) -> ShelleyBlockBody era
ShelleyBlockBody xs <-
  ShelleyBlockBodyInternal xs _ _ _ _
  where
    ShelleyBlockBody 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
          txSeqBodies :: ByteString
txSeqBodies = 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 (Tx era -> ByteString)
-> StrictSeq (Tx era) -> StrictSeq ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
txns
          txSeqWits :: ByteString
txSeqWits = 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 (Tx era -> ByteString)
-> StrictSeq (Tx era) -> StrictSeq ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
txns
          txSeqAuxDatas :: ByteString
txSeqAuxDatas =
            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 (Tx era -> StrictMaybe ByteString)
-> StrictSeq (Tx era) -> StrictSeq (StrictMaybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
txns
       in ShelleyBlockBodyInternal
            { sbbTxs :: StrictSeq (Tx era)
sbbTxs = StrictSeq (Tx era)
txns
            , sbbHash :: Hash HASH EraIndependentBlockBody
sbbHash = ByteString
-> ByteString -> ByteString -> Hash HASH EraIndependentBlockBody
hashShelleySegWits ByteString
txSeqBodies ByteString
txSeqWits ByteString
txSeqAuxDatas
            , -- bytes encoding "Seq (TxBody era)"
              sbbTxsBodyBytes :: ByteString
sbbTxsBodyBytes = ByteString
txSeqBodies
            , -- bytes encoding "Seq (TxWits era)"
              sbbTxsWitsBytes :: ByteString
sbbTxsWitsBytes = ByteString
txSeqWits
            , -- bytes encoding a "Map Int TxAuxData"
              sbbTxsAuxDataBytes :: ByteString
sbbTxsAuxDataBytes = ByteString
txSeqAuxDatas
            }

{-# COMPLETE ShelleyBlockBody #-}

instance
  forall era.
  Era era =>
  EncCBORGroup (ShelleyBlockBody era)
  where
  encCBORGroup :: ShelleyBlockBody era -> Encoding
encCBORGroup (ShelleyBlockBodyInternal StrictSeq (Tx era)
_ Hash HASH EraIndependentBlockBody
_ 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 (ShelleyBlockBody era) -> Size
encodedGroupSizeExpr forall x. EncCBOR x => Proxy x -> Size
size Proxy (ShelleyBlockBody 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 :: ShelleyBlockBody era -> Word
listLen ShelleyBlockBody era
_ = Word
3
  listLenBound :: Proxy (ShelleyBlockBody era) -> Word
listLenBound Proxy (ShelleyBlockBody era)
_ = Word
3

hashShelleySegWits ::
  BSL.ByteString ->
  -- | Bytes for transaction bodies
  BSL.ByteString ->
  -- | Bytes for transaction witnesses
  BSL.ByteString ->
  -- | Bytes for transaction auxiliary datas
  Hash HASH EraIndependentBlockBody
hashShelleySegWits :: ByteString
-> ByteString -> ByteString -> Hash HASH EraIndependentBlockBody
hashShelleySegWits 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)
-> (Builder -> Hash HASH ByteString)
-> Builder
-> Hash HASH EraIndependentBlockBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash HASH ByteString
hashLazy (ByteString -> Hash HASH ByteString)
-> (Builder -> ByteString) -> Builder -> Hash HASH ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> Hash HASH EraIndependentBlockBody)
-> Builder -> Hash HASH EraIndependentBlockBody
forall a b. (a -> b) -> a -> b
$
    ByteString -> Builder
hashPart ByteString
bodies Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hashPart ByteString
wits Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hashPart ByteString
md
  where
    hashLazy :: BSL.ByteString -> Hash HASH ByteString
    hashLazy :: ByteString -> Hash HASH ByteString
hashLazy = (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 (ByteString -> Hash HASH ByteString)
-> (ByteString -> ByteString) -> ByteString -> Hash HASH ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
    {-# INLINE hashLazy #-}
    hashPart :: BSL.ByteString -> Builder
    hashPart :: ByteString -> Builder
hashPart = ShortByteString -> Builder
shortByteString (ShortByteString -> Builder)
-> (ByteString -> ShortByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH ByteString -> ShortByteString
forall h a. Hash h a -> ShortByteString
Hash.hashToBytesShort (Hash HASH ByteString -> ShortByteString)
-> (ByteString -> Hash HASH ByteString)
-> ByteString
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash HASH ByteString
hashLazy
    {-# INLINE hashPart #-}
{-# INLINE hashShelleySegWits #-}

auxDataSeqDecoder ::
  Int -> IntMap a -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder :: forall a s. Int -> IntMap a -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder Int
bodiesLength IntMap a
auxDataMap = do
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (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 (Annotator (TxAuxData era))
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  ) =>
  DecCBOR (Annotator (ShelleyBlockBody era))
  where
  -- \| The parts of the Tx in Blocks that have to have DecCBOR(Annotator x) instances.
  --   These are exactly the parts that are SafeToHash.
  -- \| Decode a BlockBody, used in decoding a Block.
  decCBOR :: forall s. Decoder s (Annotator (ShelleyBlockBody era))
decCBOR = do
    (Seq (Annotator (TxBody era))
bodies, Annotator ByteString
bodiesAnn) <- Decoder s (Seq (Annotator (TxBody era)))
-> Decoder s (Seq (Annotator (TxBody era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Seq (Annotator (TxBody era)))
forall s. Decoder s (Seq (Annotator (TxBody era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Seq (Annotator (TxWits era))
wits, Annotator ByteString
witsAnn) <- Decoder s (Seq (Annotator (TxWits era)))
-> Decoder s (Seq (Annotator (TxWits era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Seq (Annotator (TxWits era)))
forall s. Decoder s (Seq (Annotator (TxWits era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
    let bodiesLength :: Int
bodiesLength = Seq (Annotator (TxBody era)) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxBody era))
bodies
        witsLength :: Int
witsLength = Seq (Annotator (TxWits era)) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxWits era))
wits
    (Seq (Maybe (Annotator (TxAuxData era)))
metadata, Annotator ByteString
metadataAnn) <- Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
-> Decoder
     s (Seq (Maybe (Annotator (TxAuxData era))), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
 -> Decoder
      s (Seq (Maybe (Annotator (TxAuxData era))), Annotator ByteString))
-> Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
-> Decoder
     s (Seq (Maybe (Annotator (TxAuxData era))), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ do
      IntMap (Annotator (TxAuxData era))
auxDataMap <- Decoder s (IntMap (Annotator (TxAuxData era)))
forall s. Decoder s (IntMap (Annotator (TxAuxData era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
      Int
-> IntMap (Annotator (TxAuxData era))
-> Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
forall a s. Int -> IntMap a -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder Int
bodiesLength IntMap (Annotator (TxAuxData era))
auxDataMap

    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
      segWitAnnTx :: Annotator (TxBody era)
-> Annotator (TxWits era)
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
segWitAnnTx Annotator (TxBody era)
bodyAnn Annotator (TxWits era)
witsAnn' Maybe (Annotator (TxAuxData era))
metaAnn = (FullByteString -> Tx era) -> Annotator (Tx era)
forall a. (FullByteString -> a) -> Annotator a
Annotator ((FullByteString -> Tx era) -> Annotator (Tx era))
-> (FullByteString -> Tx era) -> Annotator (Tx era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes ->
        let body' :: TxBody era
body' = Annotator (TxBody era) -> FullByteString -> TxBody era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
bodyAnn FullByteString
bytes
            witnessSet :: TxWits era
witnessSet = Annotator (TxWits era) -> FullByteString -> TxWits era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxWits era)
witsAnn' FullByteString
bytes
            metadata' :: Maybe (TxAuxData era)
metadata' = (Annotator (TxAuxData era) -> FullByteString -> TxAuxData era)
-> FullByteString -> Annotator (TxAuxData era) -> TxAuxData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxAuxData era) -> FullByteString -> TxAuxData era
forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes (Annotator (TxAuxData era) -> TxAuxData era)
-> Maybe (Annotator (TxAuxData era)) -> Maybe (TxAuxData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (TxAuxData era))
metaAnn
         in forall era. EraTx era => TxBody era -> Tx era
mkBasicTx @era TxBody era
body'
              Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> TxWits era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits era
witnessSet
              Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData era)
 -> Identity (StrictMaybe (TxAuxData era)))
-> Tx era -> Identity (Tx era)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL ((StrictMaybe (TxAuxData era)
  -> Identity (StrictMaybe (TxAuxData era)))
 -> Tx era -> Identity (Tx era))
-> StrictMaybe (TxAuxData era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (TxAuxData era) -> StrictMaybe (TxAuxData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (TxAuxData era)
metadata'
      txns :: Annotator (StrictSeq (Tx era))
txns =
        StrictSeq (Annotator (Tx era)) -> Annotator (StrictSeq (Tx era))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
StrictSeq (f a) -> f (StrictSeq a)
sequenceA (StrictSeq (Annotator (Tx era)) -> Annotator (StrictSeq (Tx era)))
-> StrictSeq (Annotator (Tx era)) -> Annotator (StrictSeq (Tx era))
forall a b. (a -> b) -> a -> b
$
          Seq (Annotator (Tx era)) -> StrictSeq (Annotator (Tx era))
forall a. Seq a -> StrictSeq a
StrictSeq.forceToStrict (Seq (Annotator (Tx era)) -> StrictSeq (Annotator (Tx era)))
-> Seq (Annotator (Tx era)) -> StrictSeq (Annotator (Tx era))
forall a b. (a -> b) -> a -> b
$
            (Annotator (TxBody era)
 -> Annotator (TxWits era)
 -> Maybe (Annotator (TxAuxData era))
 -> Annotator (Tx era))
-> Seq (Annotator (TxBody era))
-> Seq (Annotator (TxWits era))
-> Seq (Maybe (Annotator (TxAuxData era)))
-> Seq (Annotator (Tx era))
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
Seq.zipWith3 Annotator (TxBody era)
-> Annotator (TxWits era)
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
segWitAnnTx Seq (Annotator (TxBody era))
bodies Seq (Annotator (TxWits era))
wits Seq (Maybe (Annotator (TxAuxData era)))
metadata
      hashAnn :: Annotator (Hash HASH EraIndependentBlockBody)
hashAnn = ByteString
-> ByteString -> ByteString -> Hash HASH EraIndependentBlockBody
hashShelleySegWits (ByteString
 -> ByteString -> ByteString -> Hash HASH EraIndependentBlockBody)
-> Annotator ByteString
-> Annotator
     (ByteString -> ByteString -> Hash HASH EraIndependentBlockBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator ByteString
bodiesAnn Annotator
  (ByteString -> ByteString -> Hash HASH EraIndependentBlockBody)
-> Annotator ByteString
-> Annotator (ByteString -> Hash HASH EraIndependentBlockBody)
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
witsAnn Annotator (ByteString -> Hash HASH EraIndependentBlockBody)
-> Annotator ByteString
-> Annotator (Hash HASH EraIndependentBlockBody)
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
metadataAnn
    Annotator (ShelleyBlockBody era)
-> Decoder s (Annotator (ShelleyBlockBody era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (ShelleyBlockBody era)
 -> Decoder s (Annotator (ShelleyBlockBody era)))
-> Annotator (ShelleyBlockBody era)
-> Decoder s (Annotator (ShelleyBlockBody era))
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx era)
-> Hash HASH EraIndependentBlockBody
-> ByteString
-> ByteString
-> ByteString
-> ShelleyBlockBody era
forall era.
StrictSeq (Tx era)
-> Hash HASH EraIndependentBlockBody
-> ByteString
-> ByteString
-> ByteString
-> ShelleyBlockBody era
ShelleyBlockBodyInternal (StrictSeq (Tx era)
 -> Hash HASH EraIndependentBlockBody
 -> ByteString
 -> ByteString
 -> ByteString
 -> ShelleyBlockBody era)
-> Annotator (StrictSeq (Tx era))
-> Annotator
     (Hash HASH EraIndependentBlockBody
      -> ByteString -> ByteString -> ByteString -> ShelleyBlockBody era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (Tx era))
txns Annotator
  (Hash HASH EraIndependentBlockBody
   -> ByteString -> ByteString -> ByteString -> ShelleyBlockBody era)
-> Annotator (Hash HASH EraIndependentBlockBody)
-> Annotator
     (ByteString -> ByteString -> ByteString -> ShelleyBlockBody 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 (Hash HASH EraIndependentBlockBody)
hashAnn Annotator
  (ByteString -> ByteString -> ByteString -> ShelleyBlockBody era)
-> Annotator ByteString
-> Annotator (ByteString -> ByteString -> ShelleyBlockBody 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 ByteString
bodiesAnn Annotator (ByteString -> ByteString -> ShelleyBlockBody era)
-> Annotator ByteString
-> Annotator (ByteString -> ShelleyBlockBody 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 ByteString
witsAnn Annotator (ByteString -> ShelleyBlockBody era)
-> Annotator ByteString -> Annotator (ShelleyBlockBody 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 ByteString
metadataAnn

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