{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-pattern-binds #-}
{-# 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.Dijkstra.BlockBody.Internal (
  DijkstraBlockBody (DijkstraBlockBody, MkDijkstraBlockBody),
  DijkstraBlockBodyRaw (..),
  alignedValidFlags,
  mkBasicBlockBodyDijkstra,
  DijkstraEraBlockBody (..),
  PerasCert (..),
  PerasKey (..),
  validatePerasCert,
) where

import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..))
import Cardano.Ledger.BaseTypes (Nonce, ProtVer (..), maybeToStrictMaybe)
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  EncCBOR,
  EncCBORGroup (..),
  decodeNonEmptySetLikeEnforceNoDuplicates,
  decodeNullMaybe,
  decodeNullStrictMaybe,
  decodeRecordNamed,
  decodeSeq,
  encCBOR,
  encodeListLen,
  encodeNullStrictMaybe,
  serialize',
 )
import Cardano.Ledger.Core
import Cardano.Ledger.Dijkstra.Era
import Cardano.Ledger.Dijkstra.Tx (DijkstraTx, Tx (..), decodeDijkstraTopTx)
import Cardano.Ledger.MemoBytes (
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  getMemoBytesHash,
  getMemoRawType,
  lensMemoRawType,
  mkMemoized,
  mkMemoizedEra,
 )
import Cardano.Ledger.Orphans ()
import Control.DeepSeq (NFData)
import Control.Monad (forM_, unless)
import Data.Array.Byte (ByteArray)
import qualified Data.ByteString as BS
import Data.Coerce (Coercible, coerce)
import Data.Foldable (Foldable (..))
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.Sequence as Seq
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set.NonEmpty as NonEmptySet
import Data.Typeable (Typeable)
import Data.Word (Word16)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)

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

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

