{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

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

import Cardano.Binary
  ( Annotator (..),
    Decoder,
    FromCBOR (fromCBOR),
    ToCBOR (..),
    encodePreEncoded,
    serializeEncoding,
    serializeEncoding',
    withSlice,
  )
import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.BaseTypes
  ( BlocksMade (..),
    Nonce (..),
    StrictMaybe (..),
    mkNonceFromNumber,
    strictMaybeToMaybe,
  )
import Cardano.Ledger.Block (BlockAnn)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Crypto, Era)
import Cardano.Ledger.Hashes (EraIndependentBlockBody)
import Cardano.Ledger.Keys (Hash, KeyHash, KeyRole (..))
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Cardano.Ledger.Serialization
  ( ToCBORGroup (..),
    decodeMap,
    decodeSeq,
    encodeFoldableEncoder,
    encodeFoldableMapEncoder,
  )
import Cardano.Ledger.Shelley.Tx (Tx, segwitTx)
import Cardano.Ledger.Slot (SlotNo (..))
import Control.Monad (unless)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Coerce (coerce)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
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 GHC.Records (HasField (..))
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))

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

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

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

deriving stock instance
  Eq (Tx era) =>
  Eq (TxSeq era)

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

coreWitnessBytes ::
  forall era.
  ( SafeToHash (Core.Witnesses era)
  ) =>
  Tx era ->
  ByteString
coreWitnessBytes :: Tx era -> ByteString
coreWitnessBytes Tx era
coretx =
  SafeToHash (Witnesses era) => Witnesses era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes @(Core.Witnesses era) (Witnesses era -> ByteString) -> Witnesses era -> ByteString
forall a b. (a -> b) -> a -> b
$
    Tx era -> Witnesses era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wits" Tx era
coretx

coreBodyBytes ::
  forall era.
  ( SafeToHash (Core.TxBody era)
  ) =>
  Tx era ->
  ByteString
coreBodyBytes :: Tx era -> ByteString
coreBodyBytes Tx era
coretx =
  SafeToHash (TxBody era) => TxBody era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes @(Core.TxBody era) (TxBody era -> ByteString) -> TxBody era -> ByteString
forall a b. (a -> b) -> a -> b
$
    Tx era -> TxBody era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" Tx era
coretx

coreAuxDataBytes ::
  forall era.
  ( SafeToHash (Core.AuxiliaryData era)
  ) =>
  Tx era ->
  StrictMaybe ByteString
