{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Tools.DBAnalyser.Block.Cardano (
    Args (configFile, threshold, CardanoBlockArgs)
  , CardanoBlockArgs
  ) where

import qualified Cardano.Chain.Block as Byron.Block
import qualified Cardano.Chain.Genesis as Byron.Genesis
import qualified Cardano.Chain.Update as Byron.Update
import qualified Cardano.Chain.UTxO as Byron.UTxO
import           Cardano.Crypto (RequiresNetworkMagic (..))
import qualified Cardano.Crypto as Crypto
import qualified Cardano.Crypto.Hash.Class as CryptoClass
import           Cardano.Crypto.Raw (Raw)
import qualified Cardano.Ledger.Api.Era as L
import qualified Cardano.Ledger.Api.Transition as SL
import           Cardano.Ledger.Core (TxOut)
import           Cardano.Ledger.Crypto
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley.LedgerState
import qualified Cardano.Ledger.Shelley.UTxO as Shelley.UTxO
import           Cardano.Ledger.TxIn (TxIn)
import           Cardano.Node.Types (AdjustFilePaths (..))
import qualified Cardano.Tools.DBAnalyser.Block.Byron as BlockByron
import           Cardano.Tools.DBAnalyser.Block.Shelley ()
import           Cardano.Tools.DBAnalyser.HasAnalysis
import           Control.Monad (when)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as BS
import qualified Data.Compact as Compact
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromJust)
import           Data.SOP.BasicFunctors
import           Data.SOP.Strict
import qualified Data.SOP.Telescope as Telescope
import           Data.String (IsString (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import qualified Ouroboros.Consensus.Byron.Ledger.Ledger as Byron.Ledger
import           Ouroboros.Consensus.Cardano
import           Ouroboros.Consensus.Cardano.Block (CardanoEras)
import qualified Ouroboros.Consensus.Cardano.Block as Cardano.Block
import           Ouroboros.Consensus.Cardano.Node (CardanoProtocolParams (..),
                     protocolInfoCardano)
import           Ouroboros.Consensus.Config (emptyCheckpointsMap)
import           Ouroboros.Consensus.HardFork.Combinator (HardForkBlock (..),
                     OneEraBlock (..), OneEraHash (..), getHardForkState,
                     hardForkLedgerStatePerEra)
import           Ouroboros.Consensus.HardFork.Combinator.State (currentState)
import           Ouroboros.Consensus.HeaderValidation (HasAnnTip)
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Shelley.HFEras ()
import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley.Ledger
import           Ouroboros.Consensus.Shelley.Ledger.Block (IsShelleyBlock,
                     ShelleyBlock, ShelleyBlockLedgerEra)
import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import           System.Directory (makeAbsolute)
import           System.FilePath (takeDirectory, (</>))
import qualified Text.Builder as Builder
import           Text.Builder (Builder)

analyseBlock ::
     (forall blk. HasAnalysis blk => blk -> a)
  -> CardanoBlock StandardCrypto -> a
analyseBlock :: forall a.
(forall blk. HasAnalysis blk => blk -> a)
-> CardanoBlock StandardCrypto -> a
analyseBlock forall blk. HasAnalysis blk => blk -> a
f =
      NS (K a) (CardanoEras StandardCrypto) -> a
NS (K a) (CardanoEras StandardCrypto) -> CollapseTo NS a
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 a) (CardanoEras StandardCrypto) -> a)
-> (CardanoBlock StandardCrypto
    -> NS (K a) (CardanoEras StandardCrypto))
-> CardanoBlock StandardCrypto
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy HasAnalysis
-> (forall a. HasAnalysis a => I a -> K a a)
-> NS I (CardanoEras StandardCrypto)
-> NS (K a) (CardanoEras StandardCrypto)
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 HasAnalysis
p (a -> K a a
forall k a (b :: k). a -> K a b
K (a -> K a a) -> (I a -> a) -> I a -> K a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall blk. HasAnalysis blk => blk -> a
f (a -> a) -> (I a -> a) -> I a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> a
forall a. I a -> a
unI)
    (NS I (CardanoEras StandardCrypto)
 -> NS (K a) (CardanoEras StandardCrypto))
-> (CardanoBlock StandardCrypto
    -> NS I (CardanoEras StandardCrypto))
-> CardanoBlock StandardCrypto
-> NS (K a) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraBlock (CardanoEras StandardCrypto)
-> NS I (CardanoEras StandardCrypto)
forall (xs :: [*]). OneEraBlock xs -> NS I xs
getOneEraBlock
    (OneEraBlock (CardanoEras StandardCrypto)
 -> NS I (CardanoEras StandardCrypto))
-> (CardanoBlock StandardCrypto
    -> OneEraBlock (CardanoEras StandardCrypto))
-> CardanoBlock StandardCrypto
-> NS I (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoBlock StandardCrypto
-> OneEraBlock (CardanoEras StandardCrypto)
forall (xs :: [*]). HardForkBlock xs -> OneEraBlock xs
getHardForkBlock
  where
    p :: Proxy HasAnalysis
    p :: Proxy HasAnalysis
p = Proxy HasAnalysis
forall {k} (t :: k). Proxy t
Proxy

-- | Lift a function polymorphic over all block types supporting `HasAnalysis`
-- into a corresponding function over `CardanoBlock.`
analyseWithLedgerState ::
  forall a.
  (forall blk. HasAnalysis blk => WithLedgerState blk -> a) ->
  WithLedgerState (CardanoBlock StandardCrypto) ->
  a
analyseWithLedgerState :: forall a.
(forall blk. HasAnalysis blk => WithLedgerState blk -> a)
-> WithLedgerState (CardanoBlock StandardCrypto) -> a
analyseWithLedgerState forall blk. HasAnalysis blk => WithLedgerState blk -> a
f (WithLedgerState CardanoBlock StandardCrypto
cb LedgerState (CardanoBlock StandardCrypto)
sb LedgerState (CardanoBlock StandardCrypto)
sa) =
  NS (K a) (CardanoEras StandardCrypto) -> a
NS (K a) (CardanoEras StandardCrypto) -> CollapseTo NS a
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 a) (CardanoEras StandardCrypto) -> a)
-> (NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
    -> NS (K a) (CardanoEras StandardCrypto))
-> NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy HasAnalysis
-> (forall a. HasAnalysis a => WithLedgerState a -> K a a)
-> NS WithLedgerState (CardanoEras StandardCrypto)
-> NS (K a) (CardanoEras StandardCrypto)
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 HasAnalysis
p (a -> K a a
forall k a (b :: k). a -> K a b
K (a -> K a a)
-> (WithLedgerState a -> a) -> WithLedgerState a -> K a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithLedgerState a -> a
forall blk. HasAnalysis blk => WithLedgerState blk -> a
f)
    (NS WithLedgerState (CardanoEras StandardCrypto)
 -> NS (K a) (CardanoEras StandardCrypto))
-> (NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
    -> NS WithLedgerState (CardanoEras StandardCrypto))
-> NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
-> NS (K a) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NS WithLedgerState (CardanoEras StandardCrypto))
-> NS WithLedgerState (CardanoEras StandardCrypto)
forall a. HasCallStack => Maybe a -> a
fromJust
    (Maybe (NS WithLedgerState (CardanoEras StandardCrypto))
 -> NS WithLedgerState (CardanoEras StandardCrypto))
