{-# 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.UTxO as Byron.UTxO
import qualified Cardano.Chain.Update as Byron.Update
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 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 Cardano.Protocol.Crypto
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.Functors
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 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.Ledger.Abstract hiding (TxIn, TxOut)
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 TextBuilder (TextBuilder)
import qualified TextBuilder as 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) ValuesMK
sb LedgerState (CardanoBlock StandardCrypto) ValuesMK
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 (Flip LedgerState ValuesMK) a
 -> (:.:) Maybe (Flip LedgerState ValuesMK) a
 -> I a
 -> (:.:) Maybe WithLedgerState a)
-> Prod
     NS
     (Maybe :.: Flip LedgerState ValuesMK)
     (CardanoEras StandardCrypto)
-> Prod
     NS
     (Maybe :.: Flip LedgerState ValuesMK)
     (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 (Flip LedgerState ValuesMK) a
-> (:.:) Maybe (Flip LedgerState ValuesMK) a
-> I a
-> (:.:) Maybe WithLedgerState a
forall a.
(:.:) Maybe (Flip LedgerState ValuesMK) a
-> (:.:) Maybe (Flip LedgerState ValuesMK) a
-> I a
-> (:.:) Maybe WithLedgerState a
zipLS (LedgerState (CardanoBlock StandardCrypto) ValuesMK
-> NP
     (Maybe :.: Flip LedgerState ValuesMK) (CardanoEras StandardCrypto)
forall (mk :: MapKind).
LedgerState (CardanoBlock StandardCrypto) mk
-> NP (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
goLS LedgerState (CardanoBlock StandardCrypto) ValuesMK
sb) (LedgerState (CardanoBlock StandardCrypto) ValuesMK
-> NP
     (Maybe :.: Flip LedgerState ValuesMK) (CardanoEras StandardCrypto)
forall (mk :: MapKind).
LedgerState (CardanoBlock StandardCrypto) mk
-> NP (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
goLS LedgerState (CardanoBlock StandardCrypto) ValuesMK
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 (Flip LedgerState ValuesMK) p
-> (:.:) Maybe (Flip LedgerState ValuesMK) p
-> I p
-> (:.:) Maybe WithLedgerState p
zipLS (Comp (Just (Flip LedgerState p ValuesMK
sb'))) (Comp (Just (Flip LedgerState p ValuesMK
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 ValuesMK
-> LedgerState p ValuesMK
-> WithLedgerState p
forall blk.
blk
-> LedgerState blk ValuesMK
-> LedgerState blk ValuesMK
-> WithLedgerState blk
WithLedgerState p
blk LedgerState p ValuesMK
sb' LedgerState p ValuesMK
sa'
  zipLS (:.:) Maybe (Flip LedgerState ValuesMK) p
_ (:.:) Maybe (Flip LedgerState ValuesMK) 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) mk ->
    NP (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
  goLS :: forall (mk :: MapKind).
LedgerState (CardanoBlock StandardCrypto) mk
-> NP (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
goLS =
    (forall x. (:.:) Maybe (Flip LedgerState mk) x)
-> NS (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
-> Prod
     NS (Maybe :.: Flip LedgerState mk) (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 (Flip LedgerState mk x)
-> (:.:) Maybe (Flip LedgerState mk) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp Maybe (Flip LedgerState mk x)
forall a. Maybe a
Nothing)
      (NS (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
 -> NP (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto) mk
    -> NS (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto) mk
-> NP (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Current (Flip LedgerState mk) a
 -> (:.:) Maybe (Flip LedgerState mk) a)
-> NS (Current (Flip LedgerState mk)) (CardanoEras StandardCrypto)
-> NS (Maybe :.: Flip LedgerState mk) (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 (Flip LedgerState mk a)
-> (:.:) Maybe (Flip LedgerState mk) a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Maybe (Flip LedgerState mk a)
 -> (:.:) Maybe (Flip LedgerState mk) a)
-> (Current (Flip LedgerState mk) a
    -> Maybe (Flip LedgerState mk a))
-> Current (Flip LedgerState mk) a
-> (:.:) Maybe (Flip LedgerState mk) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState mk a -> Maybe (Flip LedgerState mk a)
forall a. a -> Maybe a
Just (Flip LedgerState mk a -> Maybe (Flip LedgerState mk a))
-> (Current (Flip LedgerState mk) a -> Flip LedgerState mk a)
-> Current (Flip LedgerState mk) a
-> Maybe (Flip LedgerState mk a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Flip LedgerState mk) a -> Flip LedgerState mk a
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
      (NS (Current (Flip LedgerState mk)) (CardanoEras StandardCrypto)
 -> NS (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto) mk
    -> NS (Current (Flip LedgerState mk)) (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto) mk
-> NS (Maybe :.: Flip LedgerState mk) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope
  (K Past)
  (Current (Flip LedgerState mk))
  (CardanoEras StandardCrypto)
-> NS (Current (Flip LedgerState mk)) (CardanoEras StandardCrypto)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip
      (Telescope
   (K Past)
   (Current (Flip LedgerState mk))
   (CardanoEras StandardCrypto)
 -> NS (Current (Flip LedgerState mk)) (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto) mk
    -> Telescope
         (K Past)
         (Current (Flip LedgerState mk))
         (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto) mk
-> NS (Current (Flip LedgerState mk)) (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState (Flip LedgerState mk) (CardanoEras StandardCrypto)
-> Telescope
     (K Past)
     (Current (Flip LedgerState mk))
     (CardanoEras StandardCrypto)
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState
      (HardForkState (Flip LedgerState mk) (CardanoEras StandardCrypto)
 -> Telescope
      (K Past)
      (Current (Flip LedgerState mk))
      (CardanoEras StandardCrypto))
-> (LedgerState (CardanoBlock StandardCrypto) mk
    -> HardForkState
         (Flip LedgerState mk) (CardanoEras StandardCrypto))
-> LedgerState (CardanoBlock StandardCrypto) mk
-> Telescope
     (K Past)
     (Current (Flip LedgerState mk))
     (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (CardanoBlock StandardCrypto) mk
-> HardForkState (Flip LedgerState mk) (CardanoEras StandardCrypto)
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) 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
genesisShelley <-
      (FilePath -> IO ShelleyGenesis)
-> (ShelleyGenesis -> IO ShelleyGenesis)
-> Either FilePath ShelleyGenesis
-> IO ShelleyGenesis
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO ShelleyGenesis
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ShelleyGenesis)
-> (FilePath -> FilePath) -> FilePath -> IO ShelleyGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) ShelleyGenesis -> IO ShelleyGenesis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Either FilePath ShelleyGenesis -> IO ShelleyGenesis)
-> IO (Either FilePath ShelleyGenesis) -> IO ShelleyGenesis
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO (Either FilePath ShelleyGenesis)
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
genesisConway <-
      (FilePath -> IO ConwayGenesis)
-> (ConwayGenesis -> IO ConwayGenesis)
-> Either FilePath ConwayGenesis
-> IO ConwayGenesis
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO ConwayGenesis
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ConwayGenesis)
-> (FilePath -> FilePath) -> FilePath -> IO ConwayGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) ConwayGenesis -> IO ConwayGenesis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Either FilePath ConwayGenesis -> IO ConwayGenesis)
-> IO (Either FilePath ConwayGenesis) -> IO ConwayGenesis
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO (Either FilePath ConwayGenesis)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict' (CardanoConfig -> FilePath
conwayGenesisPath CardanoConfig
cc)

    let transCfg :: TransitionConfig LatestKnownEra
transCfg =
          ShelleyGenesis
-> AlonzoGenesis
-> ConwayGenesis
-> TransitionConfig LatestKnownEra
SL.mkLatestTransitionConfig ShelleyGenesis
genesisShelley AlonzoGenesis
genesisAlonzo ConwayGenesis
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
-> Nonce
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock StandardCrypto)
mkCardanoProtocolInfo
        Config
genesisByron
        Maybe PBftSignatureThreshold
threshold
        TransitionConfig LatestKnownEra
transCfg
        Nonce
initialNonce
        (CardanoConfig -> CardanoHardForkTriggers
cfgHardForkTriggers CardanoConfig
cc)

data CardanoConfig = CardanoConfig
  { CardanoConfig -> RequiresNetworkMagic
requiresNetworkMagic :: RequiresNetworkMagic
  -- ^ @RequiresNetworkMagic@ field
  , CardanoConfig -> FilePath
byronGenesisPath :: FilePath
  -- ^ @ByronGenesisFile@ field
  , CardanoConfig -> Maybe (Hash Raw)
byronGenesisHash :: Maybe (Crypto.Hash Raw)
  -- ^ @ByronGenesisHash@ field
  , CardanoConfig -> FilePath
shelleyGenesisPath :: FilePath
  -- ^ @ShelleyGenesisFile@ field
  -- | @ShelleyGenesisHash@ field
  , CardanoConfig -> Maybe Nonce
shelleyGenesisHash :: Maybe Nonce
  , CardanoConfig -> FilePath
alonzoGenesisPath :: FilePath
  -- ^ @AlonzoGenesisFile@ field
  , CardanoConfig -> FilePath
conwayGenesisPath :: FilePath
  -- ^ @ConwayGenesisFile@ field
  , CardanoConfig -> CardanoHardForkTriggers
cfgHardForkTriggers :: CardanoHardForkTriggers
  -- ^ @Test*HardForkAtEpoch@ for each Shelley era
  }

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,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
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,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
triggers <- NP
  (Parser :.: CardanoHardForkTrigger)
  '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
          ShelleyBlock (TPraos StandardCrypto) AllegraEra,
          ShelleyBlock (TPraos StandardCrypto) MaryEra,
          ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
          ShelleyBlock (Praos StandardCrypto) BabbageEra,
          ShelleyBlock (Praos StandardCrypto) LatestKnownEra])
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,
     ShelleyBlock (TPraos StandardCrypto) AllegraEra,
     ShelleyBlock (TPraos StandardCrypto) MaryEra,
     ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
     ShelleyBlock (Praos StandardCrypto) BabbageEra,
     ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
 -> Parser
      (NP
         CardanoHardForkTrigger
         '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
           ShelleyBlock (TPraos StandardCrypto) AllegraEra,
           ShelleyBlock (TPraos StandardCrypto) MaryEra,
           ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
           ShelleyBlock (Praos StandardCrypto) BabbageEra,
           ShelleyBlock (Praos StandardCrypto) LatestKnownEra]))
-> NP
     (Parser :.: CardanoHardForkTrigger)
     '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
       ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
          ShelleyBlock (TPraos StandardCrypto) AllegraEra,
          ShelleyBlock (TPraos StandardCrypto) MaryEra,
          ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
          ShelleyBlock (Praos StandardCrypto) BabbageEra,
          ShelleyBlock (Praos StandardCrypto) LatestKnownEra])
