1641 - config can override presets

cardano-db-sync/src/Cardano/DbSync/Api.hs

@@ -9,10 +9,6 @@
 
 module Cardano.DbSync.Api (
   extractInsertOptions,
-  fullInsertOptions,
-  onlyUTxOInsertOptions,
-  onlyGovInsertOptions,
-  disableAllInsertOptions,
   setConsistentLevel,
   getConsistentLevel,
   isConsistent,
@@ -211,74 +207,7 @@ getPrunes = do
   DB.pcmPruneTxOut . getPruneConsume
 
 extractInsertOptions :: SyncPreConfig -> SyncInsertOptions
-extractInsertOptions cfg =
-  case pcInsertConfig cfg of
-    FullInsertOptions -> fullInsertOptions
-    OnlyUTxOInsertOptions -> onlyUTxOInsertOptions
-    OnlyGovInsertOptions -> onlyGovInsertOptions
-    DisableAllInsertOptions -> disableAllInsertOptions
-    SyncInsertConfig opts -> opts
-
-fullInsertOptions :: SyncInsertOptions
-fullInsertOptions =
-  SyncInsertOptions
-    { sioTxCBOR = TxCBORConfig False
-    , sioTxOut = TxOutEnable
-    , sioLedger = LedgerEnable
-    , sioShelley = ShelleyEnable
-    , sioRewards = RewardsConfig True
-    , sioMultiAsset = MultiAssetEnable
-    , sioMetadata = MetadataEnable
-    , sioPlutus = PlutusEnable
-    , sioGovernance = GovernanceConfig True
-    , sioOffchainPoolData = OffchainPoolDataConfig True
-    , sioPoolStats = PoolStatsConfig True
-    , sioJsonType = JsonTypeText
-    , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
-    }
-
-onlyUTxOInsertOptions :: SyncInsertOptions
-onlyUTxOInsertOptions =
-  SyncInsertOptions
-    { sioTxCBOR = TxCBORConfig False
-    , sioTxOut = TxOutBootstrap (ForceTxIn False)
-    , sioLedger = LedgerIgnore
-    , sioShelley = ShelleyDisable
-    , sioRewards = RewardsConfig True
-    , sioMultiAsset = MultiAssetDisable
-    , sioMetadata = MetadataDisable
-    , sioPlutus = PlutusDisable
-    , sioGovernance = GovernanceConfig False
-    , sioOffchainPoolData = OffchainPoolDataConfig False
-    , sioPoolStats = PoolStatsConfig False
-    , sioJsonType = JsonTypeText
-    , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
-    }
-
-onlyGovInsertOptions :: SyncInsertOptions
-onlyGovInsertOptions =
-  disableAllInsertOptions
-    { sioLedger = LedgerEnable
-    , sioGovernance = GovernanceConfig True
-    }
-
-disableAllInsertOptions :: SyncInsertOptions
-disableAllInsertOptions =
-  SyncInsertOptions
-    { sioTxCBOR = TxCBORConfig False
-    , sioTxOut = TxOutDisable
-    , sioLedger = LedgerDisable
-    , sioShelley = ShelleyDisable
-    , sioRewards = RewardsConfig False
-    , sioMultiAsset = MultiAssetDisable
-    , sioMetadata = MetadataDisable
-    , sioPlutus = PlutusDisable
-    , sioOffchainPoolData = OffchainPoolDataConfig False
-    , sioPoolStats = PoolStatsConfig False
-    , sioGovernance = GovernanceConfig False
-    , sioJsonType = JsonTypeText
-    , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
-    }
+extractInsertOptions = sicOptions . pcInsertConfig
 
 initCurrentEpochNo :: CurrentEpochNo
 initCurrentEpochNo =

cardano-db-sync/src/Cardano/DbSync/Config/Types.hs

@@ -22,6 +22,7 @@ module Cardano.DbSync.Config.Types (
   SyncNodeConfig (..),
   SyncPreConfig (..),
   SyncInsertConfig (..),
+  SyncInsertPreset (..),
   SyncInsertOptions (..),
   TxCBORConfig (..),
   PoolStatsConfig (..),
@@ -55,6 +56,10 @@ module Cardano.DbSync.Config.Types (
   isTxOutConsumed,
   isTxOutPrune,
   forceTxIn,
+  fullInsertOptions,
+  onlyUTxOInsertOptions,
+  onlyGovInsertOptions,
+  disableAllInsertOptions,
 ) where
 
 import qualified Cardano.BM.Configuration as Logging
@@ -68,7 +73,8 @@ import Cardano.Slotting.Slot (SlotNo (..))
 import Control.Monad (fail)
 import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.!=), (.:), (.:?), (.=))
 import qualified Data.Aeson as Aeson