-> (NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
    -> Maybe (NS WithLedgerState (CardanoEras StandardCrypto)))
-> NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
-> NS WithLedgerState (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
-> Maybe (NS WithLedgerState (CardanoEras StandardCrypto))
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NS xs, Applicative f) =>
NS (f :.: g) xs -> f (NS g xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence'
    (NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto) -> a)
-> NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto) -> a
forall a b. (a -> b) -> a -> b
$ (forall a.
 (:.:) Maybe LedgerState a
 -> (:.:) Maybe LedgerState a
 -> I a
 -> (:.:) Maybe WithLedgerState a)
-> Prod NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
-> Prod NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
-> NS I (CardanoEras StandardCrypto)
-> NS (Maybe :.: WithLedgerState) (CardanoEras StandardCrypto)
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *) (f''' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a -> f''' a)
-> Prod h f xs -> Prod h f' xs -> h f'' xs -> h f''' xs
hzipWith3 (:.:) Maybe LedgerState a
-> (:.:) Maybe LedgerState a
-> I a
-> (:.:) Maybe WithLedgerState a
forall a.
(:.:) Maybe LedgerState a
-> (:.:) Maybe LedgerState a
-> I a
-> (:.:) Maybe WithLedgerState a
zipLS (LedgerState (CardanoBlock StandardCrypto)
-> NP (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
goLS LedgerState (CardanoBlock StandardCrypto)
sb) (LedgerState (CardanoBlock StandardCrypto)
-> NP (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
goLS LedgerState (CardanoBlock StandardCrypto)
sa) NS I (CardanoEras StandardCrypto)
oeb
  where
    p :: Proxy HasAnalysis
    p :: Proxy HasAnalysis
p = Proxy HasAnalysis
forall {k} (t :: k). Proxy t
Proxy

    zipLS :: (:.:) Maybe LedgerState p
-> (:.:) Maybe LedgerState p
-> I p
-> (:.:) Maybe WithLedgerState p
zipLS (Comp (Just LedgerState p
sb')) (Comp (Just LedgerState p
sa')) (I p
blk) =
      Maybe (WithLedgerState p) -> (:.:) Maybe WithLedgerState p
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Maybe (WithLedgerState p) -> (:.:) Maybe WithLedgerState p)
-> (WithLedgerState p -> Maybe (WithLedgerState p))
-> WithLedgerState p
-> (:.:) Maybe WithLedgerState p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithLedgerState p -> Maybe (WithLedgerState p)
forall a. a -> Maybe a
Just (WithLedgerState p -> (:.:) Maybe WithLedgerState p)
-> WithLedgerState p -> (:.:) Maybe WithLedgerState p
forall a b. (a -> b) -> a -> b
$ p -> LedgerState p -> LedgerState p -> WithLedgerState p
forall blk.
blk -> LedgerState blk -> LedgerState blk -> WithLedgerState blk
WithLedgerState p
blk LedgerState p
sb' LedgerState p
sa'
    zipLS (:.:) Maybe LedgerState p
_ (:.:) Maybe LedgerState p
_ I p
_ = Maybe (WithLedgerState p) -> (:.:) Maybe WithLedgerState p
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp Maybe (WithLedgerState p)
forall a. Maybe a
Nothing

    oeb :: NS I (CardanoEras StandardCrypto)
oeb = OneEraBlock (CardanoEras StandardCrypto)
-> NS I (CardanoEras StandardCrypto)
forall (xs :: [*]). OneEraBlock xs -> NS I xs
getOneEraBlock (OneEraBlock (CardanoEras StandardCrypto)
 -> NS I (CardanoEras StandardCrypto))
-> (CardanoBlock StandardCrypto
    -> OneEraBlock (CardanoEras StandardCrypto))
-> CardanoBlock StandardCrypto
-> NS I (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoBlock StandardCrypto
-> OneEraBlock (CardanoEras StandardCrypto)
forall (xs :: [*]). HardForkBlock xs -> OneEraBlock xs
getHardForkBlock (CardanoBlock StandardCrypto -> NS I (CardanoEras StandardCrypto))
-> CardanoBlock StandardCrypto -> NS I (CardanoEras StandardCrypto)
forall a b. (a -> b) -> a -> b
$ CardanoBlock StandardCrypto
cb

    goLS ::
      LedgerState (CardanoBlock StandardCrypto) ->
      NP (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
    goLS :: LedgerState (CardanoBlock StandardCrypto)
-> NP (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
goLS =
      (forall x. (:.:) Maybe LedgerState x)
-> NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
-> Prod NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
forall (xs :: [*]) (f :: * -> *).
SListIN (Prod NS) xs =>
(forall x. f x) -> NS f xs -> Prod NS f xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HExpand h, SListIN (Prod h) xs) =>
(forall (x :: k). f x) -> h f xs -> Prod h f xs
hexpand (Maybe (LedgerState x) -> (:.:) Maybe LedgerState x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp Maybe (LedgerState x)
forall a. Maybe a
Nothing)
        (NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
 -> NP (Maybe :.: LedgerState) (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto)
    -> NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto)
-> NP (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Current LedgerState a -> (:.:) Maybe LedgerState a)
-> NS (Current LedgerState) (CardanoEras StandardCrypto)
-> NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
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 (Maybe (LedgerState a) -> (:.:) Maybe LedgerState a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Maybe (LedgerState a) -> (:.:) Maybe LedgerState a)
-> (Current LedgerState a -> Maybe (LedgerState a))
-> Current LedgerState a
-> (:.:) Maybe LedgerState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState a -> Maybe (LedgerState a)
forall a. a -> Maybe a
Just (LedgerState a -> Maybe (LedgerState a))
-> (Current LedgerState a -> LedgerState a)
-> Current LedgerState a
-> Maybe (LedgerState a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current LedgerState a -> LedgerState a
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (NS (Current LedgerState) (CardanoEras StandardCrypto)
 -> NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto)
    -> NS (Current LedgerState) (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto)
-> NS (Maybe :.: LedgerState) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope
  (K Past) (Current LedgerState) (CardanoEras StandardCrypto)
-> NS (Current LedgerState) (CardanoEras StandardCrypto)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip
        (Telescope
   (K Past) (Current LedgerState) (CardanoEras StandardCrypto)
 -> NS (Current LedgerState) (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto)
    -> Telescope
         (K Past) (Current LedgerState) (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto)
-> NS (Current LedgerState) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState LedgerState (CardanoEras StandardCrypto)
-> Telescope
     (K Past) (Current LedgerState) (CardanoEras StandardCrypto)
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState
        (HardForkState LedgerState (CardanoEras StandardCrypto)
 -> Telescope
      (K Past) (Current LedgerState) (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto)
    -> HardForkState LedgerState (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto)
-> Telescope
     (K Past) (Current LedgerState) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (CardanoBlock StandardCrypto)
-> HardForkState LedgerState (CardanoEras StandardCrypto)
forall (xs :: [*]).
LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
hardForkLedgerStatePerEra

instance HasProtocolInfo (CardanoBlock StandardCrypto) where
  data Args (CardanoBlock StandardCrypto) = CardanoBlockArgs {
          Args (CardanoBlock StandardCrypto) -> FilePath
configFile           :: FilePath
        , Args (CardanoBlock StandardCrypto) -> Maybe PBftSignatureThreshold
threshold            :: Maybe PBftSignatureThreshold
        }

  mkProtocolInfo :: Args (CardanoBlock StandardCrypto)
-> IO (ProtocolInfo (CardanoBlock StandardCrypto))
mkProtocolInfo CardanoBlockArgs{FilePath
configFile :: Args (CardanoBlock StandardCrypto) -> FilePath
configFile :: FilePath
configFile, Maybe PBftSignatureThreshold
threshold :: Args (CardanoBlock StandardCrypto) -> Maybe PBftSignatureThreshold
threshold :: Maybe PBftSignatureThreshold
threshold} = do
    FilePath -> FilePath
relativeToConfig :: (FilePath -> FilePath) <-
        FilePath -> FilePath -> FilePath
(</>) (FilePath -> FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDirectory (FilePath -> FilePath -> FilePath)
-> IO FilePath -> IO (FilePath -> FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
makeAbsolute FilePath
configFile

    CardanoConfig
cc :: CardanoConfig <-
      (FilePath -> IO CardanoConfig)
-> (CardanoConfig -> IO CardanoConfig)
-> Either FilePath CardanoConfig
-> IO CardanoConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO CardanoConfig
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO CardanoConfig)
-> (FilePath -> FilePath) -> FilePath -> IO CardanoConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) (CardanoConfig -> IO CardanoConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CardanoConfig -> IO CardanoConfig)
-> (CardanoConfig -> CardanoConfig)
-> CardanoConfig
-> IO CardanoConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> CardanoConfig -> CardanoConfig
forall a. AdjustFilePaths a => (FilePath -> FilePath) -> a -> a
adjustFilePaths FilePath -> FilePath
relativeToConfig) (Either FilePath CardanoConfig -> IO CardanoConfig)
-> IO (Either FilePath CardanoConfig) -> IO CardanoConfig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        FilePath -> IO (Either FilePath CardanoConfig)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict' FilePath
configFile

    Config
genesisByron   <-
      FilePath -> Maybe (Hash Raw) -> RequiresNetworkMagic -> IO Config
BlockByron.openGenesisByron (CardanoConfig -> FilePath
byronGenesisPath CardanoConfig
cc) (CardanoConfig -> Maybe (Hash Raw)
byronGenesisHash CardanoConfig
cc) (CardanoConfig -> RequiresNetworkMagic
requiresNetworkMagic CardanoConfig
cc)
    ShelleyGenesis StandardCrypto
genesisShelley <- (FilePath -> IO (ShelleyGenesis StandardCrypto))
-> (ShelleyGenesis StandardCrypto
    -> IO (ShelleyGenesis StandardCrypto))
-> Either FilePath (ShelleyGenesis StandardCrypto)
-> IO (ShelleyGenesis StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO (ShelleyGenesis StandardCrypto)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (ShelleyGenesis StandardCrypto))
-> (FilePath -> FilePath)
-> FilePath
-> IO (ShelleyGenesis StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) ShelleyGenesis StandardCrypto -> IO (ShelleyGenesis StandardCrypto)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (ShelleyGenesis StandardCrypto)
 -> IO (ShelleyGenesis StandardCrypto))
-> IO (Either FilePath (ShelleyGenesis StandardCrypto))
-> IO (ShelleyGenesis StandardCrypto)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      FilePath -> IO (Either FilePath (ShelleyGenesis StandardCrypto))
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict' (CardanoConfig -> FilePath
shelleyGenesisPath CardanoConfig
cc)
    AlonzoGenesis
genesisAlonzo  <- (FilePath -> IO AlonzoGenesis)
-> (AlonzoGenesis -> IO AlonzoGenesis)
-> Either FilePath AlonzoGenesis
-> IO AlonzoGenesis
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO AlonzoGenesis
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO AlonzoGenesis)
-> (FilePath -> FilePath) -> FilePath -> IO AlonzoGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) AlonzoGenesis -> IO AlonzoGenesis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath AlonzoGenesis -> IO AlonzoGenesis)
-> IO (Either FilePath AlonzoGenesis) -> IO AlonzoGenesis
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      FilePath -> IO (Either FilePath AlonzoGenesis)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict' (CardanoConfig -> FilePath
alonzoGenesisPath CardanoConfig
cc)
    ConwayGenesis StandardCrypto