forall a b. (a -> b) -> a -> b
$ Proxy IsShelleyBlock
-> (forall a.
    IsShelleyBlock a =>
    (:.:) Parser CardanoHardForkTrigger a)
-> NP
     (Parser :.: CardanoHardForkTrigger)
     '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
       ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
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,
        ShelleyBlock (TPraos StandardCrypto) AllegraEra,
        ShelleyBlock (TPraos StandardCrypto) MaryEra,
        ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
        ShelleyBlock (Praos StandardCrypto) BabbageEra,
        ShelleyBlock (Praos StandardCrypto) LatestKnownEra])
-> Parser ()
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
          ShelleyBlock (TPraos StandardCrypto) AllegraEra,
          ShelleyBlock (TPraos StandardCrypto) MaryEra,
          ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
          ShelleyBlock (Praos StandardCrypto) BabbageEra,
          ShelleyBlock (Praos StandardCrypto) LatestKnownEra])
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,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
triggers) (Parser ()
 -> Parser
      (NP
         CardanoHardForkTrigger
         '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
           ShelleyBlock (TPraos StandardCrypto) AllegraEra,
           ShelleyBlock (TPraos StandardCrypto) MaryEra,
           ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
           ShelleyBlock (Praos StandardCrypto) BabbageEra,
           ShelleyBlock (Praos StandardCrypto) LatestKnownEra]))