coreAuxDataBytes :: Tx era -> StrictMaybe ByteString
coreAuxDataBytes Tx era
coretx = AuxiliaryData era -> ByteString
getbytes (AuxiliaryData era -> ByteString)
-> StrictMaybe (AuxiliaryData era) -> StrictMaybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx era -> StrictMaybe (AuxiliaryData era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"auxiliaryData" Tx era
coretx
  where
    getbytes :: AuxiliaryData era -> ByteString
getbytes AuxiliaryData era
auxdata = AuxiliaryData era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes @(Core.AuxiliaryData era) AuxiliaryData era
auxdata

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

-- | Constuct a TxSeq (with all it bytes) from just Core.Tx's
pattern TxSeq ::
  forall era.
  ( Era era,
    SafeToHash (Core.Witnesses era)
  ) =>
  StrictSeq (Tx era) ->
  TxSeq era
pattern $bTxSeq :: StrictSeq (Tx era) -> TxSeq era
$mTxSeq :: forall r era.
(Era era, SafeToHash (Witnesses era)) =>
TxSeq era -> (StrictSeq (Tx era) -> r) -> (Void# -> r) -> r
TxSeq xs <-
  TxSeq' xs _ _ _
  where
    TxSeq StrictSeq (Tx era)
txns =
      let serializeFoldable :: f ByteString -> ByteString
serializeFoldable f ByteString
x =
            Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
              (ByteString -> Encoding) -> f ByteString -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder ByteString -> Encoding
encodePreEncoded f 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. ToCBOR a => a -> Encoding
toCBOR a
index Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded ByteString
metadata
       in TxSeq' :: forall era.
StrictSeq (Tx era)
-> ByteString -> ByteString -> ByteString -> TxSeq era
TxSeq'
            { txSeqTxns' :: StrictSeq (Tx era)
txSeqTxns' = StrictSeq (Tx era)
txns,
              -- bytes encoding Seq(Core.TxBody era)
              txSeqBodyBytes :: ByteString
txSeqBodyBytes = StrictSeq ByteString -> ByteString
forall (f :: * -> *). Foldable f => f ByteString -> ByteString
serializeFoldable (StrictSeq ByteString -> ByteString)
-> StrictSeq ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SafeToHash (TxBody era) => Tx era -> ByteString
forall era. SafeToHash (TxBody 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,
              -- bytes encoding Seq(Core.Witnesses era)
              txSeqWitsBytes :: ByteString
txSeqWitsBytes = StrictSeq ByteString -> ByteString
forall (f :: * -> *). Foldable f => f ByteString -> ByteString
serializeFoldable (StrictSeq ByteString -> ByteString)
-> StrictSeq ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SafeToHash (Witnesses era) => Tx era -> ByteString
forall era. SafeToHash (Witnesses 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,
              -- bytes encoding a (Map Int (Core.AuxiliaryData))
              txSeqMetadataBytes :: ByteString
txSeqMetadataBytes =
                Encoding -> ByteString
serializeEncoding (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. ToCBOR a => a -> StrictMaybe ByteString -> Maybe Encoding
metaChunk (StrictSeq (StrictMaybe ByteString) -> ByteString)
-> StrictSeq (StrictMaybe ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$
                  SafeToHash (AuxiliaryData era) => Tx era -> StrictMaybe ByteString
forall era.
SafeToHash (AuxiliaryData 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
            }

{-# COMPLETE TxSeq #-}

txSeqTxns :: TxSeq era -> StrictSeq (Tx era)
txSeqTxns :: TxSeq era -> StrictSeq (Tx era)
txSeqTxns (TxSeq' StrictSeq (Tx era)
ts ByteString
_ ByteString
_ ByteString
_) = StrictSeq (Tx era)
ts

instance
  forall era.
  (Era era) =>
  ToCBORGroup (TxSeq era)
  where
  toCBORGroup :: TxSeq era -> Encoding
toCBORGroup (TxSeq' StrictSeq (Tx 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. ToCBOR x => Proxy x -> Size)
-> Proxy (TxSeq era) -> Size
encodedGroupSizeExpr forall x. ToCBOR x => Proxy x -> Size
size Proxy (TxSeq era)
_proxy =
    (forall x. ToCBOR x => Proxy x -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall x. ToCBOR x => Proxy x -> Size) -> Proxy a -> Size
encodedSizeExpr forall x. ToCBOR 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. ToCBOR x => Proxy x -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall x. ToCBOR x => Proxy x -> Size) -> Proxy a -> Size
encodedSizeExpr forall x. ToCBOR 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. ToCBOR x => Proxy x -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall x. ToCBOR x => Proxy x -> Size) -> Proxy a -> Size
encodedSizeExpr forall x. ToCBOR x => Proxy x -> Size
size (Proxy ByteString
forall k (t :: k). Proxy t
Proxy :: Proxy ByteString)
  listLen :: TxSeq era -> Word
listLen TxSeq era
_ = Word
3
  listLenBound :: Proxy (TxSeq era) -> Word
listLenBound Proxy (TxSeq era)
_ = Word
3

-- | Hash a given block body
bbHash ::
  forall era.
  (Era era) =>
  TxSeq era ->
  Hash (Crypto era) EraIndependentBlockBody
bbHash :: TxSeq era -> Hash (Crypto era) EraIndependentBlockBody
bbHash (TxSeq' StrictSeq (Tx era)
_ ByteString
bodies ByteString
wits ByteString
md) =
  Hash (HASH (Crypto era)) ByteString
-> Hash (Crypto era) EraIndependentBlockBody
coerce (Hash (HASH (Crypto era)) ByteString
 -> Hash (Crypto era) EraIndependentBlockBody)
-> Hash (HASH (Crypto era)) ByteString
-> Hash (Crypto era) EraIndependentBlockBody
forall a b. (a -> b) -> a -> b
$
    ByteString -> Hash (HASH (Crypto era)) 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 (Crypto era) ByteString
    hashStrict :: ByteString -> Hash (HASH (Crypto era)) ByteString
hashStrict = (ByteString -> ByteString)
-> ByteString -> Hash (HASH (Crypto era)) 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 (Crypto era)) ByteString -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes (Hash (HASH (Crypto era)) ByteString -> ByteString)
-> (ByteString -> Hash (HASH (Crypto era)) ByteString)
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash (HASH (Crypto era)) ByteString
hashStrict (ByteString -> Hash (HASH (Crypto era)) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Hash (HASH (Crypto era)) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict

-- | Given a size and a mapping from indices to maybe metadata,
--  return a sequence whose size is the size paramater and
--  whose non-Nothing values correspond to the values in the mapping.
constructMetadata ::
  forall era.
  Int ->
  Map Int (Annotator (Core.AuxiliaryData era)) ->
  Seq (Maybe (Annotator (Core.AuxiliaryData era)))
constructMetadata :: Int
-> Map Int (Annotator (AuxiliaryData era))
-> Seq (Maybe (Annotator (AuxiliaryData era)))
constructMetadata Int
n Map Int (Annotator (AuxiliaryData era))
md = (Int -> Maybe (Annotator (AuxiliaryData era)))
-> Seq Int -> Seq (Maybe (Annotator (AuxiliaryData era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
-> Map Int (Annotator (AuxiliaryData era))
-> Maybe (Annotator (AuxiliaryData era))
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Int (Annotator (AuxiliaryData era))
md) ([Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])

-- | The parts of the Tx in Blocks that have to have FromCBOR(Annotator x) instances.
--   These are exactly the parts that are SafeToHash.
-- | Decode a TxSeq, used in decoding a Block.
txSeqDecoder ::
  forall era.
  BlockAnn era =>
  Bool ->
  forall s. Decoder s (Annotator (TxSeq era))
txSeqDecoder :: Bool -> forall s. Decoder s (Annotator (TxSeq era))
txSeqDecoder Bool
lax = 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)))
 -> Decoder s (Seq (Annotator (TxBody era)), Annotator ByteString))
-> Decoder s (Seq (Annotator (TxBody era)))
-> Decoder s (Seq (Annotator (TxBody era)), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ Decoder s (Annotator (TxBody era))
-> Decoder s (Seq (Annotator (TxBody era)))
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s (Annotator (TxBody era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
  (Seq (Annotator (Witnesses era))
wits, Annotator ByteString
witsAnn) <- Decoder s (Seq (Annotator (Witnesses era)))
-> Decoder
     s (Seq (Annotator (Witnesses era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Annotator (Witnesses era)))
 -> Decoder
      s (Seq (Annotator (Witnesses era)), Annotator ByteString))
-> Decoder s (Seq (Annotator (Witnesses era)))
-> Decoder
     s (Seq (Annotator (Witnesses era)), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ Decoder s (Annotator (Witnesses era))
-> Decoder s (Seq (Annotator (Witnesses era)))
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s (Annotator (Witnesses era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
  let b :: Int
b = Seq (Annotator (TxBody era)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxBody era))
bodies
      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
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
      w :: Int
w = Seq (Annotator (Witnesses era)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (Witnesses era))
wits
  (Seq (Maybe (Annotator (AuxiliaryData era)))
metadata, Annotator ByteString
metadataAnn) <- Decoder s (Seq (Maybe (Annotator (AuxiliaryData era))))
-> Decoder
     s
     (Seq (Maybe (Annotator (AuxiliaryData era))), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Maybe (Annotator (AuxiliaryData era))))
 -> Decoder
      s
      (Seq (Maybe (Annotator (AuxiliaryData era))),
       Annotator ByteString))
-> Decoder s (Seq (Maybe (Annotator (AuxiliaryData era))))
-> Decoder
     s
     (Seq (Maybe (Annotator (AuxiliaryData era))), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$
    do
      Map Int (Annotator (AuxiliaryData era))
m <- Decoder s Int
-> Decoder s (Annotator (AuxiliaryData era))
-> Decoder s (Map Int (Annotator (AuxiliaryData era)))
forall a s b.
Ord a =>
Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap Decoder s Int
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Annotator (AuxiliaryData era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless -- TODO this PR introduces this new test, That didn't used to run in the Shelley
        (Bool
lax Bool -> Bool -> Bool
|| (Int -> Bool) -> Set Int -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
inRange (Map Int (Annotator (AuxiliaryData era)) -> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map Int (Annotator (AuxiliaryData era))
m)) -- Era,  Is it possible there might be some blocks, that should have been caught on the chain?
        (String -> Decoder s ()
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
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
      Seq (Maybe (Annotator (AuxiliaryData era)))
-> Decoder s (Seq (Maybe (Annotator (AuxiliaryData era))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
-> Map Int (Annotator (AuxiliaryData era))
-> Seq (Maybe (Annotator (AuxiliaryData era)))
forall era.
Int
-> Map Int (Annotator (AuxiliaryData era))
-> Seq (Maybe (Annotator (AuxiliaryData era)))
constructMetadata @era Int
b Map Int (Annotator (AuxiliaryData era))
m)

  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (Bool
lax Bool -> Bool -> Bool
|| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w)
    ( String -> Decoder s ()
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
b
          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
w
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    )

  let 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)
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 (Witnesses era)
 -> Maybe (Annotator (AuxiliaryData era))
 -> Annotator (Tx era))
-> Seq (Annotator (TxBody era))
-> Seq (Annotator (Witnesses era))
-> Seq (Maybe (Annotator (AuxiliaryData 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 (Witnesses era)
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (Tx era)
forall era.
(ToCBOR (TxBody era), ToCBOR (Witnesses era),
 ToCBOR (AuxiliaryData era)) =>
Annotator (TxBody era)
-> Annotator (Witnesses era)
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (Tx era)
segwitTx Seq (Annotator (TxBody era))
bodies Seq (Annotator (Witnesses era))
wits Seq (Maybe (Annotator (AuxiliaryData era)))
metadata
  Annotator (TxSeq era) -> Decoder s (Annotator (TxSeq era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (TxSeq era) -> Decoder s (Annotator (TxSeq era)))
-> Annotator (TxSeq era) -> Decoder s (Annotator (TxSeq era))
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx era)
-> ByteString -> ByteString -> ByteString -> TxSeq era
forall era.
StrictSeq (Tx era)
-> ByteString -> ByteString -> ByteString -> TxSeq era
TxSeq' (StrictSeq (Tx era)
 -> ByteString -> ByteString -> ByteString -> TxSeq era)
-> Annotator (StrictSeq (Tx era))
-> Annotator (ByteString -> ByteString -> ByteString -> TxSeq era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (Tx era))
txns Annotator (ByteString -> ByteString -> ByteString -> TxSeq era)
-> Annotator ByteString
-> Annotator (ByteString -> ByteString -> TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
bodiesAnn Annotator (ByteString -> ByteString -> TxSeq era)
-> Annotator ByteString -> Annotator (ByteString -> TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
witsAnn Annotator (ByteString -> TxSeq era)
-> Annotator ByteString -> Annotator (TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
metadataAnn

instance
  (BlockAnn era, Typeable era) =>
  FromCBOR (Annotator (TxSeq era))
  where
  fromCBOR :: Decoder s (Annotator (TxSeq era))
fromCBOR = Bool -> forall s. Decoder s (Annotator (TxSeq era))
forall era.
BlockAnn era =>
Bool -> forall s. Decoder s (Annotator (TxSeq era))
txSeqDecoder Bool
False

bBodySize ::
  ToCBORGroup txSeq => txSeq -> Int
bBodySize :: txSeq -> Int
bBodySize = ByteString -> Int
BS.length (ByteString -> Int) -> (txSeq -> ByteString) -> txSeq -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
serializeEncoding' (Encoding -> ByteString)
-> (txSeq -> Encoding) -> txSeq -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. txSeq -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup

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

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