genesisConway  <- (FilePath -> IO (ConwayGenesis StandardCrypto))
-> (ConwayGenesis StandardCrypto
    -> IO (ConwayGenesis StandardCrypto))
-> Either FilePath (ConwayGenesis StandardCrypto)
-> IO (ConwayGenesis StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO (ConwayGenesis StandardCrypto)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (ConwayGenesis StandardCrypto))
-> (FilePath -> FilePath)
-> FilePath
-> IO (ConwayGenesis StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) ConwayGenesis StandardCrypto -> IO (ConwayGenesis StandardCrypto)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (ConwayGenesis StandardCrypto)
 -> IO (ConwayGenesis StandardCrypto))
-> IO (Either FilePath (ConwayGenesis StandardCrypto))
-> IO (ConwayGenesis StandardCrypto)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      FilePath -> IO (Either FilePath (ConwayGenesis StandardCrypto))
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict' (CardanoConfig -> FilePath
conwayGenesisPath CardanoConfig
cc)

    let transCfg :: TransitionConfig (LatestKnownEra StandardCrypto)
transCfg =
          ShelleyGenesis StandardCrypto
-> AlonzoGenesis
-> ConwayGenesis StandardCrypto
-> TransitionConfig (LatestKnownEra StandardCrypto)
forall c.
Crypto c =>
ShelleyGenesis c
-> AlonzoGenesis
-> ConwayGenesis c
-> TransitionConfig (LatestKnownEra c)
SL.mkLatestTransitionConfig ShelleyGenesis StandardCrypto
genesisShelley AlonzoGenesis
genesisAlonzo ConwayGenesis StandardCrypto
genesisConway

    Nonce
initialNonce <- case CardanoConfig -> Maybe Nonce
shelleyGenesisHash CardanoConfig
cc of
      Just Nonce
h  -> Nonce -> IO Nonce
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nonce
h
      Maybe Nonce
Nothing -> do
        ByteString
content <- FilePath -> IO ByteString
BS.readFile (CardanoConfig -> FilePath
shelleyGenesisPath CardanoConfig
cc)
        pure
          $ Hash Blake2b_256 Nonce -> Nonce
Nonce
          (Hash Blake2b_256 Nonce -> Nonce)
-> Hash Blake2b_256 Nonce -> Nonce
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
CryptoClass.castHash
          (Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce)
-> Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
CryptoClass.hashWith ByteString -> ByteString
forall a. a -> a
id
          (ByteString -> Hash Blake2b_256 ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
content

    return
      $ Config
-> Maybe PBftSignatureThreshold
-> TransitionConfig (LatestKnownEra StandardCrypto)
-> Nonce
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock StandardCrypto)
mkCardanoProtocolInfo
          Config
genesisByron
          Maybe PBftSignatureThreshold
