{-# 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
String
proto <- Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Protocol"
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
proto String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= (String
"Cardano" :: String)) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"nodeConfig.Protocol expected: Cardano; found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
proto
Value -> String -> String -> String -> String -> NodeConfigStub
NodeConfigStub Value
o
(String -> String -> String -> String -> NodeConfigStub)
-> Parser String
-> Parser (String -> String -> String -> NodeConfigStub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"AlonzoGenesisFile"
Parser (String -> String -> String -> NodeConfigStub)
-> Parser String -> Parser (String -> String -> NodeConfigStub)
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 String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ShelleyGenesisFile"
Parser (String -> String -> NodeConfigStub)
-> Parser String -> Parser (String -> NodeConfigStub)
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 String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ByronGenesisFile"
Parser (String -> NodeConfigStub)
-> Parser String -> Parser NodeConfigStub
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 String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration
NodeHardForkProtocolConfiguration
(Bool
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser Bool
-> Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe Word)
-> Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestShelleyHardForkAtVersion"
Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe Word)
-> Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestAllegraHardForkAtVersion"
Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe Word)
-> Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestMaryHardForkAtVersion"
Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe Word)
-> Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestAlonzoHardForkAtVersion"
Parser
(Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser
(Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> 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 Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration)
-> Parser (Maybe Word)
-> Parser
(Maybe EpochNo -> Maybe Word -> 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 Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestBabbageHardForkAtVersion"
Parser
(Maybe EpochNo -> Maybe Word -> NodeHardForkProtocolConfiguration)
-> Parser (Maybe EpochNo)
-> Parser (Maybe Word -> 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"
Parser (Maybe Word -> NodeHardForkProtocolConfiguration)
-> Parser (Maybe Word) -> 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 Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TestConwayHardForkAtVersion"
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