-import Data.Aeson.Types (Parser, typeMismatch)
+import Data.Aeson.Key (fromText)
+import Data.Aeson.Types (Pair, Parser, typeMismatch)
 import Data.ByteString.Short (ShortByteString (), fromShort, toShort)
 import Data.Default.Class (Default (..))
 import Ouroboros.Consensus.Cardano.CanHardFork (TriggerHardFork (..))
@@ -150,12 +156,17 @@ data SyncPreConfig = SyncPreConfig
   }
   deriving (Show)
 
-data SyncInsertConfig
-  = FullInsertOptions
-  | OnlyUTxOInsertOptions
-  | OnlyGovInsertOptions
-  | DisableAllInsertOptions
-  | SyncInsertConfig SyncInsertOptions
+data SyncInsertConfig = SyncInsertConfig
+  { sicPreset :: Maybe SyncInsertPreset
+  , sicOptions :: SyncInsertOptions
+  }
+  deriving (Eq, Show)
+
+data SyncInsertPreset
+  = FullInsertPreset
+  | OnlyUTxOInsertPreset
+  | OnlyGovInsertPreset
+  | DisableAllInsertPreset
   deriving (Eq, Show)
 
 data SyncInsertOptions = SyncInsertOptions
@@ -386,23 +397,73 @@ instance FromJSON SyncProtocol where
       String "Cardano" -> pure SyncProtocolCardano
       x -> typeMismatch "Protocol" x
 
+instance FromJSON SyncInsertPreset where
+  parseJSON = Aeson.withText "SyncInsertPreset" $ \case
+    "full" -> pure FullInsertPreset
+    "only_utxo" -> pure OnlyUTxOInsertPreset
+    "only_governance" -> pure OnlyGovInsertPreset
+    "disable_all" -> pure DisableAllInsertPreset
+    other -> fail $ "unexpected preset: " <> show other
+
+instance ToJSON SyncInsertPreset where
+  toJSON FullInsertPreset = "full"
+  toJSON OnlyUTxOInsertPreset = "only_utxo"
+  toJSON OnlyGovInsertPreset = "only_governance"
+  toJSON DisableAllInsertPreset = "disable_all"
+
 instance FromJSON SyncInsertConfig where
   parseJSON = Aeson.withObject "SyncInsertConfig" $ \obj -> do
     preset <- obj .:? "preset"
-    case preset :: Maybe Text of
-      Nothing -> SyncInsertConfig <$> parseJSON (Aeson.Object obj)
-      Just "full" -> pure FullInsertOptions
-      Just "only_utxo" -> pure OnlyUTxOInsertOptions
-      Just "only_gov" -> pure OnlyGovInsertOptions
-      Just "disable_all" -> pure DisableAllInsertOptions
-      Just other -> fail $ "unexpected preset: " <> show other
+    baseOptions <- case preset of
+      Just FullInsertPreset -> pure fullInsertOptions
+      Just OnlyUTxOInsertPreset -> pure onlyUTxOInsertOptions
+      Just OnlyGovInsertPreset -> pure onlyGovInsertOptions
+      Just DisableAllInsertPreset -> pure disableAllInsertOptions
+      Nothing -> pure def -- Default options
+    options <- parseOverrides obj baseOptions
+    pure $ SyncInsertConfig preset options
+
+parseOverrides :: Aeson.Object -> SyncInsertOptions -> Parser SyncInsertOptions
+parseOverrides obj baseOptions = do
+  SyncInsertOptions
+    <$> obj .:? "tx_cbor" .!= sioTxCBOR baseOptions
+    <*> obj .:? "tx_out" .!= sioTxOut baseOptions
+    <*> obj .:? "ledger" .!= sioLedger baseOptions
+    <*> obj .:? "shelley" .!= sioShelley baseOptions
+    <*> pure (sioRewards baseOptions)
+    <*> obj .:? "multi_asset" .!= sioMultiAsset baseOptions
+    <*> obj .:? "metadata" .!= sioMetadata baseOptions
+    <*> obj .:? "plutus" .!= sioPlutus baseOptions
+    <*> obj .:? "governance" .!= sioGovernance baseOptions
+    <*> obj .:? "offchain_pool_data" .!= sioOffchainPoolData baseOptions
+    <*> obj .:? "pool_stats" .!= sioPoolStats baseOptions
+    <*> obj .:? "json_type" .!= sioJsonType baseOptions
+    <*> obj .:? "remove_jsonb_from_schema" .!= sioRemoveJsonbFromSchema baseOptions
 
 instance ToJSON SyncInsertConfig where