threshold
          TransitionConfig (LatestKnownEra StandardCrypto)
transCfg
          Nonce
initialNonce
          (CardanoConfig -> CardanoHardForkTriggers
cfgHardForkTriggers CardanoConfig
cc)

data CardanoConfig = CardanoConfig {
    -- | @RequiresNetworkMagic@ field
    CardanoConfig -> RequiresNetworkMagic
requiresNetworkMagic :: RequiresNetworkMagic

     -- | @ByronGenesisFile@ field
  , CardanoConfig -> FilePath
byronGenesisPath     :: FilePath
    -- | @ByronGenesisHash@ field
  , CardanoConfig -> Maybe (Hash Raw)
byronGenesisHash     :: Maybe (Crypto.Hash Raw)

    -- | @ShelleyGenesisFile@ field
    -- | @ShelleyGenesisHash@ field
  , CardanoConfig -> FilePath
shelleyGenesisPath   :: FilePath
  , CardanoConfig -> Maybe Nonce
shelleyGenesisHash   :: Maybe Nonce

    -- | @AlonzoGenesisFile@ field
  , CardanoConfig -> FilePath
alonzoGenesisPath    :: FilePath

    -- | @ConwayGenesisFile@ field
  , CardanoConfig -> FilePath
conwayGenesisPath    :: FilePath

    -- | @Test*HardForkAtEpoch@ for each Shelley era
  , CardanoConfig -> CardanoHardForkTriggers
cfgHardForkTriggers  :: CardanoHardForkTriggers
  }

instance AdjustFilePaths CardanoConfig where
    adjustFilePaths :: (FilePath -> FilePath) -> CardanoConfig -> CardanoConfig
adjustFilePaths FilePath -> FilePath
f CardanoConfig
cc =
        CardanoConfig
cc {
            byronGenesisPath    = f $ byronGenesisPath cc
          , shelleyGenesisPath  = f $ shelleyGenesisPath cc
          , alonzoGenesisPath   = f $ alonzoGenesisPath cc
          , conwayGenesisPath   = f $ conwayGenesisPath cc
          -- Byron, Shelley, Alonzo, and Conway are the only eras that have genesis
          -- data. The actual genesis block is a Byron block, therefore we needed a
          -- genesis file. To transition to Shelley, we needed to add some additional
          -- genesis data (eg some initial values of new protocol parametrers like
          -- @d@). Similarly in Alonzo (eg Plutus interpreter parameters/limits) and
          -- in Conway too (ie keys of the new genesis delegates).
          --
          -- In contrast, the Allegra, Mary, and Babbage eras did not introduce any new
          -- genesis data.
          }

instance Aeson.FromJSON CardanoConfig where
  parseJSON :: Value -> Parser CardanoConfig
parseJSON = FilePath
-> (Object -> Parser CardanoConfig)
-> Value
-> Parser CardanoConfig
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject FilePath
"CardanoConfigFile" ((Object -> Parser CardanoConfig) -> Value -> Parser CardanoConfig)
-> (Object -> Parser CardanoConfig)
-> Value
-> Parser CardanoConfig
forall a b. (a -> b) -> a -> b
$ \Object
v -> do

    RequiresNetworkMagic
requiresNetworkMagic <- Object
v Object -> Key -> Parser RequiresNetworkMagic
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"RequiresNetworkMagic"

    FilePath
byronGenesisPath <- Object
v Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..:  Key
"ByronGenesisFile"
    Maybe (Hash Raw)
byronGenesisHash <- Object
v Object -> Key -> Parser (Maybe (Hash Raw))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
"ByronGenesisHash"

    FilePath
shelleyGenesisPath <- Object
v Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"ShelleyGenesisFile"
    Maybe Nonce
shelleyGenesisHash <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
"ShelleyGenesisHash" Parser (Maybe Text)
-> (Maybe Text -> Parser (Maybe Nonce)) -> Parser (Maybe Nonce)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Text
Nothing -> Maybe Nonce -> Parser (Maybe Nonce)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Nonce
forall a. Maybe a
Nothing
      Just Text
hex -> case Text -> Maybe (Hash Blake2b_256 Nonce)
forall h a. HashAlgorithm h => Text -> Maybe (Hash h a)
CryptoClass.hashFromTextAsHex Text
hex of
        Maybe (Hash Blake2b_256 Nonce)
Nothing -> FilePath -> Parser (Maybe Nonce)
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"could not parse ShelleyGenesisHash as a hex string"
        Just Hash Blake2b_256 Nonce
h  -> Maybe Nonce -> Parser (Maybe Nonce)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Nonce -> Parser (Maybe Nonce))
-> Maybe Nonce -> Parser (Maybe Nonce)
forall a b. (a -> b) -> a -> b
$ Nonce -> Maybe Nonce
forall a. a -> Maybe a
Just (Nonce -> Maybe Nonce) -> Nonce -> Maybe Nonce
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 Nonce -> Nonce
Nonce Hash Blake2b_256 Nonce
h

    FilePath
alonzoGenesisPath <- Object
v Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"AlonzoGenesisFile"

    FilePath
conwayGenesisPath <- Object
v Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"ConwayGenesisFile"

    NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
triggers <- do
      let parseTrigger ::
               forall blk era. (IsShelleyBlock blk, ShelleyBlockLedgerEra blk ~ era)
            => (Aeson.Parser :.: CardanoHardForkTrigger) blk
          parseTrigger :: forall blk era.
(IsShelleyBlock blk, ShelleyBlockLedgerEra blk ~ era) =>
(:.:) Parser CardanoHardForkTrigger blk
parseTrigger = Parser (CardanoHardForkTrigger blk)
-> (:.:) Parser CardanoHardForkTrigger blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Parser (CardanoHardForkTrigger blk)
 -> (:.:) Parser CardanoHardForkTrigger blk)
-> Parser (CardanoHardForkTrigger blk)
-> (:.:) Parser CardanoHardForkTrigger blk
forall a b. (a -> b) -> a -> b
$
                        ((EpochNo -> CardanoHardForkTrigger blk)
-> Maybe EpochNo -> Maybe (CardanoHardForkTrigger blk)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpochNo -> CardanoHardForkTrigger blk
forall blk. EpochNo -> CardanoHardForkTrigger blk
CardanoTriggerHardForkAtEpoch (Maybe EpochNo -> Maybe (CardanoHardForkTrigger blk))
-> Parser (Maybe EpochNo)
-> Parser (Maybe (CardanoHardForkTrigger blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
nm))
              Parser (Maybe (CardanoHardForkTrigger blk))
-> CardanoHardForkTrigger blk
-> Parser (CardanoHardForkTrigger blk)
forall a. Parser (Maybe a) -> a -> Parser a
Aeson..!= CardanoHardForkTrigger blk
forall blk. CardanoHardForkTrigger blk
CardanoTriggerHardForkAtDefaultVersion
            where
              nm :: Key
nm = FilePath -> Key
forall a. IsString a => FilePath -> a
fromString (FilePath -> Key) -> FilePath -> Key
forall a b. (a -> b) -> a -> b
$ FilePath
"Test" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> forall era. Era era => FilePath
L.eraName @era FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"HardForkAtEpoch"

      NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
triggers <- NP
  (Parser :.: CardanoHardForkTrigger)
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
          ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
          ShelleyBlock
            (Praos StandardCrypto) (LatestKnownEra StandardCrypto)])
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NP xs, Applicative f) =>
NP (f :.: g) xs -> f (NP g xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' (NP
   (Parser :.: CardanoHardForkTrigger)
   '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
     ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
     ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
     ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
     ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
     ShelleyBlock
       (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
 -> Parser
      (NP
         CardanoHardForkTrigger
         '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
           ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
           ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
           ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
           ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
           ShelleyBlock
             (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]))
-> NP
     (Parser :.: CardanoHardForkTrigger)
     '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
          ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
          ShelleyBlock
            (Praos StandardCrypto) (LatestKnownEra StandardCrypto)])
