{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- | TxSeq. This is effectively the block body, which consists of a sequence of
-- transactions with segregated witness and metadata information.
module Cardano.Ledger.Alonzo.TxSeq
  ( TxSeq (TxSeq, txSeqTxns),
    hashTxSeq,
  )
where

import Cardano.Binary
  ( Annotator,
    FromCBOR (..),
    ToCBOR,
    encodePreEncoded,
    encodedSizeExpr,
    serializeEncoding,
    toCBOR,
    withSlice,
  )
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Alonzo.Scripts (Script)
import Cardano.Ledger.Alonzo.Tx (IsValid (..), ValidatedTx (..), segwitTx)
import Cardano.Ledger.Alonzo.TxWitness (TxWitness)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Crypto, Era, ValidateScript)
import Cardano.Ledger.Hashes (EraIndependentBlockBody)
import Cardano.Ledger.Keys (Hash)
import Cardano.Ledger.SafeHash (SafeToHash, originalBytes)
import Cardano.Ledger.Serialization
  ( ToCBORGroup (..),
    encodeFoldableMapEncoder,
  )
import Cardano.Ledger.Shelley.BlockChain (constructMetadata)
import Control.Monad (unless)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Short (fromShort)
import Data.Coders
  ( decodeList,
    decodeMap,
    decodeSeq,
    encodeFoldable,
    encodeFoldableEncoder,
  )
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (strictMaybeToMaybe)
import Data.Proxy (Proxy (..))
import qualified Data.Sequence as Seq
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import NoThunks.Class (AllowThunksIn (..), NoThunks)

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

-- $TxSeq
--
-- * TxSeq
--
-- TxSeq provides an alternate way of formatting transactions in a block, in
-- order to support segregated witnessing.

data TxSeq era = TxSeq'
  { TxSeq era -> StrictSeq (ValidatedTx era)
txSeqTxns :: !(StrictSeq (ValidatedTx era)),
    TxSeq era -> ByteString
txSeqBodyBytes :: BSL.ByteString,
    TxSeq era -> ByteString
txSeqWitsBytes :: BSL.ByteString,
    -- | Bytes representing a (Map index metadata). Missing indices have
    -- SNothing for metadata
    TxSeq era -> ByteString
txSeqMetadataBytes :: BSL.ByteString,
    -- | Bytes representing a set of integers. These are the indices of
    -- transactions with isValid == False.
    TxSeq era -> ByteString
txSeqIsValidBytes :: BSL.ByteString
  }
  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)

pattern TxSeq ::
  forall era.
  ( Era era,
    SafeToHash (TxWitness era)
  ) =>
  StrictSeq (ValidatedTx era) ->
  TxSeq era