-  toJSON (SyncInsertConfig opts) = toJSON opts
-  toJSON FullInsertOptions = Aeson.object ["preset" .= ("full" :: Text)]
-  toJSON OnlyUTxOInsertOptions = Aeson.object ["preset" .= ("only_utxo" :: Text)]
-  toJSON OnlyGovInsertOptions = Aeson.object ["preset" .= ("only_gov" :: Text)]
-  toJSON DisableAllInsertOptions = Aeson.object ["preset" .= ("disable_all" :: Text)]
+  toJSON (SyncInsertConfig preset options) =
+    Aeson.object $ maybe [] (\p -> [fromText "preset" .= p]) preset ++ optionsToList options
+
+optionsToList :: SyncInsertOptions -> [Pair]
+optionsToList SyncInsertOptions {..} =
+  catMaybes
+    [ toJsonIfSet "tx_cbor" sioTxCBOR
+    , toJsonIfSet "tx_out" sioTxOut
+    , toJsonIfSet "ledger" sioLedger
+    , toJsonIfSet "shelley" sioShelley
+    , toJsonIfSet "rewards" sioRewards
+    , toJsonIfSet "multi_asset" sioMultiAsset
+    , toJsonIfSet "metadata" sioMetadata
+    , toJsonIfSet "plutus" sioPlutus
+    , toJsonIfSet "governance" sioGovernance
+    , toJsonIfSet "offchain_pool_data" sioOffchainPoolData
+    , toJsonIfSet "pool_stats" sioPoolStats
+    , toJsonIfSet "json_type" sioJsonType
+    , toJsonIfSet "remove_jsonb_from_schema" sioRemoveJsonbFromSchema
+    ]
+
+toJsonIfSet :: ToJSON a => Text -> a -> Maybe Pair
+toJsonIfSet key value = Just $ fromText key .= value
 
 instance FromJSON SyncInsertOptions where
   parseJSON = Aeson.withObject "SyncInsertOptions" $ \obj ->
@@ -433,11 +494,14 @@ instance ToJSON SyncInsertOptions where
       , "plutus" .= sioPlutus
       , "governance" .= sioGovernance
       , "offchain_pool_data" .= sioOffchainPoolData
-      , "pool_stat" .= sioPoolStats
+      , "pool_stats" .= sioPoolStats
       , "json_type" .= sioJsonType
       , "remove_jsonb_from_schema" .= sioRemoveJsonbFromSchema
       ]
 
+instance ToJSON RewardsConfig where
+  toJSON (RewardsConfig enabled) = Aeson.Bool enabled
+
 instance ToJSON TxCBORConfig where
   toJSON = boolToEnableDisable . isTxCBOREnabled
 
@@ -626,7 +690,7 @@ instance FromJSON JsonTypeConfig where
     other -> fail $ "unexpected json_type: " <> show other
 
 instance Default SyncInsertConfig where
-  def = SyncInsertConfig def
+  def = SyncInsertConfig Nothing def
 
 instance Default SyncInsertOptions where
   def =
@@ -646,6 +710,68 @@ instance Default SyncInsertOptions where
       , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
       }
 
+fullInsertOptions :: SyncInsertOptions
+fullInsertOptions =
+  SyncInsertOptions
+    { sioTxCBOR = TxCBORConfig False
+    , sioTxOut = TxOutEnable
+    , sioLedger = LedgerEnable
+    , sioShelley = ShelleyEnable
+    , sioRewards = RewardsConfig True
+    , sioMultiAsset = MultiAssetEnable
+    , sioMetadata = MetadataEnable
+    , sioPlutus = PlutusEnable
+    , sioGovernance = GovernanceConfig True
+    , sioOffchainPoolData = OffchainPoolDataConfig True
+    , sioPoolStats = PoolStatsConfig True
+    , sioJsonType = JsonTypeText
+    , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    }
+
+onlyUTxOInsertOptions :: SyncInsertOptions
+onlyUTxOInsertOptions =
+  SyncInsertOptions
+    { sioTxCBOR = TxCBORConfig False
+    , sioTxOut = TxOutBootstrap (ForceTxIn False)
+    , sioLedger = LedgerIgnore
+    , sioShelley = ShelleyDisable
+    , sioRewards = RewardsConfig True
+    , sioMultiAsset = MultiAssetDisable
+    , sioMetadata = MetadataDisable
+    , sioPlutus = PlutusDisable
+    , sioGovernance = GovernanceConfig False
+    , sioOffchainPoolData = OffchainPoolDataConfig False
+    , sioPoolStats = PoolStatsConfig False
+    , sioJsonType = JsonTypeText
+    , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    }
+
+onlyGovInsertOptions :: SyncInsertOptions
+onlyGovInsertOptions =
+  disableAllInsertOptions
+    { sioLedger = LedgerEnable
+    , sioGovernance = GovernanceConfig True
+    , sioPoolStats = PoolStatsConfig True
+    }
+
+disableAllInsertOptions :: SyncInsertOptions
+disableAllInsertOptions =
+  SyncInsertOptions
+    { sioTxCBOR = TxCBORConfig False
+    , sioTxOut = TxOutDisable
+    , sioLedger = LedgerDisable
+    , sioShelley = ShelleyDisable
+    , sioRewards = RewardsConfig False
+    , sioMultiAsset = MultiAssetDisable
+    , sioMetadata = MetadataDisable
+    , sioPlutus = PlutusDisable
+    , sioOffchainPoolData = OffchainPoolDataConfig False
+    , sioPoolStats = PoolStatsConfig False
+    , sioGovernance = GovernanceConfig False
+    , sioJsonType = JsonTypeText
+    , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    }
+
 boolToEnableDisable :: IsString s => Bool -> s
 boolToEnableDisable True = "enable"
 boolToEnableDisable False = "disable"