forall a b. (a -> b) -> a -> b
$ Proxy IsShelleyBlock
-> (forall a.
    IsShelleyBlock a =>
    (:.:) Parser CardanoHardForkTrigger a)
-> NP
     (Parser :.: CardanoHardForkTrigger)
     '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @IsShelleyBlock) (:.:) Parser CardanoHardForkTrigger a
forall a. IsShelleyBlock a => (:.:) Parser CardanoHardForkTrigger a
forall blk era.
(IsShelleyBlock blk, ShelleyBlockLedgerEra blk ~ era) =>
(:.:) Parser CardanoHardForkTrigger blk
parseTrigger

      let isBad :: NP CardanoHardForkTrigger xs -> Bool
          isBad :: forall (xs :: [*]). NP CardanoHardForkTrigger xs -> Bool
isBad = \case
            CardanoHardForkTrigger x
CardanoTriggerHardForkAtDefaultVersion
              :* CardanoTriggerHardForkAtEpoch{} :* NP CardanoHardForkTrigger xs1
_ -> Bool
True
            CardanoHardForkTrigger x
_ :* NP CardanoHardForkTrigger xs1
np -> NP CardanoHardForkTrigger xs1 -> Bool
forall (xs :: [*]). NP CardanoHardForkTrigger xs -> Bool
isBad NP CardanoHardForkTrigger xs1
np
            NP CardanoHardForkTrigger xs
Nil       -> Bool
False
      (()
 -> NP
      CardanoHardForkTrigger
      '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
        ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
        ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
        ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
        ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
        ShelleyBlock
          (Praos StandardCrypto) (LatestKnownEra StandardCrypto)])
-> Parser ()
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
          ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
          ShelleyBlock
            (Praos StandardCrypto) (LatestKnownEra StandardCrypto)])
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\() -> NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
triggers) (Parser ()
 -> Parser
      (NP
         CardanoHardForkTrigger
         '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
           ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
           ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
           ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
           ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
           ShelleyBlock
             (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]))
-> Parser ()
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
          ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
          ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
          ShelleyBlock
            (Praos StandardCrypto) (LatestKnownEra StandardCrypto)])
forall a b. (a -> b) -> a -> b
$ Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> Bool
isBad NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
triggers) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Parser ()
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser ()) -> FilePath -> Parser ()
forall a b. (a -> b) -> a -> b
$
           FilePath
"if the Cardano config file sets a Test*HardForkEpoch,"
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" it must also set it for all previous eras."

    pure $
      CardanoConfig
        { requiresNetworkMagic :: RequiresNetworkMagic
requiresNetworkMagic = RequiresNetworkMagic
requiresNetworkMagic
        , byronGenesisPath :: FilePath
byronGenesisPath = FilePath
byronGenesisPath
        , byronGenesisHash :: Maybe (Hash Raw)
byronGenesisHash = Maybe (Hash Raw)
byronGenesisHash
        , shelleyGenesisPath :: FilePath
shelleyGenesisPath = FilePath
shelleyGenesisPath
        , shelleyGenesisHash :: Maybe Nonce
shelleyGenesisHash = Maybe Nonce
shelleyGenesisHash
        , alonzoGenesisPath :: FilePath
alonzoGenesisPath = FilePath
alonzoGenesisPath
        , conwayGenesisPath :: FilePath
conwayGenesisPath = FilePath
conwayGenesisPath
        , cfgHardForkTriggers :: CardanoHardForkTriggers
cfgHardForkTriggers = NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> CardanoHardForkTriggers
CardanoHardForkTriggers NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
    ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
    ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
    ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
triggers
        }

instance (HasAnnTip (CardanoBlock StandardCrypto), GetPrevHash (CardanoBlock StandardCrypto)) => HasAnalysis (CardanoBlock StandardCrypto) where
  countTxOutputs :: CardanoBlock StandardCrypto -> Int
countTxOutputs = (forall blk. HasAnalysis blk => blk -> Int)
-> CardanoBlock StandardCrypto -> Int
forall a.
(forall blk. HasAnalysis blk => blk -> a)
-> CardanoBlock StandardCrypto -> a
analyseBlock blk -> Int
forall blk. HasAnalysis blk => blk -> Int
countTxOutputs
  blockTxSizes :: CardanoBlock StandardCrypto -> [SizeInBytes]
blockTxSizes   = (forall blk. HasAnalysis blk => blk -> [SizeInBytes])
-> CardanoBlock StandardCrypto -> [SizeInBytes]
forall a.
(forall blk. HasAnalysis blk => blk -> a)
-> CardanoBlock StandardCrypto -> a
analyseBlock blk -> [SizeInBytes]
forall blk. HasAnalysis blk => blk -> [SizeInBytes]
blockTxSizes
  knownEBBs :: forall (proxy :: * -> *).
proxy (CardanoBlock StandardCrypto)
-> Map
     (HeaderHash (CardanoBlock StandardCrypto))
     (ChainHash (CardanoBlock StandardCrypto))
knownEBBs proxy (CardanoBlock StandardCrypto)
_    =
      (ByronHash -> OneEraHash (CardanoEras StandardCrypto))
-> Map ByronHash (ChainHash (CardanoBlock StandardCrypto))
-> Map
     (OneEraHash (CardanoEras StandardCrypto))
     (ChainHash (CardanoBlock StandardCrypto))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys HeaderHash ByronBlock -> HeaderHash (CardanoBlock StandardCrypto)
ByronHash -> OneEraHash (CardanoEras StandardCrypto)
castHeaderHash (Map ByronHash (ChainHash (CardanoBlock StandardCrypto))
 -> Map
      (HeaderHash (CardanoBlock StandardCrypto))
      (ChainHash (CardanoBlock StandardCrypto)))
-> (Map ByronHash (ChainHash ByronBlock)
    -> Map ByronHash (ChainHash (CardanoBlock StandardCrypto)))
