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

-- | Provides TxSeq 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.Alonzo.TxSeq.Internal (
  AlonzoTxSeq (.., AlonzoTxSeq),
  hashAlonzoTxSeq,
  hashAlonzoSegWits,
  alignedValidFlags,
) where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Alonzo.Era
import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..))
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  EncCBORGroup (..),
  encCBOR,
  encodeFoldableEncoder,
  encodeFoldableMapEncoder,
  encodePreEncoded,
  encodedSizeExpr,
  serialize,
  withSlice,
 )
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.BlockChain (auxDataSeqDecoder)
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.Maybe.Strict (maybeToStrictMaybe, 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 Lens.Micro
import Lens.Micro.Extras (view)
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 AlonzoTxSeq era = AlonzoTxSeqRaw
  { forall era. AlonzoTxSeq era -> StrictSeq (Tx era)
txSeqTxns :: !(StrictSeq (Tx era))
  , forall era. AlonzoTxSeq era -> Hash HASH EraIndependentBlockBody
txSeqHash :: Hash.Hash HASH EraIndependentBlockBody
  -- ^ Memoized hash to avoid recomputation. Lazy on purpose.
  , forall era. AlonzoTxSeq era -> ByteString
txSeqBodyBytes :: BSL.ByteString
  -- ^ Bytes encoding @Seq ('TxBody' era)@
  , forall era. AlonzoTxSeq era -> ByteString
txSeqWitsBytes :: BSL.ByteString
  -- ^ Bytes encoding @Seq ('TxWits' era)@
  , forall era. AlonzoTxSeq era -> ByteString
txSeqMetadataBytes :: BSL.ByteString
  -- ^ Bytes encoding a @'TxAuxData')@. Missing indices have
  -- 'SNothing' for metadata
  , forall era. AlonzoTxSeq era -> ByteString
txSeqIsValidBytes :: BSL.ByteString
  -- ^ Bytes representing a set of integers. These are the indices of
  -- transactions with 'isValid' == False.
  }
  deriving ((forall x. AlonzoTxSeq era -> Rep (AlonzoTxSeq era) x)
-> (forall x. Rep (AlonzoTxSeq era) x -> AlonzoTxSeq era)
-> Generic (AlonzoTxSeq era)
forall x. Rep (AlonzoTxSeq era) x -> AlonzoTxSeq era
forall x. AlonzoTxSeq era -> Rep (AlonzoTxSeq era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoTxSeq era) x -> AlonzoTxSeq era
forall era x. AlonzoTxSeq era -> Rep (AlonzoTxSeq era) x
$cfrom :: forall era x. AlonzoTxSeq era -> Rep (AlonzoTxSeq era) x
from :: forall x. AlonzoTxSeq era -> Rep (AlonzoTxSeq era) x
$cto :: forall era x. Rep (AlonzoTxSeq era) x -> AlonzoTxSeq era
to :: forall x. Rep (AlonzoTxSeq era) x -> AlonzoTxSeq era
Generic)

instance EraSegWits AlonzoEra where
  type TxSeq AlonzoEra = AlonzoTxSeq AlonzoEra
  fromTxSeq :: TxSeq AlonzoEra -> StrictSeq (Tx AlonzoEra)
fromTxSeq = TxSeq AlonzoEra -> StrictSeq (Tx AlonzoEra)
AlonzoTxSeq AlonzoEra -> StrictSeq (Tx AlonzoEra)
forall era. AlonzoTxSeq era -> StrictSeq (Tx era)
txSeqTxns
  toTxSeq :: StrictSeq (Tx AlonzoEra) -> TxSeq AlonzoEra
toTxSeq = StrictSeq (Tx AlonzoEra) -> TxSeq AlonzoEra
StrictSeq (Tx AlonzoEra) -> AlonzoTxSeq AlonzoEra
forall era.
(AlonzoEraTx era, SafeToHash (TxWits era)) =>
StrictSeq (Tx era) -> AlonzoTxSeq era
AlonzoTxSeq
  hashTxSeq :: TxSeq AlonzoEra -> Hash HASH EraIndependentBlockBody
