|
| 1 | +{-# LANGUAGE ApplicativeDo #-} |
| 2 | +{-# LANGUAGE NamedFieldPuns #-} |
| 3 | +{-# LANGUAGE RecordWildCards #-} |
| 4 | + |
| 5 | +{-# OPTIONS -fno-warn-orphans #-} |
| 6 | + |
| 7 | +module BotPlutusInterface.Config ( |
| 8 | + docPABConfig, |
| 9 | + loadPABConfig, |
| 10 | + savePABConfig, |
| 11 | +) where |
| 12 | + |
| 13 | +import BotPlutusInterface.Types (CLILocation (..), LogLevel (..), PABConfig (..)) |
| 14 | +import Cardano.Api (ExecutionUnits (..)) |
| 15 | +import Config (Section (Section), Value (Atom, Sections, Text)) |
| 16 | +import Config.Schema ( |
| 17 | + HasSpec (anySpec), |
| 18 | + ValueSpec, |
| 19 | + atomSpec, |
| 20 | + generateDocs, |
| 21 | + naturalSpec, |
| 22 | + sectionsSpec, |
| 23 | + trueOrFalseSpec, |
| 24 | + (<!>), |
| 25 | + ) |
| 26 | +import Data.Default (def) |
| 27 | +import Data.Functor ((<&>)) |
| 28 | +import Data.String.ToString (toString) |
| 29 | +import PlutusConfig.Base ( |
| 30 | + enumToAtom, |
| 31 | + filepathSpec, |
| 32 | + maybeSpec, |
| 33 | + pathSpec, |
| 34 | + portSpec, |
| 35 | + ) |
| 36 | +import PlutusConfig.Cardano.Api () |
| 37 | +import PlutusConfig.Cardano.Api.Shelley ( |
| 38 | + readProtocolParametersJSON, |
| 39 | + writeProtocolParametersJSON, |
| 40 | + ) |
| 41 | +import PlutusConfig.Ledger () |
| 42 | +import PlutusConfig.Types ( |
| 43 | + ToValue (toValue), |
| 44 | + deserialize, |
| 45 | + sectionWithDefault, |
| 46 | + sectionWithDefault', |
| 47 | + serialize, |
| 48 | + withNamePrefixSpec, |
| 49 | + ) |
| 50 | +import Prelude |
| 51 | + |
| 52 | +instance ToValue CLILocation where |
| 53 | + toValue Local = Atom () "local" |
| 54 | + toValue (Remote url) = Text () url |
| 55 | + |
| 56 | +cliLocationSpec :: ValueSpec CLILocation |
| 57 | +cliLocationSpec = |
| 58 | + Local <$ atomSpec "local" |
| 59 | + <!> Remote <$> withNamePrefixSpec "destination" anySpec |
| 60 | + |
| 61 | +instance ToValue LogLevel where |
| 62 | + toValue = enumToAtom |
| 63 | + |
| 64 | +logLevelSpec :: ValueSpec LogLevel |
| 65 | +logLevelSpec = |
| 66 | + Error <$ atomSpec "error" |
| 67 | + <!> Warn <$ atomSpec "warn" |
| 68 | + <!> Notice <$ atomSpec "notice" |
| 69 | + <!> Info <$ atomSpec "info" |
| 70 | + <!> Debug <$ atomSpec "debug" |
| 71 | + |
| 72 | +instance ToValue (Integer, Integer) where |
| 73 | + toValue = toValue . forceBudgetToExecutionUnits |
| 74 | + |
| 75 | +instance HasSpec (Maybe (Integer, Integer)) where |
| 76 | + anySpec = maybeSpec (executionUnitsToForceBudget <$> anySpec) |
| 77 | + |
| 78 | +forceBudgetToExecutionUnits :: (Integer, Integer) -> ExecutionUnits |
| 79 | +forceBudgetToExecutionUnits (steps, memory) = |
| 80 | + ExecutionUnits (fromInteger steps) (fromInteger memory) |
| 81 | + |
| 82 | +executionUnitsToForceBudget :: ExecutionUnits -> (Integer, Integer) |
| 83 | +executionUnitsToForceBudget (ExecutionUnits steps memory) = |
| 84 | + (toInteger steps, toInteger memory) |
| 85 | + |
| 86 | +{- ORMOLU_DISABLE -} |
| 87 | +instance ToValue PABConfig where |
| 88 | + toValue |
| 89 | + ( PABConfig |
| 90 | + pcCliLocation |
| 91 | + pcChainIndexUrl |
| 92 | + pcNetwork |
| 93 | + _pcProtocolParams |
| 94 | + pcSlotConfig |
| 95 | + pcScriptFileDir |
| 96 | + pcSigningKeyFileDir |
| 97 | + pcTxFileDir |
| 98 | + pcProtocolParamsFile |
| 99 | + pcDryRun |
| 100 | + pcLogLevel |
| 101 | + pcOwnPubKeyHash |
| 102 | + pcOwnStakePubKeyHash |
| 103 | + pcTipPollingInterval |
| 104 | + pcForceBudget |
| 105 | + pcPort |
| 106 | + pcEnableTxEndpoint |
| 107 | + ) = |
| 108 | + Sections |
| 109 | + () |
| 110 | + [ Section () "cliLocation" $ toValue pcCliLocation |
| 111 | + , Section () "chainIndexUrl" $ toValue pcChainIndexUrl |
| 112 | + , Section () "networkId" $ toValue pcNetwork |
| 113 | + -- due to conflict, should be stored in pcProtocolParamsFile .json file |
| 114 | + -- , Section () "protocolParams" $ toValue pcProtocolParams |
| 115 | + , Section () "slotConfig" $ toValue pcSlotConfig |
| 116 | + , Section () "scriptFileDir" $ toValue pcScriptFileDir |
| 117 | + , Section () "signingKeyFileDir" $ toValue pcSigningKeyFileDir |
| 118 | + , Section () "txFileDir" $ toValue pcTxFileDir |
| 119 | + , Section () "protocolParamsFile" $ toValue pcProtocolParamsFile |
| 120 | + , Section () "dryRun" $ toValue pcDryRun |
| 121 | + , Section () "logLevel" $ toValue pcLogLevel |
| 122 | + , Section () "ownPubKeyHash" $ toValue pcOwnPubKeyHash |
| 123 | + , Section () "ownStakePubKeyHash" $ toValue pcOwnStakePubKeyHash |
| 124 | + , Section () "tipPollingInterval" $ toValue pcTipPollingInterval |
| 125 | + , Section () "forceBudget" $ toValue pcForceBudget |
| 126 | + , Section () "port" $ toValue pcPort |
| 127 | + , Section () "enableTxEndpoint" $ toValue pcEnableTxEndpoint |
| 128 | + ] |
| 129 | +{- ORMOLU_ENABLE -} |
| 130 | + |
| 131 | +instance HasSpec PABConfig where |
| 132 | + anySpec = pabConfigSpec |
| 133 | + |
| 134 | +pabConfigSpec :: ValueSpec PABConfig |
| 135 | +pabConfigSpec = sectionsSpec "PABConfig" $ do |
| 136 | + pcCliLocation <- |
| 137 | + sectionWithDefault' |
| 138 | + (pcCliLocation def) |
| 139 | + "cliLocation" |
| 140 | + cliLocationSpec |
| 141 | + "calling the cli through ssh when set to destination" |
| 142 | + |
| 143 | + pcChainIndexUrl <- |
| 144 | + sectionWithDefault (pcChainIndexUrl def) "chainIndexUrl" "" |
| 145 | + |
| 146 | + pcNetwork <- |
| 147 | + sectionWithDefault (pcNetwork def) "networkId" "" |
| 148 | + |
| 149 | + -- due to conflict with pcProtocolParams, should got from |
| 150 | + -- pcProtocolParamsFile .json file |
| 151 | + -- pcProtocolParams <- |
| 152 | + -- sectionWithDefault (pcProtocolParams def) "protocolParams" "" |
| 153 | + let pcProtocolParams = def |
| 154 | + |
| 155 | + pcSlotConfig <- |
| 156 | + sectionWithDefault (pcSlotConfig def) "slotConfig" "" |
| 157 | + |
| 158 | + pcScriptFileDir <- |
| 159 | + sectionWithDefault' |
| 160 | + (pcScriptFileDir def) |
| 161 | + "scriptFileDir" |
| 162 | + pathSpec |
| 163 | + "Directory name of the script and data files" |
| 164 | + |
| 165 | + pcSigningKeyFileDir <- |
| 166 | + sectionWithDefault' |
| 167 | + (pcSigningKeyFileDir def) |
| 168 | + "signingKeyFileDir" |
| 169 | + pathSpec |
| 170 | + "Directory name of the signing key files" |
| 171 | + |
| 172 | + pcTxFileDir <- |
| 173 | + sectionWithDefault' |
| 174 | + (pcTxFileDir def) |
| 175 | + "txFileDir" |
| 176 | + pathSpec |
| 177 | + "Directory name of the transaction files" |
| 178 | + |
| 179 | + pcProtocolParamsFile <- |
| 180 | + sectionWithDefault' |
| 181 | + (pcProtocolParamsFile def) |
| 182 | + "protocolParamsFile" |
| 183 | + filepathSpec |
| 184 | + "Protocol params file location relative to the cardano-cli working directory (needed for the cli) in JSON format. " |
| 185 | + |
| 186 | + pcDryRun <- |
| 187 | + sectionWithDefault' |
| 188 | + (pcDryRun def) |
| 189 | + "dryRun" |
| 190 | + trueOrFalseSpec |
| 191 | + "Dry run mode will build the tx, but skip the submit step" |
| 192 | + |
| 193 | + pcLogLevel <- |
| 194 | + sectionWithDefault' (pcLogLevel def) "logLevel" logLevelSpec "" |
| 195 | + |
| 196 | + pcOwnPubKeyHash <- |
| 197 | + sectionWithDefault (pcOwnPubKeyHash def) "ownPubKeyHash" "" |
| 198 | + |
| 199 | + pcOwnStakePubKeyHash <- |
| 200 | + sectionWithDefault' (pcOwnStakePubKeyHash def) "ownStakePubKeyHash" (maybeSpec anySpec) "" |
| 201 | + |
| 202 | + pcTipPollingInterval <- |
| 203 | + sectionWithDefault' (pcTipPollingInterval def) "tipPollingInterval" naturalSpec "" |
| 204 | + |
| 205 | + pcForceBudget <- |
| 206 | + sectionWithDefault |
| 207 | + (pcForceBudget def) |
| 208 | + "forceBudget" |
| 209 | + "Forced budget for scripts, as optional (CPU Steps, Memory Units)" |
| 210 | + |
| 211 | + pcPort <- |
| 212 | + sectionWithDefault' (pcPort def) "port" portSpec "" |
| 213 | + |
| 214 | + pcEnableTxEndpoint <- |
| 215 | + sectionWithDefault' (pcEnableTxEndpoint def) "enableTxEndpoint" trueOrFalseSpec "" |
| 216 | + |
| 217 | + pure PABConfig {..} |
| 218 | + |
| 219 | +docPABConfig :: String |
| 220 | +docPABConfig = show $ generateDocs pabConfigSpec |
| 221 | + |
| 222 | +loadPABConfig :: FilePath -> IO (Either String PABConfig) |
| 223 | +loadPABConfig fn = do |
| 224 | + confE <- deserialize <$> readFile fn |
| 225 | + case confE of |
| 226 | + Left err -> return $ Left $ "PABConfig: " <> fn <> ": " <> err |
| 227 | + Right conf@PABConfig {pcProtocolParamsFile} -> do |
| 228 | + readProtocolParametersJSON (toString pcProtocolParamsFile) |
| 229 | + <&> \case |
| 230 | + Left err -> Left $ "protocolParamsFile: " <> toString pcProtocolParamsFile <> ": " <> err |
| 231 | + Right pcProtocolParams -> Right conf {pcProtocolParams} |
| 232 | + |
| 233 | +savePABConfig :: FilePath -> PABConfig -> IO () |
| 234 | +savePABConfig fn conf@PABConfig {pcProtocolParams, pcProtocolParamsFile} = do |
| 235 | + writeProtocolParametersJSON (toString pcProtocolParamsFile) pcProtocolParams |
| 236 | + writeFile fn $ serialize conf <> "\n" |
0 commit comments