{-# 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
  { forall (xs :: [*]).
MismatchEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo xs
getMismatchEraInfo :: Mismatch SingleEraInfo LedgerEraInfo xs
  -- ^ Era mismatch
  --
  -- We have an era mismatch between the era of a block/header/tx/query
  -- and the era of the current ledger.
  }

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
  { EraMismatch -> Text
ledgerEraName :: !Text
  -- ^ Name of the era of the ledger ("Byron" or "Shelley").
  , EraMismatch -> Text
otherEraName :: !Text
  -- ^ Era of the block, header, transaction, or query.
  }
  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 instance Show (PartialLedgerConfig xs) => Show (WrapPartialLedgerConfig xs)
deriving via
  LiftNP WrapPartialLedgerConfig xs
  instance
    CanHardFork xs => Show (PerEraLedgerConfig 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)