data DijkstraBlockBodyRaw era = DijkstraBlockBodyRaw
  { forall era. DijkstraBlockBodyRaw era -> StrictSeq (Tx TopTx era)
dbbrTxs :: !(StrictSeq (Tx TopTx era))
  , forall era. DijkstraBlockBodyRaw era -> StrictMaybe PerasCert
dbbrPerasCert :: !(StrictMaybe PerasCert)
  -- ^ Optional Peras certificate
  }
  deriving ((forall x.
 DijkstraBlockBodyRaw era -> Rep (DijkstraBlockBodyRaw era) x)
-> (forall x.
    Rep (DijkstraBlockBodyRaw era) x -> DijkstraBlockBodyRaw era)
-> Generic (DijkstraBlockBodyRaw era)
forall x.
Rep (DijkstraBlockBodyRaw era) x -> DijkstraBlockBodyRaw era
forall x.
DijkstraBlockBodyRaw era -> Rep (DijkstraBlockBodyRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (DijkstraBlockBodyRaw era) x -> DijkstraBlockBodyRaw era
forall era x.
DijkstraBlockBodyRaw era -> Rep (DijkstraBlockBodyRaw era) x
$cfrom :: forall era x.
DijkstraBlockBodyRaw era -> Rep (DijkstraBlockBodyRaw era) x
from :: forall x.
DijkstraBlockBodyRaw era -> Rep (DijkstraBlockBodyRaw era) x
$cto :: forall era x.
Rep (DijkstraBlockBodyRaw era) x -> DijkstraBlockBodyRaw era
to :: forall x.
Rep (DijkstraBlockBodyRaw era) x -> DijkstraBlockBodyRaw era
Generic)

instance (NFData (Tx TopTx era), NFData PerasCert) => NFData (DijkstraBlockBodyRaw era)

type instance MemoHashIndex (DijkstraBlockBodyRaw era) = EraIndependentBlockBody

instance EraBlockBody DijkstraEra where
  type BlockBody DijkstraEra = DijkstraBlockBody DijkstraEra
  mkBasicBlockBody :: BlockBody DijkstraEra
mkBasicBlockBody = BlockBody DijkstraEra
DijkstraBlockBody DijkstraEra
forall era. AlonzoEraTx era => DijkstraBlockBody era
mkBasicBlockBodyDijkstra
  txSeqBlockBodyL :: Lens' (BlockBody DijkstraEra) (StrictSeq (Tx TopTx DijkstraEra))
txSeqBlockBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @DijkstraEra RawType (DijkstraBlockBody DijkstraEra)
-> StrictSeq (Tx TopTx DijkstraEra)
DijkstraBlockBodyRaw DijkstraEra
-> StrictSeq (Tx TopTx DijkstraEra)
forall era. DijkstraBlockBodyRaw era -> StrictSeq (Tx TopTx era)
dbbrTxs (\RawType (DijkstraBlockBody DijkstraEra)
bb StrictSeq (Tx TopTx DijkstraEra)
p -> RawType (DijkstraBlockBody DijkstraEra)
bb {dbbrTxs = p})
  hashBlockBody :: BlockBody DijkstraEra -> Hash HASH EraIndependentBlockBody
hashBlockBody (MkDijkstraBlockBody MemoBytes (DijkstraBlockBodyRaw DijkstraEra)
m) = SafeHash EraIndependentBlockBody
-> Hash HASH EraIndependentBlockBody
forall i. SafeHash i -> Hash HASH i
extractHash (SafeHash EraIndependentBlockBody
 -> Hash HASH EraIndependentBlockBody)
-> SafeHash EraIndependentBlockBody
-> Hash HASH EraIndependentBlockBody
forall a b. (a -> b) -> a -> b
$ MemoBytes (DijkstraBlockBodyRaw DijkstraEra)
-> SafeHash (MemoHashIndex (DijkstraBlockBodyRaw DijkstraEra))
forall t. MemoBytes t -> SafeHash (MemoHashIndex t)
getMemoBytesHash MemoBytes (DijkstraBlockBodyRaw DijkstraEra)
m
  numSegComponents :: Word64
numSegComponents = Word64
1
  blockBodySize :: ProtVer -> BlockBody DijkstraEra -> Int
blockBodySize (ProtVer Version
v Natural
_) = ByteString -> Int
BS.length (ByteString -> Int)
-> (DijkstraBlockBody DijkstraEra -> ByteString)
-> DijkstraBlockBody DijkstraEra
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
v (Encoding -> ByteString)
-> (DijkstraBlockBody DijkstraEra -> Encoding)
-> DijkstraBlockBody DijkstraEra
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DijkstraBlockBody DijkstraEra -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR

mkBasicBlockBodyDijkstra :: forall era. AlonzoEraTx era => DijkstraBlockBody era
mkBasicBlockBodyDijkstra :: forall era. AlonzoEraTx era => DijkstraBlockBody era
mkBasicBlockBodyDijkstra = Version -> RawType (DijkstraBlockBody era) -> DijkstraBlockBody era
forall t.
(EncCBOR (RawType t), Memoized t) =>
Version -> RawType t -> t
mkMemoized (forall era. Era era => Version
eraProtVerLow @era) (RawType (DijkstraBlockBody era) -> DijkstraBlockBody era)
-> RawType (DijkstraBlockBody era) -> DijkstraBlockBody era
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx TopTx era)
-> StrictMaybe PerasCert -> DijkstraBlockBodyRaw era
forall era.
StrictSeq (Tx TopTx era)
-> StrictMaybe PerasCert -> DijkstraBlockBodyRaw era
DijkstraBlockBodyRaw StrictSeq (Tx TopTx era)
forall a. Monoid a => a
mempty StrictMaybe PerasCert
forall a. StrictMaybe a
SNothing
{-# INLINEABLE mkBasicBlockBodyDijkstra #-}

-- | Dijkstra-specific extensions to 'EraBlockBody'
class EraBlockBody era => DijkstraEraBlockBody era where
  perasCertBlockBodyL :: Lens' (BlockBody era) (StrictMaybe PerasCert)
  -- ^ Lens to access the optional Peras certificate in the block body

instance DijkstraEraBlockBody DijkstraEra where
  perasCertBlockBodyL :: Lens' (BlockBody DijkstraEra) (StrictMaybe PerasCert)
perasCertBlockBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @DijkstraEra RawType (DijkstraBlockBody DijkstraEra) -> StrictMaybe PerasCert
DijkstraBlockBodyRaw DijkstraEra -> StrictMaybe PerasCert
forall era. DijkstraBlockBodyRaw era -> StrictMaybe PerasCert
dbbrPerasCert (\RawType (DijkstraBlockBody DijkstraEra)
bb StrictMaybe PerasCert
c -> RawType (DijkstraBlockBody DijkstraEra)
bb {dbbrPerasCert = c})

deriving instance (Typeable era, NoThunks (Tx TopTx era)) => NoThunks (DijkstraBlockBodyRaw era)

deriving stock instance Show (Tx TopTx era) => Show (DijkstraBlockBodyRaw era)

deriving stock instance Eq (Tx TopTx era) => Eq (DijkstraBlockBodyRaw era)

newtype DijkstraBlockBody era = MkDijkstraBlockBody (MemoBytes (DijkstraBlockBodyRaw era))
  deriving ((forall x. DijkstraBlockBody era -> Rep (DijkstraBlockBody era) x)
-> (forall x.
    Rep (DijkstraBlockBody era) x -> DijkstraBlockBody era)
-> Generic (DijkstraBlockBody era)
forall x. Rep (DijkstraBlockBody era) x -> DijkstraBlockBody era
forall x. DijkstraBlockBody era -> Rep (DijkstraBlockBody era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (DijkstraBlockBody era) x -> DijkstraBlockBody era
forall era x.
DijkstraBlockBody era -> Rep (DijkstraBlockBody era) x
$cfrom :: forall era x.
DijkstraBlockBody era -> Rep (DijkstraBlockBody era) x
from :: forall x. DijkstraBlockBody era -> Rep (DijkstraBlockBody era) x
$cto :: forall era x.
Rep (DijkstraBlockBody era) x -> DijkstraBlockBody era
to :: forall x. Rep (DijkstraBlockBody era) x -> DijkstraBlockBody era
Generic)

deriving instance Eq (Tx TopTx era) => Eq (DijkstraBlockBody era)

deriving instance Show (Tx TopTx era) => Show (DijkstraBlockBody era)

deriving newtype instance
  (NFData (Tx TopTx era), NFData PerasCert) => NFData (DijkstraBlockBody era)

deriving newtype instance EncCBOR (DijkstraBlockBody era)

instance Memoized (DijkstraBlockBody era) where
  type RawType (DijkstraBlockBody era) = DijkstraBlockBodyRaw era

pattern DijkstraBlockBody ::
  AlonzoEraTx era =>
  StrictSeq (Tx TopTx era) ->
  StrictMaybe PerasCert ->
  DijkstraBlockBody era
pattern $mDijkstraBlockBody :: forall {r} {era}.
AlonzoEraTx era =>
DijkstraBlockBody era
-> (StrictSeq (Tx TopTx era) -> StrictMaybe PerasCert -> r)
-> ((# #) -> r)
-> r
$bDijkstraBlockBody :: forall era.
AlonzoEraTx era =>
StrictSeq (Tx TopTx era)
-> StrictMaybe PerasCert -> DijkstraBlockBody era
DijkstraBlockBody txs perasCert <- (getMemoRawType -> DijkstraBlockBodyRaw txs perasCert)
  where
    DijkstraBlockBody StrictSeq (Tx TopTx era)
txs StrictMaybe PerasCert
perasCert =
      forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @DijkstraEra (RawType (DijkstraBlockBody era) -> DijkstraBlockBody era)
-> RawType (DijkstraBlockBody era) -> DijkstraBlockBody era
forall a b. (a -> b) -> a -> b
$
        StrictSeq (Tx TopTx era)
-> StrictMaybe PerasCert -> DijkstraBlockBodyRaw era
forall era.
StrictSeq (Tx TopTx era)
-> StrictMaybe PerasCert -> DijkstraBlockBodyRaw era
DijkstraBlockBodyRaw StrictSeq (Tx TopTx era)
txs StrictMaybe PerasCert
perasCert

{-# COMPLETE DijkstraBlockBody #-}

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

instance
  ( AlonzoEraTx era
  , EncCBOR (Tx TopTx era)
  ) =>
  EncCBOR (DijkstraBlockBodyRaw era)
  where
  encCBOR :: DijkstraBlockBodyRaw era -> Encoding
encCBOR (DijkstraBlockBodyRaw StrictSeq (Tx TopTx era)
txs StrictMaybe PerasCert
perasCert) =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (NonEmptySet Int -> Encoding)
-> StrictMaybe (NonEmptySet Int) -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe NonEmptySet Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe (NonEmptySet Int)
invalidIndices
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictSeq (Tx TopTx era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictSeq (Tx TopTx era)
txs
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (PerasCert -> Encoding) -> StrictMaybe PerasCert -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe PerasCert -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe PerasCert
perasCert
    where
      invalidIndices :: StrictMaybe (NonEmptySet Int)
invalidIndices =
        Maybe (NonEmptySet Int) -> StrictMaybe (NonEmptySet Int)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe (NonEmptySet Int) -> StrictMaybe (NonEmptySet Int))
-> ([Int] -> Maybe (NonEmptySet Int))
-> [Int]
-> StrictMaybe (NonEmptySet Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmptySet Int)
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
f a -> Maybe (NonEmptySet a)
NonEmptySet.fromFoldable ([Int] -> StrictMaybe (NonEmptySet Int))
-> [Int] -> StrictMaybe (NonEmptySet Int)
forall a b. (a -> b) -> a -> b
$
          (Tx TopTx era -> Bool) -> StrictSeq (Tx TopTx era) -> [Int]
forall a. (a -> Bool) -> StrictSeq a -> [Int]
StrictSeq.findIndicesL (\Tx TopTx era
tx -> Tx TopTx era
tx Tx TopTx era -> Getting IsValid (Tx TopTx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx TopTx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx era) IsValid
isValidTxL IsValid -> IsValid -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> IsValid
IsValid Bool
False) StrictSeq (Tx TopTx era)
txs

instance
  ( AlonzoEraTx era
  , DecCBOR (Annotator (TxAuxData era))
  , DecCBOR (Annotator (TxBody TopTx era))
  , DecCBOR (Annotator (TxWits era))
  , Coercible (DijkstraTx TopTx era) (Tx TopTx era)
  ) =>
  DecCBOR (Annotator (DijkstraBlockBodyRaw era))
  where
  decCBOR :: forall s. Decoder s (Annotator (DijkstraBlockBodyRaw era))
decCBOR = Text
-> (Annotator (DijkstraBlockBodyRaw era) -> Int)
-> Decoder s (Annotator (DijkstraBlockBodyRaw era))
-> Decoder s (Annotator (DijkstraBlockBodyRaw era))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"DijkstraBlockBodyRaw" (Int -> Annotator (DijkstraBlockBodyRaw era) -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s (Annotator (DijkstraBlockBodyRaw era))
 -> Decoder s (Annotator (DijkstraBlockBodyRaw era)))
-> Decoder s (Annotator (DijkstraBlockBodyRaw era))
-> Decoder s (Annotator (DijkstraBlockBodyRaw era))
forall a b. (a -> b) -> a -> b
$ do
    let
      decodeInvalidTxs :: Decoder s IntSet
decodeInvalidTxs =
        (Word16 -> IntSet -> IntSet)
-> (IntSet -> (Int, IntSet))
-> Decoder s Word16
-> Decoder s IntSet
forall s a b c.
Monoid b =>
(a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeNonEmptySetLikeEnforceNoDuplicates
          (Int -> IntSet -> IntSet
IntSet.insert (Int -> IntSet -> IntSet)
-> (Word16 -> Int) -> Word16 -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int)
          (\IntSet
x -> (IntSet -> Int
IntSet.size IntSet
x, IntSet
x))
          (forall a s. DecCBOR a => Decoder s a
decCBOR @Word16)
    invalidTxs :: IntSet <- Maybe IntSet -> IntSet
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe IntSet -> IntSet)
-> Decoder s (Maybe IntSet) -> Decoder s IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IntSet -> Decoder s (Maybe IntSet)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s IntSet
forall {s}. Decoder s IntSet
decodeInvalidTxs
    txs <- decodeSeq (decodeDijkstraTopTx @era False)
    perasCert <- decodeNullStrictMaybe decCBOR
    let txsLength = Seq (Annotator (DijkstraTx TopTx era)) -> Int
forall a. Seq a -> Int
Seq.length Seq (Annotator (DijkstraTx TopTx era))
txs
        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
txsLength
    forM_ (IntSet.toList invalidTxs) $ \Int
i ->
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Bool
inRange Int
i) (Decoder s () -> Decoder s ())
-> (String -> Decoder s ()) -> String -> Decoder s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
"index is out of range: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i
    let
      setValidityFlag f (Tx TopTx era)
tx IsValid
isValid = ASetter (Tx TopTx era) (Tx TopTx era) IsValid IsValid
-> IsValid -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Tx TopTx era) (Tx TopTx era) IsValid IsValid
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx era) IsValid
isValidTxL IsValid
isValid (Tx TopTx era -> Tx TopTx era)
-> f (Tx TopTx era) -> f (Tx TopTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Tx TopTx era)
tx
      validityFlags = Int -> IntSet -> Seq IsValid
alignedValidFlags Int
txsLength IntSet
invalidTxs
      txsWithIsValid = (Annotator (Tx TopTx era) -> IsValid -> Annotator (Tx TopTx era))
-> Seq (Annotator (Tx TopTx era))
-> Seq IsValid
-> Seq (Annotator (Tx TopTx era))
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith Annotator (Tx TopTx era) -> IsValid -> Annotator (Tx TopTx era)
forall {era} {f :: * -> *}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Functor f, AlonzoEraTx era) =>
f (Tx TopTx era) -> IsValid -> f (Tx TopTx era)
setValidityFlag (Seq (Annotator (DijkstraTx TopTx era))
-> Seq (Annotator (Tx TopTx era))
forall a b. Coercible a b => a -> b
coerce Seq (Annotator (DijkstraTx TopTx era))
txs) Seq IsValid
validityFlags
    pure $
      DijkstraBlockBodyRaw
        <$> sequenceA (StrictSeq.forceToStrict txsWithIsValid)
        <*> pure perasCert

deriving via
  Mem (DijkstraBlockBodyRaw era)
  instance
    ( AlonzoEraTx era
    , Coercible (DijkstraTx TopTx era) (Tx TopTx era)
    , DecCBOR (Annotator (TxAuxData era))
    , DecCBOR (Annotator (TxBody TopTx era))
    , DecCBOR (Annotator (TxWits era))
    ) =>
    DecCBOR (Annotator (DijkstraBlockBody era))

instance (AlonzoEraTx era, EncCBOR (Tx TopTx era)) => EncCBORGroup (DijkstraBlockBody era) where
  encCBORGroup :: DijkstraBlockBody era -> Encoding
encCBORGroup (DijkstraBlockBody StrictSeq (Tx TopTx era)
txs StrictMaybe PerasCert
perasCert) = do
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictSeq (Tx TopTx era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictSeq (Tx TopTx era)
txs Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe PerasCert -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe PerasCert
perasCert
  listLen :: Proxy (DijkstraBlockBody era) -> Word
listLen Proxy (DijkstraBlockBody era)
_ = Word
1

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

-- | Given the number of transactions, and the set of indices for which these
-- transactions do not validate, create an aligned sequence of `IsValid`
-- flags.
alignedValidFlags :: Int -> IntSet -> Seq.Seq IsValid
alignedValidFlags :: Int -> IntSet -> Seq IsValid
alignedValidFlags Int
n IntSet
invalidSet =
  Int -> (Int -> IsValid) -> Seq IsValid
forall a. Int -> (Int -> a) -> Seq a
Seq.fromFunction Int
n ((Int -> IsValid) -> Seq IsValid)
-> (Int -> IsValid) -> Seq IsValid
forall a b. (a -> b) -> a -> b
$ \Int
i -> Bool -> IsValid
IsValid (Int
i Int -> IntSet -> Bool
`IntSet.notMember` IntSet
invalidSet)

-- | Placeholder for Peras certificates
--
-- NOTE: The real type will be brought from 'cardano-base' once it's ready.
newtype PerasCert = PerasCert ByteArray
  deriving (PerasCert -> PerasCert -> Bool
(PerasCert -> PerasCert -> Bool)
-> (PerasCert -> PerasCert -> Bool) -> Eq PerasCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerasCert -> PerasCert -> Bool
== :: PerasCert -> PerasCert -> Bool
$c/= :: PerasCert -> PerasCert -> Bool
/= :: PerasCert -> PerasCert -> Bool
Eq, Int -> PerasCert -> ShowS
[PerasCert] -> ShowS
PerasCert -> String
(Int -> PerasCert -> ShowS)
-> (PerasCert -> String)
-> ([PerasCert] -> ShowS)
-> Show PerasCert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasCert -> ShowS
showsPrec :: Int -> PerasCert -> ShowS
$cshow :: PerasCert -> String
show :: PerasCert -> String
$cshowList :: [PerasCert] -> ShowS
showList :: [PerasCert] -> ShowS
Show, (forall x. PerasCert -> Rep PerasCert x)
-> (forall x. Rep PerasCert x -> PerasCert) -> Generic PerasCert
forall x. Rep PerasCert x -> PerasCert
forall x. PerasCert -> Rep PerasCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PerasCert -> Rep PerasCert x
from :: forall x. PerasCert -> Rep PerasCert x
$cto :: forall x. Rep PerasCert x -> PerasCert
to :: forall x. Rep PerasCert x -> PerasCert
Generic)
  deriving newtype (PerasCert -> Encoding
(PerasCert -> Encoding) -> EncCBOR PerasCert
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: PerasCert -> Encoding
encCBOR :: PerasCert -> Encoding
EncCBOR, Typeable PerasCert
Typeable PerasCert =>
(forall s. Decoder s PerasCert)
-> (forall s. Proxy PerasCert -> Decoder s ())
-> (Proxy PerasCert -> Text)
-> DecCBOR PerasCert
Proxy PerasCert -> Text
forall s. Decoder s PerasCert
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy PerasCert -> Decoder s ()
$cdecCBOR :: forall s. Decoder s PerasCert
decCBOR :: forall s. Decoder s PerasCert
$cdropCBOR :: forall s. Proxy PerasCert -> Decoder s ()
dropCBOR :: forall s. Proxy PerasCert -> Decoder s ()
$clabel :: Proxy PerasCert -> Text
label :: Proxy PerasCert -> Text
DecCBOR)

instance NoThunks PerasCert

instance NFData PerasCert

-- | Placeholder for Peras public keys
--
-- NOTE: The real type will be brought from 'cardano-base' once it's ready.
data PerasKey = PerasKey
  deriving (PerasKey -> PerasKey -> Bool
(PerasKey -> PerasKey -> Bool)
-> (PerasKey -> PerasKey -> Bool) -> Eq PerasKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerasKey -> PerasKey -> Bool
== :: PerasKey -> PerasKey -> Bool
$c/= :: PerasKey -> PerasKey -> Bool
/= :: PerasKey -> PerasKey -> Bool
Eq, Int -> PerasKey -> ShowS
[PerasKey] -> ShowS
PerasKey -> String
(Int -> PerasKey -> ShowS)
-> (PerasKey -> String) -> ([PerasKey] -> ShowS) -> Show PerasKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasKey -> ShowS
showsPrec :: Int -> PerasKey -> ShowS
$cshow :: PerasKey -> String
show :: PerasKey -> String
$cshowList :: [PerasKey] -> ShowS
showList :: [PerasKey] -> ShowS
Show, (forall x. PerasKey -> Rep PerasKey x)
-> (forall x. Rep PerasKey x -> PerasKey) -> Generic PerasKey
forall x. Rep PerasKey x -> PerasKey
forall x. PerasKey -> Rep PerasKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PerasKey -> Rep PerasKey x
from :: forall x. PerasKey -> Rep PerasKey x
$cto :: forall x. Rep PerasKey x -> PerasKey
to :: forall x. Rep PerasKey x -> PerasKey
Generic, Context -> PerasKey -> IO (Maybe ThunkInfo)
Proxy PerasKey -> String
(Context -> PerasKey -> IO (Maybe ThunkInfo))
-> (Context -> PerasKey -> IO (Maybe ThunkInfo))
-> (Proxy PerasKey -> String)
-> NoThunks PerasKey
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PerasKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> PerasKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PerasKey -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PerasKey -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PerasKey -> String
showTypeOf :: Proxy PerasKey -> String
NoThunks)

-- | Mocked-up Peras certificate validation routine
--
-- NOTE: this function will be replaced with the real implementation from
-- 'cardano-base' once it's ready.
validatePerasCert :: Nonce -> PerasKey -> PerasCert -> Bool
validatePerasCert :: Nonce -> PerasKey -> PerasCert -> Bool
validatePerasCert Nonce
_ PerasKey
_ PerasCert
_ = Bool
True