-> Parser ()
-> Parser
     (NP
        CardanoHardForkTrigger
        '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
          ShelleyBlock (TPraos StandardCrypto) AllegraEra,
          ShelleyBlock (TPraos StandardCrypto) MaryEra,
          ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
          ShelleyBlock (Praos StandardCrypto) BabbageEra,
          ShelleyBlock (Praos StandardCrypto) LatestKnownEra])
forall a b. (a -> b) -> a -> b
$
        Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> Bool
isBad NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
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,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> CardanoHardForkTriggers
CardanoHardForkTriggers NP
  CardanoHardForkTrigger
  '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
    ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
triggers
        }

instance 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 -> [TextBuilder]
blockStats = (forall blk. HasAnalysis blk => blk -> [TextBuilder])
-> CardanoBlock StandardCrypto -> [TextBuilder]
forall a.
(forall blk. HasAnalysis blk => blk -> a)
-> CardanoBlock StandardCrypto -> a
analyseBlock blk -> [TextBuilder]
forall blk. HasAnalysis blk => blk -> [TextBuilder]
blockStats

  blockApplicationMetrics :: [(TextBuilder,
  WithLedgerState (CardanoBlock StandardCrypto) -> IO TextBuilder)]
blockApplicationMetrics =
    [
      ( TextBuilder
"Slot Number"
      , \(WithLedgerState CardanoBlock StandardCrypto
blk LedgerState (CardanoBlock StandardCrypto) ValuesMK
_preSt LedgerState (CardanoBlock StandardCrypto) ValuesMK
_postSt) ->
          TextBuilder -> IO TextBuilder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextBuilder -> IO TextBuilder) -> TextBuilder -> IO TextBuilder
forall a b. (a -> b) -> a -> b
$ Word64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
Builder.decimal (Word64 -> TextBuilder) -> Word64 -> TextBuilder
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
      )
    ,
      ( TextBuilder
"Block Number"
      , \(WithLedgerState CardanoBlock StandardCrypto
blk LedgerState (CardanoBlock StandardCrypto) ValuesMK
_preSt LedgerState (CardanoBlock StandardCrypto) ValuesMK
_postSt) ->
          TextBuilder -> IO TextBuilder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextBuilder -> IO TextBuilder) -> TextBuilder -> IO TextBuilder