hashTxSeq = TxSeq AlonzoEra -> Hash HASH EraIndependentBlockBody
AlonzoTxSeq AlonzoEra -> Hash HASH EraIndependentBlockBody
forall era. AlonzoTxSeq era -> Hash HASH EraIndependentBlockBody
hashAlonzoTxSeq
  numSegComponents :: Word64
numSegComponents = Word64
4

pattern AlonzoTxSeq ::
  forall era.
  ( AlonzoEraTx era
  , SafeToHash (TxWits era)
  ) =>
  StrictSeq (Tx era) ->
  AlonzoTxSeq era
pattern $mAlonzoTxSeq :: forall {r} {era}.
(AlonzoEraTx era, SafeToHash (TxWits era)) =>
AlonzoTxSeq era -> (StrictSeq (Tx era) -> r) -> ((# #) -> r) -> r
$bAlonzoTxSeq :: forall era.
(AlonzoEraTx era, SafeToHash (TxWits era)) =>
StrictSeq (Tx era) -> AlonzoTxSeq era
AlonzoTxSeq xs <-
  AlonzoTxSeqRaw xs _ _ _ _ _
  where
    AlonzoTxSeq StrictSeq (Tx era)
txns =
      let version :: Version
version = forall era. Era era => Version
eraProtVerLow @era
          serializeFoldablePreEncoded :: StrictSeq ByteString -> ByteString
serializeFoldablePreEncoded 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
encodeIndexed (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
              encodeIndexed :: ByteString -> Encoding
encodeIndexed 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
serializeFoldablePreEncoded (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)
-> (Tx era -> TxBody era) -> Tx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (TxBody era) (Tx era) (TxBody era) -> Tx era -> TxBody era
forall a s. Getting a s a -> s -> a
view Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL (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
serializeFoldablePreEncoded (StrictSeq ByteString -> ByteString)
-> StrictSeq ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TxWits era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (TxWits era -> ByteString)
-> (Tx era -> TxWits era) -> Tx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (TxWits era) (Tx era) (TxWits era) -> Tx era -> TxWits era
forall a s. Getting a s a -> s -> a
view Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL (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
$
              (TxAuxData era -> ByteString)
-> StrictMaybe (TxAuxData era) -> StrictMaybe ByteString
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (StrictMaybe (TxAuxData era) -> StrictMaybe ByteString)
-> (Tx era -> StrictMaybe (TxAuxData era))
-> Tx era
-> StrictMaybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (StrictMaybe (TxAuxData era))
  (Tx era)
  (StrictMaybe (TxAuxData era))
-> Tx era -> StrictMaybe (TxAuxData era)
forall a s. Getting a s a -> s -> a
view 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 (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
          txSeqIsValids :: ByteString
txSeqIsValids =
            Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ [Int] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ([Int] -> Encoding) -> [Int] -> Encoding
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx era) -> [Int]
forall era. AlonzoEraTx era => StrictSeq (Tx era) -> [Int]
nonValidatingIndices StrictSeq (Tx era)
txns
       in AlonzoTxSeqRaw
            { txSeqTxns :: StrictSeq (Tx era)
txSeqTxns = StrictSeq (Tx era)
txns
            , txSeqHash :: Hash HASH EraIndependentBlockBody
txSeqHash = ByteString
-> ByteString
-> ByteString
-> ByteString
-> Hash HASH EraIndependentBlockBody
hashAlonzoSegWits ByteString
txSeqBodies ByteString
txSeqWits ByteString
txSeqAuxDatas ByteString
txSeqIsValids
            , txSeqBodyBytes :: ByteString
txSeqBodyBytes = ByteString
txSeqBodies
            , txSeqWitsBytes :: ByteString
txSeqWitsBytes = ByteString
txSeqWits
            , txSeqMetadataBytes :: ByteString
txSeqMetadataBytes = ByteString
txSeqAuxDatas
            , txSeqIsValidBytes :: ByteString
txSeqIsValidBytes = ByteString
txSeqIsValids
            }

{-# COMPLETE AlonzoTxSeq #-}

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

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

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

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

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

-- | Hash a given block body
hashAlonzoTxSeq ::
  forall era.
  AlonzoTxSeq era ->
  Hash HASH EraIndependentBlockBody
hashAlonzoTxSeq :: forall era. AlonzoTxSeq era -> Hash HASH EraIndependentBlockBody
hashAlonzoTxSeq = AlonzoTxSeq era -> Hash HASH EraIndependentBlockBody
forall era. AlonzoTxSeq era -> Hash HASH EraIndependentBlockBody
txSeqHash

hashAlonzoSegWits ::
  BSL.ByteString ->
  -- | Bytes for transaction bodies
  BSL.ByteString ->
  -- | Bytes for transaction witnesses
  BSL.ByteString ->
  -- | Bytes for transaction auxiliary datas
  BSL.ByteString ->
  -- | Bytes for transaction isValid flags
  Hash HASH EraIndependentBlockBody
hashAlonzoSegWits :: ByteString
-> ByteString
-> ByteString
-> ByteString
-> Hash HASH EraIndependentBlockBody
hashAlonzoSegWits ByteString
txSeqBodies ByteString
txSeqWits ByteString
txAuxData ByteString
txSeqIsValids =
  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
txSeqBodies
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hashPart ByteString
txSeqWits
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hashPart ByteString
txAuxData
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hashPart ByteString
txSeqIsValids
  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 hashAlonzoSegWits #-}

instance
  ( AlonzoEraTx era
  , DecCBOR (Annotator (TxAuxData era))
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  ) =>
  DecCBOR (Annotator (AlonzoTxSeq era))
  where
  decCBOR :: forall s. Decoder s (Annotator (AlonzoTxSeq 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
        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))
        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)))
auxData, Annotator ByteString
auxDataAnn) <- 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

    ([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]
forall s. Decoder s [Int]
forall a s. DecCBOR a => Decoder s a
decCBOR
    let validFlags :: Seq IsValid
validFlags = Int -> [Int] -> Seq IsValid
alignedValidFlags Int
bodiesLength [Int]
isValIdxs
    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) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
      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
")"
    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) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
      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
"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
bodiesLength 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 (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)
 -> IsValid
 -> Maybe (Annotator (TxAuxData era))
 -> Annotator (Tx era))