cardano-db-sync/test/Cardano/DbSync/ApiTest.hs

@@ -22,46 +22,47 @@ prop_extractInsertOptions :: Property
 prop_extractInsertOptions = property $ do
   cfg <- forAll Gen.syncPreConfig
 
-  let insertOpts = pcInsertConfig cfg
-  coverInsertCfg insertOpts
+  let insertCfg = pcInsertConfig cfg
+  coverInsertCfg insertCfg
 
-  case insertOpts of
-    FullInsertOptions ->
+  case insertCfg of
+    SyncInsertConfig (Just FullInsertPreset) _ ->
       extractInsertOptions cfg === fullInsertOptions
-    OnlyUTxOInsertOptions ->
+    SyncInsertConfig (Just OnlyUTxOInsertPreset) _ ->
       extractInsertOptions cfg === onlyUTxOInsertOptions
-    OnlyGovInsertOptions ->
+    SyncInsertConfig (Just OnlyGovInsertPreset) _ ->
       extractInsertOptions cfg === onlyGovInsertOptions
-    DisableAllInsertOptions ->
+    SyncInsertConfig (Just DisableAllInsertPreset) _ ->
       extractInsertOptions cfg === disableAllInsertOptions
-    SyncInsertConfig cfg' ->
-      extractInsertOptions cfg === cfg'
+    SyncInsertConfig Nothing opts ->
+      extractInsertOptions cfg === opts
 
 prop_extractInsertOptionsRewards :: Property
 prop_extractInsertOptionsRewards = property $ do
   cfg <- forAll Gen.syncPreConfig
 
-  let insertOpts = pcInsertConfig cfg
-  coverInsertCfg insertOpts
+  let insertCfg = pcInsertConfig cfg
+  coverInsertCfg insertCfg
 
   let areRewardsEnabled' = areRewardsEnabled $ sioRewards (extractInsertOptions cfg)
 
-  case insertOpts of
-    OnlyGovInsertOptions ->
+  case insertCfg of
+    SyncInsertConfig (Just OnlyGovInsertPreset) _ ->
       assert $ not areRewardsEnabled'
-    DisableAllInsertOptions ->
+    SyncInsertConfig (Just DisableAllInsertPreset) _ ->
       assert $ not areRewardsEnabled'
-    _ -> assert areRewardsEnabled'
+    _other -> assert areRewardsEnabled'
 
 coverInsertCfg :: MonadTest m => SyncInsertConfig -> m ()
 coverInsertCfg insertOpts = do
-  cover 5 "full" (insertOpts == FullInsertOptions)
-  cover 5 "only utxo" (insertOpts == OnlyUTxOInsertOptions)
-  cover 5 "only gov" (insertOpts == OnlyGovInsertOptions)
-  cover 5 "disable all" (insertOpts == DisableAllInsertOptions)
+  let preset = sicPreset insertOpts
+  cover 5 "full" (preset == Just FullInsertPreset)
+  cover 5 "only utxo" (preset == Just OnlyUTxOInsertPreset)
+  cover 5 "only gov" (preset == Just OnlyGovInsertPreset)
+  cover 5 "disable all" (preset == Just DisableAllInsertPreset)
   cover 5 "config" isSyncInsertConfig
   where
     isSyncInsertConfig =
       case insertOpts of
-        SyncInsertConfig _ -> True
-        _ -> False
+        (SyncInsertConfig Nothing _) -> True
+        _other -> False