forall a b. (a -> b) -> a -> b
$ Word64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
Builder.decimal (Word64 -> TextBuilder) -> Word64 -> TextBuilder
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
      )
    , -- TODO the states will only contain the outputs produced by the block,
      -- not the whole UTxO set, so there is a regression here.

      ( TextBuilder
"UTxO size (via Compact)"
      , \(WithLedgerState CardanoBlock StandardCrypto
_blk LedgerState (CardanoBlock StandardCrypto) ValuesMK
_preSt LedgerState (CardanoBlock StandardCrypto) ValuesMK
postSt) -> do
          let compactSize :: a -> IO TextBuilder
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 -> TextBuilder
forall a. Integral a => a -> TextBuilder
Builder.decimal (Word -> TextBuilder) -> Word -> TextBuilder
forall a b. (a -> b) -> a -> b
$ Word
compactedUtxoSize

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

dispatch ::
  LedgerState (CardanoBlock StandardCrypto) ValuesMK ->
  (LedgerState ByronBlock ValuesMK -> IO TextBuilder) ->
  (forall proto era. LedgerState (ShelleyBlock proto era) ValuesMK -> IO TextBuilder) ->
  IO TextBuilder
dispatch :: LedgerState (CardanoBlock StandardCrypto) ValuesMK
-> (LedgerState ByronBlock ValuesMK -> IO TextBuilder)
-> (forall proto era.
    LedgerState (ShelleyBlock proto era) ValuesMK -> IO TextBuilder)
-> IO TextBuilder
dispatch LedgerState (CardanoBlock StandardCrypto) ValuesMK
cardanoSt LedgerState ByronBlock ValuesMK -> IO TextBuilder
fByron forall proto era.
LedgerState (ShelleyBlock proto era) ValuesMK -> IO TextBuilder
fShelley =
  HardForkState (K (IO TextBuilder)) (CardanoEras StandardCrypto)
-> CollapseTo HardForkState (IO TextBuilder)
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 TextBuilder)) (CardanoEras StandardCrypto)
 -> CollapseTo HardForkState (IO TextBuilder))