-> Seq (Annotator (TxBody era))
-> Seq (Annotator (TxWits era))
-> Seq IsValid
-> Seq (Maybe (Annotator (TxAuxData era)))
-> Seq (Annotator (Tx 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 (TxWits era)
-> IsValid
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
forall era.
AlonzoEraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> IsValid
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
alonzoSegwitTx Seq (Annotator (TxBody era))
bodies Seq (Annotator (TxWits era))
wits Seq IsValid
validFlags Seq (Maybe (Annotator (TxAuxData era)))
auxData
    Annotator (AlonzoTxSeq era)
-> Decoder s (Annotator (AlonzoTxSeq era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (AlonzoTxSeq era)
 -> Decoder s (Annotator (AlonzoTxSeq era)))
-> Annotator (AlonzoTxSeq era)
-> Decoder s (Annotator (AlonzoTxSeq era))
forall a b. (a -> b) -> a -> b
$
      StrictSeq (Tx era)
-> Hash HASH EraIndependentBlockBody
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> AlonzoTxSeq era
forall era.
StrictSeq (Tx era)
-> Hash HASH EraIndependentBlockBody
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> AlonzoTxSeq era
AlonzoTxSeqRaw
        (StrictSeq (Tx era)
 -> Hash HASH EraIndependentBlockBody
 -> ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> AlonzoTxSeq era)
-> Annotator (StrictSeq (Tx era))
-> Annotator
     (Hash HASH EraIndependentBlockBody
      -> ByteString
      -> ByteString
      -> ByteString
      -> ByteString
      -> AlonzoTxSeq 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
   -> ByteString
   -> AlonzoTxSeq era)
-> Annotator (Hash HASH EraIndependentBlockBody)
-> Annotator
     (ByteString
      -> ByteString -> ByteString -> ByteString -> AlonzoTxSeq era)
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString
-> ByteString
-> ByteString
-> ByteString
-> Hash HASH EraIndependentBlockBody
hashAlonzoSegWits (ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Hash HASH EraIndependentBlockBody)
-> Annotator ByteString
-> Annotator
     (ByteString
      -> ByteString -> ByteString -> Hash HASH EraIndependentBlockBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator ByteString
bodiesAnn Annotator
  (ByteString
   -> ByteString -> ByteString -> Hash HASH EraIndependentBlockBody)
-> Annotator ByteString
-> Annotator
     (ByteString -> 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 -> 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
auxDataAnn 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
isValAnn)
        Annotator
  (ByteString
   -> ByteString -> ByteString -> ByteString -> AlonzoTxSeq era)
-> Annotator ByteString
-> Annotator
     (ByteString -> ByteString -> ByteString -> AlonzoTxSeq 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 -> ByteString -> AlonzoTxSeq era)
-> Annotator ByteString
-> Annotator (ByteString -> ByteString -> AlonzoTxSeq 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 -> ByteString -> AlonzoTxSeq era)
-> Annotator ByteString
-> Annotator (ByteString -> AlonzoTxSeq 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
auxDataAnn
        Annotator (ByteString -> AlonzoTxSeq era)
-> Annotator ByteString -> Annotator (AlonzoTxSeq 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
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 :: AlonzoEraTx era => StrictSeq (Tx era) -> [Int]
nonValidatingIndices :: forall era. AlonzoEraTx era => StrictSeq (Tx era) -> [Int]
nonValidatingIndices (StrictSeq (Tx era) -> Seq (Tx era)
forall a. StrictSeq a -> Seq a
StrictSeq.fromStrict -> Seq (Tx era)
xs) =
  (Int -> Tx era -> [Int] -> [Int]) -> [Int] -> Seq (Tx era) -> [Int]
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
Seq.foldrWithIndex
    ( \Int
idx Tx era
tx [Int]
acc ->
        if Tx era
tx Tx era -> Getting IsValid (Tx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL 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 (Tx 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

-- | Construct an annotated Alonzo style transaction.
alonzoSegwitTx ::
  AlonzoEraTx era =>
  Annotator (TxBody era) ->
  Annotator (TxWits era) ->
  IsValid ->
  Maybe (Annotator (TxAuxData era)) ->
  Annotator (Tx era)
alonzoSegwitTx :: forall era.
AlonzoEraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> IsValid
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
alonzoSegwitTx Annotator (TxBody era)
txBodyAnn Annotator (TxWits era)
txWitsAnn IsValid
txIsValid Maybe (Annotator (TxAuxData era))
auxDataAnn = (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 txBody :: TxBody era
txBody = Annotator (TxBody era) -> FullByteString -> TxBody era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
txBodyAnn FullByteString
bytes
      txWits :: TxWits era
txWits = Annotator (TxWits era) -> FullByteString -> TxWits era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxWits era)
txWitsAnn FullByteString
bytes
      txAuxData :: StrictMaybe (TxAuxData era)
txAuxData = Maybe (TxAuxData era) -> StrictMaybe (TxAuxData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe ((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))
auxDataAnn)
   in TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
txBody
        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
txWits
        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
.~ StrictMaybe (TxAuxData era)
txAuxData
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid) -> Tx era -> Identity (Tx era)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL ((IsValid -> Identity IsValid) -> Tx era -> Identity (Tx era))
-> IsValid -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsValid
txIsValid