pattern $bTxSeq :: StrictSeq (ValidatedTx era) -> TxSeq era
$mTxSeq :: forall r era.
(Era era, SafeToHash (TxWitness era)) =>
TxSeq era
-> (StrictSeq (ValidatedTx era) -> r) -> (Void# -> r) -> r
TxSeq xs <-
  TxSeq' xs _ _ _ _
  where
    TxSeq StrictSeq (ValidatedTx 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 (ValidatedTx era)
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> TxSeq era
TxSeq'
            { txSeqTxns :: StrictSeq (ValidatedTx era)
txSeqTxns = StrictSeq (ValidatedTx 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
$
                  TxBody era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (TxBody era -> ByteString)
-> (ValidatedTx era -> TxBody era) -> ValidatedTx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "body" r a => r -> a
getField @"body" (ValidatedTx era -> ByteString)
-> StrictSeq (ValidatedTx era) -> StrictSeq ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (ValidatedTx 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
$
                  TxWitness era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (TxWitness era -> ByteString)
-> (ValidatedTx era -> TxWitness era)
-> ValidatedTx era
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "wits" r a => r -> a
getField @"wits" (ValidatedTx era -> ByteString)
-> StrictSeq (ValidatedTx era) -> StrictSeq ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (ValidatedTx 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
$
                  (AuxiliaryData era -> ByteString)
-> StrictMaybe (AuxiliaryData era) -> StrictMaybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuxiliaryData era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (StrictMaybe (AuxiliaryData era) -> StrictMaybe ByteString)
-> (ValidatedTx era -> StrictMaybe (AuxiliaryData era))
-> ValidatedTx era
-> StrictMaybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "auxiliaryData" r a => r -> a
getField @"auxiliaryData" (ValidatedTx era -> StrictMaybe ByteString)
-> StrictSeq (ValidatedTx era)
-> StrictSeq (StrictMaybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (ValidatedTx era)
txns,
              -- bytes encoding a [Int] Indexes where IsValid is False.
              txSeqIsValidBytes :: ByteString
txSeqIsValidBytes =
                Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ [Int] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable ([Int] -> Encoding) -> [Int] -> Encoding
forall a b. (a -> b) -> a -> b
$ StrictSeq (ValidatedTx era) -> [Int]
forall era. StrictSeq (ValidatedTx era) -> [Int]
nonValidatingIndices StrictSeq (ValidatedTx era)
txns
            }

{-# COMPLETE TxSeq #-}

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

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

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

--------------------------------------------------------------------------------
-- Serialisation and hashing
--------------------------------------------------------------------------------

instance
  forall era.
  (Era era) =>
  ToCBORGroup (TxSeq era)
  where
  toCBORGroup :: TxSeq era -> Encoding
toCBORGroup (TxSeq' StrictSeq (ValidatedTx era)
_ ByteString
bodyBytes ByteString
witsBytes ByteString
metadataBytes ByteString
invalidBytes) =
    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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
invalidBytes
  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)
      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
4
  listLenBound :: Proxy (TxSeq era) -> Word
listLenBound Proxy (TxSeq era)
_ = Word
4

-- | Hash a given block body
hashTxSeq ::
  forall era.
  (Era era) =>
  TxSeq era ->
  Hash (Crypto era) EraIndependentBlockBody
hashTxSeq :: TxSeq era -> Hash (Crypto era) EraIndependentBlockBody
hashTxSeq (TxSeq' StrictSeq (ValidatedTx era)
_ ByteString
bodies ByteString
ws ByteString
md ByteString
vs) =
  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 -> Hash (HASH (Crypto era)) ByteString)
-> ByteString -> Hash (HASH (Crypto era)) ByteString
forall a b. (a -> b) -> a -> b
$
      ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
        [ShortByteString] -> ShortByteString
forall a. Monoid a => [a] -> a
mconcat
          [ ByteString -> ShortByteString
hashPart ByteString
bodies,
            ByteString -> ShortByteString
hashPart ByteString
ws,
            ByteString -> ShortByteString
hashPart ByteString
md,
            ByteString -> ShortByteString
hashPart ByteString
vs
          ]
  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 -> ShortByteString
hashPart = Hash (HASH (Crypto era)) ByteString -> ShortByteString
forall h a. Hash h a -> ShortByteString
Hash.hashToBytesShort (Hash (HASH (Crypto era)) ByteString -> ShortByteString)
-> (ByteString -> Hash (HASH (Crypto era)) ByteString)
-> ByteString
-> ShortByteString
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

instance
  ( FromCBOR (Annotator (Core.AuxiliaryData era)),
    FromCBOR (Annotator (Core.Script era)),
    FromCBOR (Annotator (Core.TxBody era)),
    FromCBOR (Annotator (Core.Witnesses era)),
    ToCBOR (Core.AuxiliaryData era),
    ToCBOR (Core.Script era),
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.Witnesses era),
    ValidateScript era,
    Core.Script era ~ Script era,
    Era era
  ) =>
  FromCBOR (Annotator (TxSeq era))
  where
  fromCBOR :: Decoder s (Annotator (TxSeq era))
fromCBOR = 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 (TxWitness era))
ws, Annotator ByteString
witsAnn) <- Decoder s (Seq (Annotator (TxWitness era)))
-> Decoder
     s (Seq (Annotator (TxWitness era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Annotator (TxWitness era)))
 -> Decoder
      s (Seq (Annotator (TxWitness era)), Annotator ByteString))
-> Decoder s (Seq (Annotator (TxWitness era)))
-> Decoder
     s (Seq (Annotator (TxWitness era)), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ Decoder s (Annotator (TxWitness era))
-> Decoder s (Seq (Annotator (TxWitness era)))
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s (Annotator (TxWitness 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 (TxWitness era)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxWitness era))
ws
    (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
          ((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))
          ( 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)
    ([Int]
isValIdxs, Annotator ByteString
isValAnn) <- Decoder s [Int] -> Decoder s ([Int], Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s [Int] -> Decoder s ([Int], Annotator ByteString))
-> Decoder s [Int] -> Decoder s ([Int], Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ Decoder s Int -> Decoder s [Int]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s Int
forall a s. FromCBOR a => Decoder s a
fromCBOR
    let vs :: Seq IsValid
vs = Int -> [Int] -> Seq IsValid
alignedValidFlags Int
b [Int]
isValIdxs
    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
      (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
")"
      )
    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
      ((Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
inRange [Int]
isValIdxs)
      ( String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
          ( String
"Some IsValid 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)
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
isValIdxs
          )
      )

    let txns :: Annotator (StrictSeq (ValidatedTx era))
txns =
          StrictSeq (Annotator (ValidatedTx era))
-> Annotator (StrictSeq (ValidatedTx era))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (StrictSeq (Annotator (ValidatedTx era))
 -> Annotator (StrictSeq (ValidatedTx era)))
-> StrictSeq (Annotator (ValidatedTx era))
-> Annotator (StrictSeq (ValidatedTx era))
forall a b. (a -> b) -> a -> b
$
            Seq (Annotator (ValidatedTx era))
-> StrictSeq (Annotator (ValidatedTx era))
forall a. Seq a -> StrictSeq a
StrictSeq.forceToStrict (Seq (Annotator (ValidatedTx era))
 -> StrictSeq (Annotator (ValidatedTx era)))
-> Seq (Annotator (ValidatedTx era))
-> StrictSeq (Annotator (ValidatedTx era))
forall a b. (a -> b) -> a -> b
$
              (Annotator (TxBody era)
 -> Annotator (TxWitness era)
 -> IsValid
 -> Maybe (Annotator (AuxiliaryData era))
 -> Annotator (ValidatedTx era))
-> Seq (Annotator (TxBody era))
-> Seq (Annotator (TxWitness era))
-> Seq IsValid
-> Seq (Maybe (Annotator (AuxiliaryData era)))
-> Seq (Annotator (ValidatedTx era))
forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
Seq.zipWith4 Annotator (TxBody era)
-> Annotator (TxWitness era)
-> IsValid
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (ValidatedTx era)
forall era.
Annotator (TxBody era)
-> Annotator (TxWitness era)
-> IsValid
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (ValidatedTx era)
segwitTx Seq (Annotator (TxBody era))
bodies Seq (Annotator (TxWitness era))
ws Seq IsValid
vs 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 (ValidatedTx era)
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> TxSeq era
forall era.
StrictSeq (ValidatedTx era)
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> TxSeq era
TxSeq'
        (StrictSeq (ValidatedTx era)
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> TxSeq era)
-> Annotator (StrictSeq (ValidatedTx era))
-> Annotator
     (ByteString -> ByteString -> ByteString -> ByteString -> TxSeq era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (ValidatedTx era))
txns
        Annotator
  (ByteString -> ByteString -> ByteString -> ByteString -> TxSeq era)
-> Annotator ByteString
-> Annotator (ByteString -> ByteString -> ByteString -> TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
bodiesAnn
        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
witsAnn
        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
metadataAnn
        Annotator (ByteString -> TxSeq era)
-> Annotator ByteString -> Annotator (TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
isValAnn

--------------------------------------------------------------------------------
-- Internal utility functions
--------------------------------------------------------------------------------

-- | Given a sequence of transactions, return the indices of those which do not
-- validate. We store the indices of the non-validating transactions because we
-- expect this to be a much smaller set than the validating transactions.
nonValidatingIndices :: StrictSeq (ValidatedTx era) -> [Int]
nonValidatingIndices :: StrictSeq (ValidatedTx era) -> [Int]
nonValidatingIndices (StrictSeq (ValidatedTx era) -> Seq (ValidatedTx era)
forall a. StrictSeq a -> Seq a
StrictSeq.fromStrict -> Seq (ValidatedTx era)
xs) =
  (Int -> ValidatedTx era -> [Int] -> [Int])
-> [Int] -> Seq (ValidatedTx era) -> [Int]
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
Seq.foldrWithIndex
    ( \Int
idx ValidatedTx era
elt [Int]
acc ->
        if ValidatedTx era -> IsValid
forall k (x :: k) r a. HasField x r a => r -> a
getField @"isValid" ValidatedTx era
elt IsValid -> IsValid -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> IsValid
IsValid Bool
False
          then Int
idx Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc
          else [Int]
acc
    )
    []
    Seq (ValidatedTx era)
xs

-- | Given the number of transactions, and the set of indices for which these
-- transactions do not validate, create an aligned sequence of `IsValid`
-- flags.
--
-- This function operates much as the inverse of 'nonValidatingIndices'.
alignedValidFlags :: Int -> [Int] -> Seq.Seq IsValid
alignedValidFlags :: Int -> [Int] -> Seq IsValid
alignedValidFlags = Int -> Int -> [Int] -> Seq IsValid
alignedValidFlags' (-Int
1)
  where
    alignedValidFlags' :: Int -> Int -> [Int] -> Seq IsValid
alignedValidFlags' Int
_ Int
n [] = Int -> IsValid -> Seq IsValid
forall a. Int -> a -> Seq a
Seq.replicate Int
n (IsValid -> Seq IsValid) -> IsValid -> Seq IsValid
forall a b. (a -> b) -> a -> b
$ Bool -> IsValid
IsValid Bool
True
    alignedValidFlags' Int
prev Int
n (Int
x : [Int]
xs) =
      Int -> IsValid -> Seq IsValid
forall a. Int -> a -> Seq a
Seq.replicate (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prev Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Bool -> IsValid
IsValid Bool
True)
        Seq IsValid -> Seq IsValid -> Seq IsValid
forall a. Seq a -> Seq a -> Seq a
Seq.>< Bool -> IsValid
IsValid Bool
False
        IsValid -> Seq IsValid -> Seq IsValid
forall a. a -> Seq a -> Seq a
Seq.<| Int -> Int -> [Int] -> Seq IsValid
alignedValidFlags' Int
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prev)) [Int]
xs