-> HardForkState (K (IO TextBuilder)) (CardanoEras StandardCrypto)
-> CollapseTo HardForkState (IO TextBuilder)
forall a b. (a -> b) -> a -> b
$
    Prod
  HardForkState
  (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
  (CardanoEras StandardCrypto)
-> HardForkState
     (Flip LedgerState ValuesMK) (CardanoEras StandardCrypto)
-> HardForkState (K (IO TextBuilder)) (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
      ( (Flip LedgerState ValuesMK ByronBlock
 -> K (IO TextBuilder) ByronBlock)
-> (-.->)
     (Flip LedgerState ValuesMK) (K (IO TextBuilder)) ByronBlock
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn Flip LedgerState ValuesMK ByronBlock
-> K (IO TextBuilder) ByronBlock
k_fByron
          (-.->) (Flip LedgerState ValuesMK) (K (IO TextBuilder)) ByronBlock
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
       ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Flip
   LedgerState
   ValuesMK
   (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
 -> K (IO TextBuilder)
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> (-.->)
     (Flip LedgerState ValuesMK)
     (K (IO TextBuilder))
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn Flip
  LedgerState
  ValuesMK
  (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> K (IO TextBuilder)
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall proto era.
Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
k_fShelley
          (-.->)
  (Flip LedgerState ValuesMK)
  (K (IO TextBuilder))
  (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
       ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Flip
   LedgerState
   ValuesMK
   (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
 -> K (IO TextBuilder)
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> (-.->)
     (Flip LedgerState ValuesMK)
     (K (IO TextBuilder))
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn Flip
  LedgerState
  ValuesMK
  (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> K (IO TextBuilder)
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall proto era.
Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
k_fShelley
          (-.->)
  (Flip LedgerState ValuesMK)
  (K (IO TextBuilder))
  (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Flip
   LedgerState ValuesMK (ShelleyBlock (TPraos StandardCrypto) MaryEra)
 -> K (IO TextBuilder)
      (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> (-.->)
     (Flip LedgerState ValuesMK)
     (K (IO TextBuilder))
     (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn Flip
  LedgerState ValuesMK (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> K (IO TextBuilder)
     (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall proto era.
Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
k_fShelley
          (-.->)
  (Flip LedgerState ValuesMK)
  (K (IO TextBuilder))
  (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Flip
   LedgerState
   ValuesMK
   (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
 -> K (IO TextBuilder)
      (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> (-.->)
     (Flip LedgerState ValuesMK)
     (K (IO TextBuilder))
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn Flip
  LedgerState
  ValuesMK
  (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> K (IO TextBuilder)
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall proto era.
Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
k_fShelley
          (-.->)
  (Flip LedgerState ValuesMK)
  (K (IO TextBuilder))
  (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Flip
   LedgerState
   ValuesMK
   (ShelleyBlock (Praos StandardCrypto) BabbageEra)
 -> K (IO TextBuilder)
      (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> (-.->)
     (Flip LedgerState ValuesMK)
     (K (IO TextBuilder))
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn Flip
  LedgerState
  ValuesMK
  (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> K (IO TextBuilder)
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall proto era.
Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
k_fShelley
          (-.->)
  (Flip LedgerState ValuesMK)
  (K (IO TextBuilder))
  (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Flip
   LedgerState
   ValuesMK
   (ShelleyBlock (Praos StandardCrypto) LatestKnownEra)
 -> K (IO TextBuilder)
      (ShelleyBlock (Praos StandardCrypto) LatestKnownEra))
-> (-.->)
     (Flip LedgerState ValuesMK)
     (K (IO TextBuilder))
     (ShelleyBlock (Praos StandardCrypto) LatestKnownEra)
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn Flip
  LedgerState
  ValuesMK
  (ShelleyBlock (Praos StandardCrypto) LatestKnownEra)
-> K (IO TextBuilder)
     (ShelleyBlock (Praos StandardCrypto) LatestKnownEra)
forall proto era.
Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
k_fShelley
          (-.->)
  (Flip LedgerState ValuesMK)
  (K (IO TextBuilder))
  (ShelleyBlock (Praos StandardCrypto) LatestKnownEra)
-> NP (Flip LedgerState ValuesMK -.-> K (IO TextBuilder)) '[]
-> NP
     (Flip LedgerState ValuesMK -.-> K (IO TextBuilder))
     '[ShelleyBlock (Praos StandardCrypto) LatestKnownEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (Flip LedgerState ValuesMK -.-> K (IO TextBuilder)) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
      )
      (LedgerState (CardanoBlock StandardCrypto) ValuesMK
-> HardForkState
     (Flip LedgerState ValuesMK) (CardanoEras StandardCrypto)
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra LedgerState (CardanoBlock StandardCrypto) ValuesMK
cardanoSt)
 where
  k_fByron :: Flip LedgerState ValuesMK ByronBlock
-> K (IO TextBuilder) ByronBlock
k_fByron = IO TextBuilder -> K (IO TextBuilder) ByronBlock
forall k a (b :: k). a -> K a b
K (IO TextBuilder -> K (IO TextBuilder) ByronBlock)
-> (Flip LedgerState ValuesMK ByronBlock -> IO TextBuilder)
-> Flip LedgerState ValuesMK ByronBlock
-> K (IO TextBuilder) ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock ValuesMK -> IO TextBuilder
fByron (LedgerState ByronBlock ValuesMK -> IO TextBuilder)
-> (Flip LedgerState ValuesMK ByronBlock
    -> LedgerState ByronBlock ValuesMK)
-> Flip LedgerState ValuesMK ByronBlock
-> IO TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState ValuesMK ByronBlock
-> LedgerState ByronBlock ValuesMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip

  k_fShelley ::
    forall proto era.
    Flip LedgerState ValuesMK (ShelleyBlock proto era) ->
    K (IO TextBuilder) (ShelleyBlock proto era)
  k_fShelley :: forall proto era.
Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
k_fShelley = IO TextBuilder -> K (IO TextBuilder) (ShelleyBlock proto era)
forall k a (b :: k). a -> K a b
K (IO TextBuilder -> K (IO TextBuilder) (ShelleyBlock proto era))
-> (Flip LedgerState ValuesMK (ShelleyBlock proto era)
    -> IO TextBuilder)
-> Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> K (IO TextBuilder) (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) ValuesMK -> IO TextBuilder
forall proto era.
LedgerState (ShelleyBlock proto era) ValuesMK -> IO TextBuilder
fShelley (LedgerState (ShelleyBlock proto era) ValuesMK -> IO TextBuilder)
-> (Flip LedgerState ValuesMK (ShelleyBlock proto era)
    -> LedgerState (ShelleyBlock proto era) ValuesMK)
-> Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> IO TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState ValuesMK (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip

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

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

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

getShelleyBasedUtxo ::
  LedgerState (ShelleyBlock proto era) ValuesMK ->
  Map TxIn (TxOut era)
getShelleyBasedUtxo :: forall proto era.
LedgerState (ShelleyBlock proto era) ValuesMK
-> Map TxIn (TxOut era)
getShelleyBasedUtxo =
  (\(Shelley.UTxO.UTxO Map TxIn (TxOut era)
xs) -> Map TxIn (TxOut era)
xs)
    (UTxO era -> Map TxIn (TxOut era))
-> (LedgerState (ShelleyBlock proto era) ValuesMK -> UTxO era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> Map TxIn (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) ValuesMK -> UTxOState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> 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) ValuesMK
    -> LedgerState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> 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) ValuesMK
    -> EpochState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> 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) ValuesMK
    -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> EpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) ValuesMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
Shelley.Ledger.shelleyLedgerState

type CardanoBlockArgs = Args (CardanoBlock StandardCrypto)

mkCardanoProtocolInfo ::
  Byron.Genesis.Config ->
  Maybe PBftSignatureThreshold ->
  SL.TransitionConfig L.LatestKnownEra ->
  Nonce ->
  CardanoHardForkTriggers ->
  ProtocolInfo (CardanoBlock StandardCrypto)
mkCardanoProtocolInfo :: Config
-> Maybe PBftSignatureThreshold
-> TransitionConfig LatestKnownEra
-> Nonce
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock StandardCrypto)
mkCardanoProtocolInfo Config
genesisByron Maybe PBftSignatureThreshold
signatureThreshold TransitionConfig LatestKnownEra
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
-> CheckpointsMap (CardanoBlock StandardCrypto)
-> ProtVer
-> CardanoProtocolParams StandardCrypto
forall c.
ProtocolParamsByron
-> ProtocolParamsShelleyBased c
-> CardanoHardForkTriggers
-> TransitionConfig LatestKnownEra
-> CheckpointsMap (CardanoBlock c)
-> ProtVer
-> CardanoProtocolParams c
CardanoProtocolParams
          ProtocolParamsByron
            { byronGenesis :: Config
byronGenesis = Config
genesisByron
            , byronPbftSignatureThreshold :: Maybe PBftSignatureThreshold
byronPbftSignatureThreshold = Maybe PBftSignatureThreshold
signatureThreshold
            , byronProtocolVersion :: ProtocolVersion
byronProtocolVersion = Word16 -> Word16 -> Word8 -> ProtocolVersion
Byron.Update.ProtocolVersion Word16
1 Word16
2 Word8
0
            , byronSoftwareVersion :: SoftwareVersion
byronSoftwareVersion =
                ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Byron.Update.SoftwareVersion (Text -> ApplicationName
Byron.Update.ApplicationName Text
"db-analyser") NumSoftwareVersion
2
            , byronLeaderCredentials :: Maybe ByronLeaderCredentials
byronLeaderCredentials = Maybe ByronLeaderCredentials
forall a. Maybe a
Nothing
            }
          ProtocolParamsShelleyBased
            { shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce = Nonce
initialNonce
            , shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials StandardCrypto]
shelleyBasedLeaderCredentials = []
            }
          CardanoHardForkTriggers
triggers
          TransitionConfig LatestKnownEra
transitionConfig
          CheckpointsMap (CardanoBlock StandardCrypto)
forall blk. CheckpointsMap blk
emptyCheckpointsMap
          (Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
L.eraProtVerHigh @L.LatestKnownEra) 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