WIP

Author: jasagredo

cardano-config/src/Cardano/Configuration.hs

@@ -49,7 +49,6 @@ module Cardano.Configuration
 
     -- * Basics
   , Basics.File (..)
-  , Basics.Override (..)
   ) where
 
 import qualified Cardano.Configuration.Basics as Basics
@@ -89,6 +88,7 @@ data NodeConfiguration = NodeConfiguration
   , shutdownIPC :: Maybe Fd
   , shutdownOnTarget :: Maybe CLI.ShutdownOn
   }
+  deriving Show
 
 -- | Combine the cli arguments and configuration file values into a full
 -- configuration

cardano-config/src/Cardano/Configuration/Basics.hs

@@ -7,11 +7,9 @@ module Cardano.Configuration.Basics
   , anchorRelativePath
 
     -- * Defaults
-  , Override (..)
   , (.:=)
   ) where
 
-import Control.Applicative ((<|>))
 import Data.Aeson
 import Data.Aeson.Types (Parser)
 import Data.Default
@@ -41,27 +39,6 @@ anchorRelativePath fp1 (RelativeFile fp2) = fp1 </> fp2
 
 --------------------------------------------------------------------------------
 
--- | Signal whether the default value should not be overriden, but don't provide
--- a default at this level. The particular component will have to then apply
--- whatever defaults it considers acceptable.
-data Override a = NoOverride | Override a deriving (Generic, Show, Eq)
-
-instance Default (Override a) where
-  def = NoOverride
-
-instance FromJSON a => FromJSON (Override a) where
-  parseJSON v =
-    withText
-      "Override"
-      ( \case
-          "NoOverride" -> pure NoOverride
-          _ -> fail "Not text"
-      )
-      v
-      <|> Override <$> parseJSON v
-
---------------------------------------------------------------------------------
-
 -- | If the key is missing, use the default value
 (.:=) :: (FromJSON a, Default a) => Object -> Key -> Parser a
 a .:= b = a .:? b .!= def

cardano-config/src/Cardano/Configuration/Common.hs

@@ -17,21 +17,21 @@ import Options.Applicative
 -- | The databases that will be used by the node
 data NodeDatabasePaths
   = -- | Store everything in a single directory
-    Unique (File "Database")
+    SingleDB (File "Database")
   | -- | Store the immutable data in one (possibly slower) directory and the
     -- volatile data in a different (possible faster) directory
-    Split (File "ImmutableDB") (File "VolatileDB")
+    SplitDB (File "ImmutableDB") (File "VolatileDB")
   deriving (Generic, Show)
 
 instance Default NodeDatabasePaths where
-  def = Unique "mainnet/db"
+  def = SingleDB "mainnet/db"
 
 instance FromJSON NodeDatabasePaths where
   parseJSON v =
-    withText "OneDatabase" (pure . Unique . File . T.unpack) v
+    withText "OneDatabase" (pure . SingleDB . File . T.unpack) v
       <|> withObject
         "MultipleDatabases"