-> Map ByronHash (ChainHash ByronBlock)
-> Map
     (HeaderHash (CardanoBlock StandardCrypto))
     (ChainHash (CardanoBlock StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainHash ByronBlock -> ChainHash (CardanoBlock StandardCrypto))
-> Map ByronHash (ChainHash ByronBlock)
-> Map ByronHash (ChainHash (CardanoBlock StandardCrypto))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ChainHash ByronBlock -> ChainHash (CardanoBlock StandardCrypto)
castChainHash (Map ByronHash (ChainHash ByronBlock)
 -> Map
      (HeaderHash (CardanoBlock StandardCrypto))
      (ChainHash (CardanoBlock StandardCrypto)))
-> Map ByronHash (ChainHash ByronBlock)
-> Map
     (HeaderHash (CardanoBlock StandardCrypto))
     (ChainHash (CardanoBlock StandardCrypto))
forall a b. (a -> b) -> a -> b
$
        Proxy ByronBlock
-> Map (HeaderHash ByronBlock) (ChainHash ByronBlock)
forall blk (proxy :: * -> *).
HasAnalysis blk =>
proxy blk -> Map (HeaderHash blk) (ChainHash blk)
forall (proxy :: * -> *).
proxy ByronBlock
-> Map (HeaderHash ByronBlock) (ChainHash ByronBlock)
knownEBBs (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)

  emitTraces :: WithLedgerState (CardanoBlock StandardCrypto) -> [FilePath]
emitTraces = (forall blk. HasAnalysis blk => WithLedgerState blk -> [FilePath])
-> WithLedgerState (CardanoBlock StandardCrypto) -> [FilePath]
forall a.
(forall blk. HasAnalysis blk => WithLedgerState blk -> a)
-> WithLedgerState (CardanoBlock StandardCrypto) -> a
analyseWithLedgerState WithLedgerState blk -> [FilePath]
forall blk. HasAnalysis blk => WithLedgerState blk -> [FilePath]
emitTraces

  blockStats :: CardanoBlock StandardCrypto -> [Builder]
blockStats = (forall blk. HasAnalysis blk => blk -> [Builder])
-> CardanoBlock StandardCrypto -> [Builder]
forall a.
(forall blk. HasAnalysis blk => blk -> a)
-> CardanoBlock StandardCrypto -> a
analyseBlock blk -> [Builder]
forall blk. HasAnalysis blk => blk -> [Builder]
blockStats

  blockApplicationMetrics :: [(Builder,
  WithLedgerState (CardanoBlock StandardCrypto) -> IO Builder)]
blockApplicationMetrics =
      [ (Builder
"Slot Number", \(WithLedgerState CardanoBlock StandardCrypto
blk LedgerState (CardanoBlock StandardCrypto)
_preSt LedgerState (CardanoBlock StandardCrypto)
_postSt) ->
            Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$ Word64 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal (Word64 -> Builder) -> Word64 -> Builder
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ CardanoBlock StandardCrypto -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot CardanoBlock StandardCrypto
blk
        )
      , (Builder
"Block Number", \(WithLedgerState CardanoBlock StandardCrypto
blk LedgerState (CardanoBlock StandardCrypto)
_preSt LedgerState (CardanoBlock StandardCrypto)
_postSt) ->
            Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$ Word64 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal (Word64 -> Builder) -> Word64 -> Builder
forall a b. (a -> b) -> a -> b
$ BlockNo -> Word64
unBlockNo (BlockNo -> Word64) -> BlockNo -> Word64
forall a b. (a -> b) -> a -> b
$ CardanoBlock StandardCrypto -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo CardanoBlock StandardCrypto
blk
        )
      , (Builder
"UTxO size (via Compact)", \(WithLedgerState CardanoBlock StandardCrypto
_blk LedgerState (CardanoBlock StandardCrypto)
_preSt LedgerState (CardanoBlock StandardCrypto)
postSt) -> do
            let compactSize :: a -> IO Builder
compactSize a
utxo = do
                    Compact a
compactedUtxo     <- a -> IO (Compact a)
forall a. a -> IO (Compact a)
Compact.compact a
utxo
                    Word
compactedUtxoSize <- Compact a -> IO Word
forall a. Compact a -> IO Word
Compact.compactSize Compact a
compactedUtxo
                    pure $ Word -> Builder
forall a. Integral a => a -> Builder
Builder.decimal (Word -> Builder) -> Word -> Builder
forall a b. (a -> b) -> a -> b
$ Word
compactedUtxoSize

            LedgerState (CardanoBlock StandardCrypto)
-> (LedgerState ByronBlock -> IO Builder)
-> (forall proto era.
    LedgerState (ShelleyBlock proto era) -> IO Builder)
-> IO Builder
dispatch LedgerState (CardanoBlock StandardCrypto)
postSt
                     ((Map CompactTxIn CompactTxOut -> IO Builder)
-> LedgerState ByronBlock -> IO Builder
applyToByronUtxo        Map CompactTxIn CompactTxOut -> IO Builder
forall {a}. a -> IO Builder
compactSize)
                     ((Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder)
-> LedgerState (ShelleyBlock proto era) -> IO Builder
forall era proto.
(Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder)
-> LedgerState (ShelleyBlock proto era) -> IO Builder
applyToShelleyBasedUtxo Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder
forall {a}. a -> IO Builder
compactSize)
        )
      , (Builder
"UTxO map size",  \(WithLedgerState CardanoBlock StandardCrypto
_blk LedgerState (CardanoBlock StandardCrypto)
_preSt LedgerState (CardanoBlock StandardCrypto)
postSt) -> do
            let mapSize :: Map k a -> IO Builder
mapSize = Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> IO Builder)
-> (Map k a -> Builder) -> Map k a -> IO Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. Integral a => a -> Builder
Builder.decimal (Int -> Builder) -> (Map k a -> Int) -> Map k a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Int
forall k a. Map k a -> Int
Map.size
            LedgerState (CardanoBlock StandardCrypto)
-> (LedgerState ByronBlock -> IO Builder)
-> (forall proto era.
    LedgerState (ShelleyBlock proto era) -> IO Builder)
-> IO Builder
dispatch LedgerState (CardanoBlock StandardCrypto)
postSt
                     ((Map CompactTxIn CompactTxOut -> IO Builder)
-> LedgerState ByronBlock -> IO Builder
applyToByronUtxo        Map CompactTxIn CompactTxOut -> IO Builder
forall {k} {a}. Map k a -> IO Builder
mapSize)
                     ((Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder)
-> LedgerState (ShelleyBlock proto era) -> IO Builder
forall era proto.
(Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder)
-> LedgerState (ShelleyBlock proto era) -> IO Builder
applyToShelleyBasedUtxo Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder
forall {k} {a}. Map k a -> IO Builder
mapSize)
        )
      ]

dispatch ::
     LedgerState (CardanoBlock StandardCrypto)
  -> (LedgerState ByronBlock -> IO Builder)
  -> (forall proto era. LedgerState (ShelleyBlock proto era) -> IO Builder)
  -> IO Builder
dispatch :: LedgerState (CardanoBlock StandardCrypto)
-> (LedgerState ByronBlock -> IO Builder)
-> (forall proto era.
    LedgerState (ShelleyBlock proto era) -> IO Builder)
-> IO Builder
dispatch LedgerState (CardanoBlock StandardCrypto)
cardanoSt LedgerState ByronBlock -> IO Builder
fByron forall proto era.
LedgerState (ShelleyBlock proto era) -> IO Builder
fShelley =
    HardForkState (K (IO Builder)) (CardanoEras StandardCrypto)
-> CollapseTo HardForkState (IO Builder)
forall (xs :: [*]) a.
SListIN HardForkState xs =>
HardForkState (K a) xs -> CollapseTo HardForkState a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (HardForkState (K (IO Builder)) (CardanoEras StandardCrypto)
 -> CollapseTo HardForkState (IO Builder))
