{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Tools.DBSynthesizer.Orphans () where
import qualified Cardano.Chain.Update as Byron (ApplicationName (..))
import Cardano.Crypto (RequiresNetworkMagic (..))
import Cardano.Node.Types
( AdjustFilePaths (..)
, NodeByronProtocolConfiguration (..)
, NodeHardForkProtocolConfiguration (..)
)
import Cardano.Tools.DBSynthesizer.Types
import Control.Monad (when)
import Data.Aeson as Aeson
( FromJSON (..)
, withObject
, (.!=)
, (.:)
, (.:?)
)
instance FromJSON NodeConfigStub where
parseJSON :: Value -> Parser NodeConfigStub
parseJSON Value
val = String
-> (Object -> Parser NodeConfigStub)
-> Value
-> Parser NodeConfigStub
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeConfigStub" (Value -> Object -> Parser NodeConfigStub
parse' Value
val) Value
val
where
parse' :: Value -> Object -> Parser NodeConfigStub
parse' Value
o Object
v = do
proto <- Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Protocol"
when (proto /= ("Cardano" :: String)) $
fail $
"nodeConfig.Protocol expected: Cardano; found: " ++ proto
NodeConfigStub o
<$> v .: "AlonzoGenesisFile"
<*> v .: "ShelleyGenesisFile"
<*> v .: "ByronGenesisFile"
<*> v .: "ConwayGenesisFile"
instance AdjustFilePaths NodeConfigStub where
adjustFilePaths :: (String -> String) -> NodeConfigStub -> NodeConfigStub
adjustFilePaths String -> String
f NodeConfigStub
nc =
NodeConfigStub
nc
{ ncsAlonzoGenesisFile = f $ ncsAlonzoGenesisFile nc
, ncsShelleyGenesisFile = f $ ncsShelleyGenesisFile nc
, ncsByronGenesisFile = f $ ncsByronGenesisFile nc
, ncsConwayGenesisFile = f $ ncsConwayGenesisFile nc
}
instance AdjustFilePaths NodeCredentials where
adjustFilePaths :: (String -> String) -> NodeCredentials -> NodeCredentials
adjustFilePaths String -> String
f NodeCredentials
nc =
NodeCredentials
nc
{ credCertFile = f <$> credCertFile nc
, credVRFFile = f <$> credVRFFile nc
, credKESFile = f <$> credKESFile nc
, credBulkFile = f <$> credBulkFile nc
}
instance FromJSON NodeHardForkProtocolConfiguration where
parseJSON :: Value -> Parser NodeHardForkProtocolConfiguration
parseJSON = String
-> (Object -> Parser NodeHardForkProtocolConfiguration)
-> Value
-> Parser NodeHardForkProtocolConfiguration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeHardForkProtocolConfiguration" ((Object -> Parser NodeHardForkProtocolConfiguration)
-> Value -> Parser NodeHardForkProtocolConfiguration)
-> (Object -> Parser NodeHardForkProtocolConfiguration)
-> Value
-> Parser NodeHardForkProtocolConfiguration
forall a b. (a -> b) -> a -> b
$ \Object
v ->
Bool
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration
NodeHardForkProtocolConfiguration
(Bool
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
-> Parser Bool
-> Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestEnableDevelopmentHardForkEras"
Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestShelleyHardForkAtEpoch"
Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestAllegraHardForkAtEpoch"
Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestMaryHardForkAtEpoch"
Parser
(Maybe EpochNo
-> Maybe EpochNo
-> Maybe EpochNo
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe EpochNo
-> Maybe EpochNo -> NodeHardForkProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestAlonzoHardForkAtEpoch"
Parser
(Maybe EpochNo
-> Maybe EpochNo -> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser (Maybe EpochNo -> NodeHardForkProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestBabbageHardForkAtEpoch"
Parser (Maybe EpochNo -> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser NodeHardForkProtocolConfiguration
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestConwayHardForkAtEpoch"
instance FromJSON NodeByronProtocolConfiguration where
parseJSON :: Value -> Parser NodeByronProtocolConfiguration
parseJSON = String
-> (Object -> Parser NodeByronProtocolConfiguration)
-> Value
-> Parser NodeByronProtocolConfiguration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeByronProtocolConfiguration" ((Object -> Parser NodeByronProtocolConfiguration)
-> Value -> Parser NodeByronProtocolConfiguration)
-> (Object -> Parser NodeByronProtocolConfiguration)
-> Value
-> Parser NodeByronProtocolConfiguration
forall a b. (a -> b) -> a -> b
$ \Object
v ->
GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration
NodeByronProtocolConfiguration
(GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
-> Parser GenesisFile
-> Parser
(Maybe GenesisHash
-> RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser GenesisFile
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ByronGenesisFile"
Parser
(Maybe GenesisHash
-> RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
-> Parser (Maybe GenesisHash)
-> Parser
(RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe GenesisHash)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ByronGenesisHash"
Parser
(RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
-> Parser RequiresNetworkMagic
-> Parser
(Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
Object -> Key -> Parser (Maybe RequiresNetworkMagic)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"RequiresNetworkMagic"
Parser (Maybe RequiresNetworkMagic)
-> RequiresNetworkMagic -> Parser RequiresNetworkMagic
forall a. Parser (Maybe a) -> a -> Parser a
.!= RequiresNetworkMagic
RequiresNoMagic
Parser
(Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
-> Parser (Maybe Double)
-> Parser
(ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"PBftSignatureThreshold"
Parser
(ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration)
-> Parser ApplicationName
-> Parser
(NumSoftwareVersion
-> Word16 -> Word16 -> Word8 -> NodeByronProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ApplicationName -> Parser ApplicationName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ApplicationName
Byron.ApplicationName Text
"cardano-sl")
Parser
(NumSoftwareVersion
-> Word16 -> Word16 -> Word8 -> NodeByronProtocolConfiguration)
-> Parser NumSoftwareVersion
-> Parser
(Word16 -> Word16 -> Word8 -> NodeByronProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
Object -> Key -> Parser (Maybe NumSoftwareVersion)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ApplicationVersion"
Parser (Maybe NumSoftwareVersion)
-> NumSoftwareVersion -> Parser NumSoftwareVersion
forall a. Parser (Maybe a) -> a -> Parser a
.!= NumSoftwareVersion
1
Parser
(Word16 -> Word16 -> Word8 -> NodeByronProtocolConfiguration)
-> Parser Word16
-> Parser (Word16 -> Word8 -> NodeByronProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Word16
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"LastKnownBlockVersion-Major"
Parser (Word16 -> Word8 -> NodeByronProtocolConfiguration)
-> Parser Word16
-> Parser (Word8 -> NodeByronProtocolConfiguration)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Word16
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"LastKnownBlockVersion-Minor"
Parser (Word8 -> NodeByronProtocolConfiguration)
-> Parser Word8 -> Parser NodeByronProtocolConfiguration
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
Object -> Key -> Parser (Maybe Word8)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"LastKnownBlockVersion-Alt"
Parser (Maybe Word8) -> Word8 -> Parser Word8
forall a. Parser (Maybe a) -> a -> Parser a
.!= Word8
0