-        (\v' -> Split <$> v' .: "ImmutablePath" <*> v' .: "VolatilePath")
+        (\v' -> SplitDB <$> v' .: "ImmutablePath" <*> v' .: "VolatilePath")
         v
 
 parseNodeDatabasePaths :: Parser (Maybe NodeDatabasePaths)
@@ -40,7 +40,7 @@ parseNodeDatabasePaths =
 
 parseDbPath :: Parser NodeDatabasePaths
 parseDbPath =
-  fmap Unique $
+  fmap SingleDB $
     strOption $
       mconcat
         [ long "database-path"
@@ -50,7 +50,7 @@ parseDbPath =
         ]
 
 parseMultipleDbPaths :: Parser NodeDatabasePaths
-parseMultipleDbPaths = Split <$> parseImmutableDbPath <*> parseVolatileDbPath
+parseMultipleDbPaths = SplitDB <$> parseImmutableDbPath <*> parseVolatileDbPath
 
 parseVolatileDbPath :: Parser (File "VolatileDB")
 parseVolatileDbPath =

cardano-config/src/Cardano/Configuration/File/Consensus.hs

@@ -8,6 +8,7 @@ import Cardano.Configuration.Basics
 import Cardano.Ledger.BaseTypes
 import Data.Aeson
 import Data.Default
+import Data.Functor.Identity (Identity)
 import Data.Time.Clock (DiffTime)
 import GHC.Generics (Generic)
 
@@ -23,6 +24,7 @@ instance Default ConsensusMode where
 newtype ConsensusConfiguration f = ConsensusConfiguration {getConsensusConfiguration :: f ConsensusMode}
 
 deriving instance Show (ConsensusConfiguration Maybe)
+deriving instance Show (ConsensusConfiguration Identity)
 
 instance FromJSON (ConsensusConfiguration Maybe) where
   parseJSON val =
@@ -40,14 +42,14 @@ instance FromJSON (ConsensusConfiguration Maybe) where
 
 -- | Configuration options for Genesis parameters
 data GenesisConfigFlags = GenesisConfigFlags
-  { gcfEnableCSJ :: Override Bool
-  , gcfEnableLoEAndGDD :: Override Bool
-  , gcfEnableLoP :: Override Bool
-  , gcfBlockFetchGracePeriod :: Override DiffTime
-  , gcfBucketCapacity :: Override Integer
-  , gcfBucketRate :: Override Integer
-  , gcfCSJJumpSize :: Override SlotNo
-  , gcfGDDRateLimit :: Override DiffTime
+  { gcfEnableCSJ :: Maybe Bool
+  , gcfEnableLoEAndGDD :: Maybe Bool
+  , gcfEnableLoP :: Maybe Bool
+  , gcfBlockFetchGracePeriod :: Maybe DiffTime
+  , gcfBucketCapacity :: Maybe Integer
+  , gcfBucketRate :: Maybe Integer
+  , gcfCSJJumpSize :: Maybe SlotNo
+  , gcfGDDRateLimit :: Maybe DiffTime
   }
   deriving (Generic, Show)
 

cardano-config/src/Cardano/Configuration/File/Network.hs

@@ -61,34 +61,34 @@ instance FromJSON ResponderCoreAffinityPolicy where
       x -> fail $ "Unknown responder core affinity policy: " <> T.unpack x
 
 -- | Options related to Networking configuration. Most of the fields are
--- @Override@ such that the networking layer can then set the appropriate
+-- @Maybe@ such that the networking layer can then set the appropriate
 -- defaults.
 data NetworkConfiguration = NetworkConfiguration
   { pncDiffusionMode :: DiffusionMode
-  , pncMaxConcurrencyBulkSync :: Override Word
-  , pncMaxConcurrencyDeadline :: Override Word
-  , pncProtocolIdleTimeout :: Override DiffTime
-  , pncTimeWaitTimeout :: Override DiffTime
-  , pncEgressPollInterval :: Override DiffTime
-  , pncChainSyncIdleTimeout :: Override DiffTime
-  , pncAcceptedConnectionsLimit :: Override AcceptedConnectionsLimit
-  , pncDeadlineTargetOfRootPeers :: Override Int
-  , pncDeadlineTargetOfKnownPeers :: Override Int
-  , pncDeadlineTargetOfEstablishedPeers :: Override Int
-  , pncDeadlineTargetOfActivePeers :: Override Int
-  , pncDeadlineTargetOfKnownBigLedgerPeers :: Override Int
-  , pncDeadlineTargetOfEstablishedBigLedgerPeers :: Override Int
-  , pncDeadlineTargetOfActiveBigLedgerPeers :: Override Int
-  , pncSyncTargetOfRootPeers :: Override Int
-  , pncSyncTargetOfKnownPeers :: Override Int
-  , pncSyncTargetOfEstablishedPeers :: Override Int
-  , pncSyncTargetOfActivePeers :: Override Int
-  , pncSyncTargetOfKnownBigLedgerPeers :: Override Int
-  , pncSyncTargetOfEstablishedBigLedgerPeers :: Override Int
-  , pncSyncTargetOfActiveBigLedgerPeers :: Override Int
-  , pncMinBigLedgerPeersForTrustedState :: Override Int
-  , pncPeerSharing :: Override PeerSharing
-  , pncResponderCoreAffinityPolicy :: Override ResponderCoreAffinityPolicy
+  , pncMaxConcurrencyBulkSync :: Maybe Word
+  , pncMaxConcurrencyDeadline :: Maybe Word
+  , pncProtocolIdleTimeout :: Maybe DiffTime
+  , pncTimeWaitTimeout :: Maybe DiffTime
+  , pncEgressPollInterval :: Maybe DiffTime
+  , pncChainSyncIdleTimeout :: Maybe DiffTime
+  , pncAcceptedConnectionsLimit :: Maybe AcceptedConnectionsLimit
+  , pncDeadlineTargetOfRootPeers :: Maybe Int
+  , pncDeadlineTargetOfKnownPeers :: Maybe Int
+  , pncDeadlineTargetOfEstablishedPeers :: Maybe Int
+  , pncDeadlineTargetOfActivePeers :: Maybe Int
+  , pncDeadlineTargetOfKnownBigLedgerPeers :: Maybe Int
+  , pncDeadlineTargetOfEstablishedBigLedgerPeers :: Maybe Int
+  , pncDeadlineTargetOfActiveBigLedgerPeers :: Maybe Int
+  , pncSyncTargetOfRootPeers :: Maybe Int
+  , pncSyncTargetOfKnownPeers :: Maybe Int
+  , pncSyncTargetOfEstablishedPeers :: Maybe Int
+  , pncSyncTargetOfActivePeers :: Maybe Int
+  , pncSyncTargetOfKnownBigLedgerPeers :: Maybe Int
+  , pncSyncTargetOfEstablishedBigLedgerPeers :: Maybe Int
+  , pncSyncTargetOfActiveBigLedgerPeers :: Maybe Int
+  , pncMinBigLedgerPeersForTrustedState :: Maybe Int
+  , pncPeerSharing :: Maybe PeerSharing
+  , pncResponderCoreAffinityPolicy :: Maybe ResponderCoreAffinityPolicy
   }
   deriving (Generic, Show)
 

cardano-config/src/Cardano/Configuration/File/Storage.hs

@@ -52,10 +52,10 @@ newtype MaxReaders = MaxReaders Word64
 -- | Selector for the backend
 data LedgerDbBackendSelector f
   = V1LMDB
-      (Override FlushFrequency)
+      (Maybe FlushFrequency)
       (f (File "LMDB"))
-      (Override MaxMapSize)
-      (Override MaxReaders)
+      (Maybe MaxMapSize)
+      (Maybe MaxReaders)
   | V2InMemory
   | V2LSM (f (File "LSM"))
   deriving Generic
@@ -82,9 +82,9 @@ newtype QueryBatchSize = QueryBatchSize Word64
 -- | The Ledger DB configuration
 data LedgerDbConfiguration f
   = LedgerDbConfiguration
-  { numOfDiskSnapshots :: Override NumOfDiskSnapshots
-  , snapshotInterval :: Override SnapshotInterval
-  , queryBatchSize :: Override QueryBatchSize
+  { numOfDiskSnapshots :: Maybe NumOfDiskSnapshots
+  , snapshotInterval :: Maybe SnapshotInterval
+  , queryBatchSize :: Maybe QueryBatchSize
   , backendSelector :: f (LedgerDbBackendSelector f)
   }
   deriving Generic
@@ -132,12 +132,12 @@ class DefaultGiven given a where
   defGiven :: given -> a
 
 instance DefaultGiven NodeDatabasePaths (File "LMDB") where
-  defGiven (Unique fp) = fp `anchorRelativePath` def
-  defGiven (Split _ fp) = fp `anchorRelativePath` def
+  defGiven (SingleDB fp) = fp `anchorRelativePath` def
+  defGiven (SplitDB _ fp) = fp `anchorRelativePath` def
 
 instance DefaultGiven NodeDatabasePaths (File "LSM") where
-  defGiven (Unique fp) = fp `anchorRelativePath` def
-  defGiven (Split _ fp) = fp `anchorRelativePath` def
+  defGiven (SingleDB fp) = fp `anchorRelativePath` def
+  defGiven (SplitDB _ fp) = fp `anchorRelativePath` def
 
 instance
   (Default (RelativeFile a), DefaultGiven b (File a)) =>

cardano-config/src/Cardano/Configuration/File/Testing.hs

@@ -17,7 +17,7 @@ newtype MempoolCapacityBytes = MempoolCapacityBytes Word64
 
 -- | The testing configuration
 data TestingConfiguration = TestingConfiguration
-  { pncMaybeMempoolCapacityOverride :: !(Override MempoolCapacityBytes)
+  { pncMaybeMempoolCapacityMaybe :: !(Maybe MempoolCapacityBytes)
   , pncExperimentalGenesis :: Maybe (EraGenesis ExperimentalCardanoEra)
   }
   deriving (Generic, Show)
@@ -26,7 +26,7 @@ instance FromJSON TestingConfiguration where
   parseJSON =
     withObject "Configuration" $ \v ->
       TestingConfiguration
-        <$> v .:= "MempoolCapacityBytesOverride"
+        <$> v .:= "MempoolCapacityBytesMaybe"
         <*> ( do
                 enabled <- v .:? "ExperimentalHardForksEnabled" .!= False
                 if enabled