-> HardForkState (K (IO Builder)) (CardanoEras StandardCrypto)
-> CollapseTo HardForkState (IO Builder)
forall a b. (a -> b) -> a -> b
$
        Prod
  HardForkState
  (LedgerState -.-> K (IO Builder))
  (CardanoEras StandardCrypto)
-> HardForkState LedgerState (CardanoEras StandardCrypto)
-> HardForkState (K (IO Builder)) (CardanoEras StandardCrypto)
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod HardForkState (f -.-> g) xs
-> HardForkState f xs -> HardForkState g xs
hap (   (LedgerState ByronBlock -> K (IO Builder) ByronBlock)
-> (-.->) LedgerState (K (IO Builder)) ByronBlock
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState ByronBlock -> K (IO Builder) ByronBlock
k_fByron
             (-.->) LedgerState (K (IO Builder)) ByronBlock
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> NP
     (LedgerState -.-> K (IO Builder)) (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (LedgerState
   (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
 -> K (IO Builder)
      (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto)))
-> (-.->)
     LedgerState
     (K (IO Builder))
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> K (IO Builder)
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall proto era.
LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
k_fShelley
             (-.->)
  LedgerState
  (K (IO Builder))
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (LedgerState
   (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
 -> K (IO Builder)
      (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto)))
-> (-.->)
     LedgerState
     (K (IO Builder))
     (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
-> K (IO Builder)
     (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
forall proto era.
LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
k_fShelley
             (-.->)
  LedgerState
  (K (IO Builder))
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (LedgerState
   (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
 -> K (IO Builder)
      (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto)))
-> (-.->)
     LedgerState
     (K (IO Builder))
     (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
-> K (IO Builder)
     (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
forall proto era.
LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
k_fShelley
             (-.->)
  LedgerState
  (K (IO Builder))
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto),
       ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (LedgerState
   (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
 -> K (IO Builder)
      (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto)))
-> (-.->)
     LedgerState
     (K (IO Builder))
     (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
-> K (IO Builder)
     (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
forall proto era.
LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
k_fShelley
             (-.->)
  LedgerState
  (K (IO Builder))
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto),
       ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (LedgerState
   (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
 -> K (IO Builder)
      (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto)))
-> (-.->)
     LedgerState
     (K (IO Builder))
     (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
-> K (IO Builder)
     (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
forall proto era.
LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
k_fShelley
             (-.->)
  LedgerState
  (K (IO Builder))
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto),
       ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (LedgerState
   (ShelleyBlock
      (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
 -> K (IO Builder)
      (ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)))
-> (-.->)
     LedgerState
     (K (IO Builder))
     (ShelleyBlock
        (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState
  (ShelleyBlock
     (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
-> K (IO Builder)
     (ShelleyBlock
        (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
forall proto era.
LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
k_fShelley
             (-.->)
  LedgerState
  (K (IO Builder))
  (ShelleyBlock
     (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
-> NP (LedgerState -.-> K (IO Builder)) '[]
-> NP
     (LedgerState -.-> K (IO Builder))
     '[ShelleyBlock
         (Praos StandardCrypto) (LatestKnownEra StandardCrypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (LedgerState -.-> K (IO Builder)) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
            )
            (LedgerState (CardanoBlock StandardCrypto)
-> HardForkState LedgerState (CardanoEras StandardCrypto)
forall (xs :: [*]).
LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
hardForkLedgerStatePerEra LedgerState (CardanoBlock StandardCrypto)
cardanoSt)
  where
    k_fByron :: LedgerState ByronBlock -> K (IO Builder) ByronBlock
k_fByron   = IO Builder -> K (IO Builder) ByronBlock
forall k a (b :: k). a -> K a b
K (IO Builder -> K (IO Builder) ByronBlock)
-> (LedgerState ByronBlock -> IO Builder)
-> LedgerState ByronBlock
-> K (IO Builder) ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock -> IO Builder
fByron

    k_fShelley ::
         forall proto era.
         LedgerState (ShelleyBlock proto era)
      -> K (IO Builder) (ShelleyBlock proto era)
    k_fShelley :: forall proto era.
LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
k_fShelley = IO Builder -> K (IO Builder) (ShelleyBlock proto era)
forall k a (b :: k). a -> K a b
K (IO Builder -> K (IO Builder) (ShelleyBlock proto era))
-> (LedgerState (ShelleyBlock proto era) -> IO Builder)
-> LedgerState (ShelleyBlock proto era)
-> K (IO Builder) (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) -> IO Builder
forall proto era.
LedgerState (ShelleyBlock proto era) -> IO Builder
fShelley

applyToByronUtxo ::
    (Map Byron.UTxO.CompactTxIn Byron.UTxO.CompactTxOut -> IO Builder)
  -> LedgerState ByronBlock
  -> IO Builder
applyToByronUtxo :: (Map CompactTxIn CompactTxOut -> IO Builder)
-> LedgerState ByronBlock -> IO Builder
applyToByronUtxo Map CompactTxIn CompactTxOut -> IO Builder
f LedgerState ByronBlock
st  =
   Map CompactTxIn CompactTxOut -> IO Builder
f (Map CompactTxIn CompactTxOut -> IO Builder)
-> Map CompactTxIn CompactTxOut -> IO Builder
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock -> Map CompactTxIn CompactTxOut
getByronUtxo LedgerState ByronBlock
st

getByronUtxo :: LedgerState ByronBlock
             -> Map Byron.UTxO.CompactTxIn Byron.UTxO.CompactTxOut
getByronUtxo :: LedgerState ByronBlock -> Map CompactTxIn CompactTxOut
getByronUtxo = UTxO -> Map CompactTxIn CompactTxOut
Byron.UTxO.unUTxO
             (UTxO -> Map CompactTxIn CompactTxOut)
-> (LedgerState ByronBlock -> UTxO)
-> LedgerState ByronBlock
-> Map CompactTxIn CompactTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainValidationState -> UTxO
Byron.Block.cvsUtxo
             (ChainValidationState -> UTxO)
-> (LedgerState ByronBlock -> ChainValidationState)
-> LedgerState ByronBlock
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock -> ChainValidationState
Byron.Ledger.byronLedgerState

applyToShelleyBasedUtxo ::
     (Map (TxIn (Cardano.Block.EraCrypto era)) (TxOut era) -> IO Builder)
  -> LedgerState (ShelleyBlock proto era)
  -> IO Builder
applyToShelleyBasedUtxo :: forall era proto.
(Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder)
-> LedgerState (ShelleyBlock proto era) -> IO Builder
applyToShelleyBasedUtxo Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder
f LedgerState (ShelleyBlock proto era)
st = do
    Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder
f (Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder)
-> Map (TxIn (EraCrypto era)) (TxOut era) -> IO Builder
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
-> Map (TxIn (EraCrypto era)) (TxOut era)
forall proto era.
LedgerState (ShelleyBlock proto era)
-> Map (TxIn (EraCrypto era)) (TxOut era)
getShelleyBasedUtxo LedgerState (ShelleyBlock proto era)
st

getShelleyBasedUtxo ::
     LedgerState (ShelleyBlock proto era)
  -> Map (TxIn (Cardano.Block.EraCrypto era)) (TxOut era)
getShelleyBasedUtxo :: forall proto era.
LedgerState (ShelleyBlock proto era)
-> Map (TxIn (EraCrypto era)) (TxOut era)
getShelleyBasedUtxo = (\(Shelley.UTxO.UTxO Map (TxIn (EraCrypto era)) (TxOut era)
xs)->  Map (TxIn (EraCrypto era)) (TxOut era)
xs)
                    (UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era))
-> (LedgerState (ShelleyBlock proto era) -> UTxO era)
-> LedgerState (ShelleyBlock proto era)
-> Map (TxIn (EraCrypto era)) (TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
Shelley.LedgerState.utxosUtxo
                    (UTxOState era -> UTxO era)
-> (LedgerState (ShelleyBlock proto era) -> UTxOState era)
-> LedgerState (ShelleyBlock proto era)
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
Shelley.LedgerState.lsUTxOState
                    (LedgerState era -> UTxOState era)
-> (LedgerState (ShelleyBlock proto era) -> LedgerState era)
-> LedgerState (ShelleyBlock proto era)
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
Shelley.LedgerState.esLState
                    (EpochState era -> LedgerState era)
-> (LedgerState (ShelleyBlock proto era) -> EpochState era)
-> LedgerState (ShelleyBlock proto era)
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
Shelley.LedgerState.nesEs
                    (NewEpochState era -> EpochState era)
-> (LedgerState (ShelleyBlock proto era) -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era)
-> EpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
Shelley.Ledger.shelleyLedgerState


type CardanoBlockArgs = Args (CardanoBlock StandardCrypto)

mkCardanoProtocolInfo ::
     Byron.Genesis.Config
  -> Maybe PBftSignatureThreshold
  -> SL.TransitionConfig (L.LatestKnownEra StandardCrypto)
  -> Nonce
  -> CardanoHardForkTriggers
  -> ProtocolInfo (CardanoBlock StandardCrypto)
mkCardanoProtocolInfo :: Config
-> Maybe PBftSignatureThreshold
-> TransitionConfig (LatestKnownEra StandardCrypto)
-> Nonce
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock StandardCrypto)
mkCardanoProtocolInfo Config
genesisByron Maybe PBftSignatureThreshold
signatureThreshold TransitionConfig (LatestKnownEra StandardCrypto)
transitionConfig Nonce
initialNonce CardanoHardForkTriggers
triggers =
    (ProtocolInfo (CardanoBlock StandardCrypto),
 IO [BlockForging IO (CardanoBlock StandardCrypto)])
-> ProtocolInfo (CardanoBlock StandardCrypto)
forall a b. (a, b) -> a
fst ((ProtocolInfo (CardanoBlock StandardCrypto),
  IO [BlockForging IO (CardanoBlock StandardCrypto)])
 -> ProtocolInfo (CardanoBlock StandardCrypto))
-> (ProtocolInfo (CardanoBlock StandardCrypto),
    IO [BlockForging IO (CardanoBlock StandardCrypto)])
-> ProtocolInfo (CardanoBlock StandardCrypto)
forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *).
(IOLike m, CardanoHardForkConstraints c) =>
CardanoProtocolParams c
-> (ProtocolInfo (CardanoBlock c),
    m [BlockForging m (CardanoBlock c)])
protocolInfoCardano @_ @IO
      (ProtocolParamsByron
-> ProtocolParamsShelleyBased StandardCrypto
-> CardanoHardForkTriggers
-> TransitionConfig (LatestKnownEra StandardCrypto)
-> CheckpointsMap (CardanoBlock StandardCrypto)
-> ProtVer
-> CardanoProtocolParams StandardCrypto
forall c.
ProtocolParamsByron
-> ProtocolParamsShelleyBased c
-> CardanoHardForkTriggers
-> TransitionConfig (LatestKnownEra c)
-> CheckpointsMap (CardanoBlock c)
-> ProtVer
-> CardanoProtocolParams c
CardanoProtocolParams
        ProtocolParamsByron {
            $sel:byronGenesis:ProtocolParamsByron :: Config
byronGenesis                = Config
genesisByron
          , $sel:byronPbftSignatureThreshold:ProtocolParamsByron :: Maybe PBftSignatureThreshold
byronPbftSignatureThreshold = Maybe PBftSignatureThreshold
signatureThreshold
          , $sel:byronProtocolVersion:ProtocolParamsByron :: ProtocolVersion
byronProtocolVersion        = Word16 -> Word16 -> Word8 -> ProtocolVersion
Byron.Update.ProtocolVersion Word16
1 Word16
2 Word8
0
          , $sel:byronSoftwareVersion:ProtocolParamsByron :: SoftwareVersion
byronSoftwareVersion        = ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Byron.Update.SoftwareVersion (Text -> ApplicationName
Byron.Update.ApplicationName Text
"db-analyser") NumSoftwareVersion
2
          , $sel:byronLeaderCredentials:ProtocolParamsByron :: Maybe ByronLeaderCredentials
byronLeaderCredentials      = Maybe ByronLeaderCredentials
forall a. Maybe a
Nothing
          }
        ProtocolParamsShelleyBased {
            shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce      = Nonce
initialNonce
          , shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials StandardCrypto]
shelleyBasedLeaderCredentials = []
          }
        CardanoHardForkTriggers
triggers
        TransitionConfig (LatestKnownEra StandardCrypto)
transitionConfig
        CheckpointsMap (CardanoBlock StandardCrypto)
forall blk. CheckpointsMap blk
emptyCheckpointsMap
        (Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
L.eraProtVerHigh @(L.LatestKnownEra StandardCrypto)) Natural
0)
      )
  where

castHeaderHash ::
     HeaderHash ByronBlock
  -> HeaderHash (CardanoBlock StandardCrypto)
castHeaderHash :: HeaderHash ByronBlock -> HeaderHash (CardanoBlock StandardCrypto)
castHeaderHash = ShortByteString -> OneEraHash (CardanoEras StandardCrypto)
forall k (xs :: [k]). ShortByteString -> OneEraHash xs
OneEraHash (ShortByteString -> OneEraHash (CardanoEras StandardCrypto))
-> (ByronHash -> ShortByteString)
-> ByronHash
-> OneEraHash (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy ByronBlock -> HeaderHash ByronBlock -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy ByronBlock -> HeaderHash ByronBlock -> ShortByteString
toShortRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)

castChainHash ::
     ChainHash ByronBlock
  -> ChainHash (CardanoBlock StandardCrypto)
castChainHash :: ChainHash ByronBlock -> ChainHash (CardanoBlock StandardCrypto)
castChainHash ChainHash ByronBlock
GenesisHash   = ChainHash (CardanoBlock StandardCrypto)
forall {k} (b :: k). ChainHash b
GenesisHash
castChainHash (BlockHash HeaderHash ByronBlock
h) = HeaderHash (CardanoBlock StandardCrypto)
-> ChainHash (CardanoBlock StandardCrypto)
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (HeaderHash (CardanoBlock StandardCrypto)
 -> ChainHash (CardanoBlock StandardCrypto))
-> HeaderHash (CardanoBlock StandardCrypto)
-> ChainHash (CardanoBlock StandardCrypto)
forall a b. (a -> b) -> a -> b
$ HeaderHash ByronBlock -> HeaderHash (CardanoBlock StandardCrypto)
castHeaderHash HeaderHash ByronBlock
h