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

-- 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