Using a config file

bot-plutus-interface.cabal

@@ -78,6 +78,12 @@ library
     BotPlutusInterface
     BotPlutusInterface.CardanoCLI
     BotPlutusInterface.ChainIndex
+    BotPlutusInterface.Config
+    BotPlutusInterface.Config.Base
+    BotPlutusInterface.Config.Cardano.Api
+    BotPlutusInterface.Config.Cardano.Api.Shelley
+    BotPlutusInterface.Config.Ledger
+    BotPlutusInterface.Config.Types
     BotPlutusInterface.Contract
     BotPlutusInterface.Effects
     BotPlutusInterface.Files
@@ -92,6 +98,8 @@ library
     , cardano-api
     , cardano-crypto
     , cardano-ledger-alonzo
+    , config-schema
+    , config-value
     , containers
     , data-default
     , data-default-class
@@ -117,17 +125,21 @@ library
     , plutus-pab
     , plutus-tx
     , plutus-tx-plugin
+    , pretty
     , process
     , QuickCheck
+    , regex-compat
     , row-types
     , serialise
     , servant
     , servant-client
+    , servant-client-core
     , servant-server
     , servant-websockets
     , split
     , stm
     , text                       ^>=1.2.4.0
+    , tostring
     , transformers
     , transformers-either
     , uuid
@@ -144,6 +156,7 @@ test-suite bot-plutus-interface-test
   ghc-options:    -fplugin-opt PlutusTx.Plugin:defer-errors
   other-modules:
     Spec.BotPlutusInterface.Contract
+    Spec.BotPlutusInterface.Config
     Spec.BotPlutusInterface.Balance
     Spec.BotPlutusInterface.UtxoParser
     Spec.BotPlutusInterface.Server
@@ -158,6 +171,8 @@ test-suite bot-plutus-interface-test
     , bytestring                 ^>=0.10.12.0
     , cardano-api
     , cardano-crypto-class
+    , config-schema
+    , config-value
     , containers
     , data-default
     , data-default-class

src/BotPlutusInterface/Config.hs

