{-# 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
      }

-- DUPLICATE: mirroring parsers from cardano-node/src/Cardano/Node/Configuration/POM.hs

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