{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.HardFork.Combinator.AcrossEras ( -- * Value for /each/ era PerEraBlockConfig (..) , PerEraChainOrderConfig (..) , PerEraCodecConfig (..) , PerEraConsensusConfig (..) , PerEraLedgerConfig (..) , PerEraStorageConfig (..) -- * Values for /some/ eras , SomeErasCanBeLeader (..) -- * Value for /one/ era , OneEraApplyTxErr (..) , OneEraBlock (..) , OneEraCannotForge (..) , OneEraEnvelopeErr (..) , OneEraForgeStateInfo (..) , OneEraForgeStateUpdateError (..) , OneEraGenTx (..) , OneEraGenTxId (..) , OneEraHash (..) , OneEraHeader (..) , OneEraIsLeader (..) , OneEraLedgerError (..) , OneEraLedgerEvent (..) , OneEraLedgerUpdate (..) , OneEraLedgerWarning (..) , OneEraSelectView (..) , OneEraTentativeHeaderState (..) , OneEraTentativeHeaderView (..) , OneEraTipInfo (..) , OneEraValidateView (..) , OneEraValidatedGenTx (..) , OneEraValidationErr (..) -- * Value for two /different/ eras , EraMismatch (..) , MismatchEraInfo (..) , mismatchFutureEra , mismatchOneEra , mkEraMismatch -- * Utility , getSameValue , oneEraBlockHeader ) where import Codec.Serialise (Serialise (..)) import Control.Monad.Except (throwError) import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as BSC import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as Short import Data.Function (on) import Data.Proxy import Data.SOP.BasicFunctors import Data.SOP.Constraint import Data.SOP.Match (Mismatch) import qualified Data.SOP.Match as Match import Data.SOP.OptNP (NonEmptyOptNP) import Data.SOP.Strict import Data.Text (Text) import Data.Void import GHC.Generics (Generic) import GHC.Stack import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block.Abstract import Ouroboros.Consensus.HardFork.Combinator.Abstract import Ouroboros.Consensus.HardFork.Combinator.Info import Ouroboros.Consensus.HardFork.Combinator.Lifting import Ouroboros.Consensus.HardFork.Combinator.PartialConfig import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util (allEqual) import Ouroboros.Consensus.Util.Assert import Ouroboros.Consensus.Util.Condense (Condense (..)) {------------------------------------------------------------------------------- Value for /each/ era -------------------------------------------------------------------------------} newtype PerEraBlockConfig xs = PerEraBlockConfig { forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs getPerEraBlockConfig :: NP BlockConfig xs } newtype PerEraChainOrderConfig xs = PerEraChainOrderConfig { forall (xs :: [*]). PerEraChainOrderConfig xs -> NP WrapChainOrderConfig xs getPerEraChainOrderConfig :: NP WrapChainOrderConfig xs } newtype PerEraCodecConfig xs = PerEraCodecConfig { forall (xs :: [*]). PerEraCodecConfig xs -> NP CodecConfig xs getPerEraCodecConfig :: NP CodecConfig xs } newtype PerEraConsensusConfig xs = PerEraConsensusConfig { forall (xs :: [*]). PerEraConsensusConfig xs -> NP WrapPartialConsensusConfig xs getPerEraConsensusConfig :: NP WrapPartialConsensusConfig xs } newtype PerEraLedgerConfig xs = PerEraLedgerConfig { forall (xs :: [*]). PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs getPerEraLedgerConfig :: NP WrapPartialLedgerConfig xs } newtype PerEraStorageConfig xs = PerEraStorageConfig { forall (xs :: [*]). PerEraStorageConfig xs -> NP StorageConfig xs getPerEraStorageConfig :: NP StorageConfig xs } {------------------------------------------------------------------------------- Values for /some/ eras The reason for using @NonEmptyOptNP f xs@ as opposed to @NP (Maybe :.: f) xs@ is to maintain the isomorphism between @blk@ and @HardForkBlock '[blk]@ in "Ouroboros.Consensus.HardFork.Combinator.Embed.Unary" -------------------------------------------------------------------------------} newtype SomeErasCanBeLeader xs = SomeErasCanBeLeader { forall (xs :: [*]). SomeErasCanBeLeader xs -> NonEmptyOptNP WrapCanBeLeader xs getSomeErasCanBeLeader :: NonEmptyOptNP WrapCanBeLeader xs } {------------------------------------------------------------------------------- Value for /one/ era -------------------------------------------------------------------------------} newtype OneEraApplyTxErr xs = OneEraApplyTxErr { forall (xs :: [*]). OneEraApplyTxErr xs -> NS WrapApplyTxErr xs getOneEraApplyTxErr :: NS WrapApplyTxErr xs } newtype OneEraBlock xs = OneEraBlock { forall (xs :: [*]). OneEraBlock xs -> NS I xs getOneEraBlock :: NS I xs } newtype OneEraCannotForge xs = OneEraCannotForge { forall (xs :: [*]). OneEraCannotForge xs -> NS WrapCannotForge xs getOneEraCannotForge :: NS WrapCannotForge xs } newtype OneEraEnvelopeErr xs = OneEraEnvelopeErr { forall (xs :: [*]). OneEraEnvelopeErr xs -> NS WrapEnvelopeErr xs getOneEraEnvelopeErr :: NS WrapEnvelopeErr xs } newtype OneEraForgeStateInfo xs = OneEraForgeStateInfo { forall (xs :: [*]). OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs getOneEraForgeStateInfo :: NS WrapForgeStateInfo xs } newtype OneEraForgeStateUpdateError xs = OneEraForgeStateUpdateError { forall (xs :: [*]). OneEraForgeStateUpdateError xs -> NS WrapForgeStateUpdateError xs getOneEraForgeStateUpdateError :: NS WrapForgeStateUpdateError xs } newtype OneEraGenTx xs = OneEraGenTx { forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs getOneEraGenTx :: NS GenTx xs } newtype OneEraGenTxId xs = OneEraGenTxId { forall (xs :: [*]). OneEraGenTxId xs -> NS WrapGenTxId xs getOneEraGenTxId :: NS WrapGenTxId xs } newtype OneEraHeader xs = OneEraHeader { forall (xs :: [*]). OneEraHeader xs -> NS Header xs getOneEraHeader :: NS Header xs } newtype OneEraIsLeader xs = OneEraIsLeader { forall (xs :: [*]). OneEraIsLeader xs -> NS WrapIsLeader xs getOneEraIsLeader :: NS WrapIsLeader xs } newtype OneEraLedgerError xs = OneEraLedgerError { forall (xs :: [*]). OneEraLedgerError xs -> NS WrapLedgerErr xs getOneEraLedgerError :: NS WrapLedgerErr xs } newtype OneEraLedgerEvent xs = OneEraLedgerEvent { forall (xs :: [*]). OneEraLedgerEvent xs -> NS WrapLedgerEvent xs getOneEraLedgerEvent :: NS WrapLedgerEvent xs } newtype OneEraLedgerUpdate xs = OneEraLedgerUpdate { forall (xs :: [*]). OneEraLedgerUpdate xs -> NS WrapLedgerUpdate xs getOneEraLedgerUpdate :: NS WrapLedgerUpdate xs } newtype OneEraLedgerWarning xs = OneEraLedgerWarning { forall (xs :: [*]). OneEraLedgerWarning xs -> NS WrapLedgerWarning xs getOneEraLedgerWarning :: NS WrapLedgerWarning xs } newtype OneEraSelectView xs = OneEraSelectView { forall (xs :: [*]). OneEraSelectView xs -> NS WrapSelectView xs getOneEraSelectView :: NS WrapSelectView xs } newtype OneEraTentativeHeaderState xs = OneEraTentativeHeaderState { forall (xs :: [*]). OneEraTentativeHeaderState xs -> NS WrapTentativeHeaderState xs getOneEraTentativeHeaderState :: NS WrapTentativeHeaderState xs } newtype OneEraTentativeHeaderView xs = OneEraTentativeHeaderView { forall (xs :: [*]). OneEraTentativeHeaderView xs -> NS WrapTentativeHeaderView xs getOneEraTentativeHeaderView :: NS WrapTentativeHeaderView xs } newtype OneEraTipInfo xs = OneEraTipInfo { forall (xs :: [*]). OneEraTipInfo xs -> NS WrapTipInfo xs getOneEraTipInfo :: NS WrapTipInfo xs } newtype OneEraValidateView xs = OneEraValidateView { forall (xs :: [*]). OneEraValidateView xs -> NS WrapValidateView xs getOneEraValidateView :: NS WrapValidateView xs } newtype OneEraValidatedGenTx xs = OneEraValidatedGenTx { forall (xs :: [*]). OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs getOneEraValidatedGenTx :: NS WrapValidatedGenTx xs } newtype OneEraValidationErr xs = OneEraValidationErr { forall (xs :: [*]). OneEraValidationErr xs -> NS WrapValidationErr xs getOneEraValidationErr :: NS WrapValidationErr xs } {------------------------------------------------------------------------------- Hash -------------------------------------------------------------------------------} -- | The hash for an era -- -- This type is special: we don't use an NS here, because the hash by itself -- should not allow us to differentiate between eras. If it did, the /size/ -- of the hash would necessarily have to increase, and that leads to trouble. -- So, the type parameter @xs@ here is merely a phantom one, and we just store -- the underlying raw hash. newtype OneEraHash (xs :: [k]) = OneEraHash { forall k (xs :: [k]). OneEraHash xs -> ShortByteString getOneEraHash :: ShortByteString } deriving newtype (OneEraHash xs -> OneEraHash xs -> Bool (OneEraHash xs -> OneEraHash xs -> Bool) -> (OneEraHash xs -> OneEraHash xs -> Bool) -> Eq (OneEraHash xs) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool $c== :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool == :: OneEraHash xs -> OneEraHash xs -> Bool $c/= :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool /= :: OneEraHash xs -> OneEraHash xs -> Bool Eq, Eq (OneEraHash xs) Eq (OneEraHash xs) => (OneEraHash xs -> OneEraHash xs -> Ordering) -> (OneEraHash xs -> OneEraHash xs -> Bool) -> (OneEraHash xs -> OneEraHash xs -> Bool) -> (OneEraHash xs -> OneEraHash xs -> Bool) -> (OneEraHash xs -> OneEraHash xs -> Bool) -> (OneEraHash xs -> OneEraHash xs -> OneEraHash xs) -> (OneEraHash xs -> OneEraHash xs -> OneEraHash xs) -> Ord (OneEraHash xs) OneEraHash xs -> OneEraHash xs -> Bool OneEraHash xs -> OneEraHash xs -> Ordering OneEraHash xs -> OneEraHash xs -> OneEraHash xs forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall k (xs :: [k]). Eq (OneEraHash xs) forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Ordering forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> OneEraHash xs $ccompare :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Ordering compare :: OneEraHash xs -> OneEraHash xs -> Ordering $c< :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool < :: OneEraHash xs -> OneEraHash xs -> Bool $c<= :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool <= :: OneEraHash xs -> OneEraHash xs -> Bool $c> :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool > :: OneEraHash xs -> OneEraHash xs -> Bool $c>= :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> Bool >= :: OneEraHash xs -> OneEraHash xs -> Bool $cmax :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> OneEraHash xs max :: OneEraHash xs -> OneEraHash xs -> OneEraHash xs $cmin :: forall k (xs :: [k]). OneEraHash xs -> OneEraHash xs -> OneEraHash xs min :: OneEraHash xs -> OneEraHash xs -> OneEraHash xs Ord, Context -> OneEraHash xs -> IO (Maybe ThunkInfo) Proxy (OneEraHash xs) -> String (Context -> OneEraHash xs -> IO (Maybe ThunkInfo)) -> (Context -> OneEraHash xs -> IO (Maybe ThunkInfo)) -> (Proxy (OneEraHash xs) -> String) -> NoThunks (OneEraHash xs) forall a. (Context -> a -> IO (Maybe ThunkInfo)) -> (Context -> a -> IO (Maybe ThunkInfo)) -> (Proxy a -> String) -> NoThunks a forall k (xs :: [k]). Context -> OneEraHash xs -> IO (Maybe ThunkInfo) forall k (xs :: [k]). Proxy (OneEraHash xs) -> String $cnoThunks :: forall k (xs :: [k]). Context -> OneEraHash xs -> IO (Maybe ThunkInfo) noThunks :: Context -> OneEraHash xs -> IO (Maybe ThunkInfo) $cwNoThunks :: forall k (xs :: [k]). Context -> OneEraHash xs -> IO (Maybe ThunkInfo) wNoThunks :: Context -> OneEraHash xs -> IO (Maybe ThunkInfo) $cshowTypeOf :: forall k (xs :: [k]). Proxy (OneEraHash xs) -> String showTypeOf :: Proxy (OneEraHash xs) -> String NoThunks, [OneEraHash xs] -> Encoding OneEraHash xs -> Encoding (OneEraHash xs -> Encoding) -> (forall s. Decoder s (OneEraHash xs)) -> ([OneEraHash xs] -> Encoding) -> (forall s. Decoder s [OneEraHash xs]) -> Serialise (OneEraHash xs) forall s. Decoder s [OneEraHash xs] forall s. Decoder s (OneEraHash xs) forall a. (a -> Encoding) -> (forall s. Decoder s a) -> ([a] -> Encoding) -> (forall s. Decoder s [a]) -> Serialise a forall k (xs :: [k]). [OneEraHash xs] -> Encoding forall k (xs :: [k]). OneEraHash xs -> Encoding forall k (xs :: [k]) s. Decoder s [OneEraHash xs] forall k (xs :: [k]) s. Decoder s (OneEraHash xs) $cencode :: forall k (xs :: [k]). OneEraHash xs -> Encoding encode :: OneEraHash xs -> Encoding $cdecode :: forall k (xs :: [k]) s. Decoder s (OneEraHash xs) decode :: forall s. Decoder s (OneEraHash xs) $cencodeList :: forall k (xs :: [k]). [OneEraHash xs] -> Encoding encodeList :: [OneEraHash xs] -> Encoding $cdecodeList :: forall k (xs :: [k]) s. Decoder s [OneEraHash xs] decodeList :: forall s. Decoder s [OneEraHash xs] Serialise) instance Show (OneEraHash xs) where show :: OneEraHash xs -> String show = ByteString -> String BSC.unpack (ByteString -> String) -> (OneEraHash xs -> ByteString) -> OneEraHash xs -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString B16.encode (ByteString -> ByteString) -> (OneEraHash xs -> ByteString) -> OneEraHash xs -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . ShortByteString -> ByteString Short.fromShort (ShortByteString -> ByteString) -> (OneEraHash xs -> ShortByteString) -> OneEraHash xs -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . OneEraHash xs -> ShortByteString forall k (xs :: [k]). OneEraHash xs -> ShortByteString getOneEraHash instance Condense (OneEraHash xs) where condense :: OneEraHash xs -> String condense = OneEraHash xs -> String forall a. Show a => a -> String show {------------------------------------------------------------------------------- OneEraGenTxId -------------------------------------------------------------------------------} -- | This instance compares the underlying raw hash ('toRawTxIdHash') of the -- 'TxId'. -- -- Note that this means that transactions in different eras can have equal -- 'TxId's. This should only be the case when the transaction format is -- backwards compatible from one era to the next. instance CanHardFork xs => Eq (OneEraGenTxId xs) where == :: OneEraGenTxId xs -> OneEraGenTxId xs -> Bool (==) = ShortByteString -> ShortByteString -> Bool forall a. Eq a => a -> a -> Bool (==) (ShortByteString -> ShortByteString -> Bool) -> (OneEraGenTxId xs -> ShortByteString) -> OneEraGenTxId xs -> OneEraGenTxId xs -> Bool forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` OneEraGenTxId xs -> ShortByteString forall (xs :: [*]). CanHardFork xs => OneEraGenTxId xs -> ShortByteString oneEraGenTxIdRawHash -- | See the corresponding 'Eq' instance. instance CanHardFork xs => Ord (OneEraGenTxId xs) where compare :: OneEraGenTxId xs -> OneEraGenTxId xs -> Ordering compare = ShortByteString -> ShortByteString -> Ordering forall a. Ord a => a -> a -> Ordering compare (ShortByteString -> ShortByteString -> Ordering) -> (OneEraGenTxId xs -> ShortByteString) -> OneEraGenTxId xs -> OneEraGenTxId xs -> Ordering forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` OneEraGenTxId xs -> ShortByteString forall (xs :: [*]). CanHardFork xs => OneEraGenTxId xs -> ShortByteString oneEraGenTxIdRawHash {------------------------------------------------------------------------------- Value for two /different/ eras -------------------------------------------------------------------------------} newtype MismatchEraInfo xs = MismatchEraInfo { -- | Era mismatch -- -- We have an era mismatch between the era of a block/header/tx/query -- and the era of the current ledger. forall (xs :: [*]). MismatchEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo xs getMismatchEraInfo :: Mismatch SingleEraInfo LedgerEraInfo xs } mismatchOneEra :: MismatchEraInfo '[b] -> Void mismatchOneEra :: forall b. MismatchEraInfo '[b] -> Void mismatchOneEra = Mismatch SingleEraInfo LedgerEraInfo '[b] -> Void forall {k} (f :: k -> *) (g :: k -> *) (x :: k). Mismatch f g '[x] -> Void Match.mismatchOne (Mismatch SingleEraInfo LedgerEraInfo '[b] -> Void) -> (MismatchEraInfo '[b] -> Mismatch SingleEraInfo LedgerEraInfo '[b]) -> MismatchEraInfo '[b] -> Void forall b c a. (b -> c) -> (a -> b) -> a -> c . MismatchEraInfo '[b] -> Mismatch SingleEraInfo LedgerEraInfo '[b] forall (xs :: [*]). MismatchEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo xs getMismatchEraInfo -- | A mismatch _must_ involve a future era mismatchFutureEra :: SListI xs => MismatchEraInfo (x ': xs) -> NS SingleEraInfo xs mismatchFutureEra :: forall (xs :: [*]) x. SListI xs => MismatchEraInfo (x : xs) -> NS SingleEraInfo xs mismatchFutureEra = (NS SingleEraInfo xs -> NS SingleEraInfo xs) -> (NS LedgerEraInfo xs -> NS SingleEraInfo xs) -> Either (NS SingleEraInfo xs) (NS LedgerEraInfo xs) -> NS SingleEraInfo xs forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either NS SingleEraInfo xs -> NS SingleEraInfo xs forall a. a -> a id ((forall a. LedgerEraInfo a -> SingleEraInfo a) -> NS LedgerEraInfo xs -> NS SingleEraInfo xs forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *) (f' :: k -> *). (SListIN (Prod h) xs, HAp h) => (forall (a :: k). f a -> f' a) -> h f xs -> h f' xs hmap LedgerEraInfo a -> SingleEraInfo a forall a. LedgerEraInfo a -> SingleEraInfo a getLedgerEraInfo) (Either (NS SingleEraInfo xs) (NS LedgerEraInfo xs) -> NS SingleEraInfo xs) -> (MismatchEraInfo (x : xs) -> Either (NS SingleEraInfo xs) (NS LedgerEraInfo xs)) -> MismatchEraInfo (x : xs) -> NS SingleEraInfo xs forall b c a. (b -> c) -> (a -> b) -> a -> c . Mismatch SingleEraInfo LedgerEraInfo (x : xs) -> Either (NS SingleEraInfo xs) (NS LedgerEraInfo xs) forall {k} (f :: k -> *) (g :: k -> *) (x :: k) (xs :: [k]). Mismatch f g (x : xs) -> Either (NS f xs) (NS g xs) Match.mismatchNotFirst (Mismatch SingleEraInfo LedgerEraInfo (x : xs) -> Either (NS SingleEraInfo xs) (NS LedgerEraInfo xs)) -> (MismatchEraInfo (x : xs) -> Mismatch SingleEraInfo LedgerEraInfo (x : xs)) -> MismatchEraInfo (x : xs) -> Either (NS SingleEraInfo xs) (NS LedgerEraInfo xs) forall b c a. (b -> c) -> (a -> b) -> a -> c . MismatchEraInfo (x : xs) -> Mismatch SingleEraInfo LedgerEraInfo (x : xs) forall (xs :: [*]). MismatchEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo xs getMismatchEraInfo {------------------------------------------------------------------------------- Untyped version of 'MismatchEraInfo' -------------------------------------------------------------------------------} -- | Extra info for errors caused by applying a block, header, transaction, or -- query from one era to a ledger from a different era. data EraMismatch = EraMismatch { -- | Name of the era of the ledger ("Byron" or "Shelley"). EraMismatch -> Text ledgerEraName :: !Text -- | Era of the block, header, transaction, or query. , EraMismatch -> Text otherEraName :: !Text } deriving (EraMismatch -> EraMismatch -> Bool (EraMismatch -> EraMismatch -> Bool) -> (EraMismatch -> EraMismatch -> Bool) -> Eq EraMismatch forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: EraMismatch -> EraMismatch -> Bool == :: EraMismatch -> EraMismatch -> Bool $c/= :: EraMismatch -> EraMismatch -> Bool /= :: EraMismatch -> EraMismatch -> Bool Eq, Int -> EraMismatch -> ShowS [EraMismatch] -> ShowS EraMismatch -> String (Int -> EraMismatch -> ShowS) -> (EraMismatch -> String) -> ([EraMismatch] -> ShowS) -> Show EraMismatch forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> EraMismatch -> ShowS showsPrec :: Int -> EraMismatch -> ShowS $cshow :: EraMismatch -> String show :: EraMismatch -> String $cshowList :: [EraMismatch] -> ShowS showList :: [EraMismatch] -> ShowS Show, (forall x. EraMismatch -> Rep EraMismatch x) -> (forall x. Rep EraMismatch x -> EraMismatch) -> Generic EraMismatch forall x. Rep EraMismatch x -> EraMismatch forall x. EraMismatch -> Rep EraMismatch x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall x. EraMismatch -> Rep EraMismatch x from :: forall x. EraMismatch -> Rep EraMismatch x $cto :: forall x. Rep EraMismatch x -> EraMismatch to :: forall x. Rep EraMismatch x -> EraMismatch Generic) -- | When a transaction or block from a certain era was applied to a ledger -- from another era, we get a 'MismatchEraInfo'. -- -- Given such a 'MismatchEraInfo', return the name of the era of the -- transaction/block and the name of the era of the ledger. mkEraMismatch :: SListI xs => MismatchEraInfo xs -> EraMismatch mkEraMismatch :: forall (xs :: [*]). SListI xs => MismatchEraInfo xs -> EraMismatch mkEraMismatch (MismatchEraInfo Mismatch SingleEraInfo LedgerEraInfo xs mismatch) = Mismatch SingleEraInfo LedgerEraInfo xs -> EraMismatch forall (xs :: [*]). SListI xs => Mismatch SingleEraInfo LedgerEraInfo xs -> EraMismatch go Mismatch SingleEraInfo LedgerEraInfo xs mismatch where go :: SListI xs => Mismatch SingleEraInfo LedgerEraInfo xs -> EraMismatch go :: forall (xs :: [*]). SListI xs => Mismatch SingleEraInfo LedgerEraInfo xs -> EraMismatch go (Match.ML SingleEraInfo x otherEra NS LedgerEraInfo xs1 ledgerEra) = EraMismatch { ledgerEraName :: Text ledgerEraName = NS (K Text) xs1 -> CollapseTo NS Text forall (xs :: [*]) a. SListIN NS xs => NS (K a) xs -> CollapseTo NS a forall k l (h :: (k -> *) -> l -> *) (xs :: l) a. (HCollapse h, SListIN h xs) => h (K a) xs -> CollapseTo h a hcollapse (NS (K Text) xs1 -> CollapseTo NS Text) -> NS (K Text) xs1 -> CollapseTo NS Text forall a b. (a -> b) -> a -> b $ (forall a. LedgerEraInfo a -> K Text a) -> NS LedgerEraInfo xs1 -> NS (K Text) xs1 forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *) (f' :: k -> *). (SListIN (Prod h) xs, HAp h) => (forall (a :: k). f a -> f' a) -> h f xs -> h f' xs hmap (Text -> K Text a forall k a (b :: k). a -> K a b K (Text -> K Text a) -> (LedgerEraInfo a -> Text) -> LedgerEraInfo a -> K Text a forall b c a. (b -> c) -> (a -> b) -> a -> c . LedgerEraInfo a -> Text forall blk. LedgerEraInfo blk -> Text ledgerName) NS LedgerEraInfo xs1 ledgerEra , otherEraName :: Text otherEraName = SingleEraInfo x -> Text forall blk. SingleEraInfo blk -> Text otherName SingleEraInfo x otherEra } go (Match.MR NS SingleEraInfo xs1 otherEra LedgerEraInfo x ledgerEra) = EraMismatch { ledgerEraName :: Text ledgerEraName = LedgerEraInfo x -> Text forall blk. LedgerEraInfo blk -> Text ledgerName LedgerEraInfo x ledgerEra , otherEraName :: Text otherEraName = NS (K Text) xs1 -> CollapseTo NS Text forall (xs :: [*]) a. SListIN NS xs => NS (K a) xs -> CollapseTo NS a forall k l (h :: (k -> *) -> l -> *) (xs :: l) a. (HCollapse h, SListIN h xs) => h (K a) xs -> CollapseTo h a hcollapse (NS (K Text) xs1 -> CollapseTo NS Text) -> NS (K Text) xs1 -> CollapseTo NS Text forall a b. (a -> b) -> a -> b $ (forall a. SingleEraInfo a -> K Text a) -> NS SingleEraInfo xs1 -> NS (K Text) xs1 forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *) (f' :: k -> *). (SListIN (Prod h) xs, HAp h) => (forall (a :: k). f a -> f' a) -> h f xs -> h f' xs hmap (Text -> K Text a forall k a (b :: k). a -> K a b K (Text -> K Text a) -> (SingleEraInfo a -> Text) -> SingleEraInfo a -> K Text a forall b c a. (b -> c) -> (a -> b) -> a -> c . SingleEraInfo a -> Text forall blk. SingleEraInfo blk -> Text otherName) NS SingleEraInfo xs1 otherEra } go (Match.MS Mismatch SingleEraInfo LedgerEraInfo xs1 m) = Mismatch SingleEraInfo LedgerEraInfo xs1 -> EraMismatch forall (xs :: [*]). SListI xs => Mismatch SingleEraInfo LedgerEraInfo xs -> EraMismatch go Mismatch SingleEraInfo LedgerEraInfo xs1 m ledgerName :: LedgerEraInfo blk -> Text ledgerName :: forall blk. LedgerEraInfo blk -> Text ledgerName = SingleEraInfo blk -> Text forall blk. SingleEraInfo blk -> Text singleEraName (SingleEraInfo blk -> Text) -> (LedgerEraInfo blk -> SingleEraInfo blk) -> LedgerEraInfo blk -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . LedgerEraInfo blk -> SingleEraInfo blk forall a. LedgerEraInfo a -> SingleEraInfo a getLedgerEraInfo otherName :: SingleEraInfo blk -> Text otherName :: forall blk. SingleEraInfo blk -> Text otherName = SingleEraInfo blk -> Text forall blk. SingleEraInfo blk -> Text singleEraName {------------------------------------------------------------------------------- Utility -------------------------------------------------------------------------------} oneEraBlockHeader :: CanHardFork xs => OneEraBlock xs -> OneEraHeader xs oneEraBlockHeader :: forall (xs :: [*]). CanHardFork xs => OneEraBlock xs -> OneEraHeader xs oneEraBlockHeader = NS Header xs -> OneEraHeader xs forall (xs :: [*]). NS Header xs -> OneEraHeader xs OneEraHeader (NS Header xs -> OneEraHeader xs) -> (OneEraBlock xs -> NS Header xs) -> OneEraBlock xs -> OneEraHeader xs forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy SingleEraBlock -> (forall a. SingleEraBlock a => I a -> Header a) -> NS I xs -> NS Header xs forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint) (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *) (f' :: k -> *). (AllN (Prod h) c xs, HAp h) => proxy c -> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs hcmap Proxy SingleEraBlock proxySingle (a -> Header a forall blk. GetHeader blk => blk -> Header blk getHeader (a -> Header a) -> (I a -> a) -> I a -> Header a forall b c a. (b -> c) -> (a -> b) -> a -> c . I a -> a forall a. I a -> a unI) (NS I xs -> NS Header xs) -> (OneEraBlock xs -> NS I xs) -> OneEraBlock xs -> NS Header xs forall b c a. (b -> c) -> (a -> b) -> a -> c . OneEraBlock xs -> NS I xs forall (xs :: [*]). OneEraBlock xs -> NS I xs getOneEraBlock getSameValue :: forall xs a. (IsNonEmpty xs, Eq a, SListI xs, HasCallStack) => NP (K a) xs -> a getSameValue :: forall {k} (xs :: [k]) a. (IsNonEmpty xs, Eq a, SListI xs, HasCallStack) => NP (K a) xs -> a getSameValue NP (K a) xs values = case Proxy xs -> ProofNonEmpty xs forall {a} (xs :: [a]) (proxy :: [a] -> *). IsNonEmpty xs => proxy xs -> ProofNonEmpty xs forall (proxy :: [k] -> *). proxy xs -> ProofNonEmpty xs isNonEmpty (forall (t :: [k]). Proxy t forall {k} (t :: k). Proxy t Proxy @xs) of ProofNonEmpty {} -> Either String () -> a -> a forall a. HasCallStack => Either String () -> a -> a assertWithMsg Either String () allEqualCheck (K a x -> a forall {k} a (b :: k). K a b -> a unK (NP (K a) (x : xs1) -> K a x forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x hd NP (K a) xs NP (K a) (x : xs1) values)) where allEqualCheck :: Either String () allEqualCheck :: Either String () allEqualCheck | [a] -> Bool forall a. Eq a => [a] -> Bool allEqual (NP (K a) xs -> CollapseTo NP a forall (xs :: [k]) a. SListIN NP xs => NP (K a) xs -> CollapseTo NP a forall k l (h :: (k -> *) -> l -> *) (xs :: l) a. (HCollapse h, SListIN h xs) => h (K a) xs -> CollapseTo h a hcollapse NP (K a) xs values) = () -> Either String () forall a. a -> Either String a forall (m :: * -> *) a. Monad m => a -> m a return () | Bool otherwise = String -> Either String () forall a. String -> Either String a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError String "differing values across hard fork" oneEraGenTxIdRawHash :: CanHardFork xs => OneEraGenTxId xs -> ShortByteString oneEraGenTxIdRawHash :: forall (xs :: [*]). CanHardFork xs => OneEraGenTxId xs -> ShortByteString oneEraGenTxIdRawHash = NS (K ShortByteString) xs -> ShortByteString NS (K ShortByteString) xs -> CollapseTo NS ShortByteString forall (xs :: [*]) a. SListIN NS xs => NS (K a) xs -> CollapseTo NS a forall k l (h :: (k -> *) -> l -> *) (xs :: l) a. (HCollapse h, SListIN h xs) => h (K a) xs -> CollapseTo h a hcollapse (NS (K ShortByteString) xs -> ShortByteString) -> (OneEraGenTxId xs -> NS (K ShortByteString) xs) -> OneEraGenTxId xs -> ShortByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy SingleEraBlock -> (forall a. SingleEraBlock a => WrapGenTxId a -> K ShortByteString a) -> NS WrapGenTxId xs -> NS (K ShortByteString) xs forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint) (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *) (f' :: k -> *). (AllN (Prod h) c xs, HAp h) => proxy c -> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs hcmap Proxy SingleEraBlock proxySingle (ShortByteString -> K ShortByteString a forall k a (b :: k). a -> K a b K (ShortByteString -> K ShortByteString a) -> (WrapGenTxId a -> ShortByteString) -> WrapGenTxId a -> K ShortByteString a forall b c a. (b -> c) -> (a -> b) -> a -> c . TxId (GenTx a) -> ShortByteString forall tx. ConvertRawTxId tx => TxId tx -> ShortByteString toRawTxIdHash (TxId (GenTx a) -> ShortByteString) -> (WrapGenTxId a -> TxId (GenTx a)) -> WrapGenTxId a -> ShortByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . WrapGenTxId a -> TxId (GenTx a) forall blk. WrapGenTxId blk -> GenTxId blk unwrapGenTxId) (NS WrapGenTxId xs -> NS (K ShortByteString) xs) -> (OneEraGenTxId xs -> NS WrapGenTxId xs) -> OneEraGenTxId xs -> NS (K ShortByteString) xs forall b c a. (b -> c) -> (a -> b) -> a -> c . OneEraGenTxId xs -> NS WrapGenTxId xs forall (xs :: [*]). OneEraGenTxId xs -> NS WrapGenTxId xs getOneEraGenTxId {------------------------------------------------------------------------------- NoThunks instances -------------------------------------------------------------------------------} deriving via LiftNamedNP "PerEraBlockConfig" BlockConfig xs instance CanHardFork xs => NoThunks (PerEraBlockConfig xs) deriving via LiftNamedNP "PerEraCodecConfig" CodecConfig xs instance CanHardFork xs => NoThunks (PerEraCodecConfig xs) deriving via LiftNamedNP "PerEraConsensusConfig" WrapPartialConsensusConfig xs instance CanHardFork xs => NoThunks (PerEraConsensusConfig xs) deriving via LiftNamedNP "PerEraLedgerConfig" WrapPartialLedgerConfig xs instance CanHardFork xs => NoThunks (PerEraLedgerConfig xs) deriving via LiftNamedNP "PerEraStorageConfig" StorageConfig xs instance CanHardFork xs => NoThunks (PerEraStorageConfig xs) deriving via LiftNamedNS "OneEraEnvelopeErr" WrapEnvelopeErr xs instance CanHardFork xs => NoThunks (OneEraEnvelopeErr xs) deriving via LiftNamedNS "OneEraGenTx" GenTx xs instance CanHardFork xs => NoThunks (OneEraGenTx xs) deriving via LiftNamedNS "OneEraGenTxId" WrapGenTxId xs instance CanHardFork xs => NoThunks (OneEraGenTxId xs) deriving via LiftNamedNS "OneEraHeader" Header xs instance CanHardFork xs => NoThunks (OneEraHeader xs) deriving via LiftNamedNS "OneEraLedgerError" WrapLedgerErr xs instance CanHardFork xs => NoThunks (OneEraLedgerError xs) deriving via LiftNamedNS "OneEraSelectView" WrapSelectView xs instance CanHardFork xs => NoThunks (OneEraSelectView xs) deriving via LiftNamedNS "OneEraTentativeHeaderState" WrapTentativeHeaderState xs instance CanHardFork xs => NoThunks (OneEraTentativeHeaderState xs) deriving via LiftNamedNS "OneEraTipInfo" WrapTipInfo xs instance CanHardFork xs => NoThunks (OneEraTipInfo xs) deriving via LiftNamedNS "OneEraValidated" WrapValidatedGenTx xs instance CanHardFork xs => NoThunks (OneEraValidatedGenTx xs) deriving via LiftNamedNS "OneEraValidationErr" WrapValidationErr xs instance CanHardFork xs => NoThunks (OneEraValidationErr xs) deriving via LiftNamedMismatch "MismatchEraInfo" SingleEraInfo LedgerEraInfo xs instance CanHardFork xs => NoThunks (MismatchEraInfo xs) {------------------------------------------------------------------------------- Other instances -------------------------------------------------------------------------------} deriving via LiftNS WrapApplyTxErr xs instance CanHardFork xs => Eq (OneEraApplyTxErr xs) deriving via LiftNS WrapEnvelopeErr xs instance CanHardFork xs => Eq (OneEraEnvelopeErr xs) deriving via LiftNS GenTx xs instance CanHardFork xs => Eq (OneEraGenTx xs) deriving via LiftNS WrapLedgerErr xs instance CanHardFork xs => Eq (OneEraLedgerError xs) deriving via LiftNS WrapLedgerUpdate xs instance CanHardFork xs => Eq (OneEraLedgerUpdate xs) deriving via LiftNS WrapLedgerWarning xs instance CanHardFork xs => Eq (OneEraLedgerWarning xs) deriving via LiftNS WrapSelectView xs instance CanHardFork xs => Eq (OneEraSelectView xs) deriving via LiftNS WrapTipInfo xs instance CanHardFork xs => Eq (OneEraTipInfo xs) deriving via LiftNS WrapValidatedGenTx xs instance CanHardFork xs => Eq (OneEraValidatedGenTx xs) deriving via LiftNS WrapValidationErr xs instance CanHardFork xs => Eq (OneEraValidationErr xs) deriving via LiftNS WrapEnvelopeErr xs instance CanHardFork xs => Show (OneEraEnvelopeErr xs) deriving via LiftNS WrapForgeStateInfo xs instance CanHardFork xs => Show (OneEraForgeStateInfo xs) deriving via LiftNS WrapForgeStateUpdateError xs instance CanHardFork xs => Show (OneEraForgeStateUpdateError xs) deriving via LiftNS WrapLedgerErr xs instance CanHardFork xs => Show (OneEraLedgerError xs) deriving via LiftNS WrapLedgerUpdate xs instance CanHardFork xs => Show (OneEraLedgerUpdate xs) deriving via LiftNS WrapLedgerWarning xs instance CanHardFork xs => Show (OneEraLedgerWarning xs) deriving via LiftNS WrapTentativeHeaderState xs instance CanHardFork xs => Show (OneEraTentativeHeaderState xs) deriving via LiftNS WrapTentativeHeaderView xs instance CanHardFork xs => Show (OneEraTentativeHeaderView xs) deriving via LiftNS WrapTipInfo xs instance CanHardFork xs => Show (OneEraTipInfo xs) deriving via LiftNS WrapValidatedGenTx xs instance CanHardFork xs => Show (OneEraValidatedGenTx xs) deriving via LiftNS WrapValidationErr xs instance CanHardFork xs => Show (OneEraValidationErr xs) deriving via LiftMismatch SingleEraInfo LedgerEraInfo xs instance All SingleEraBlock xs => Eq (MismatchEraInfo xs) deriving via LiftMismatch SingleEraInfo LedgerEraInfo xs instance All SingleEraBlock xs => Show (MismatchEraInfo xs) {------------------------------------------------------------------------------- Show instances used in tests only -------------------------------------------------------------------------------} deriving via LiftNS WrapApplyTxErr xs instance CanHardFork xs => Show (OneEraApplyTxErr xs) deriving via LiftNS I xs instance CanHardFork xs => Show (OneEraBlock xs) deriving via LiftNS WrapCannotForge xs instance CanHardFork xs => Show (OneEraCannotForge xs) deriving via LiftNS GenTx xs instance CanHardFork xs => Show (OneEraGenTx xs) deriving via LiftNS WrapGenTxId xs instance CanHardFork xs => Show (OneEraGenTxId xs) deriving via LiftNS Header xs instance CanHardFork xs => Show (OneEraHeader xs) deriving via LiftNS WrapSelectView xs instance CanHardFork xs => Show (OneEraSelectView xs)