@@ -0,0 +1,174 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+
+{-# OPTIONS -fno-warn-orphans  #-}
+
+module BotPlutusInterface.Config (
+  docPABConfig,
+  loadPABConfig,
+  savePABConfig,
+  customRationalSpec,
+) where
+
+import BotPlutusInterface.Config.Base (customRationalSpec, filepathSpec, pathSpec, portSpec)
+import BotPlutusInterface.Config.Cardano.Api ()
+import BotPlutusInterface.Config.Cardano.Api.Shelley ()
+import BotPlutusInterface.Config.Ledger ()
+import BotPlutusInterface.Config.Types
+import BotPlutusInterface.Types
+import Config
+import Config.Schema
+import Data.Default
+import Data.String
+import Data.Text qualified as Text
+import Prelude
+
+instance ToValue CLILocation where
+  toValue Local =
+    Atom () "local"
+  toValue (Remote url) = Text () url
+
+cliLocationSpec :: ValueSpec CLILocation
+cliLocationSpec =
+  Local <$ atomSpec "local"
+    <!> Remote <$> withNamePrefixSpec "destination" anySpec
+
+instance ToValue LogLevel where
+  toValue = Atom () . MkAtom . Text.toLower . Text.pack . show
+
+logLevelSpec :: ValueSpec LogLevel
+logLevelSpec =
+  Error <$ atomSpec "error"
+    <!> Warn <$ atomSpec "warn"
+    <!> Notice <$ atomSpec "notice"
+    <!> Info <$ atomSpec "info"
+    <!> Debug <$ atomSpec "debug"
+
+{- ORMOLU_DISABLE -}
+instance ToValue PABConfig where
+  toValue
+    ( PABConfig
+        pcCliLocation
+        pcChainIndexUrl
+        pcNetwork
+        pcProtocolParams
+        pcSlotConfig
+        pcScriptFileDir
+        pcSigningKeyFileDir
+        pcTxFileDir
+        pcProtocolParamsFile
+        pcDryRun
+        pcLogLevel
+        pcOwnPubKeyHash
+        pcTipPollingInterval
+        pcPort
+        pcEnableTxEndpoint
+      ) =
+      Sections
+        ()
+        [ Section () "cliLocation"        $ toValue pcCliLocation
+        , Section () "chainIndexUrl"      $ toValue pcChainIndexUrl
+        , Section () "networkId"          $ toValue pcNetwork
+        , Section () "protocolParams"     $ toValue pcProtocolParams
+        , Section () "slotConfig"         $ toValue pcSlotConfig
+        , Section () "scriptFileDir"      $ toValue pcScriptFileDir
+        , Section () "signingKeyFileDir"  $ toValue pcSigningKeyFileDir
+        , Section () "txFileDir"          $ toValue pcTxFileDir
+        , Section () "protocolParamsFile" $ toValue pcProtocolParamsFile
+        , Section () "dryRun"             $ toValue pcDryRun
+        , Section () "logLevel"           $ toValue pcLogLevel
+        , Section () "ownPubKeyHash"      $ toValue pcOwnPubKeyHash
+        , Section () "tipPollingInterval" $ toValue pcTipPollingInterval
+        , Section () "port"               $ toValue pcPort
+        , Section () "enableTxEndpoint"   $ toValue pcEnableTxEndpoint
+        ]
+{- ORMOLU_ENABLE -}
+
+instance HasSpec PABConfig where
+  anySpec = pabConfigSpec
+
+pabConfigSpec :: ValueSpec PABConfig
+pabConfigSpec = sectionsSpec "PABConfig" $ do
+  pcCliLocation <-
+    sectionWithDefault'
+      (pcCliLocation def)
+      "cliLocation"
+      cliLocationSpec
+      "calling the cli through ssh when set to destination"
+
+  pcChainIndexUrl <-
+    sectionWithDefault (pcChainIndexUrl def) "chainIndexUrl" ""
+
+  pcNetwork <-
+    sectionWithDefault (pcNetwork def) "networkId" ""
+
+  pcProtocolParams <-
+    sectionWithDefault (pcProtocolParams def) "protocolParams" ""
+
+  pcSlotConfig <-
+    sectionWithDefault (pcSlotConfig def) "slotConfig" ""
+
+  pcScriptFileDir <-
+    sectionWithDefault'
+      (pcScriptFileDir def)
+      "scriptFileDir"
+      pathSpec
+      "Directory name of the script and data files"
+
+  pcSigningKeyFileDir <-
+    sectionWithDefault'
+      (pcSigningKeyFileDir def)
+      "signingKeyFileDir"
+      pathSpec
+      "Directory name of the signing key files"
+
+  pcTxFileDir <-
+    sectionWithDefault'
+      (pcTxFileDir def)
+      "txFileDir"
+      pathSpec
+      "Directory name of the transaction files"
+
+  pcProtocolParamsFile <-
+    sectionWithDefault'
+      (pcProtocolParamsFile def)
+      "protocolParamsFile"
+      filepathSpec
+      $ Text.concat
+        [ "Protocol params file location relative to the cardano-cli working directory (needed for the cli) in JSON format. "
+        , "BE AWARE: can overwrite the 'pcProtocolParams' section."
+        ]
+
+  pcDryRun <-
+    sectionWithDefault'
+      (pcDryRun def)
+      "dryRun"
+      trueOrFalseSpec
+      "Dry run mode will build the tx, but skip the submit step"
+
+  pcLogLevel <-
+    sectionWithDefault' (pcLogLevel def) "logLevel" logLevelSpec ""
+
+  pcOwnPubKeyHash <-
+    sectionWithDefault (pcOwnPubKeyHash def) "ownPubKeyHash" ""
+
+  pcTipPollingInterval <-
+    sectionWithDefault' (pcTipPollingInterval def) "tipPollingInterval" naturalSpec ""
+
+  pcPort <-
+    sectionWithDefault' (pcPort def) "port" portSpec ""
+
+  pcEnableTxEndpoint <-
+    sectionWithDefault' (pcEnableTxEndpoint def) "enableTxEndpoint" trueOrFalseSpec ""
+
+  pure PABConfig {..}
+
+docPABConfig :: String
+docPABConfig = show $ generateDocs pabConfigSpec
+
+loadPABConfig :: FilePath -> IO (Either String PABConfig)
+loadPABConfig fn = deserialize <$> readFile fn
+
+savePABConfig :: FilePath -> PABConfig -> IO ()
+savePABConfig fn conf = writeFile fn $ serialize conf

src/BotPlutusInterface/Config/Base.hs

@@ -0,0 +1,107 @@
+{-# OPTIONS -fno-warn-orphans  #-}
+
+module BotPlutusInterface.Config.Base (
+  maybeSpec,
+  customRationalSpec,
+  portSpec,
+  pathSpec,
+  filepathSpec,
+  toValueTextViaJSON,
+  textSpecViaJSON,
+) where
+
+import BotPlutusInterface.Config.Types
+import BotPlutusInterface.Types ()
+import Config
+import Config.Schema
+import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)
+import Data.Ratio ((%))
+import Data.String
+import Data.String.ToString
+import Data.Text (Text)
+import Data.Text qualified as Text
+import Network.Wai.Handler.Warp (Port)
+import Numeric.Natural (Natural)
+import Servant.Client.Core (BaseUrl (..), parseBaseUrl, showBaseUrl)
+import Text.Regex
+import Prelude
+
+instance ToValue Bool where
+  toValue = Atom () . MkAtom . Text.toLower . Text.pack . show
+
+instance ToValue Natural where
+  toValue x = Number () $ integerToNumber $ toInteger x
+
+instance ToValue Integer where
+  toValue x = Number () $ integerToNumber x
+
+instance ToValue Text where
+  toValue = Text ()
+
+instance (ToValue a) => ToValue (Maybe a) where
+  toValue = maybe (Atom () "nothing") toValue
+
+maybeSpec :: ValueSpec a -> ValueSpec (Maybe a)
+maybeSpec spec =
+  Nothing <$ atomSpec "nothing"
+    <!> Just <$> spec
+
+instance ToValue Rational where
+  toValue x = Text () $ Text.pack $ show x
+
+customRationalSpec :: ValueSpec Rational
+customRationalSpec =
+  customSpec
+    "Ratio number (\"1 % 2\") in"
+    stringSpec
+    ( \x -> case matchRegex ratioRE x of
+        Just [n, d] ->
+          let n' = read n
+              d' = read d
+           in if d' == 0
+                then Left "denominator should not be zero"
+                else Right $ n' % d'
+        _ -> Left $ Text.pack "Ratio format: '1 % 2'"
+    )
+  where
+    ratioRE = mkRegex "^ *([0-9]+) *% *([0-9]+) *$"
+
+pathSpec :: ValueSpec Text
+pathSpec = withNamePrefixSpec "path" anySpec
+
+filepathSpec :: ValueSpec Text
+filepathSpec = withNamePrefixSpec "filepath" anySpec
+
+toValueTextViaJSON :: (ToJSON a) => a -> Value ()
+toValueTextViaJSON = Text () . Text.pack . filter (/= '"') . toString . encode
+
+textSpecViaJSON :: (FromJSON a) => Text -> ValueSpec a
+textSpecViaJSON name =
+  customSpec
+    name
+    textSpec
+    ( \s -> case eitherDecode $ fromString $ wrap $ toString s of
+        Left err -> Left $ "parse error: " <> fromString err
+        Right res -> Right res
+    )
+  where
+    wrap s = "\"" <> s <> "\""
+
+instance ToValue BaseUrl where
+  toValue = Text () . Text.pack . showBaseUrl
+
+instance HasSpec BaseUrl where
+  anySpec = baseUrlSpec
+
+baseUrlSpec :: ValueSpec BaseUrl
+baseUrlSpec =
+  customSpec
+    "url"
+    anySpec
+    (first Text.showText . parseBaseUrl . Text.unpack)
+
+instance ToValue Port where
+  toValue = Number () . integerToNumber . toInteger
+
+portSpec :: ValueSpec Port
+portSpec = fromEnum <$> customSpec "port" naturalSpec Right