diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 2d1db0b1..c0d58a60 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -45,9 +45,9 @@ jobs: - name: Download fourmolu uses: supplypike/setup-bin@v1 with: - uri: 'https://github.com/fourmolu/fourmolu/releases/download/v0.9.0.0/fourmolu-0.9.0.0-linux-x86_64' + uri: 'https://github.com/fourmolu/fourmolu/releases/download/v0.13.1.0/fourmolu-0.13.1.0-linux-x86_64' name: 'fourmolu' - version: '0.9.0.0' + version: '0.13.1.0' - name: Checkout project uses: actions/checkout@v2 diff --git a/app/Main.hs b/app/Main.hs index 2edd60f9..f74db2c7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -14,9 +14,9 @@ ccPrefs = prefShowHelpOnEmpty = True } --- |Set the encoding on the given handle in such a way that unsupported --- characters are replaced with a replacement character. --- See: https://hackage.haskell.org/package/base-4.14.0.0/docs/System-IO.html#v:mkTextEncoding +-- | Set the encoding on the given handle in such a way that unsupported +-- characters are replaced with a replacement character. +-- See: https://hackage.haskell.org/package/base-4.14.0.0/docs/System-IO.html#v:mkTextEncoding setReplacement :: Handle -> IO () setReplacement h = do ce' <- hGetEncoding h diff --git a/deps/concordium-base b/deps/concordium-base index b2281716..77e926c0 160000 --- a/deps/concordium-base +++ b/deps/concordium-base @@ -1 +1 @@ -Subproject commit b228171650f890818466b28d417bfbf8c11cdd98 +Subproject commit 77e926c0d261a038b712385de279ef0cb622c871 diff --git a/fourmolu.yaml b/fourmolu.yaml index fad47e57..ecee11df 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -1,12 +1,26 @@ indentation: 4 # How many spaces to use as an indent. +column-limit: none # We do not set a limit as it may break idempotence. function-arrows: trailing # Where to place arrows in type signatures. comma-style: trailing # Where to place commas in lists, tuples, etc. import-export-style: diff-friendly # How to format multiline import/export lists (diff-friendly lists have trailing commas but keep the opening parenthesis on the same line as import). -record-brace-space: false # rec {x = 1} vs. rec{x = 1}. indent-wheres: false # 'false' means save space by only half-indenting the 'where' keyword. +record-brace-space: false # rec {x = 1} vs. rec{x = 1}. newlines-between-decls: 1 # number of newlines between top-level declarations. haddock-style: single-line # Use -- |, {- |, or {-| for multiline haddocks (single-line haddocks always use --). let-style: auto # How to style let blocks (auto uses newline if there's a newline in the input and inline otherwise, and mixed uses inline only when the let has exactly one binding). in-style: left-align # How to align the in keyword with respect to let. +single-constraint-parens: always # Whether to put parentheses round a single constraint +unicode: never respectful: true # Be less aggressive in reformatting input, e.g. keep empty lines in import list. -fixities: [] # Override fixities of operators. +fixities: # Override fixities of operators. + # This operator is defined in Concordium.Utils. Fourmolu seems to ignore its fixity specification. + - infixr 0 $!! + # Fourmolu incorrectly determines the fixity of operators re-exported in Lens.Micro.Platform. + # We make explicit those that are in Lens.Micro.Mtl, since it does not seem sufficient to + # use a reexport directive. + - infixl 1 &, <&>, &~ + - infixr 2 <~ + - infix 4 .=, ?=, +=, -=, *=, //=, <%=, <.=, ((,) <$> backendParser <*> txOptions)) (fullDesc <> progDesc "Generate transactions for a fixed contract.") -sendTx :: MonadIO m => BareBlockItem -> ClientMonad m BareBlockItem +sendTx :: (MonadIO m) => BareBlockItem -> ClientMonad m BareBlockItem sendTx tx = do sbiRes <- sendBlockItem tx let res = case sbiRes of @@ -75,7 +75,7 @@ sendTx tx = do Left err -> liftIO $ die $ "Could not send transaction: " <> err Right _ -> return tx -iterateM_ :: Monad m => (a -> m a) -> a -> m b +iterateM_ :: (Monad m) => (a -> m a) -> a -> m b iterateM_ f a = f a >>= iterateM_ f go :: Backend -> Bool -> Int -> a -> (Nonce -> a -> IO (AccountAddress, BareBlockItem, a)) -> Nonce -> IO () diff --git a/src/Concordium/Client/Cli.hs b/src/Concordium/Client/Cli.hs index 14f24335..ad8ef139 100644 --- a/src/Concordium/Client/Cli.hs +++ b/src/Concordium/Client/Cli.hs @@ -38,13 +38,13 @@ import Prelude hiding (fail, log) data Level = Info | Warn | Err deriving (Eq) --- |Log a list of sentences. The sentences are pretty printed (capital first letter and dot at the end), --- so the input messages should only contain capital letters for names and have no dot suffix. --- Sentences will be joined on the same line as long as the resulting line doesn't exceed 90 chars. --- Depending on the log level, an appropriate prefix is added to the first line. --- All lines will be indented such that they align with the first line --- (i.e. as if they had all been prefixed). -log :: MonadIO m => Level -> Maybe Color -> [String] -> m () +-- | Log a list of sentences. The sentences are pretty printed (capital first letter and dot at the end), +-- so the input messages should only contain capital letters for names and have no dot suffix. +-- Sentences will be joined on the same line as long as the resulting line doesn't exceed 90 chars. +-- Depending on the log level, an appropriate prefix is added to the first line. +-- All lines will be indented such that they align with the first line +-- (i.e. as if they had all been prefixed). +log :: (MonadIO m) => Level -> Maybe Color -> [String] -> m () log lvl color msgs = do let doc = prefix <+> fsep (expandLines $ map (prettyMsg ".") msgs) out = logStrLn $ renderStyle s doc @@ -61,26 +61,26 @@ log lvl color msgs = do Warn -> text "Warning:" Err -> text "Error:" -logSuccess :: MonadIO m => [String] -> m () +logSuccess :: (MonadIO m) => [String] -> m () logSuccess = log Info $ Just Green -logInfo :: MonadIO m => [String] -> m () +logInfo :: (MonadIO m) => [String] -> m () logInfo = log Info Nothing -logWarn :: MonadIO m => [String] -> m () +logWarn :: (MonadIO m) => [String] -> m () logWarn = log Warn $ Just Yellow -logError :: MonadIO m => [String] -> m () +logError :: (MonadIO m) => [String] -> m () logError = log Err $ Just Red -logFatal :: MonadIO m => [String] -> m a +logFatal :: (MonadIO m) => [String] -> m a logFatal msgs = logError msgs >> liftIO exitFailure -withLogFatal :: MonadIO m => Either e' a -> (e' -> String) -> m a +withLogFatal :: (MonadIO m) => Either e' a -> (e' -> String) -> m a withLogFatal (Left x) f = logFatal [f x] withLogFatal (Right x) _ = return x -logFatalOnError :: MonadIO m => Either String a -> m a +logFatalOnError :: (MonadIO m) => Either String a -> m a logFatalOnError x = x `withLogFatal` id withLogFatalIO :: IO (Either e' a) -> (e' -> String) -> IO a @@ -94,15 +94,15 @@ withLogFatalIO' e action = Nothing -> logFatal [e] Just x -> return x -logExit :: MonadIO m => [String] -> m a +logExit :: (MonadIO m) => [String] -> m a logExit msgs = logInfo msgs >> liftIO exitSuccess --- |Expand each string into a document of the string's lines joined together using vcat. +-- | Expand each string into a document of the string's lines joined together using vcat. expandLines :: [String] -> [Doc] expandLines = map $ vcat . map text . lines --- |Ensure that a string is printable as a sentence by converting the first letter to upper case --- and, unless it already ends with "standard" punctuation, appending the provided punctionation. +-- | Ensure that a string is printable as a sentence by converting the first letter to upper case +-- and, unless it already ends with "standard" punctuation, appending the provided punctionation. prettyMsg :: String -> String -> String prettyMsg punctuation = \case "" -> "" @@ -115,16 +115,16 @@ prettyMsg punctuation = \case where p = ".,:;?!{}" :: String -logStr :: MonadIO m => String -> m () +logStr :: (MonadIO m) => String -> m () logStr = liftIO . hPutStr stderr -logStrLn :: MonadIO m => String -> m () +logStrLn :: (MonadIO m) => String -> m () logStrLn = liftIO . hPutStrLn stderr --- |Ask the user to "confirm" on stdin and return the result. --- Note that this only appends " [yN]: " if the prompt does not end in --- one of ".,:;?!{}" -askConfirmation :: MonadIO m => Maybe String -> m Bool +-- | Ask the user to "confirm" on stdin and return the result. +-- Note that this only appends " [yN]: " if the prompt does not end in +-- one of ".,:;?!{}" +askConfirmation :: (MonadIO m) => Maybe String -> m Bool askConfirmation prompt = liftIO $ do putStr $ prettyMsg " [yN]: " $ fromMaybe defaultPrompt prompt input <- T.getLine @@ -209,8 +209,8 @@ decryptAccountEncryptionSecretKeyInteractive secret = do pwd <- liftIO $ askPassword $ "Enter password for decrypting the secret encryption key: " decryptAccountEncryptionSecretKey pwd secret --- |Standardized method of exiting the command because the transaction is cancelled. -exitTransactionCancelled :: MonadIO m => m a +-- | Standardized method of exiting the command because the transaction is cancelled. +exitTransactionCancelled :: (MonadIO m) => m a exitTransactionCancelled = liftIO $ logExit ["transaction cancelled"] getLocalTimeOfDay :: IO TimeOfDay @@ -259,7 +259,7 @@ data BakerKeys = BakerKeys bkAggrVerifyKey :: Bls.PublicKey, bkElectionSignKey :: VRF.SecretKey, bkElectionVerifyKey :: VRF.PublicKey, - -- |The id of the baker these keys belong to, if known. + -- | The id of the baker these keys belong to, if known. bkBakerId :: Maybe BakerId } @@ -305,13 +305,13 @@ bakerPublicKeysToPairs v = ] ++ ["bakerId" .= bid | bid <- maybeToList (bkBakerId v)] --- |Hardcoded network ID. +-- | Hardcoded network ID. defaultNetId :: Int defaultNetId = 100 --- |If the string starts with @ we assume the remaining characters are a file name --- and we try to read the contents of that file. -decodeJsonArg :: FromJSON a => String -> Maybe (IO (Either String a)) +-- | If the string starts with @ we assume the remaining characters are a file name +-- and we try to read the contents of that file. +decodeJsonArg :: (FromJSON a) => String -> Maybe (IO (Either String a)) decodeJsonArg s = Just $ do res <- case uncons s of diff --git a/src/Concordium/Client/Commands.hs b/src/Concordium/Client/Commands.hs index 734ef2af..6f4c6cd5 100644 --- a/src/Concordium/Client/Commands.hs +++ b/src/Concordium/Client/Commands.hs @@ -185,7 +185,7 @@ data TransactionCmd } | TransactionStatus { tsHash :: !Text, - -- |Path to a contract schema, used to display the transaction event info. + -- | Path to a contract schema, used to display the transaction event info. tsSchema :: !(Maybe FilePath) } | TransactionSendCcd @@ -196,7 +196,7 @@ data TransactionCmd } | TransactionSendWithSchedule { twsReceiver :: !Text, - -- |Eiher total amount, interval, number of intervals and starting time or a raw list of timestamps and amounts. + -- | Eiher total amount, interval, number of intervals and starting time or a raw list of timestamps and amounts. twsSchedule :: !(Either (Amount, Interval, Int, Timestamp) [(Timestamp, Amount)]), twsMemo :: !(Maybe MemoInput), twsOpts :: !(TransactionOpts (Maybe Energy)) @@ -239,178 +239,178 @@ data AccountCmd aukCredId :: !CredentialRegistrationID, aukTransactionOpts :: !(TransactionOpts (Maybe Energy)) } - | -- |Transfer part of the public balance to the encrypted balance of the - -- account. + | -- | Transfer part of the public balance to the encrypted balance of the + -- account. AccountEncrypt { aeTransactionOpts :: !(TransactionOpts (Maybe Energy)), -- | Amount to transfer from public to encrypted balance. aeAmount :: !Amount } - | -- |Transfer part of the encrypted balance to the public balance of the - -- account. + | -- | Transfer part of the encrypted balance to the public balance of the + -- account. AccountDecrypt { adTransactionOpts :: !(TransactionOpts (Maybe Energy)), - -- |Amount to transfer from encrypted to public balance. + -- | Amount to transfer from encrypted to public balance. adAmount :: !Amount, -- | Which indices of incoming amounts to use as inputs. -- If none are provided all existing ones will be used. adIndex :: !(Maybe Int) } - | -- |Updated credentials and account threshold (i.e. how many credential holders that need to sign transactions) + | -- | Updated credentials and account threshold (i.e. how many credential holders that need to sign transactions) AccountUpdateCredentials { aucNewCredInfos :: !(Maybe FilePath), -- File containing the new CredentialDeploymentInformation's aucRemoveCredIds :: !(Maybe FilePath), -- File containing the CredentialRegistrationID's for the credentials to be removed aucNewThreshold :: !AccountThreshold, -- The new account threshold aucTransactionOpts :: !(TransactionOpts (Maybe Energy)) } - | -- |Show an alias for the account. + | -- | Show an alias for the account. AccountShowAlias - { -- |Name or address of the account. + { -- | Name or address of the account. asaAddress :: !Text, asaAlias :: !Word } deriving (Show) data ModuleCmd - = -- |Deploy the provided smart contract module on chain. + = -- | Deploy the provided smart contract module on chain. ModuleDeploy - { -- |Path to the module. + { -- | Path to the module. mdModuleFile :: !FilePath, - -- |Local alias for the module reference. + -- | Local alias for the module reference. mdName :: !(Maybe Text), - -- |Optional Wasm version for the module. + -- | Optional Wasm version for the module. mdWasmVersion :: !(Maybe Wasm.WasmVersion), - -- |Options for transaction. + -- | Options for transaction. mdTransactionOpts :: !(TransactionOpts (Maybe Energy)) } - | -- |List all modules. + | -- | List all modules. ModuleList - { -- |Hash of the block (default "best"). + { -- | Hash of the block (default "best"). mlBlockHash :: !(Maybe Text) } - | -- |Output the binary source code of the module to the provided file. + | -- | Output the binary source code of the module to the provided file. ModuleShow - { -- |Reference to the module OR a module name. + { -- | Reference to the module OR a module name. msModuleRefOrName :: !Text, - -- |Output the module to this file. - -- Use '-' to output to stdout. + -- | Output the module to this file. + -- Use '-' to output to stdout. msOutFile :: !FilePath, - -- |Hash of the block (default "best"). + -- | Hash of the block (default "best"). msBlockHash :: !(Maybe Text) } - | -- |Show the functions available in a module, including type signatures if schema is provided. + | -- | Show the functions available in a module, including type signatures if schema is provided. ModuleInspect - { -- |Reference to the module OR a module name. + { -- | Reference to the module OR a module name. miModuleRefOrName :: !Text, - -- |Path to a contract schema, used to display the type signatures. + -- | Path to a contract schema, used to display the type signatures. miSchema :: !(Maybe FilePath), - -- |Hash of the block (default "best"). + -- | Hash of the block (default "best"). miBlockHash :: !(Maybe Text) } - | -- |Add a local name to a module. + | -- | Add a local name to a module. ModuleName - { -- |Module reference OR path to the module (reference then calculated by hashing). + { -- | Module reference OR path to the module (reference then calculated by hashing). mnModule :: !String, - -- |Name for the module. + -- | Name for the module. mnName :: !Text, - -- |Optional Wasm version for the module. + -- | Optional Wasm version for the module. mnWasmVersion :: !(Maybe Wasm.WasmVersion) } - | -- |Remove a local name from the module name map + | -- | Remove a local name from the module name map ModuleRemoveName - { -- |The module name to remove + { -- | The module name to remove mrnText :: !Text } deriving (Show) data ContractCmd - = -- |Show the state of specified contract. + = -- | Show the state of specified contract. ContractShow - { -- |Index of the contract address OR a contract name. + { -- | Index of the contract address OR a contract name. csAddressIndexOrName :: !Text, - -- |Subindex of the address for the contract (default: 0). + -- | Subindex of the address for the contract (default: 0). csAddressSubindex :: !(Maybe Word64), - -- |Path to a contract schema, used to display the contract info. + -- | Path to a contract schema, used to display the contract info. csSchema :: !(Maybe FilePath), - -- |Hash of the block (default "best"). + -- | Hash of the block (default "best"). csBlockHash :: !(Maybe Text) } - | -- |List all contracts on chain. + | -- | List all contracts on chain. ContractList - { -- |Hash of the block (default "best"). + { -- | Hash of the block (default "best"). clBlockHash :: !(Maybe Text) } - | -- |Initialize a contract from a module on chain. + | -- | Initialize a contract from a module on chain. ContractInit - { -- |Module reference OR module name OR (if ciPath == True) path to the module (reference then calculated by hashing). + { -- | Module reference OR module name OR (if ciPath == True) path to the module (reference then calculated by hashing). ciModule :: !String, - -- |Name of the contract to initialize. This corresponds to a specific init function. + -- | Name of the contract to initialize. This corresponds to a specific init function. ciContractName :: !Text, - -- |Optional path to a JSON or binary file containing parameters for the init function. + -- | Optional path to a JSON or binary file containing parameters for the init function. ciParameterFileJSON :: !(Maybe ParameterFileInput), - -- |Path to a contract schema. + -- | Path to a contract schema. ciSchema :: !(Maybe FilePath), - -- |Local alias for the contract address. + -- | Local alias for the contract address. ciName :: !(Maybe Text), - -- |Determines whether ciModule should be interpreted as a path. + -- | Determines whether ciModule should be interpreted as a path. ciPath :: !Bool, - -- |Optional Wasm version for the module. + -- | Optional Wasm version for the module. ciWasmVersion :: !(Maybe Wasm.WasmVersion), - -- |Amount to be send to contract (default: 0). + -- | Amount to be send to contract (default: 0). ciAmount :: !Amount, - -- |Options for transaction. + -- | Options for transaction. ciTransactionOpts :: !(TransactionOpts Energy) } - | -- |Update an existing contract, i.e. invoke a receive function. + | -- | Update an existing contract, i.e. invoke a receive function. ContractUpdate - { -- |Index of the contract address OR a contract name. + { -- | Index of the contract address OR a contract name. cuAddressIndexOrName :: !Text, - -- |Subindex of the address for the contract to invoke (default: 0). + -- | Subindex of the address for the contract to invoke (default: 0). cuAddressSubindex :: !(Maybe Word64), - -- |Name of the receive function to use. + -- | Name of the receive function to use. cuReceiveName :: !Text, - -- |Optional path to a JSON or binary file containing parameters for the receive function. + -- | Optional path to a JSON or binary file containing parameters for the receive function. cuParameterFileJSON :: !(Maybe ParameterFileInput), - -- |Path to a contract schema. + -- | Path to a contract schema. cuSchema :: !(Maybe FilePath), - -- |Amount to invoke the receive function with (default: 0). + -- | Amount to invoke the receive function with (default: 0). cuAmount :: !Amount, - -- |Options for transaction. + -- | Options for transaction. cuTransactionOpts :: !(TransactionOpts Energy) } - | -- |Invoke a contract locally and view its output. + | -- | Invoke a contract locally and view its output. ContractInvoke - { -- |Index of the contract address OR a contract name. + { -- | Index of the contract address OR a contract name. civAddressIndexOrName :: !Text, - -- |Subindex of the address fro the contract to invoke (default: 0). + -- | Subindex of the address fro the contract to invoke (default: 0). civAddressSubindex :: !(Maybe Word64), - -- |Name of the receive function to use. + -- | Name of the receive function to use. civReceiveName :: !Text, - -- |Optional path to a JSON or binary file containing parameters for the receive function. + -- | Optional path to a JSON or binary file containing parameters for the receive function. civParameterFile :: !(Maybe ParameterFileInput), - -- |Path to a contract schema. + -- | Path to a contract schema. civSchema :: !(Maybe FilePath), - -- |Amount to invoke the receive function with (default: 0). + -- | Amount to invoke the receive function with (default: 0). civAmount :: !Amount, - -- |Account address or name to use as invoker. + -- | Account address or name to use as invoker. civInvoker :: !(Maybe InvokerInput), - -- |Maximum energy allowed for the invocation (default: 10,000,000). + -- | Maximum energy allowed for the invocation (default: 10,000,000). civMaxEnergy :: !(Maybe Energy), - -- |Hash of the block (default: "best"). + -- | Hash of the block (default: "best"). civBlockHash :: !(Maybe Text) } - | -- |Add a local name to a contract. + | -- | Add a local name to a contract. ContractName - { -- |Index of the address for the contract. + { -- | Index of the address for the contract. cnAddressIndex :: !Word64, - -- |Subindex of the address for the contract (default: 0). + -- | Subindex of the address for the contract (default: 0). cnAddressSubindex :: !(Maybe Word64), - -- |Name for the contract. + -- | Name for the contract. cnName :: !Text } - | -- |Remove a local name from the contract name map + | -- | Remove a local name from the contract name map ContractRemoveName - { -- |The contract name to remove + { -- | The contract name to remove crnText :: !Text } deriving (Show) @@ -626,19 +626,19 @@ tlsParser = <> help "Enable TLS." ) --- |Parse transactionOpts with an optional energy flag +-- | Parse transactionOpts with an optional energy flag transactionOptsParser :: Parser (TransactionOpts (Maybe Energy)) transactionOptsParser = transactionOptsParserBuilder $ optional (option (eitherReader energyFromStringInform) (long "energy" <> metavar "MAX-ENERGY" <> help "Maximum allowed amount of energy to spend on transaction.")) --- |Parse transactionOpts with a required energy flag +-- | Parse transactionOpts with a required energy flag requiredEnergyTransactionOptsParser :: Parser (TransactionOpts Energy) requiredEnergyTransactionOptsParser = transactionOptsParserBuilder $ option (eitherReader energyFromStringInform) (long "energy" <> metavar "MAX-ENERGY" <> help "Maximum allowed amount of energy to spend on transaction.") --- |Helper function to build an transactionOptsParser with or without a required energy flag +-- | Helper function to build an transactionOptsParser with or without a required energy flag transactionOptsParserBuilder :: Parser energyOrMaybe -> Parser (TransactionOpts energyOrMaybe) transactionOptsParserBuilder energyOrMaybeParser = TransactionOpts @@ -1025,7 +1025,7 @@ moduleCmds = (progDesc "Commands for inspecting and deploying modules.") ) --- |Parse a contract version. +-- | Parse a contract version. contractVersionOption :: Parser Wasm.WasmVersion contractVersionOption = option @@ -1953,16 +1953,16 @@ identityShowARsCmd = docFromLines :: [String] -> Maybe P.Doc docFromLines = Just . P.vsep . map P.text --- |A parameter file used for initializing, updating, and invoking smart contracts. --- For the JSON parameter a schema must be embedded in the module or supplied with the --schema flag. --- The schema is then used to serialize the JSON to binary. +-- | A parameter file used for initializing, updating, and invoking smart contracts. +-- For the JSON parameter a schema must be embedded in the module or supplied with the --schema flag. +-- The schema is then used to serialize the JSON to binary. data ParameterFileInput = ParameterJSON FilePath | ParameterBinary FilePath deriving (Show) --- |Parse an optional parameter file. --- Either with '--parameter-json' or '--parameter-binary', but not both. +-- | Parse an optional parameter file. +-- Either with '--parameter-json' or '--parameter-binary', but not both. parameterFileParser :: Parser (Maybe ParameterFileInput) parameterFileParser = optional @@ -1986,9 +1986,9 @@ parameterFileParser = ) ) --- |An invoker of a smart contract used with 'contract invoke'. --- The invoker can either be an account or a contract. --- For the contract, the subindex is optional and defaults to 0. +-- | An invoker of a smart contract used with 'contract invoke'. +-- The invoker can either be an account or a contract. +-- For the contract, the subindex is optional and defaults to 0. data InvokerInput = InvokerAccount Text | InvokerContract @@ -1997,9 +1997,9 @@ data InvokerInput } deriving (Show) --- |Parse an optional invoker. --- Either with '--invoker-account' or '--invoker-contract', but not both. --- If the invoker is a contract, the subindex can be provided with '--invoker-contract-subindex'. +-- | Parse an optional invoker. +-- Either with '--invoker-account' or '--invoker-contract', but not both. +-- If the invoker is a contract, the subindex can be provided with '--invoker-contract-subindex'. invokerParser :: Parser (Maybe InvokerInput) invokerParser = optional $ diff --git a/src/Concordium/Client/Config.hs b/src/Concordium/Client/Config.hs index 3743d579..70ea2af8 100644 --- a/src/Concordium/Client/Config.hs +++ b/src/Concordium/Client/Config.hs @@ -43,48 +43,48 @@ import Text.Printf import Text.Read (readMaybe) -- | ---The layout of the config directory is shown in this example: +-- The layout of the config directory is shown in this example: -- --- @ --- --- ├── accounts --- │   ├── names.map --- │   ├── --- │   │   ├── --- │   │   │ ├── keypair0.json --- │   │   │ ├── keypair1.json --- │   │   │ ├── .threshold --- │   │   │ ├── .index --- │   │   ... --- │   │   │ └── encSecretKey.json --- │   │   ├── --- │   │   │ ├── keypair0.json --- │   │   │ ├── keypair1.json --- │   │   │ ├── .threshold --- │   │   │ ├── .index --- │   │   ... --- │   │   │ └── encSecretKey.json --- │   ├── .threshold --- │   ├── --- │   │   ├── --- │   │   │ ├── keypair0.json --- │   │   │ ├── keypair1.json --- │   │   │ ├── .threshold --- │   │   │ ├── .index --- │   │   ... --- │   │   │ └── encSecretKey.json --- │   │   ├── --- │   │   │ ├── keypair0.json --- │   │   │ ├── keypair1.json --- │   │   │ ├── .threshold --- │   │   │ ├── .index --- │   │   ... --- │   │   │ └── encSecretKey.json --- │   ├── .threshold --- └── contracts --- ├── contractNames.map --- └── moduleNames.map --- @ +-- @ +-- +-- ├── accounts +-- │   ├── names.map +-- │   ├── +-- │   │   ├── +-- │   │   │ ├── keypair0.json +-- │   │   │ ├── keypair1.json +-- │   │   │ ├── .threshold +-- │   │   │ ├── .index +-- │   │   ... +-- │   │   │ └── encSecretKey.json +-- │   │   ├── +-- │   │   │ ├── keypair0.json +-- │   │   │ ├── keypair1.json +-- │   │   │ ├── .threshold +-- │   │   │ ├── .index +-- │   │   ... +-- │   │   │ └── encSecretKey.json +-- │   ├── .threshold +-- │   ├── +-- │   │   ├── +-- │   │   │ ├── keypair0.json +-- │   │   │ ├── keypair1.json +-- │   │   │ ├── .threshold +-- │   │   │ ├── .index +-- │   │   ... +-- │   │   │ └── encSecretKey.json +-- │   │   ├── +-- │   │   │ ├── keypair0.json +-- │   │   │ ├── keypair1.json +-- │   │   │ ├── .threshold +-- │   │   │ ├── .index +-- │   │   ... +-- │   │   │ └── encSecretKey.json +-- │   ├── .threshold +-- └── contracts +-- ├── contractNames.map +-- └── moduleNames.map +-- @ type BaseConfigDir = FilePath type AccountConfigDir = FilePath @@ -92,23 +92,23 @@ type ContractConfigDir = FilePath -- JSON HELPERS --- |Serialize to JSON and pretty-print. -showPrettyJSON :: AE.ToJSON a => a -> String +-- | Serialize to JSON and pretty-print. +showPrettyJSON :: (AE.ToJSON a) => a -> String showPrettyJSON = unpack . decodeUtf8 . BSL.toStrict . AE.encodePretty --- |Serialize to JSON, order by keys, and pretty-print. -showSortedPrettyJSON :: AE.ToJSON a => a -> String +-- | Serialize to JSON, order by keys, and pretty-print. +showSortedPrettyJSON :: (AE.ToJSON a) => a -> String showSortedPrettyJSON = unpack . decodeUtf8 . BSL.toStrict . AE.encodePretty' config where config = AE.defConfig{AE.confCompare = compare} --- |Serialize to JSON, order by keys, and pretty-print without whitespace. -showCompactPrettyJSON :: AE.ToJSON a => a -> String +-- | Serialize to JSON, order by keys, and pretty-print without whitespace. +showCompactPrettyJSON :: (AE.ToJSON a) => a -> String showCompactPrettyJSON = unpack . decodeUtf8 . BSL.toStrict . AE.encodePretty' config where config = AE.defConfig{AE.confIndent = AE.Spaces 0, AE.confCompare = compare} --- |The default location of the config root directory. +-- | The default location of the config root directory. getDefaultBaseConfigDir :: IO BaseConfigDir getDefaultBaseConfigDir = getXdgDirectory XdgConfig "concordium" @@ -116,20 +116,20 @@ getDefaultBaseConfigDir = getXdgDirectory XdgConfig "concordium" accountConfigDir :: BaseConfigDir -> AccountConfigDir accountConfigDir baseCfgDir = baseCfgDir "accounts" --- |The default location of the data root directory. +-- | The default location of the data root directory. getDefaultDataDir :: IO FilePath getDefaultDataDir = getXdgDirectory XdgData "concordium" --- |Get the path to the account names map file. +-- | Get the path to the account names map file. accountNameMapFile :: AccountConfigDir -> FilePath accountNameMapFile accountCfgDir = accountCfgDir "names.map" --- |Get the name of the directory with keys of an account. +-- | Get the name of the directory with keys of an account. accountKeysDir :: AccountConfigDir -> Types.AccountAddress -> FilePath accountKeysDir accCfgDir addr = accCfgDir show addr --- |Get the name of the file which contains the threshold for the amount of --- signatures needed to sign a transaction. +-- | Get the name of the file which contains the threshold for the amount of +-- signatures needed to sign a transaction. accountThresholdFile :: AccountConfigDir -> Types.AccountAddress -> FilePath accountThresholdFile accCfgDir addr = accCfgDir show addr <.> "threshold" @@ -139,60 +139,60 @@ accountKeyFileExt = "json" accountKeyFilePrefix :: String accountKeyFilePrefix = "keypair" --- |Return file path of the key with the given index in the provided key directory. +-- | Return file path of the key with the given index in the provided key directory. accountKeyFile :: FilePath -> KeyIndex -> FilePath accountKeyFile keysDir idx = keysDir accountKeyFilePrefix ++ show idx <.> accountKeyFileExt --- |Return file path of the decryption key for encrypted amounts in the provided key directory. +-- | Return file path of the decryption key for encrypted amounts in the provided key directory. accountEncryptionSecretKeyFile :: FilePath -> FilePath accountEncryptionSecretKeyFile keysDir = keysDir "encSecretKey.json" --- |For a filename (without directory but with extension) determine whether it is a valid name --- of an account key file (as it would be produced by 'accountKeyFile'). +-- | For a filename (without directory but with extension) determine whether it is a valid name +-- of an account key file (as it would be produced by 'accountKeyFile'). parseAccountKeyFileName :: FilePath -> Maybe KeyIndex parseAccountKeyFileName fileName = if takeExtension fileName == "." ++ accountKeyFileExt then readMaybe (drop (length accountKeyFilePrefix) $ takeBaseName fileName) else Nothing --- |For a credential folder name, find the corresponding credential index --- of an account key file (as it would be produced by 'accountKeyFile'). +-- | For a credential folder name, find the corresponding credential index +-- of an account key file (as it would be produced by 'accountKeyFile'). parseCredentialFolder :: FilePath -> Maybe CredentialIndex parseCredentialFolder fileName = if takeExtension fileName == "." ++ accountKeyFileExt then readMaybe (drop (length accountKeyFilePrefix) $ takeBaseName fileName) else Nothing --- |Name to use if no account name is provided. +-- | Name to use if no account name is provided. defaultAccountName :: Text defaultAccountName = "default" --- |Get path to contracts config directory from the base config. +-- | Get path to contracts config directory from the base config. contractConfigDir :: BaseConfigDir -> ContractConfigDir contractConfigDir = ( "contracts") --- |Get path to contractNames.map file. +-- | Get path to contractNames.map file. contractNameMapFile :: ContractConfigDir -> FilePath contractNameMapFile = ( "contractNames.map") --- |Get path to moduleNames.map file. +-- | Get path to moduleNames.map file. moduleNameMapFile :: ContractConfigDir -> FilePath moduleNameMapFile = ( "moduleNames.map") --- |Mapping builder from a name to a provided type. +-- | Mapping builder from a name to a provided type. type NameMap = M.Map Text --- |Mapping from account names to their addresses. +-- | Mapping from account names to their addresses. type AccountNameMap = NameMap Types.AccountAddress --- |Mapping from contract names to their addresses. +-- | Mapping from contract names to their addresses. type ContractNameMap = NameMap Types.ContractAddress --- |Mapping from module names to their references. +-- | Mapping from module names to their references. type ModuleNameMap = NameMap Types.ModuleRef --- |Base configuration consists of the account name mapping and location of --- account keys to be loaded on demand. +-- | Base configuration consists of the account name mapping and location of +-- account keys to be loaded on demand. data BaseConfig = BaseConfig { bcVerbose :: Bool, bcAccountNameMap :: AccountNameMap, @@ -203,7 +203,7 @@ data BaseConfig = BaseConfig } deriving (Show) --- |Initialize an empty config structure and returns the corresponding base config. +-- | Initialize an empty config structure and returns the corresponding base config. initBaseConfig :: Maybe FilePath -> Verbose -> IO BaseConfig initBaseConfig f verbose = do baseCfgDir <- getBaseConfigDir f @@ -246,25 +246,25 @@ initBaseConfig f verbose = do bcModuleNameMap = moduleNameMap } --- |Ensure the basic account config is initialized. +-- | Ensure the basic account config is initialized. ensureAccountConfigInitialized :: BaseConfig -> IO () ensureAccountConfigInitialized baseCfg = do let accCfgDir = bcAccountCfgDir baseCfg ensureDirCreated False accCfgDir --- |Ensure the basic contract config is initialized. +-- | Ensure the basic contract config is initialized. ensureContractConfigInitialized :: BaseConfig -> IO () ensureContractConfigInitialized baseCfg = do let conCfgDir = bcContractCfgDir baseCfg ensureDirCreated False conCfgDir --- |Ensure the basic module config is initialized. +-- | Ensure the basic module config is initialized. ensureModuleConfigInitialized :: BaseConfig -> IO () ensureModuleConfigInitialized baseCfg = do let modCfgDir = bcContractCfgDir baseCfg ensureDirCreated False modCfgDir --- |Ensure a directory is created and, if Verbose, logInfo actions. +-- | Ensure a directory is created and, if Verbose, logInfo actions. ensureDirCreated :: Verbose -> FilePath -> IO () ensureDirCreated verbose dir = do when verbose $ logInfo [[i|creating directory '#{dir}'|]] @@ -363,8 +363,8 @@ initAccountConfigEither baseCfg namedAddr inCLI skipExisting = runExceptT $ do written ) --- |Add an account to the configuration by creating its key directory and --- optionally a name mapping. +-- | Add an account to the configuration by creating its key directory and +-- optionally a name mapping. initAccountConfig :: BaseConfig -> NamedAddress -> @@ -379,9 +379,9 @@ initAccountConfig baseCfg namedAddr inCLI skipExisting = do Left err -> logFatal [err] Right config -> return config --- |Remove a name from the account name map. If the name is not in use --- |it does nothing --- |Returns the potentially updated baseConfig +-- | Remove a name from the account name map. If the name is not in use +-- |it does nothing +-- |Returns the potentially updated baseConfig removeAccountNameAndWrite :: BaseConfig -> Text -> Verbose -> IO BaseConfig removeAccountNameAndWrite baseCfg name verbose = do -- Check if config has been initialized. @@ -394,9 +394,9 @@ removeAccountNameAndWrite baseCfg name verbose = do logSuccess ["removed account name mapping"] return baseCfg{bcAccountNameMap = m} --- |Remove a name from the contract name map. If the name is not in use, --- |it does nothing. --- |Returns the potentially updated baseConfig. +-- | Remove a name from the contract name map. If the name is not in use, +-- |it does nothing. +-- |Returns the potentially updated baseConfig. removeContractNameAndWrite :: BaseConfig -> Text -> Verbose -> IO BaseConfig removeContractNameAndWrite baseCfg name verbose = do -- Check if config has been initialized. @@ -409,9 +409,9 @@ removeContractNameAndWrite baseCfg name verbose = do logSuccess ["removed contract name mapping"] return baseCfg{bcContractNameMap = m} --- |Remove a name from the module name map. If the name is not in use --- |it does nothing --- |Returns the potentially updated baseConfig +-- | Remove a name from the module name map. If the name is not in use +-- |it does nothing +-- |Returns the potentially updated baseConfig removeModuleNameAndWrite :: BaseConfig -> Text -> Verbose -> IO BaseConfig removeModuleNameAndWrite baseCfg name verbose = do -- Check if config has been initialized. @@ -447,8 +447,8 @@ removeAccountConfig baseCfg@BaseConfig{..} NamedAddress{..} = do -- Remove the alias, if it exists (foldr M.delete bcAccountNameMap names, True) --- |Import the contents of a `ConfigBackup` and log information about each step in the process. --- Naming conflicts are handled by prompting the user for new names. +-- | Import the contents of a `ConfigBackup` and log information about each step in the process. +-- Naming conflicts are handled by prompting the user for new names. importConfigBackup :: Verbose -> BaseConfig -> Bool -> ([AccountConfig], ContractNameMap, ModuleNameMap) -> IO BaseConfig importConfigBackup verbose baseCfg skipExistingAccounts (accs, cnm, mnm) = do logInfo ["\nImporting accounts..."] @@ -517,10 +517,10 @@ importConfigBackup verbose baseCfg skipExistingAccounts (accs, cnm, mnm) = do checkAndPrompt = checkNameUntilNoCollision typeOfValue validateName --- |Check if the provided name (key) is invalid or already used, --- and continually prompt the user to provide an alternative, --- until a valid and non-colliding one is entered. --- Returns a valid and non-colliding name. +-- | Check if the provided name (key) is invalid or already used, +-- and continually prompt the user to provide an alternative, +-- until a valid and non-colliding one is entered. +-- Returns a valid and non-colliding name. checkNameUntilNoCollision :: (Eq v, Show v) => -- | Name of the value type, fx "account" or "module". Used in the prompt. @@ -545,7 +545,7 @@ checkNameUntilNoCollision typeOfValue validateName nm unvalidatedName newVal = d _ -> return validName where -- \|Prompt the user to input a name repeatedly until it passes validation. - promptNameUntilValid :: MonadIO m => m Text + promptNameUntilValid :: (MonadIO m) => m Text promptNameUntilValid = liftIO $ do putStr $ prettyMsg ": " [i|specify a new name to map to this #{typeOfValue}|] input <- T.getLine >>= ensureValidName @@ -559,10 +559,10 @@ checkNameUntilNoCollision typeOfValue validateName nm unvalidatedName newVal = d T.getLine >>= ensureValidName Right () -> return name --- |Add a name to the account name map. --- If the name is invalid or collides with an existing one, `checkNameUntilNoCollision` is --- used to resolve the conflict and find a new name. --- Returns the name that was actually added. +-- | Add a name to the account name map. +-- If the name is invalid or collides with an existing one, `checkNameUntilNoCollision` is +-- used to resolve the conflict and find a new name. +-- Returns the name that was actually added. addAccountNameAndWrite :: Verbose -> BaseConfig -> Text -> AccountAddress -> IO Text addAccountNameAndWrite verbose baseCfg name accountAddr = do newName <- checkNameUntilNoCollision "account" validateAccountName nameMap name accountAddr @@ -574,11 +574,11 @@ addAccountNameAndWrite verbose baseCfg name accountAddr = do mapFile = accountNameMapFile accCfgDir nameMap = bcAccountNameMap baseCfg --- |Add a contract name and write it to 'contractNames.map'. --- If the name collides with an existing one, `checkNameUntilNoCollision` is --- used to resolve the conflict and find a new name. --- Returns the name that was actually added. --- Logs fatally, if 'contractNames.map' cannot be written to. +-- | Add a contract name and write it to 'contractNames.map'. +-- If the name collides with an existing one, `checkNameUntilNoCollision` is +-- used to resolve the conflict and find a new name. +-- Returns the name that was actually added. +-- Logs fatally, if 'contractNames.map' cannot be written to. addContractNameAndWrite :: Verbose -> BaseConfig -> Text -> ContractAddress -> IO Text addContractNameAndWrite verbose baseCfg name contrAddr = do newName <- checkNameUntilNoCollision "contract instance" validateContractOrModuleName nameMap name contrAddr @@ -589,11 +589,11 @@ addContractNameAndWrite verbose baseCfg name contrAddr = do mapFile = contractNameMapFile . bcContractCfgDir $ baseCfg nameMap = bcContractNameMap baseCfg --- |Add a module name and write it to 'moduleNames.map'. --- If the name collides with an existing one, `checkNameUntilNoCollision` is --- used to resolve the conflict and find a new name. --- Returns the name that was actually added. --- Logs fatally, if 'moduleNames.map' cannot be written to. +-- | Add a module name and write it to 'moduleNames.map'. +-- If the name collides with an existing one, `checkNameUntilNoCollision` is +-- used to resolve the conflict and find a new name. +-- Returns the name that was actually added. +-- Logs fatally, if 'moduleNames.map' cannot be written to. addModuleNameAndWrite :: Verbose -> BaseConfig -> Text -> ModuleRef -> IO Text addModuleNameAndWrite verbose baseCfg name modRef = do newName <- checkNameUntilNoCollision "module" validateContractOrModuleName nameMap name modRef @@ -604,7 +604,7 @@ addModuleNameAndWrite verbose baseCfg name modRef = do mapFile = moduleNameMapFile . bcContractCfgDir $ baseCfg nameMap = bcModuleNameMap baseCfg --- |A contract address along with a list of local names. +-- | A contract address along with a list of local names. data NamedContractAddress = NamedContractAddress { -- | The contract address. ncaAddr :: Types.ContractAddress, @@ -613,7 +613,7 @@ data NamedContractAddress = NamedContractAddress } deriving (Show) --- |A module reference along with a list of local names. +-- | A module reference along with a list of local names. data NamedModuleRef = NamedModuleRef { -- | The module reference. nmrRef :: Types.ModuleRef, @@ -622,21 +622,21 @@ data NamedModuleRef = NamedModuleRef } deriving (Show) --- |Write the name map to a file in a pretty JSON format. -writeNameMapAsJSON :: AE.ToJSON v => Verbose -> FilePath -> NameMap v -> IO () +-- | Write the name map to a file in a pretty JSON format. +writeNameMapAsJSON :: (AE.ToJSON v) => Verbose -> FilePath -> NameMap v -> IO () writeNameMapAsJSON verbose file = void . handledWriteFile file . AE.encodePretty' config where config = AE.defConfig{AE.confCompare = compare} handledWriteFile = handleWriteFile BSL.writeFile AllowOverwrite verbose --- |Write the name map to a file in the expected format. -writeNameMap :: Show v => Verbose -> FilePath -> NameMap v -> IO () +-- | Write the name map to a file in the expected format. +writeNameMap :: (Show v) => Verbose -> FilePath -> NameMap v -> IO () writeNameMap verbose file = void . handledWriteFile file . BSL.fromStrict . encodeUtf8 . T.pack . unlines . map f . M.toAscList where f (name, val) = printf "%s = %s" name (show val) handledWriteFile = handleWriteFile BSL.writeFile AllowOverwrite verbose --- |Used in `handleWriteFile` to determine how already exisiting files should be handled. +-- | Used in `handleWriteFile` to determine how already exisiting files should be handled. data OverwriteSetting = -- | The user should be prompted to confirm before overwriting. PromptBeforeOverwrite @@ -644,10 +644,10 @@ data OverwriteSetting AllowOverwrite deriving (Eq) --- |Write to a file with the provided function and handle IO errors with an appropriate logging of errors. --- Also ensures that the parent folders are created if missing. --- If `OverwriteSetting == PromptBeforeOverwrite` then the user is prompted to confirm. --- Return True if write was attempted, and False otherwise. +-- | Write to a file with the provided function and handle IO errors with an appropriate logging of errors. +-- Also ensures that the parent folders are created if missing. +-- If `OverwriteSetting == PromptBeforeOverwrite` then the user is prompted to confirm. +-- Return True if write was attempted, and False otherwise. handleWriteFile :: (FilePath -> s -> IO ()) -> OverwriteSetting -> Verbose -> FilePath -> s -> IO Bool handleWriteFile wrtFile overwriteSetting verbose file contents = do writeConfirmed <- case overwriteSetting of @@ -674,7 +674,7 @@ handleWriteFile wrtFile overwriteSetting verbose file contents = do | isPermissionError e = logFatal [[i|you do not have permissions to write to the file '#{file}'|]] | otherwise = logFatal [[i|something went wrong while writing to the file '#{file}', err: '#{e}'|]] --- |Read a file with the provided function and handle IO errors with an appropriate logging of errors. +-- | Read a file with the provided function and handle IO errors with an appropriate logging of errors. handleReadFile :: (FilePath -> IO s) -> FilePath -> IO s handleReadFile rdFile file = catchIOError (rdFile file) logFatalOnErrors where @@ -683,9 +683,9 @@ handleReadFile rdFile file = catchIOError (rdFile file) logFatalOnErrors | isPermissionError e = logFatal [[i|you do not have permissions to read the file '#{file}'|]] | otherwise = logFatal [[i|something went wrong while reading the file '#{file}', err: '#{e}'|]] --- |Write the account keys structure into the directory of the given account. --- Each 'EncryptedAccountKeyPair' is written to a JSON file the name of which --- is determined by 'accountKeyFile'. +-- | Write the account keys structure into the directory of the given account. +-- Each 'EncryptedAccountKeyPair' is written to a JSON file the name of which +-- is determined by 'accountKeyFile'. writeAccountKeys :: BaseConfig -> AccountConfig -> Verbose -> IO () writeAccountKeys baseCfg accCfg verbose = do let accCfgDir = bcAccountCfgDir baseCfg @@ -713,7 +713,7 @@ writeAccountKeys baseCfg accCfg verbose = do -- writeThresholdFile accCfgDir accCfg verbose logSuccess ["the keys were successfully written to disk"] --- |Remove the account keys, i.e. keypair{idx}.json files, with the provided indices. +-- | Remove the account keys, i.e. keypair{idx}.json files, with the provided indices. removeAccountKeys :: BaseConfig -> AccountConfig -> CredentialIndex -> [KeyIndex] -> Verbose -> IO () removeAccountKeys baseCfg accCfg cidx idxs verbose = do let accCfgDir = bcAccountCfgDir baseCfg @@ -760,8 +760,8 @@ getBaseConfigDir = \case Nothing -> getDefaultBaseConfigDir Just p -> return p --- |Load a NameMap from a file in JSON format, or logFatal if file has invalid format. -loadNameMapFromJSON :: AE.FromJSON v => FilePath -> IO (NameMap v) +-- | Load a NameMap from a file in JSON format, or logFatal if file has invalid format. +loadNameMapFromJSON :: (AE.FromJSON v) => FilePath -> IO (NameMap v) loadNameMapFromJSON mapFile = do -- Simply use an empty map if the reading fails content <- BSL.readFile mapFile `catch` (\(_ :: SomeException) -> return emptyMapContentJSON) @@ -769,12 +769,12 @@ loadNameMapFromJSON mapFile = do Left err -> logFatal [[i|cannot parse name map file '#{mapFile}' as JSON: #{err}|]] Right nm -> return nm --- |A string representing an empty map in JSON format. -emptyMapContentJSON :: IsString s => s +-- | A string representing an empty map in JSON format. +emptyMapContentJSON :: (IsString s) => s emptyMapContentJSON = "{}" --- |Load an AccountNameMap from a file in the format specified by `parseAccountNameMap`. --- LogFatal if the file format is invalid. +-- | Load an AccountNameMap from a file in the format specified by `parseAccountNameMap`. +-- LogFatal if the file format is invalid. loadAccountNameMap :: FilePath -> IO AccountNameMap loadAccountNameMap mapFile = do -- Simply use an empty map if the reading fails @@ -786,14 +786,14 @@ loadAccountNameMap mapFile = do Left err -> logFatal [[i|cannot parse account name map file '#{content}': #{err}|]] Right m -> return m --- |Parse an AccountNamepMap from zero or more entries, as specificied in `parseAccoutNameMapEntry`. +-- | Parse an AccountNamepMap from zero or more entries, as specificied in `parseAccoutNameMapEntry`. parseAccountNameMap :: (MonadError String m) => [String] -> m AccountNameMap parseAccountNameMap ls = M.fromList <$> mapM parseAccountNameMapEntry ls' where ls' = filter (not . all isSpace) ls --- |Parse a line representing a single name-account mapping of the format " =
". --- Leading and trailing whitespaces around name and address are ignored. +-- | Parse a line representing a single name-account mapping of the format " =
". +-- Leading and trailing whitespaces around name and address are ignored. parseAccountNameMapEntry :: (MonadError String m) => String -> m (Text, Types.AccountAddress) parseAccountNameMapEntry line = case splitOn "=" line of @@ -808,15 +808,15 @@ parseAccountNameMapEntry line = return (name, addr) _ -> throwError $ printf "invalid mapping format '%s' (should be ' =
')" line --- |Check whether the given text is a valid name. +-- | Check whether the given text is a valid name. isValidAccountName :: Text -> Bool isValidAccountName n = not (T.null n) && not (isSpace $ T.head n) && not (isSpace $ T.last n) && T.all supportedChar n where supportedChar c = isAlphaNum c || c `elem` supportedSpecialChars supportedSpecialChars = "-_,.!? " :: String --- |Check whether the given text is a valid contract or module name. --- Is different from account names in that it must start with a letter. +-- | Check whether the given text is a valid contract or module name. +-- Is different from account names in that it must start with a letter. isValidContractOrModuleName :: Text -> Bool isValidContractOrModuleName n = not (T.null n) @@ -828,7 +828,7 @@ isValidContractOrModuleName n = supportedChar c = isAlphaNum c || c `elem` supportedSpecialChars supportedSpecialChars = "-_,.!? " :: String --- |Check whether the given text is a valid name and fail with an error message if it is not. +-- | Check whether the given text is a valid name and fail with an error message if it is not. validateAccountName :: (MonadError String m) => Text -> m () validateAccountName name = unless (isValidAccountName name) $ @@ -837,7 +837,7 @@ validateAccountName name = and consist of letters, numbers, space, '.', ',', '!', '?', '-', and '_' only)|] --- |Check whether the given text is a valid contract or module name and fail with an error message if it is not. +-- | Check whether the given text is a valid contract or module name and fail with an error message if it is not. validateContractOrModuleName :: (MonadError String m) => Text -> m () validateContractOrModuleName name = unless (isValidContractOrModuleName name) $ @@ -846,14 +846,14 @@ validateContractOrModuleName name = and should otherwise consist of letters, numbers, space, '.', ',', '!', '?', '-', and '_' only)|] --- |Current version of accountconfig, for configbackup export/import compatability +-- | Current version of accountconfig, for configbackup export/import compatability accountConfigVersion :: Version accountConfigVersion = 1 data AccountConfig = AccountConfig { acAddr :: !NamedAddress, acKeys :: EncryptedAccountKeyMap, - -- |Index assignment of credential registration ids to credential indices. + -- | Index assignment of credential registration ids to credential indices. acCids :: !(M.Map IDTypes.CredentialIndex IDTypes.CredentialRegistrationID), -- | FIXME: This is a Maybe because the setup with account init being a -- special thing is such that we need to be able to initialize a dummy config. @@ -889,24 +889,24 @@ acAddress :: AccountConfig -> AccountAddress acAddress = naAddr . acAddr getAccountConfig :: - -- |Name or address of the account, defaulting to 'defaultAccountName' if not present. + -- | Name or address of the account, defaulting to 'defaultAccountName' if not present. Maybe Text -> - -- |Configuration settings. + -- | Configuration settings. BaseConfig -> - -- |Optional path to the key directory. Defaulting to directory derived from - -- 'BaseConfig' if absent. + -- | Optional path to the key directory. Defaulting to directory derived from + -- 'BaseConfig' if absent. Maybe FilePath -> - -- |Explicit keys. If provided they take precedence over other parameters, - -- otherwise the function attempts to lookup them up from the key directory. - -- If explicit keys are provided it is assumed that the - -- signature threshold for the account is less than the amount - -- of keys provided and all keys will be used to, e.g., sign the transaction. + -- | Explicit keys. If provided they take precedence over other parameters, + -- otherwise the function attempts to lookup them up from the key directory. + -- If explicit keys are provided it is assumed that the + -- signature threshold for the account is less than the amount + -- of keys provided and all keys will be used to, e.g., sign the transaction. Maybe (EncryptedAccountKeyMap) -> - -- |Explicit secret encryption key. If provided it takes precedence over other - -- parameters, otherwise the function attemps to lookup it ip from the key directory. + -- | Explicit secret encryption key. If provided it takes precedence over other + -- parameters, otherwise the function attemps to lookup it ip from the key directory. Maybe EncryptedAccountEncryptionSecretKey -> - -- |Whether to initialize the account config when it does not exist. - -- This will also ask the user for an optional name mapping. + -- | Whether to initialize the account config when it does not exist. + -- This will also ask the user for an optional name mapping. AutoInit -> IO (BaseConfig, AccountConfig) getAccountConfig account baseCfg keysDir keyMap encKey autoInit = do @@ -999,11 +999,11 @@ getAccountConfig account baseCfg keysDir keyMap encKey autoInit = do else do return Nothing --- |Look up an account by name or address: --- If input is a well-formed account address, try to (reverse) look up its name in the map. --- If this lookup fails, return the address with name Nothing. --- Otherwise assume the input is a local name of an account, and try to look up its address. --- If this lookup fails, return Nothing. +-- | Look up an account by name or address: +-- If input is a well-formed account address, try to (reverse) look up its name in the map. +-- If this lookup fails, return the address with name Nothing. +-- Otherwise assume the input is a local name of an account, and try to look up its address. +-- If this lookup fails, return Nothing. resolveAccountAddress :: AccountNameMap -> Text -> Maybe NamedAddress resolveAccountAddress m input = do -- Try parsing input as account address. @@ -1018,19 +1018,19 @@ resolveAccountAddress m input = do return (names, a) return NamedAddress{naNames = n, naAddr = a} --- |Find all names (keys) for the given value in a namemap. -findAllNamesFor :: Eq v => NameMap v -> v -> [Text] +-- | Find all names (keys) for the given value in a namemap. +findAllNamesFor :: (Eq v) => NameMap v -> v -> [Text] findAllNamesFor m input = map fst $ filter ((== input) . snd) (M.toList m) --- |Look up an account by name or address. See doc for 'resolveAccountAddress'. --- If the lookup fails, an error is thrown. +-- | Look up an account by name or address. See doc for 'resolveAccountAddress'. +-- If the lookup fails, an error is thrown. getAccountAddress :: (MonadError String m) => AccountNameMap -> Text -> m NamedAddress getAccountAddress m input = case resolveAccountAddress m input of Nothing -> throwError $ printf "the identifier '%s' is neither the address nor the name of an account" input Just a -> return a --- |Return all 'AccountConfig's from the config. +-- | Return all 'AccountConfig's from the config. getAllAccountConfigs :: BaseConfig -> IO [AccountConfig] getAllAccountConfigs cfg = do let dir = bcAccountCfgDir cfg @@ -1042,7 +1042,7 @@ getAllAccountConfigs cfg = do isDirectory dir f = doesDirectoryExist $ joinPath [dir, f] --- |Return all key pairs and CredentialID's from the provided directory. +-- | Return all key pairs and CredentialID's from the provided directory. loadKeyMap :: FilePath -> IO (EncryptedAccountKeyMap, M.Map IDTypes.CredentialIndex IDTypes.CredentialRegistrationID) loadKeyMap accountDir = do filesInAccountDir <- listDirectory accountDir @@ -1078,12 +1078,12 @@ loadCredentialIndex credDir = do let file = credDir "" <.> "index" AE.eitherDecodeFileStrict' file `withLogFatalIO` (\e -> "cannot load credential index file " ++ file ++ " " ++ e) --- |Insert key pairs on the given index. +-- | Insert key pairs on the given index. insertAccountKey :: EncryptedAccountKeyMap -> (CredentialIndex, [(KeyIndex, EncryptedAccountKeyPair)]) -> EncryptedAccountKeyMap insertAccountKey km (cidx, kpm) = M.insert cidx (M.fromList kpm) km --- |Compute the next index not already in use, starting from the one provided --- (which is assumed to be less than or equal to the first element of the list). +-- | Compute the next index not already in use, starting from the one provided +-- (which is assumed to be less than or equal to the first element of the list). nextUnusedIdx :: KeyIndex -> [KeyIndex] -> KeyIndex nextUnusedIdx idx sortedKeys = case sortedKeys of [] -> idx @@ -1095,7 +1095,7 @@ type KeyName = String data KeyType = Sign | Verify deriving (Eq, Show) type KeyContents = Text --- |Load threshold from a file or return the provided default if the file does not exist. +-- | Load threshold from a file or return the provided default if the file does not exist. loadThreshold :: FilePath -> IDTypes.AccountThreshold -> IO IDTypes.AccountThreshold loadThreshold file defaultThreshold = do handleJust (guard . isDoesNotExistError) (const (return defaultThreshold)) $ @@ -1103,17 +1103,17 @@ loadThreshold file defaultThreshold = do Left err -> logFatal [printf "corrupt threshold file '%s': %s" file err] Right t -> return t --- |Return list of files in the directory or the empty list if it does not exist. +-- | Return list of files in the directory or the empty list if it does not exist. safeListDirectory :: FilePath -> IO [FilePath] safeListDirectory dir = do e <- doesDirectoryExist dir if e then listDirectory dir else return [] --- |Show a list of names with spacing and quotes. The names are sorted while ignoring case. --- Example: +-- | Show a list of names with spacing and quotes. The names are sorted while ignoring case. +-- Example: -- --- >>> showNameList ["B", "a"] --- "'a' 'B'" +-- >>> showNameList ["B", "a"] +-- "'a' 'B'" showNameList :: [T.Text] -> String showNameList = T.unpack . T.unwords . map addQuotes . caseInsensitiveSort where diff --git a/src/Concordium/Client/Export.hs b/src/Concordium/Client/Export.hs index cfc3e696..bc24e1e9 100644 --- a/src/Concordium/Client/Export.hs +++ b/src/Concordium/Client/Export.hs @@ -29,19 +29,19 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Text.Printf --- |Format of keys in genesis per credential. +-- | Format of keys in genesis per credential. data GenesisCredentialKeys = GenesisCredentialKeys { gckKeys :: !(OrdMap.Map IDTypes.KeyIndex KeyPair), gckThreshold :: !IDTypes.SignatureThreshold } --- |Format of keys in a genesis account. +-- | Format of keys in a genesis account. data GenesisAccountKeys = GenesisAccountKeys { gakKeys :: OrdMap.Map IDTypes.CredentialIndex GenesisCredentialKeys, gakThreshold :: !IDTypes.AccountThreshold } --- |Credentials for genesis accounts. +-- | Credentials for genesis accounts. newtype GenesisCredentials = GenesisCredentials {gcCredentials :: OrdMap.Map IDTypes.CredentialIndex IDTypes.AccountCredential} deriving newtype (AE.FromJSON, AE.ToJSON) @@ -57,14 +57,14 @@ instance AE.FromJSON GenesisAccountKeys where gakThreshold <- obj AE..: "threshold" return GenesisAccountKeys{..} --- |Get the list of keys suitable for signing. This will respect the thresholds --- so that the lists are no longer than the threshold that is specified. +-- | Get the list of keys suitable for signing. This will respect the thresholds +-- so that the lists are no longer than the threshold that is specified. toKeysList :: GenesisAccountKeys -> [(IDTypes.CredentialIndex, [(IDTypes.KeyIndex, KeyPair)])] toKeysList GenesisAccountKeys{..} = take (fromIntegral gakThreshold) . fmap toKeysListCred . OrdMap.toAscList $ gakKeys where toKeysListCred (ci, GenesisCredentialKeys{..}) = (ci, take (fromIntegral gckThreshold) . OrdMap.toAscList $ gckKeys) --- |Environment for the export, e.g., staging, testnet, mainnet or something else. +-- | Environment for the export, e.g., staging, testnet, mainnet or something else. type Environment = Text -- | An export format used by wallets including accounts and identities. @@ -75,15 +75,15 @@ data WalletExport = WalletExport } deriving (Show) --- |Parse export from the wallet. The data that is exported depends a bit on --- which wallet it is, so the parser requires some context which is why this is --- a separate function, and not a @FromJSON@ instance. +-- | Parse export from the wallet. The data that is exported depends a bit on +-- which wallet it is, so the parser requires some context which is why this is +-- a separate function, and not a @FromJSON@ instance. parseWalletExport :: - -- |The name of the account to import. The old mobile wallet export does not - -- require this, but for the new mobile wallet export it is required, and parsing - -- will fail if this is not provided. + -- | The name of the account to import. The old mobile wallet export does not + -- require this, but for the new mobile wallet export it is required, and parsing + -- will fail if this is not provided. Maybe Text -> - -- |The JSON value to be parsed. + -- | The JSON value to be parsed. AE.Value -> AE.Parser WalletExport parseWalletExport mName = AE.withObject "Wallet Export" $ \v -> do @@ -221,9 +221,9 @@ accountCfgsFromWalletExportAccounts weas name pwd = do namesFound -> return namesFound forM selectedAccounts $ accountCfgFromWalletExportAccount pwd --- |Convert a wallet export account to a regular account config. --- This checks whether the name provided by the export is a valid account name. --- This encrypts all signing keys with the provided password. +-- | Convert a wallet export account to a regular account config. +-- This checks whether the name provided by the export is a valid account name. +-- This encrypts all signing keys with the provided password. accountCfgFromWalletExportAccount :: Password -> WalletExportAccount -> ExceptT String IO AccountConfig accountCfgFromWalletExportAccount pwd WalletExportAccount{weaKeys = AccountSigningData{..}, ..} = do name <- liftIO $ ensureValidName weaName @@ -247,8 +247,8 @@ accountCfgFromWalletExportAccount pwd WalletExportAccount{weaKeys = AccountSigni T.getLine >>= ensureValidName Right () -> return trimmedName --- |Decode and parse a genesis account into a named account config. --- All signing keys are encrypted with the given password. +-- | Decode and parse a genesis account into a named account config. +-- All signing keys are encrypted with the given password. decodeGenesisFormattedAccountExport :: -- | JSON with the account information. BS.ByteString -> @@ -327,7 +327,7 @@ configExport cb pwd = do where vcb = Versioned configBackupVersion cb --- |Decrypt and decode an exported config, optionally protected under a password. +-- | Decrypt and decode an exported config, optionally protected under a password. configImport :: BS.ByteString -> -- | Action to obtain the password if necessary. diff --git a/src/Concordium/Client/GRPC2.hs b/src/Concordium/Client/GRPC2.hs index dc63ceb1..4834e9b7 100644 --- a/src/Concordium/Client/GRPC2.hs +++ b/src/Concordium/Client/GRPC2.hs @@ -7,11 +7,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} --- |Part of the implementation of the GRPC API node API V2. This module --- contains client logic and API wrappers for the services exposed, and --- a typeclass @FromProto@ with accompanying instances. The latter are --- used to convert Protocol-buffer payloads into our "native" Haskell data- --- type equivalents. +-- | Part of the implementation of the GRPC API node API V2. This module +-- contains client logic and API wrappers for the services exposed, and +-- a typeclass @FromProto@ with accompanying instances. The latter are +-- used to convert Protocol-buffer payloads into our "native" Haskell data- +-- type equivalents. module Concordium.Client.GRPC2 where import Control.Concurrent @@ -82,25 +82,25 @@ import qualified Proto.V2.Concordium.Types as ProtoFields import qualified Proto.V2.Concordium.Types_Fields as Proto import qualified Proto.V2.Concordium.Types_Fields as ProtoFields --- |A helper function that serves as an inverse to @mkSerialize@, +-- | A helper function that serves as an inverse to @mkSerialize@, -- --- Converts a protocol buffer message to a native Haskell type --- that is a member of @Serialize@. +-- Converts a protocol buffer message to a native Haskell type +-- that is a member of @Serialize@. -- --- More concretely, the protocol buffer message should have the form: --- @ --- > message Wrapper { --- > .. --- > bytes value = 1 --- > ... --- > } --- @ +-- More concretely, the protocol buffer message should have the form: +-- @ +-- > message Wrapper { +-- > .. +-- > bytes value = 1 +-- > ... +-- > } +-- @ -- --- where @Wrapper@ is an arbitrary message name that must contain a field --- named @value@ of type @bytes@. Returns @Left@ if the bytestring contained --- in the @value@-field could not be converted or if the entire bytestring was --- not consumed while converting it. Returns a @Right@ wrapping the converted --- value otherwise. +-- where @Wrapper@ is an arbitrary message name that must contain a field +-- named @value@ of type @bytes@. Returns @Left@ if the bytestring contained +-- in the @value@-field could not be converted or if the entire bytestring was +-- not consumed while converting it. Returns a @Right@ wrapping the converted +-- value otherwise. deMkSerialize :: ( Data.ProtoLens.Field.HasField b @@ -115,11 +115,11 @@ deMkSerialize val = Left err -> Left $ "deMkSerialize error: " <> err Right v -> return v --- |A helper function that serves as an inverse to @mkWord64@, --- Like @deMkSerialize@, but the @value@ field must be a @Word64@, --- and the output a type which can be coerced from a @Word64@. --- Coercible here means that the output is a @Word64@ wrapped in --- a (or possibly several) newtype wrapper(s). +-- | A helper function that serves as an inverse to @mkWord64@, +-- Like @deMkSerialize@, but the @value@ field must be a @Word64@, +-- and the output a type which can be coerced from a @Word64@. +-- Coercible here means that the output is a @Word64@ wrapped in +-- a (or possibly several) newtype wrapper(s). deMkWord64 :: ( Coercible Word64 a, Data.ProtoLens.Field.HasField @@ -131,8 +131,8 @@ deMkWord64 :: a deMkWord64 val = coerce $ val ^. ProtoFields.value --- |Like @deMkWord64@, but the value field should be a @Word32@ --- and the output should be coercible from this. +-- | Like @deMkWord64@, but the value field should be a @Word32@ +-- and the output should be coercible from this. deMkWord32 :: ( Coercible Word32 a, Data.ProtoLens.Field.HasField @@ -144,10 +144,10 @@ deMkWord32 :: a deMkWord32 val = coerce $ val ^. ProtoFields.value --- |Like @deMkWord32@ but the output should be coercible from --- a @Word16@. Returns @Left@ if the value of the @Word32@ can --- not fit in a @Word16@ and a @Right@ wrapping the coerced value --- otherwise. +-- | Like @deMkWord32@ but the output should be coercible from +-- a @Word16@. Returns @Left@ if the value of the @Word32@ can +-- not fit in a @Word16@ and a @Right@ wrapping the coerced value +-- otherwise. deMkWord16 :: ( Coercible Word16 a, Data.ProtoLens.Field.HasField @@ -170,10 +170,10 @@ deMkWord16 val = where v = val ^. ProtoFields.value --- |Like @deMkWord32@ but the output should be coercible from --- a @Word8@. Returns @Left@ if the value of the @Word32@ can --- not fit in a @Word8@ and a @Right@ wrapping the coerced value --- otherwise. +-- | Like @deMkWord32@ but the output should be coercible from +-- a @Word8@. Returns @Left@ if the value of the @Word32@ can +-- not fit in a @Word8@ and a @Right@ wrapping the coerced value +-- otherwise. deMkWord8 :: ( Coercible Word8 a, Data.ProtoLens.Field.HasField @@ -196,9 +196,9 @@ deMkWord8 val = where v = val ^. ProtoFields.value --- |Validate a protocol buffer message with an @url@ Text field. --- Returns @Left@ if the string is longer than the maxium permissible --- length, and returns a @UrlText@ wrapped in a @Right@ otherwise. +-- | Validate a protocol buffer message with an @url@ Text field. +-- Returns @Left@ if the string is longer than the maxium permissible +-- length, and returns a @UrlText@ wrapped in a @Right@ otherwise. deMkUrlText :: ( Data.ProtoLens.Field.HasField b @@ -220,10 +220,10 @@ deMkUrlText val = where v = val ^. ProtoFields.url --- |Decode a bytestring and return the decoded value if the --- input was consumed. Returns @Left@ if the bytestring --- could not be decoded or if the input was not consumed, --- and the decoded value wrapped in a @Right@ otherwise. +-- | Decode a bytestring and return the decoded value if the +-- input was consumed. Returns @Left@ if the bytestring +-- could not be decoded or if the input was not consumed, +-- and the decoded value wrapped in a @Right@ otherwise. decodeAndConsume :: (S.Serialize a) => ByteString -> Either String a decodeAndConsume bs = do case S.runGet getter bs of @@ -243,31 +243,31 @@ decodeAndConsume bs = do then return v else fail "Did not consume the input." --- |The result of converting a protocol buffer message with @fromProto@. --- A @Left@ wrapping an error string indicates that the conversion failed --- and a @Right@ wrapping the converted value indicates that it succeeded. +-- | The result of converting a protocol buffer message with @fromProto@. +-- A @Left@ wrapping an error string indicates that the conversion failed +-- and a @Right@ wrapping the converted value indicates that it succeeded. type FromProtoResult a = Either String a --- |A helper class analogous to something like Aeson's FromJSON. --- It exists to make it more manageable to convert the Protobuf --- types to their internal Haskell type equivalents. +-- | A helper class analogous to something like Aeson's FromJSON. +-- It exists to make it more manageable to convert the Protobuf +-- types to their internal Haskell type equivalents. class FromProto a where - -- |The corresponding Haskell type. + -- | The corresponding Haskell type. type Output a - -- |A conversion function from the protobuf type to its Haskell - -- equivalent. + -- | A conversion function from the protobuf type to its Haskell + -- equivalent. fromProto :: a -> FromProtoResult (Output a) --- |A helper to be used to indicate that something went wrong in a --- @FromProto@ instance. +-- | A helper to be used to indicate that something went wrong in a +-- @FromProto@ instance. fromProtoFail :: String -> FromProtoResult a fromProtoFail msg = Left $ "fromProto: " <> msg --- |Like @fromProtoM@ but maps from and into the @Maybe@ monad. --- Returns @Nothing@ if the input is @Nothing@ or if the input --- value wrapped in @Just@ could not be converted. Returns a --- @Just@ wrapping the converted value otherwise +-- | Like @fromProtoM@ but maps from and into the @Maybe@ monad. +-- Returns @Nothing@ if the input is @Nothing@ or if the input +-- value wrapped in @Just@ could not be converted. Returns a +-- @Just@ wrapping the converted value otherwise fromProtoMaybe :: (FromProto a) => Maybe a -> FromProtoResult (Maybe (Output a)) fromProtoMaybe Nothing = Right Nothing fromProtoMaybe (Just m) = @@ -2839,12 +2839,12 @@ data GrpcConfig = GrpcConfig port :: !PortNumber, -- Target node, i.e. "node-0" for use with grpc-proxy.eu.test.concordium.com against testnet target :: !(Maybe String), - -- |Number of times to __retry__ to establish a connection. Thus a value of - -- 0 means try only once. + -- | Number of times to __retry__ to establish a connection. Thus a value of + -- 0 means try only once. retryNum :: !Int, - -- |Timeout of each RPC call (defaults to 5min if not given). + -- | Timeout of each RPC call (defaults to 5min if not given). timeout :: !(Maybe Int), - -- |Whether to use TLS or not. + -- | Whether to use TLS or not. useTls :: !Bool } @@ -2854,31 +2854,31 @@ data EnvData = EnvData retryTimes :: !Int, config :: !GrpcClientConfig, rwlock :: !RWLock, - -- |A shared reference to a connection together with a generation counter. - -- All queries will reuse this single connection as much as possible. This - -- is @Nothing@ if no connection is yet established. When we reconnect we - -- increase the generation counter. The reason for the generation counter - -- is so that if multiple queries are in-flight at the time the connection - -- is reset, we only reconnect once, and then retry the queries. + -- | A shared reference to a connection together with a generation counter. + -- All queries will reuse this single connection as much as possible. This + -- is @Nothing@ if no connection is yet established. When we reconnect we + -- increase the generation counter. The reason for the generation counter + -- is so that if multiple queries are in-flight at the time the connection + -- is reset, we only reconnect once, and then retry the queries. grpc :: !(IORef (Maybe (Word64, GrpcClient))), logger :: LoggerMethod, - -- |A flag indicating that all the in-flight queries should be killed. - -- |This is a workaround for the inadequate behaviour of the grpc library - -- which does not handle disconnects from the server very well, and in - -- particular it does not handle the server sending GoAway frames. Ideally - -- in that scenario the library would either try to reconnect itself, or, - -- alternatively, trigger a normal error that we could recover from and - -- re-establish the connection. None of the two happen. So instead we - -- install our own custom GoAway handler that kills all in-flight queries, - -- and then re-establishes the connection. + -- | A flag indicating that all the in-flight queries should be killed. + -- |This is a workaround for the inadequate behaviour of the grpc library + -- which does not handle disconnects from the server very well, and in + -- particular it does not handle the server sending GoAway frames. Ideally + -- in that scenario the library would either try to reconnect itself, or, + -- alternatively, trigger a normal error that we could recover from and + -- re-establish the connection. None of the two happen. So instead we + -- install our own custom GoAway handler that kills all in-flight queries, + -- and then re-establishes the connection. -- - -- This MVar will be empty when queries are progressing. When the queries - -- need to be killed then we write to it. When we successfully - -- re-establish the connection then the the MVar is again emptied. + -- This MVar will be empty when queries are progressing. When the queries + -- need to be killed then we write to it. When we successfully + -- re-establish the connection then the the MVar is again emptied. killConnection :: !(MVar ()) } --- |Monad in which the program would run +-- | Monad in which the program would run newtype ClientMonad m a = ClientMonad { _runClientMonad :: ReaderT EnvData (ExceptT ClientError (StateT CookieHeaders m)) a } @@ -2891,15 +2891,15 @@ newtype ClientMonad m a = ClientMonad MonadIO ) --- |Cookie headers that may be returned by the node in a query. +-- | Cookie headers that may be returned by the node in a query. type CookieHeaders = Map.Map BS8.ByteString BS8.ByteString --- |Execute the computation with the given environment (using the established connection). -runClient :: Monad m => EnvData -> ClientMonad m a -> m (Either ClientError a) +-- | Execute the computation with the given environment (using the established connection). +runClient :: (Monad m) => EnvData -> ClientMonad m a -> m (Either ClientError a) runClient config comp = evalStateT (runExceptT $ runReaderT (_runClientMonad comp) config) (Map.empty :: CookieHeaders) --- |@runClient@ but with additional cookies set in the @GRPCRequest@. --- The updated set of cookies (set via set-cookie headers) are returned. +-- | @runClient@ but with additional cookies set in the @GRPCRequest@. +-- The updated set of cookies (set via set-cookie headers) are returned. runClientWithCookies :: CookieHeaders -> EnvData -> ClientMonad m a -> m (Either ClientError a, CookieHeaders) runClientWithCookies hds cfg comp = runStateT (runExceptT $ runReaderT (_runClientMonad comp) cfg) hds @@ -2922,7 +2922,7 @@ mkGrpcClient config mLogger = let logger = fromMaybe (const (return ())) mLogger return $! EnvData (retryNum config) cfg lock ioref logger killConnection --- |Get and print the status of a transaction. +-- | Get and print the status of a transaction. instance (MonadIO m) => TransactionStatusQuery (ClientMonad m) where queryTransactionStatus hash = do r <- getResponseValueOrDie =<< getBlockItemStatus hash @@ -2933,108 +2933,108 @@ instance (MonadIO m) => TransactionStatusQuery (ClientMonad m) where putChar '.' threadDelay $ t * 1_000_000 --- |Get all pending updates to chain parameters at the end of a given block. +-- | Get all pending updates to chain parameters at the end of a given block. getBlockPendingUpdates :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq PendingUpdate))) getBlockPendingUpdates bhInput = withServerStreamCollect (call @"getBlockPendingUpdates") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all special events in a given block. --- A special event is protocol generated event that is not directly caused by a transaction, such as minting, paying out rewards, etc. +-- | Get all special events in a given block. +-- A special event is protocol generated event that is not directly caused by a transaction, such as minting, paying out rewards, etc. getBlockSpecialEvents :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq Transactions.SpecialTransactionOutcome))) getBlockSpecialEvents bhInput = withServerStreamCollect (call @"getBlockSpecialEvents") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all transaction events in a given block. +-- | Get all transaction events in a given block. getBlockTransactionEvents :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq TransactionSummary))) getBlockTransactionEvents bhInput = withServerStreamCollect (call @"getBlockTransactionEvents") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all hashes of non-finalized transactions for a given account. +-- | Get all hashes of non-finalized transactions for a given account. getAccountNonFinalizedTransactions :: (MonadIO m) => AccountAddress -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq TransactionHash))) getAccountNonFinalizedTransactions accountAddress = withServerStreamCollect (call @"getAccountNonFinalizedTransactions") msg ((fmap . mapM) fromProto) where msg = toProto accountAddress --- |Get all anonymity revokers registered at the end of a given block. +-- | Get all anonymity revokers registered at the end of a given block. getAnonymityRevokers :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq ArInfo.ArInfo))) getAnonymityRevokers bhInput = withServerStreamCollect (call @"getAnonymityRevokers") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all identity providers registered at the end of a given block. +-- | Get all identity providers registered at the end of a given block. getIdentityProviders :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq IpInfo.IpInfo))) getIdentityProviders bhInput = withServerStreamCollect (call @"getIdentityProviders") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all fixed passive delegators for the reward period of a given block. --- In contrast to @getPassiveDelegators@ which returns all delegators registered --- at the end of a given block, this returns all fixed delegators contributing --- stake in the reward period containing the given block. +-- | Get all fixed passive delegators for the reward period of a given block. +-- In contrast to @getPassiveDelegators@ which returns all delegators registered +-- at the end of a given block, this returns all fixed delegators contributing +-- stake in the reward period containing the given block. getPassiveDelegatorsRewardPeriod :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq DelegatorRewardPeriodInfo))) getPassiveDelegatorsRewardPeriod bhInput = withServerStreamCollect (call @"getPassiveDelegatorsRewardPeriod") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all registered passive delegators at the end of a given block. +-- | Get all registered passive delegators at the end of a given block. getPassiveDelegators :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq DelegatorInfo))) getPassiveDelegators bhInput = withServerStreamCollect (call @"getPassiveDelegators") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all fixed delegators of a given pool for the reward period of a given block. --- In contrast to @getPoolDelegators@ which returns all active delegators registered --- for the given block, this returns all the active fixed delegators contributing stake --- in the reward period containing the given block. +-- | Get all fixed delegators of a given pool for the reward period of a given block. +-- In contrast to @getPoolDelegators@ which returns all active delegators registered +-- for the given block, this returns all the active fixed delegators contributing stake +-- in the reward period containing the given block. getPoolDelegatorsRewardPeriod :: (MonadIO m) => BlockHashInput -> BakerId -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq DelegatorRewardPeriodInfo))) getPoolDelegatorsRewardPeriod bhInput baker = withServerStreamCollect (call @"getPoolDelegatorsRewardPeriod") msg ((fmap . mapM) fromProto) where msg = defMessage & ProtoFields.blockHash .~ toProto bhInput & ProtoFields.baker .~ toProto baker --- |Get all registered delegators of a given pool at the end of a given block. +-- | Get all registered delegators of a given pool at the end of a given block. getPoolDelegators :: (MonadIO m) => BlockHashInput -> BakerId -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq DelegatorInfo))) getPoolDelegators bhInput baker = withServerStreamCollect (call @"getPoolDelegators") msg ((fmap . mapM) fromProto) where msg = defMessage & ProtoFields.blockHash .~ toProto bhInput & ProtoFields.baker .~ toProto baker --- |Get IDs of all bakers at the end of a given block. +-- | Get IDs of all bakers at the end of a given block. getBakerList :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq BakerId))) getBakerList bhInput = withServerStreamCollect (call @"getBakerList") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get key-value pairs representing the entire state of a specific contract instance in a given block. --- The resulting sequence consists of key-value pairs ordered lexicographically according to the keys. +-- | Get key-value pairs representing the entire state of a specific contract instance in a given block. +-- The resulting sequence consists of key-value pairs ordered lexicographically according to the keys. getInstanceState :: (MonadIO m) => BlockHashInput -> ContractAddress -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq (ByteString, ByteString)))) getInstanceState bhInput cAddress = withServerStreamCollect (call @"getInstanceState") msg ((fmap . mapM) fromProto) where msg = defMessage & ProtoFields.blockHash .~ toProto bhInput & ProtoFields.address .~ toProto cAddress --- |Get the addresses of all smart contract instances in a given block. +-- | Get the addresses of all smart contract instances in a given block. getInstanceList :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq ContractAddress))) getInstanceList bhInput = withServerStreamCollect (call @"getInstanceList") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get ancestors of a given block. --- The first element of the sequence is the requested block itself, and the block --- immediately following a block in the sequence is the parent of that block. --- The sequence contains at most @limit@ blocks, and if the sequence is --- strictly shorter, the last block in the list is the genesis block. +-- | Get ancestors of a given block. +-- The first element of the sequence is the requested block itself, and the block +-- immediately following a block in the sequence is the parent of that block. +-- The sequence contains at most @limit@ blocks, and if the sequence is +-- strictly shorter, the last block in the list is the genesis block. getAncestors :: (MonadIO m) => BlockHashInput -> Word64 -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq BlockHash))) getAncestors bhInput limit = withServerStreamCollect (call @"getAncestors") msg ((fmap . mapM) fromProto) where @@ -3043,40 +3043,40 @@ getAncestors bhInput limit = withServerStreamCollect (call @"getAncestors") msg & ProtoFields.blockHash .~ toProto bhInput & ProtoFields.amount .~ limit --- |Get all smart contract modules that exist at the end of a given block. +-- | Get all smart contract modules that exist at the end of a given block. getModuleList :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq ModuleRef))) getModuleList bhInput = withServerStreamCollect (call @"getModuleList") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Get all accounts that exist at the end of a given block. +-- | Get all accounts that exist at the end of a given block. getAccountList :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq AccountAddress))) getAccountList bhInput = withServerStreamCollect (call @"getAccountList") msg ((fmap . mapM) fromProto) where msg = toProto bhInput --- |Process a stream of blocks that are finalized from the time the query is made onward. --- This can be used to listen for newly finalized blocks. Note that there is no guarantee --- that blocks will not be skipped if the client is too slow in processing the stream, --- however blocks will always be sent by increasing block height. Note that this function --- is non-terminating, so some care should be taken when invoking this. See @withGRPCCore@ --- for more info. +-- | Process a stream of blocks that are finalized from the time the query is made onward. +-- This can be used to listen for newly finalized blocks. Note that there is no guarantee +-- that blocks will not be skipped if the client is too slow in processing the stream, +-- however blocks will always be sent by increasing block height. Note that this function +-- is non-terminating, so some care should be taken when invoking this. See @withGRPCCore@ +-- for more info. getFinalizedBlocks :: (MonadIO m) => (FromProtoResult ArrivedBlockInfo -> ClientIO ()) -> ClientMonad m (GRPCResult ()) getFinalizedBlocks f = withServerStreamCallback (call @"getFinalizedBlocks") defMessage mempty (\_ o -> f (fromProto o)) id --- |Process a stream of blocks that arrive from the time the query is made onward. --- This can be used to listen for incoming blocks. Note that this is non-terminating, --- so some care should be taken when using this. See @withGRPCCore@ for more info. +-- | Process a stream of blocks that arrive from the time the query is made onward. +-- This can be used to listen for incoming blocks. Note that this is non-terminating, +-- so some care should be taken when using this. See @withGRPCCore@ for more info. getBlocks :: (MonadIO m) => (FromProtoResult ArrivedBlockInfo -> ClientIO ()) -> ClientMonad m (GRPCResult ()) getBlocks f = withServerStreamCallback (call @"getBlocks") defMessage mempty (\_ o -> f (fromProto o)) id --- |Get cryptographic parameters in a given block. +-- | Get cryptographic parameters in a given block. getCryptographicParameters :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult Parameters.CryptographicParameters)) getCryptographicParameters bhInput = withUnary (call @"getCryptographicParameters") msg (fmap fromProto) where msg = toProto bhInput --- |Get values of chain parameters in a given block. +-- | Get values of chain parameters in a given block. getBlockChainParameters :: (MonadIO m) => BlockHashInput -> @@ -3110,7 +3110,7 @@ getBlockChainParameters bHash = do where msg = toProto bHash --- |Get information about the node. See @NodeInfo@ for details. +-- | Get information about the node. See @NodeInfo@ for details. getNodeInfo :: (MonadIO m) => ClientMonad m (GRPCResult (FromProtoResult NodeInfo)) getNodeInfo = withUnary (call @"getNodeInfo") msg (fmap fromProto) where @@ -3122,34 +3122,34 @@ getPeersInfo = withUnary (call @"getPeersInfo") msg (fmap fromProto) where msg = defMessage --- |Get a summary of the finalization data in a given block. +-- | Get a summary of the finalization data in a given block. getBlockFinalizationSummary :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Maybe FinalizationSummary))) getBlockFinalizationSummary bhInput = withUnary (call @"getBlockFinalizationSummary") msg (fmap fromProto) where msg = toProto bhInput --- |Get the status of and information about a specific block item (transaction). +-- | Get the status of and information about a specific block item (transaction). getBlockItemStatus :: (MonadIO m) => TransactionHash -> ClientMonad m (GRPCResult (FromProtoResult TransactionStatus)) getBlockItemStatus tHash = withUnary (call @"getBlockItemStatus") msg (fmap fromProto) where msg = toProto tHash --- |Send a block item. A block item is either an @AccountTransaction@, which is --- a transaction signed and paid for by an account, a @CredentialDeployment@, --- which creates a new account, or an @UpdateInstruction@, which is an --- instruction to change some parameters of the chain. Update instructions can --- only be sent by the governance committee. +-- | Send a block item. A block item is either an @AccountTransaction@, which is +-- a transaction signed and paid for by an account, a @CredentialDeployment@, +-- which creates a new account, or an @UpdateInstruction@, which is an +-- instruction to change some parameters of the chain. Update instructions can +-- only be sent by the governance committee. -- --- Returns a hash of the block item, which can be used with --- @GetBlockItemStatus@. +-- Returns a hash of the block item, which can be used with +-- @GetBlockItemStatus@. sendBlockItem :: (MonadIO m) => Transactions.BareBlockItem -> ClientMonad m (GRPCResult (FromProtoResult TransactionHash)) sendBlockItem bbiInput = withUnary (call @"sendBlockItem") msg (fmap fromProto) where msg = toProto bbiInput --- |Get the value at a specific key of a contract state. In contrast to --- @GetInstanceState@ this is more efficient, but requires the user to know --- the specific key to look for. +-- | Get the value at a specific key of a contract state. In contrast to +-- @GetInstanceState@ this is more efficient, but requires the user to know +-- the specific key to look for. instanceStateLookup :: (MonadIO m) => BlockHashInput -> @@ -3165,75 +3165,75 @@ instanceStateLookup bhInput cAddr key = & ProtoFields.address .~ toProto cAddr & ProtoFields.key .~ key --- |Stop dumping packets. --- This feature is enabled if the node was built with the @network_dump@ feature. --- Returns a GRPC error if the network dump could not be stopped. +-- | Stop dumping packets. +-- This feature is enabled if the node was built with the @network_dump@ feature. +-- Returns a GRPC error if the network dump could not be stopped. dumpStop :: (MonadIO m) => ClientMonad m (GRPCResult ()) dumpStop = withUnary (call @"dumpStop") defMessage ((fmap . const) ()) --- |Start dumping network packets into the specified file. --- This feature is enabled if the node was built with the @network_dump@ feature. --- Returns a GRPC error if the network dump failed to start. +-- | Start dumping network packets into the specified file. +-- This feature is enabled if the node was built with the @network_dump@ feature. +-- Returns a GRPC error if the network dump failed to start. dumpStart :: (MonadIO m) => Text -> Bool -> ClientMonad m (GRPCResult ()) dumpStart file raw = withUnary (call @"dumpStart") msg ((fmap . const) ()) where msg = defMessage & ProtoFields.file .~ file & ProtoFields.raw .~ raw --- |Unban a peer. Returns a GRPC error if the action failed. +-- | Unban a peer. Returns a GRPC error if the action failed. unbanPeer :: (MonadIO m) => Peer -> ClientMonad m (GRPCResult ()) unbanPeer peer = withUnary (call @"unbanPeer") msg ((fmap . const) ()) where msg = defMessage & ProtoFields.ipAddress .~ toProto peer --- |Ban a peer. Returns a GRPC error if the action failed. +-- | Ban a peer. Returns a GRPC error if the action failed. banPeer :: (MonadIO m) => Peer -> ClientMonad m (GRPCResult ()) banPeer peer = withUnary (call @"banPeer") msg ((fmap . const) ()) where msg = defMessage & ProtoFields.ipAddress .~ toProto peer --- |Get a list of peers banned by the node. +-- | Get a list of peers banned by the node. getBannedPeers :: (MonadIO m) => ClientMonad m (GRPCResult (FromProtoResult [Peer])) getBannedPeers = withUnary (call @"getBannedPeers") defMessage (fmap fromProto) --- |Ask the node to disconnect from the peer with the submitted details. --- On success, the peer is removed from the peer-list of the node and a --- @GRPCResponse@ is returned. Otherwise a GRPC error is returned. +-- | Ask the node to disconnect from the peer with the submitted details. +-- On success, the peer is removed from the peer-list of the node and a +-- @GRPCResponse@ is returned. Otherwise a GRPC error is returned. peerDisconnect :: (MonadIO m) => IpAddress -> IpPort -> ClientMonad m (GRPCResult ()) peerDisconnect ip port = withUnary (call @"peerDisconnect") msg ((fmap . const) ()) where msg = defMessage & ProtoFields.ip .~ toProto ip & ProtoFields.port .~ toProto port --- |Ask a peer to connect to the peer with the submitted details. --- On success, the peer is added in the peer-list of the node and a --- @GRPCResponse@ is returned. Otherwise a GRPC error is returned. --- Note that the peer may not be connected instantly, in which case --- the call succeeds. +-- | Ask a peer to connect to the peer with the submitted details. +-- On success, the peer is added in the peer-list of the node and a +-- @GRPCResponse@ is returned. Otherwise a GRPC error is returned. +-- Note that the peer may not be connected instantly, in which case +-- the call succeeds. peerConnect :: (MonadIO m) => IpAddress -> IpPort -> ClientMonad m (GRPCResult ()) peerConnect ip port = withUnary (call @"peerConnect") msg ((fmap . const) ()) where msg = defMessage & ProtoFields.ip .~ toProto ip & ProtoFields.port .~ toProto port --- |Shut down the node. Returns a GRPC error if the shutdown failed. +-- | Shut down the node. Returns a GRPC error if the shutdown failed. shutdown :: (MonadIO m) => ClientMonad m (GRPCResult ()) shutdown = withUnary (call @"shutdown") defMessage ((fmap . const) ()) --- |Get next available sequence numbers for updating chain parameters after a given block. +-- | Get next available sequence numbers for updating chain parameters after a given block. getNextUpdateSequenceNumbers :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult NextUpdateSequenceNumbers)) getNextUpdateSequenceNumbers bhInput = withUnary (call @"getNextUpdateSequenceNumbers") msg (fmap fromProto) where msg = toProto bhInput --- |Get information related to the baker election for a particular block. +-- | Get information related to the baker election for a particular block. getElectionInfo :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult BlockBirkParameters)) getElectionInfo bhInput = withUnary (call @"getElectionInfo") msg (fmap fromProto) where msg = toProto bhInput --- |Get the current branches of blocks starting from and including the last finalized block. +-- | Get the current branches of blocks starting from and including the last finalized block. getBranches :: (MonadIO m) => ClientMonad m (GRPCResult (FromProtoResult Branch)) getBranches = withUnary (call @"getBranches") defMessage (fmap fromProto) --- |Run the smart contract entrypoint in a given context and in the state at the end of a given block. +-- | Run the smart contract entrypoint in a given context and in the state at the end of a given block. invokeInstance :: (MonadIO m) => BlockHashInput -> @@ -3243,47 +3243,47 @@ invokeInstance bhInput cContext = withUnary (call @"invokeInstance") msg (fmap f where msg = toProto (bhInput, cContext) --- |Get information about tokenomics at the end of a given block. +-- | Get information about tokenomics at the end of a given block. getTokenomicsInfo :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult RewardStatus)) getTokenomicsInfo bhInput = withUnary (call @"getTokenomicsInfo") msg (fmap fromProto) where msg = toProto bhInput --- |Get a list of live blocks at a given height. +-- | Get a list of live blocks at a given height. getBlocksAtHeight :: (MonadIO m) => BlockHeightInput -> ClientMonad m (GRPCResult (FromProtoResult [BlockHash])) getBlocksAtHeight blockHeight = withUnary (call @"getBlocksAtHeight") msg (fmap fromProto) where msg = toProto blockHeight --- |Get information about the passive delegators at the end of a given block. +-- | Get information about the passive delegators at the end of a given block. getPassiveDelegationInfo :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult PoolStatus)) getPassiveDelegationInfo bhInput = withUnary (call @"getPassiveDelegationInfo") msg (fmap fromProto) where msg = toProto bhInput --- |Get information about a given pool at the end of a given block. +-- | Get information about a given pool at the end of a given block. getPoolInfo :: (MonadIO m) => BlockHashInput -> BakerId -> ClientMonad m (GRPCResult (FromProtoResult PoolStatus)) getPoolInfo bhInput baker = withUnary (call @"getPoolInfo") msg (fmap fromProto) where msg = defMessage & ProtoFields.blockHash .~ toProto bhInput & ProtoFields.baker .~ toProto baker --- |Get information, such as height, timings, and transaction counts for a given block. +-- | Get information, such as height, timings, and transaction counts for a given block. getBlockInfo :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult BlockInfo)) getBlockInfo bhInput = withUnary (call @"getBlockInfo") msg (fmap fromProto) where msg = toProto bhInput --- |Get information about the current state of consensus. +-- | Get information about the current state of consensus. getConsensusInfo :: (MonadIO m) => ClientMonad m (GRPCResult (FromProtoResult ConsensusStatus)) getConsensusInfo = withUnary (call @"getConsensusInfo") defMessage (fmap fromProto) --- |Get the source of a smart contract module. +-- | Get the source of a smart contract module. getModuleSource :: (MonadIO m) => ModuleRef -> BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult Wasm.WasmModule)) getModuleSource modRef bhInput = withUnary (call @"getModuleSource") msg (fmap fromProto) where msg = defMessage & ProtoFields.blockHash .~ toProto bhInput & ProtoFields.moduleRef .~ toProto modRef --- |Retrieve the account information from the chain. +-- | Retrieve the account information from the chain. getAccountInfo :: (MonadIO m) => AccountIdentifier -> BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult Concordium.Types.AccountInfo)) getAccountInfo account bhInput = withUnary (call @"getAccountInfo") msg (fmap fromProto) where @@ -3299,7 +3299,7 @@ getNextSequenceNumber accAddress = withUnary (call @"getNextAccountSequenceNumbe where msg = toProto accAddress --- |Retrieve a stream of 'BakerRewardPeriodInfo' given the input. +-- | Retrieve a stream of 'BakerRewardPeriodInfo' given the input. getBakersRewardPeriod :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq BakerRewardPeriodInfo))) getBakersRewardPeriod bhInput = withServerStreamCollect (call @"getBakersRewardPeriod") msg ((fmap . mapM) fromProto) where @@ -3310,7 +3310,7 @@ getBlockCertificates bhInput = withUnary (call @"getBlockCertificates") msg (fma where msg = toProto bhInput --- |Get the earliest time at which a baker may be expected to bake a block. +-- | Get the earliest time at which a baker may be expected to bake a block. getBakerEarliestWinTime :: (MonadIO m) => BakerId -> ClientMonad m (GRPCResult (FromProtoResult Timestamp)) getBakerEarliestWinTime bakerId = withUnary (call @"getBakerEarliestWinTime") msg (fmap fromProto) where @@ -3326,18 +3326,18 @@ getFirstBlockEpoch epochReq = withUnary (call @"getFirstBlockEpoch") msg (fmap f where msg = toProto epochReq --- |Call a unary V2 GRPC API endpoint and return the result. +-- | Call a unary V2 GRPC API endpoint and return the result. withUnary :: ( HasMethod CS.Queries m, MonadIO n, i ~ MethodInput CS.Queries m, o ~ MethodOutput CS.Queries m ) => - -- |The procedure to call. + -- | The procedure to call. RPC CS.Queries m -> - -- |The procedure input. + -- | The procedure input. i -> - -- |A mapping of the result. + -- | A mapping of the result. (GRPCResult o -> b) -> ClientMonad n b withUnary method input k = withGRPCCore callHelper k @@ -3347,20 +3347,20 @@ withUnary method input k = withGRPCCore callHelper k res <- rawUnary method client input return $ fmap RawUnaryOutput res --- |Call a streaming V2 GRPC API endpoint and return the (collected) results in a sequence. --- Note that some care should be taken when using this with long-running calls. See --- @withGRPCCore@ for more info. +-- | Call a streaming V2 GRPC API endpoint and return the (collected) results in a sequence. +-- Note that some care should be taken when using this with long-running calls. See +-- @withGRPCCore@ for more info. withServerStreamCollect :: ( HasMethod CS.Queries m, MonadIO n, i ~ MethodInput CS.Queries m, o ~ Seq.Seq (MethodOutput CS.Queries m) ) => - -- |The procedure to call. + -- | The procedure to call. RPC CS.Queries m -> - -- |The procedure input. + -- | The procedure input. i -> - -- |A mapping of the collected result. + -- | A mapping of the collected result. (GRPCResult o -> b) -> ClientMonad n b withServerStreamCollect method input = @@ -3368,30 +3368,30 @@ withServerStreamCollect method input = where handler acc o = return $ acc <> pure o --- |Call a streaming GRPC API endpoint and return the (collected) results. --- Takes a @fold@-like callback and an accumulator, and returns the result --- of folding through each stream element, once the stream terminates. Note --- that some care should be taken when using this with long-running calls. --- See @withGRPCCore@ for more info. +-- | Call a streaming GRPC API endpoint and return the (collected) results. +-- Takes a @fold@-like callback and an accumulator, and returns the result +-- of folding through each stream element, once the stream terminates. Note +-- that some care should be taken when using this with long-running calls. +-- See @withGRPCCore@ for more info. withServerStreamCallback :: ( HasMethod CS.Queries m, MonadIO n, i ~ MethodInput CS.Queries m, o ~ MethodOutput CS.Queries m ) => - -- |The procedure to call. + -- | The procedure to call. RPC CS.Queries m -> - -- |The procedure input. + -- | The procedure input. i -> - -- |An initial @fold@-like accumulator that - -- is updated with the handler each time a - -- stream element arrives. + -- | An initial @fold@-like accumulator that + -- is updated with the handler each time a + -- stream element arrives. a -> - -- |A @fold@-like handler which is used - -- to process a stream object and update - -- the accumulator. + -- | A @fold@-like handler which is used + -- to process a stream object and update + -- the accumulator. (a -> o -> ClientIO a) -> - -- |A mapping of the accumulated result. + -- | A mapping of the accumulated result. (GRPCResult a -> b) -> ClientMonad n b withServerStreamCallback method input acc handler = @@ -3407,18 +3407,18 @@ withServerStreamCallback method input acc handler = res <- rawStreamServer method client acc input handler' return $ fmap ServerStreamOutput res --- |Run a request helper function with a client instance to call a GRPC procedure. --- The output is interpreted using the function given in the second parameter. +-- | Run a request helper function with a client instance to call a GRPC procedure. +-- The output is interpreted using the function given in the second parameter. -- --- Note that long-running streaming call may block other calls from retrying to --- establish their connection if they fail. Therefore some care should be taken --- when using long-running or unproductive calls, and in particular those targeting --- never-ending streaming endpoints such as @getBlocks@ and @getFinalizedBlocks@. +-- Note that long-running streaming call may block other calls from retrying to +-- establish their connection if they fail. Therefore some care should be taken +-- when using long-running or unproductive calls, and in particular those targeting +-- never-ending streaming endpoints such as @getBlocks@ and @getFinalizedBlocks@. withGRPCCore :: (MonadIO n) => - -- |A helper which takes a client, issues a GRPC request in the client and returns the result. + -- | A helper which takes a client, issues a GRPC request in the client and returns the result. (GrpcClient -> ClientIO (Either TooMuchConcurrency (GRPCOutput b))) -> - -- |A mapping of the result. + -- | A mapping of the result. (GRPCResult b -> t) -> ClientMonad n t withGRPCCore helper k = do diff --git a/src/Concordium/Client/LegacyCommands.hs b/src/Concordium/Client/LegacyCommands.hs index d5bb68b0..7f19d711 100644 --- a/src/Concordium/Client/LegacyCommands.hs +++ b/src/Concordium/Client/LegacyCommands.hs @@ -8,18 +8,18 @@ import Concordium.Types import Data.Text import Options.Applicative --- |Representation of the arguments to a command that expects an epoch to be specified as input. +-- | Representation of the arguments to a command that expects an epoch to be specified as input. data EpochSpecifier = EpochSpecifier - { -- |The genesis index to query. Should be provided with 'esEpoch'. + { -- | The genesis index to query. Should be provided with 'esEpoch'. esGenesisIndex :: !(Maybe GenesisIndex), - -- |The epoch number to query. Should be provided with 'esGenesisIndex'. + -- | The epoch number to query. Should be provided with 'esGenesisIndex'. esEpoch :: !(Maybe Epoch), - -- |The block to use the epoch of. Should not be provided with any other fields. + -- | The block to use the epoch of. Should not be provided with any other fields. esBlock :: !(Maybe BlockHash) } deriving (Show) --- |Helper function for parsing an 'EpochSpecifier' as command line options. +-- | Helper function for parsing an 'EpochSpecifier' as command line options. parseEpochSpecifier :: Parser EpochSpecifier parseEpochSpecifier = EpochSpecifier diff --git a/src/Concordium/Client/Output.hs b/src/Concordium/Client/Output.hs index 2be3c083..f353b864 100644 --- a/src/Concordium/Client/Output.hs +++ b/src/Concordium/Client/Output.hs @@ -62,31 +62,31 @@ import Text.Printf -- PRINTER --- |Specialized writer for producing a list of lines. +-- | Specialized writer for producing a list of lines. type Printer = Writer [String] () --- |Print the lines of a printer. +-- | Print the lines of a printer. runPrinter :: (MonadIO m) => Printer -> m () runPrinter = liftIO . mapM_ putStrLn . execWriter -- TIME --- |Convert time to string using the provided formatting and "default" (American) locale. --- Normally one of the functions below should be used instead of this one. +-- | Convert time to string using the provided formatting and "default" (American) locale. +-- Normally one of the functions below should be used instead of this one. showTime :: String -> UTCTime -> String showTime = formatTime defaultTimeLocale --- |Convert time to string using the RFC822 date formatting and "default" (American) locale. +-- | Convert time to string using the RFC822 date formatting and "default" (American) locale. showTimeFormatted :: UTCTime -> String showTimeFormatted = showTime rfc822DateFormat --- |Convert time to string formatted as " ". --- This is the format used for credential expiration. +-- | Convert time to string formatted as " ". +-- This is the format used for credential expiration. showTimeYearMonth :: UTCTime -> String showTimeYearMonth = showTime "%b %0Y" --- |Convert time of day to string formatted as "::" (all zero-padded). --- This is the format used for timestamps in logging. +-- | Convert time of day to string formatted as "::" (all zero-padded). +-- This is the format used for timestamps in logging. showTimeOfDay :: TimeOfDay -> String showTimeOfDay = formatTime defaultTimeLocale "%T" @@ -166,13 +166,13 @@ printAccountConfigList cfgs = -- ACCOUNT --- |Get a string representation of given @AccountIdentifier@ variant. +-- | Get a string representation of given @AccountIdentifier@ variant. showAccountIdentifier :: Types.AccountIdentifier -> String showAccountIdentifier (Types.AccAddress addr) = [i|account address '#{addr}'|] showAccountIdentifier (Types.CredRegID cred) = [i|credential registration ID '#{cred}'|] showAccountIdentifier (Types.AccIndex idx) = [i|account index '#{idx}'|] --- |Standardized method of displaying "no" information. +-- | Standardized method of displaying "no" information. showNone :: String showNone = "none" @@ -300,13 +300,13 @@ printAccountInfo addr a verbose showEncrypted mEncKey = do then tell $ [showPrettyJSON (Types.aiAccountCredentials a)] else forM_ (Map.toList (Types.aiAccountCredentials a)) printVersionedCred --- |Print a versioned credential. This only prints the credential value, and not the --- associated version. -printVersionedCred :: Show credTy => (IDTypes.CredentialIndex, (Versioned (IDTypes.AccountCredential' credTy))) -> Printer +-- | Print a versioned credential. This only prints the credential value, and not the +-- associated version. +printVersionedCred :: (Show credTy) => (IDTypes.CredentialIndex, (Versioned (IDTypes.AccountCredential' credTy))) -> Printer printVersionedCred (ci, vc) = printCred ci (vValue vc) --- |Print the registration id, expiry date, and revealed attributes of a credential. -printCred :: Show credTy => IDTypes.CredentialIndex -> IDTypes.AccountCredential' credTy -> Printer +-- | Print the registration id, expiry date, and revealed attributes of a credential. +printCred :: (Show credTy) => IDTypes.CredentialIndex -> IDTypes.AccountCredential' credTy -> Printer printCred ci c = tell [ printf "* %s:" (show $ IDTypes.credId c), @@ -327,7 +327,7 @@ printCred ci c = Nothing -> printf "invalid expiration time '%s'" e Just t -> showTimeYearMonth t --- |Print a list of accounts along with optional names. +-- | Print a list of accounts along with optional names. printAccountList :: AccountNameMap -> [IDTypes.AccountAddress] -> Printer printAccountList nameMap accs = printNameList "Accounts" header format namedAccs where @@ -340,7 +340,7 @@ printAccountList nameMap accs = printNameList "Accounts" header format namedAccs ] format NamedAddress{..} = [i|#{naAddr} #{showNameList naNames}|] --- |Print a list of modules along with optional names. +-- | Print a list of modules along with optional names. printModuleList :: ModuleNameMap -> [Types.ModuleRef] -> Printer printModuleList nameMap refs = printNameList "Modules" header format namedModRefs where @@ -353,7 +353,7 @@ printModuleList nameMap refs = printNameList "Modules" header format namedModRef ] format NamedModuleRef{..} = [i|#{nmrRef} #{showNameList nmrNames}|] --- |Print a list of contracts along with optional names. +-- | Print a list of contracts along with optional names. printContractList :: ContractNameMap -> [Types.ContractAddress] -> Printer printContractList nameMap addrs = printNameList "Contracts" header format namedContrAddrs where @@ -368,7 +368,7 @@ printContractList nameMap addrs = printNameList "Contracts" header format namedC where addr = showCompactPrettyJSON ncaAddr --- |Print a header and a list of named items in the provided format. +-- | Print a header and a list of named items in the provided format. printNameList :: String -> [String] -> (a -> String) -> [a] -> Printer printNameList variantName header format xs = case xs of @@ -377,9 +377,9 @@ printNameList variantName header format xs = tell header tell $ map format xs --- |Print contract info using a provided namedAddress and namedModRef. --- Since ContractInfo comes directly from the node, the names are not included and must --- be provided separately. +-- | Print contract info using a provided namedAddress and namedModRef. +-- Since ContractInfo comes directly from the node, the names are not included and must +-- be provided separately. printContractInfo :: CI.ContractInfo -> NamedAddress -> NamedModuleRef -> Printer printContractInfo ci namedOwner namedModRef = case ci of @@ -453,16 +453,16 @@ showContractFuncV2 funcName mFuncSchema = case mFuncSchema of Just CS.RvError{..} -> [i|- #{funcName}\n Return value:\n#{indentBy 8 $ showPrettyJSON fs2ReturnValue}\n Error:\n#{indentBy 8 $ showPrettyJSON fs2Error}|] Just CS.ParamRvError{..} -> [i|- #{funcName}\n Parameter:\n#{indentBy 8 $ showPrettyJSON fs2Parameter}\n Return value:\n#{indentBy 8 $ showPrettyJSON fs2ReturnValue}\n Error:\n#{indentBy 8 $ showPrettyJSON fs2Error}|] --- |Print a V3 event schema. +-- | Print a V3 event schema. showContractEventV3 :: Maybe SchemaType -> String showContractEventV3 stM = case stM of Nothing -> [i||] Just st -> [i| #{showPrettyJSON st}|] --- |Print module inspect info, i.e., the named moduleRef and its included contracts. --- If the init or receive signatures for a contract exist in the schema, they are also printed. --- Otherwise, it just prints the method names. --- If the schema contains signatures for init or receive methods not in the module, a warning is displayed. +-- | Print module inspect info, i.e., the named moduleRef and its included contracts. +-- If the init or receive signatures for a contract exist in the schema, they are also printed. +-- Otherwise, it just prints the method names. +-- If the schema contains signatures for init or receive methods not in the module, a warning is displayed. printModuleInspectInfo :: CI.ModuleInspectInfo -> Printer printModuleInspectInfo CI.ModuleInspectInfo{..} = do tell @@ -571,11 +571,11 @@ printModuleInspectInfo CI.ModuleInspectInfo{..} = do showReceives :: (a -> b -> String) -> [(a, b)] -> [String] showReceives showContractFunc = fmap (indentBy 4 . uncurry showContractFunc) --- |Indents each line in a string by the number of spaces specified. +-- | Indents each line in a string by the number of spaces specified. indentBy :: Int -> String -> String indentBy spaces = intercalate "\n" . map (replicate spaces ' ' <>) . lines --- |Invert a map and combine the new values in a list. +-- | Invert a map and combine the new values in a list. invertHashMapAndCombine :: (Ord v) => Map.Map k v -> Map.Map v [k] invertHashMapAndCombine = Map.fromListWith (++) . map (\(k, v) -> (v, [k])) . Map.toList @@ -604,16 +604,16 @@ parseTransactionBlockResult status = in MultipleBlocksUnambiguous hashes outcome _ -> MultipleBlocksAmbiguous blocks --- |Print transaction status, optionally decoding events and parameters according --- to contract module schema. --- Since the transaction may be present in multiple blocks before it is finalized, --- the schema information is passed as a map from blockhashes to pairs of events and --- its associated contract information. For a block in which the transaction is --- present, @printTransactionSchema@ looks up its blockhash in the map and retrieves --- the relevant schema information from the @ContractInfo@ associated with each event. --- If a parameter or event could not be decoded either because a schema was not present --- in the contract information or because the decoding failed, a hexadecimal string --- representing the raw data will be shown instead. +-- | Print transaction status, optionally decoding events and parameters according +-- to contract module schema. +-- Since the transaction may be present in multiple blocks before it is finalized, +-- the schema information is passed as a map from blockhashes to pairs of events and +-- its associated contract information. For a block in which the transaction is +-- present, @printTransactionSchema@ looks up its blockhash in the map and retrieves +-- the relevant schema information from the @ContractInfo@ associated with each event. +-- If a parameter or event could not be decoded either because a schema was not present +-- in the contract information or because the decoding failed, a hexadecimal string +-- representing the raw data will be shown instead. printTransactionStatus :: TransactionStatusResult -> Bool -> @@ -755,16 +755,16 @@ showOutcomeResult verbose contrInfoWithEventsM = \case in (idtFollowing, out <> [evStringM]) --- |Return string representation of outcome event if verbose or if the event includes --- relevant information that wasn't part of the transaction request. Otherwise return Nothing. --- If verbose is true, the string includes the details from the fields of the event. --- Otherwise, only the fields that are not known from the transaction request are included. --- Currently this is only the baker ID from AddBaker, which is computed by the backend. --- The non-verbose version is used by the transaction commands (through tailTransaction_) --- where the input parameters have already been specified manually and repeated in a block --- of text that they confirmed manually. --- The verbose version is used by 'transaction status' and the non-trivial cases of the above --- where there are multiple distinct outcomes. +-- | Return string representation of outcome event if verbose or if the event includes +-- relevant information that wasn't part of the transaction request. Otherwise return Nothing. +-- If verbose is true, the string includes the details from the fields of the event. +-- Otherwise, only the fields that are not known from the transaction request are included. +-- Currently this is only the baker ID from AddBaker, which is computed by the backend. +-- The non-verbose version is used by the transaction commands (through tailTransaction_) +-- where the input parameters have already been specified manually and repeated in a block +-- of text that they confirmed manually. +-- The verbose version is used by 'transaction status' and the non-trivial cases of the above +-- where there are multiple distinct outcomes. showEvent :: -- | Whether the output should be verbose. Verbose -> @@ -933,15 +933,15 @@ showEvent verbose ciM = \case Nothing -> Nothing Just ci -> CI.getParameterSchema ci rName --- |Return string representation of reject reason. --- If verbose is true, the string includes the details from the fields of the reason. --- Otherwise, only the fields that are not known from the transaction request are included. --- Currently this is only the baker address from NotFromBakerAccount. --- The non-verbose version is used by the transaction commands (through tailTransaction_) --- where the input parameters have already been specified manually and repeated in a block --- of text that they confirmed manually. --- The verbose version is used by 'transaction status' and the non-trivial cases of the above --- where there are multiple distinct outcomes. +-- | Return string representation of reject reason. +-- If verbose is true, the string includes the details from the fields of the reason. +-- Otherwise, only the fields that are not known from the transaction request are included. +-- Currently this is only the baker address from NotFromBakerAccount. +-- The non-verbose version is used by the transaction commands (through tailTransaction_) +-- where the input parameters have already been specified manually and repeated in a block +-- of text that they confirmed manually. +-- The verbose version is used by 'transaction status' and the non-trivial cases of the above +-- where there are multiple distinct outcomes. showRejectReason :: Verbose -> Types.RejectReason -> String showRejectReason verbose = \case Types.ModuleNotWF -> @@ -1082,7 +1082,7 @@ printConsensusStatus r = printf "Trigger block time: %s" (show cbftsTriggerBlockTime) ] --- |Print Birk parameters from a @BlockBirkParameters@. +-- | Print Birk parameters from a @BlockBirkParameters@. printQueryBirkParameters :: Bool -> Queries.BlockBirkParameters -> Map.Map IDTypes.AccountAddress Text -> Printer printQueryBirkParameters includeBakers r addrmap = do tell $ @@ -1116,7 +1116,7 @@ printQueryBirkParameters includeBakers r addrmap = do maybeElectionDiffiulty Nothing = [] maybeElectionDiffiulty (Just ed) = [printf "Election difficulty: %s" (show ed)] --- |Print Birk parameters from a @BirkParametersResult@. +-- | Print Birk parameters from a @BirkParametersResult@. printBirkParameters :: Bool -> BirkParametersResult -> Map.Map IDTypes.AccountAddress Text -> Printer printBirkParameters includeBakers r addrmap = do tell @@ -1142,7 +1142,7 @@ printBirkParameters includeBakers r addrmap = do accountName bkr = fromMaybe " " $ Map.lookup bkr addrmap -- | Prints the chain parameters. -printChainParameters :: forall cpv. IsChainParametersVersion cpv => ChainParameters' cpv -> Printer +printChainParameters :: forall cpv. (IsChainParametersVersion cpv) => ChainParameters' cpv -> Printer printChainParameters cp = do case chainParametersVersion @cpv of SChainParametersV0 -> printChainParametersV0 cp @@ -1310,7 +1310,7 @@ showExchangeRate (Types.ExchangeRate r) = showRatio r -- BLOCK --- |Get a string representation of a given @BlockHashInput@ variant. +-- | Get a string representation of a given @BlockHashInput@ variant. showBlockHashInput :: Queries.BlockHashInput -> String showBlockHashInput Queries.Best = [i|best block|] showBlockHashInput (Queries.Given bh) = [i|block with hash #{bh}|] @@ -1392,24 +1392,24 @@ printAnonymityRevokers arInfos = do -- AMOUNT AND ENERGY --- |Standardized method of displaying an amount as CCD. +-- | Standardized method of displaying an amount as CCD. showCcd :: Types.Amount -> String showCcd = printf "%s CCD" . Types.amountToString --- |Standardized method of displaying energy as NRG. +-- | Standardized method of displaying energy as NRG. showNrg :: Types.Energy -> String showNrg = printf "%s NRG" . show -- UTIL --- |Produce a string fragment of the account address and, if available, a list of names for it. +-- | Produce a string fragment of the account address and, if available, a list of names for it. showNamedAddress :: NamedAddress -> String showNamedAddress NamedAddress{..} = case naNames of [] -> [i|'#{naAddr}'|] names -> [i|'#{naAddr}' (#{showNameList names})|] --- |Produce a string fragment of the contract address and, if available, a list of names for it. +-- | Produce a string fragment of the contract address and, if available, a list of names for it. showNamedContractAddress :: NamedContractAddress -> String showNamedContractAddress NamedContractAddress{..} = case ncaNames of @@ -1418,57 +1418,57 @@ showNamedContractAddress NamedContractAddress{..} = where ncaAddr' = showCompactPrettyJSON ncaAddr --- |Produce a string fragment of the moduleRef and, if available, a list of names for it. +-- | Produce a string fragment of the moduleRef and, if available, a list of names for it. showNamedModuleRef :: NamedModuleRef -> String showNamedModuleRef NamedModuleRef{..} = case nmrNames of [] -> [i|'#{nmrRef}'|] names -> [i|'#{nmrRef}' (#{showNameList names})|] --- |Standardized method of displaying optional values. +-- | Standardized method of displaying optional values. showMaybe :: (a -> String) -> Maybe a -> String showMaybe = maybe showNone --- |Standardized method of displaying optional time values. +-- | Standardized method of displaying optional time values. showMaybeUTC :: Maybe UTCTime -> String showMaybeUTC = showMaybe showTimeFormatted --- |Standardized method of displaying EMA/EMSD values. +-- | Standardized method of displaying EMA/EMSD values. showEm :: String -> String -> String showEm = printf "%s (EMA), %s (EMSD)" --- |Standardized method of displaying EMA/EMSD number of seconds. +-- | Standardized method of displaying EMA/EMSD number of seconds. showEmSeconds :: Double -> Double -> String showEmSeconds a d = showEm (showSeconds a) (showSeconds d) --- |Standardized method of displaying optional EMA/EMSD number of seconds. +-- | Standardized method of displaying optional EMA/EMSD number of seconds. showMaybeEmSeconds :: Maybe Double -> Maybe Double -> String showMaybeEmSeconds a d = case (a, d) of (Just a', Just d') -> showEmSeconds a' d' _ -> showNone --- |Standardized method of displaying a number of seconds. +-- | Standardized method of displaying a number of seconds. showSeconds :: Double -> String showSeconds s = printf "%5d ms" (round $ 1000 * s :: Int) --- |Standardized method of displaying a number of milliseconds in a nice way, e.g. "2h 15m 3s". +-- | Standardized method of displaying a number of milliseconds in a nice way, e.g. "2h 15m 3s". showDuration :: Word64 -> String showDuration = Text.unpack . durationToText --- |Print a line for each entry in the provided map using the provided print function. +-- | Print a line for each entry in the provided map using the provided print function. printMap :: ((k, v) -> String) -> [(k, v)] -> Printer printMap s m = forM_ m $ \(k, v) -> tell [s (k, v)] --- |Standardized method of displaying a boolean as "yes" or "no" --- (for True and False, respectively). +-- | Standardized method of displaying a boolean as "yes" or "no" +-- (for True and False, respectively). showYesNo :: Bool -> String showYesNo = bool "no" "yes" --- |Unwrap a list from within `Maybe`. `Nothing` becomes an empty list. +-- | Unwrap a list from within `Maybe`. `Nothing` becomes an empty list. unwrapMaybeList :: Maybe [a] -> [a] unwrapMaybeList = concat --- |Show a value wrapped in a @Conditionally@. +-- | Show a value wrapped in a @Conditionally@. showConditionally :: (Show a) => Conditionally b a -> String showConditionally (CFalse) = "N/A" showConditionally (CTrue v) = show v diff --git a/src/Concordium/Client/Parse.hs b/src/Concordium/Client/Parse.hs index 70dabe11..868cb738 100644 --- a/src/Concordium/Client/Parse.hs +++ b/src/Concordium/Client/Parse.hs @@ -26,17 +26,17 @@ data DurationUnit = Second | Minute | Hour type TimeFormat = String --- |Parse time from a string using the provided format. --- This is a simple convenience wrapper around the more general function parseTimeM. +-- | Parse time from a string using the provided format. +-- This is a simple convenience wrapper around the more general function parseTimeM. parseTime :: (MonadFail m) => TimeFormat -> String -> m UTCTime parseTime = parseTimeM False defaultTimeLocale --- |Parse credential expiry time formatted as "" +-- | Parse credential expiry time formatted as "" parseCredExpiry :: (MonadFail m) => String -> m UTCTime parseCredExpiry = parseTime "%0Y%0m" --- |Parse expiry time given as absolute Unix epoch or a duration string --- relative to the provided "now" time. +-- | Parse expiry time given as absolute Unix epoch or a duration string +-- relative to the provided "now" time. parseExpiry :: (MonadError String m) => TransactionExpiryTime -> Text -> m TransactionExpiryTime parseExpiry now input = do (t, u) <- parseDuration input @@ -50,7 +50,7 @@ parseExpiry now input = do Minute -> 60 Hour -> 3600 --- |Parse a string into an integer and an optional duration unit. +-- | Parse a string into an integer and an optional duration unit. parseDuration :: (MonadError String m) => Text -> m (Word64, Maybe DurationUnit) parseDuration t = case reads $ unpack t of diff --git a/src/Concordium/Client/RWLock.hs b/src/Concordium/Client/RWLock.hs index e0068bf1..c4f0bb80 100644 --- a/src/Concordium/Client/RWLock.hs +++ b/src/Concordium/Client/RWLock.hs @@ -9,85 +9,85 @@ import Control.Concurrent import Control.Exception import Data.Word --- |A reader-writer lock that strongly prefer writers. More precisely this means the following --- - readers and writers are mutually exclusive --- - multiple readers may hold the lock at the same time if there is no writer --- - at most one writer may hold the lock +-- | A reader-writer lock that strongly prefer writers. More precisely this means the following +-- - readers and writers are mutually exclusive +-- - multiple readers may hold the lock at the same time if there is no writer +-- - at most one writer may hold the lock -- --- If a writer tries to acquire a lock it will either --- - succeed if there are no current readers or writers --- - block after recording the intent to lock. While there are pending writers no new readers can acquire the lock. +-- If a writer tries to acquire a lock it will either +-- - succeed if there are no current readers or writers +-- - block after recording the intent to lock. While there are pending writers no new readers can acquire the lock. -- --- If multiple writers are blocking on the lock they will be served in an --- unspecified order and in principle it is possible that with heavy write --- contention some writers would be starved. This is not the case for the --- use-case we have. +-- If multiple writers are blocking on the lock they will be served in an +-- unspecified order and in principle it is possible that with heavy write +-- contention some writers would be starved. This is not the case for the +-- use-case we have. -- --- Let ⊤ mean that the MVar is full and ⊥ that it is empty. The fields of the lock satisfy the following --- properties. --- - there are exactly waitingWriters threads blocking on acquireWrite --- - rwlState == Free if and only if rwlReadLock == ⊤ and rwlWriteLock == ⊤ --- - rwlReadLock == ⊥ if and only if there is an active reader. --- - rwlWriteLock == ⊥ if and only if there is an active writer. +-- Let ⊤ mean that the MVar is full and ⊥ that it is empty. The fields of the lock satisfy the following +-- properties. +-- - there are exactly waitingWriters threads blocking on acquireWrite +-- - rwlState == Free if and only if rwlReadLock == ⊤ and rwlWriteLock == ⊤ +-- - rwlReadLock == ⊥ if and only if there is an active reader. +-- - rwlWriteLock == ⊥ if and only if there is an active writer. -- --- Transitions between states are governed by the following transition system --- where AW/RW and AR/RR mean acquire write, release write and acquire read, --- release read, respectively. The WR and WW mean that the thread that --- executed the transition is blocked waiting for rwlReadLock and rwlWriteLock MVar to be full. --- (Free 0, ⊤, ⊤) -AR-> (ReadLocked 1 0, ⊥, ⊤) --- (Free (n+1), ⊤, ⊤) -AR-> (Free (n+1), ⊤, ⊤) --- (Free 0, ⊤, ⊤) -AW-> (WriteLocked 0, ⊤, ⊥) --- (Free (n+1), ⊤, ⊤) -AW-> (WriteLocked n, ⊤, ⊥) +-- Transitions between states are governed by the following transition system +-- where AW/RW and AR/RR mean acquire write, release write and acquire read, +-- release read, respectively. The WR and WW mean that the thread that +-- executed the transition is blocked waiting for rwlReadLock and rwlWriteLock MVar to be full. +-- (Free 0, ⊤, ⊤) -AR-> (ReadLocked 1 0, ⊥, ⊤) +-- (Free (n+1), ⊤, ⊤) -AR-> (Free (n+1), ⊤, ⊤) +-- (Free 0, ⊤, ⊤) -AW-> (WriteLocked 0, ⊤, ⊥) +-- (Free (n+1), ⊤, ⊤) -AW-> (WriteLocked n, ⊤, ⊥) -- --- (ReadLocked n 0, ⊥, ⊤) -AR-> (ReadLocked (n+1) 0, ⊥, ⊤) --- (ReadLocked n (m+1), ⊥, ⊤) -AR-> (ReadLocked n (m+1), ⊥, ⊤), WR --- (ReadLocked n m, ⊥, ⊤) -AW-> (ReadLocked n (m+1), ⊥, ⊤), WW --- (ReadLocked 1 m, ⊥, ⊤) -RR-> (Free m, ⊤, ⊤) --- (ReadLocked (n+1) m, ⊥, ⊤) -RR-> (ReadLocked n m, ⊥, ⊤) +-- (ReadLocked n 0, ⊥, ⊤) -AR-> (ReadLocked (n+1) 0, ⊥, ⊤) +-- (ReadLocked n (m+1), ⊥, ⊤) -AR-> (ReadLocked n (m+1), ⊥, ⊤), WR +-- (ReadLocked n m, ⊥, ⊤) -AW-> (ReadLocked n (m+1), ⊥, ⊤), WW +-- (ReadLocked 1 m, ⊥, ⊤) -RR-> (Free m, ⊤, ⊤) +-- (ReadLocked (n+1) m, ⊥, ⊤) -RR-> (ReadLocked n m, ⊥, ⊤) -- --- (WriteLocked n, ⊤, ⊥) -AR-> (WriteLocked n, ⊤, ⊥) --- (WriteLocked n, ⊤, ⊥) -AW-> (WriteLocked (n+1), ⊤, ⊥), WR --- (WriteLocked n, ⊤, ⊥) -RW-> (Free n, ⊤, ⊤), WW +-- (WriteLocked n, ⊤, ⊥) -AR-> (WriteLocked n, ⊤, ⊥) +-- (WriteLocked n, ⊤, ⊥) -AW-> (WriteLocked (n+1), ⊤, ⊥), WR +-- (WriteLocked n, ⊤, ⊥) -RW-> (Free n, ⊤, ⊤), WW -- --- No other state should be reachable. +-- No other state should be reachable. -- --- Additionally, rwlReadLock and rwlWriteLock can only be modified while the --- rwlState MVar is held. +-- Additionally, rwlReadLock and rwlWriteLock can only be modified while the +-- rwlState MVar is held. data RWLock = RWLock - { -- |The state the lock is currently in. + { -- | The state the lock is currently in. rwlState :: !(MVar RWState), - -- |An MVar used to signal threads that are waiting for all active readers to - -- wake up. This is empty when there is at least one active reader and full - -- otherwise. + -- | An MVar used to signal threads that are waiting for all active readers to + -- wake up. This is empty when there is at least one active reader and full + -- otherwise. rwlReadLock :: !(MVar ()), - -- |An MVar used to signal waiting readers and writers to wake up. This is - -- empty when there is an active writer, and full otherwise. Readers wait on - -- this MVar when there is an active writer. + -- | An MVar used to signal waiting readers and writers to wake up. This is + -- empty when there is an active writer, and full otherwise. Readers wait on + -- this MVar when there is an active writer. rwlWriteLock :: !(MVar ()) } --- |State of a reader-writer lock. +-- | State of a reader-writer lock. data RWState - = -- |Nobody has acquired the lock. + = -- | Nobody has acquired the lock. Free - { -- |The lock is not acquired, but there might be pending writers that want to acquire it. + { -- | The lock is not acquired, but there might be pending writers that want to acquire it. waitingWriters :: !Word64 } - | -- |There is at least one active reader. + | -- | There is at least one active reader. ReadLocked - { -- |The number of readers that are currently active. + { -- | The number of readers that are currently active. readers :: !Word64, - -- |The number of pending writers. + -- | The number of pending writers. waitingWriters :: !Word64 } - | -- |The lock is acquired by a single writer. + | -- | The lock is acquired by a single writer. WriteLocked - { -- |The number of writers that are pending (that is, currently blocked on this lock). + { -- | The number of writers that are pending (that is, currently blocked on this lock). waitingWriters :: !Word64 } deriving (Show) --- |Initialize a lock in the unlocked state. +-- | Initialize a lock in the unlocked state. initializeLock :: IO RWLock initializeLock = do rwlState <- newMVar (Free 0) @@ -95,8 +95,8 @@ initializeLock = do rwlWriteLock <- newMVar () return RWLock{..} --- |Acquire a read lock. This will block until there are no pending writers --- waiting to acquire the lock. +-- | Acquire a read lock. This will block until there are no pending writers +-- waiting to acquire the lock. acquireRead :: RWLock -> IO () acquireRead RWLock{..} = mask_ go where @@ -137,9 +137,9 @@ acquireRead RWLock{..} = mask_ go readMVar rwlWriteLock go --- |Acquire a write lock. This will block when there are active readers or --- writers. When this operation is blocked it also blocks new readers from --- acquiring the lock. +-- | Acquire a write lock. This will block when there are active readers or +-- writers. When this operation is blocked it also blocks new readers from +-- acquiring the lock. acquireWrite :: RWLock -> IO () acquireWrite RWLock{..} = mask_ $ go False where @@ -163,8 +163,8 @@ acquireWrite RWLock{..} = mask_ $ go False readMVar rwlWriteLock go True --- |Release the write lock. The lock is assumed to be in write state, otherwise --- this function will raise an exception. +-- | Release the write lock. The lock is assumed to be in write state, otherwise +-- this function will raise an exception. releaseWrite :: RWLock -> IO () releaseWrite RWLock{..} = mask_ $ @@ -176,11 +176,11 @@ releaseWrite RWLock{..} = putMVar rwlState lockState error $ "releaseWrite: attempting to release while in state: " ++ show lockState --- |Release the read lock. The lock is assumed to be in read state, otherwise --- this function will raise an exception. Note that since multiple readers may --- acquire the read lock at the same time this either decrements the read count --- and leaves the lock in read state, or unlocks it if called when there is only --- a single active reader. +-- | Release the read lock. The lock is assumed to be in read state, otherwise +-- this function will raise an exception. Note that since multiple readers may +-- acquire the read lock at the same time this either decrements the read count +-- and leaves the lock in read state, or unlocks it if called when there is only +-- a single active reader. releaseRead :: RWLock -> IO () releaseRead RWLock{..} = mask_ $ @@ -193,12 +193,12 @@ releaseRead RWLock{..} = putMVar rwlState lockState error $ "releaseRead: attempting to release read when in state: " ++ show lockState --- |Acquire the write lock and execute the action. The lock will be released --- even if the action raises an exception. See 'acquireWrite' for more details. +-- | Acquire the write lock and execute the action. The lock will be released +-- even if the action raises an exception. See 'acquireWrite' for more details. withWriteLock :: RWLock -> IO a -> IO a withWriteLock ls = bracket_ (acquireWrite ls) (releaseWrite ls) --- |Acquire the read lock and execute the action. The lock will be released even --- if the action raises an exception. See 'acquireRead' for more details. +-- | Acquire the read lock and execute the action. The lock will be released even +-- if the action raises an exception. See 'acquireRead' for more details. withReadLock :: RWLock -> IO a -> IO a withReadLock ls = bracket_ (acquireRead ls) (releaseRead ls) diff --git a/src/Concordium/Client/Runner.hs b/src/Concordium/Client/Runner.hs index 8ff75e38..e293584e 100644 --- a/src/Concordium/Client/Runner.hs +++ b/src/Concordium/Client/Runner.hs @@ -121,10 +121,10 @@ import Text.Printf import Text.Read (readEither, readMaybe) import Prelude hiding (fail, log, unlines) --- |Establish a new connection to the backend and run the provided computation. --- Close a connection after completion of the computation. Establishing a --- connection is expensive, and thus if multiple RPC calls are going to be made --- they should be made in the context of the same 'withClient' so they reuse it. +-- | Establish a new connection to the backend and run the provided computation. +-- Close a connection after completion of the computation. Establishing a +-- connection is expensive, and thus if multiple RPC calls are going to be made +-- they should be made in the context of the same 'withClient' so they reuse it. withClient :: Backend -> ClientMonad IO a -> IO a withClient bkend comp = do let config = GrpcConfig (COM.grpcHost bkend) (COM.grpcPort bkend) (COM.grpcTarget bkend) (COM.grpcRetryNum bkend) Nothing (COM.grpcUseTls bkend) @@ -146,16 +146,16 @@ withClient bkend comp = do withClientJson :: (FromJSON a) => Backend -> ClientMonad IO (Either String Value) -> IO a withClientJson b c = withClient b c >>= getFromJson --- |Helper function for parsing JSON Value or fail if the value is missing or cannot be converted correctly. --- The parameter has the same type as the one returned by e.g. eitherDecode or processJSON, --- which many of the GRPC commands use. +-- | Helper function for parsing JSON Value or fail if the value is missing or cannot be converted correctly. +-- The parameter has the same type as the one returned by e.g. eitherDecode or processJSON, +-- which many of the GRPC commands use. getFromJson :: (MonadIO m, FromJSON a) => Either String Value -> m a getFromJson = getFromJsonAndHandleError onError where onError val err = logFatal ["cannot convert '" ++ show val ++ "': " ++ err] --- |Helper function for parsing JSON Value, logFatal if the Either is Left, --- and use the provided function to handle Error in fromJSON. +-- | Helper function for parsing JSON Value, logFatal if the Either is Left, +-- and use the provided function to handle Error in fromJSON. getFromJsonAndHandleError :: (MonadIO m, FromJSON a) => -- | Takes the JSON being converted and the err string from (Error err) if fromJSON fails. @@ -170,15 +170,15 @@ getFromJsonAndHandleError handleError r = do Error err -> handleError s err Success v -> return v --- |Look up account from the provided name or address. --- Fail if the address cannot be found. +-- | Look up account from the provided name or address. +-- Fail if the address cannot be found. getAccountAddressArg :: AccountNameMap -> Text -> IO NamedAddress getAccountAddressArg m account = do case getAccountAddress m account of Left err -> logFatal [err] Right v -> return v --- |Process CLI command. +-- | Process CLI command. process :: COM.Options -> IO () process Options{optsCmd = command, optsBackend = backend, optsConfigDir = cfgDir, optsVerbose = verbose} = do -- Disable output buffering. @@ -197,7 +197,7 @@ process Options{optsCmd = command, optsBackend = backend, optsConfigDir = cfgDir DelegatorCmd c -> processDelegatorCmd c cfgDir verbose backend IdentityCmd c -> processIdentityCmd c backend --- |Process a 'config ...' command. +-- | Process a 'config ...' command. processConfigCmd :: ConfigCmd -> Maybe FilePath -> Verbose -> IO () processConfigCmd action baseCfgDir verbose = case action of @@ -512,13 +512,13 @@ processConfigCmd action baseCfgDir verbose = getAccountConfigFromAddr :: Text -> BaseConfig -> IO (BaseConfig, AccountConfig) getAccountConfigFromAddr addr baseCfg = getAccountConfig (Just addr) baseCfg Nothing Nothing Nothing AutoInit --- |Read and parse a file exported from either genesis data or mobile wallet. --- The format specifier tells which format to expect. --- If the format is "mobile", the user is prompted for a password which is used to decrypt --- the exported data. This may result in multiple named accounts. If a name is provided, --- only the account with that name is being selected for import. --- The "genesis" format is not encrypted and only contains a single account which is not named. --- If a name is provided in this case, this will become the account name. +-- | Read and parse a file exported from either genesis data or mobile wallet. +-- The format specifier tells which format to expect. +-- If the format is "mobile", the user is prompted for a password which is used to decrypt +-- the exported data. This may result in multiple named accounts. If a name is provided, +-- only the account with that name is being selected for import. +-- The "genesis" format is not encrypted and only contains a single account which is not named. +-- If a name is provided in this case, this will become the account name. loadAccountImportFile :: AccountExportFormat -> FilePath -> Maybe Text -> IO [AccountConfig] loadAccountImportFile format file name = do contents <- handleReadFile BS.readFile file @@ -606,14 +606,14 @@ getContractInfoWithSchemas schemaFile blockHash ev = do Just schema -> CI.addSchemaData contrInfo schema _ -> return Nothing --- |Get @ContractInfo@ for all events in all blocks in which a transaction is present. --- Returns a map from blockhashes of blocks in which the transaction is present to the --- events of the transaction in that block. Each event appears in a pair with an optional --- @ContractInfo@ value containing contract schema info associated with the event of the --- transaction in that block, if present. --- Optionally takes a path to a schema file to be parsed. If a schema is contained in the --- file, it will take precedence over any schemas that may be embedded in the module and --- will therefore be present in the @ContractInfo@ for all events. +-- | Get @ContractInfo@ for all events in all blocks in which a transaction is present. +-- Returns a map from blockhashes of blocks in which the transaction is present to the +-- events of the transaction in that block. Each event appears in a pair with an optional +-- @ContractInfo@ value containing contract schema info associated with the event of the +-- transaction in that block, if present. +-- Optionally takes a path to a schema file to be parsed. If a schema is contained in the +-- file, it will take precedence over any schemas that may be embedded in the module and +-- will therefore be present in the @ContractInfo@ for all events. getTxContractInfoWithSchemas :: (MonadIO m) => -- | Path pointing to a schema file. @@ -647,7 +647,7 @@ getTxContractInfoWithSchemas schemaFile status = do MultipleBlocksUnambiguous bhs ts -> map (,f ts) bhs MultipleBlocksAmbiguous bhts -> map (second f) bhts --- |Process a 'transaction ...' command. +-- | Process a 'transaction ...' command. processTransactionCmd :: TransactionCmd -> Maybe FilePath -> Verbose -> Backend -> IO () processTransactionCmd action baseCfgDir verbose backend = case action of @@ -844,9 +844,9 @@ processTransactionCmd action baseCfgDir verbose backend = Just (Left err) -> logFatal ["Registering data failed:", err] Just (Right _) -> logSuccess ["Data succesfully registered."] --- |Construct a transaction config for registering data. --- The data is read from the 'FilePath' provided. --- Fails if the data can't be read or it violates the size limit checked by 'Types.registeredDataFromBSS'. +-- | Construct a transaction config for registering data. +-- The data is read from the 'FilePath' provided. +-- Fails if the data can't be read or it violates the size limit checked by 'Types.registeredDataFromBSS'. getRegisterDataTransactionCfg :: BaseConfig -> TransactionOpts (Maybe Types.Energy) -> RegisterDataInput -> IO RegisterDataTransactionCfg getRegisterDataTransactionCfg baseCfg txOpts dataInput = do bss <- @@ -883,17 +883,17 @@ getRegisterDataTransactionCfg baseCfg txOpts dataInput = do registerDataTransactionPayload :: RegisterDataTransactionCfg -> Types.Payload registerDataTransactionPayload RegisterDataTransactionCfg{..} = Types.RegisterData rdtcData --- |Transaction config for registering data. +-- | Transaction config for registering data. data RegisterDataTransactionCfg = RegisterDataTransactionCfg - { -- |Configuration for the transaction. + { -- | Configuration for the transaction. rdtcTransactionCfg :: !TransactionConfig, - -- |The data to register. + -- | The data to register. rdtcData :: !Types.RegisteredData } --- |Poll the transaction state continuously until it is "at least" the provided one. --- Note that the "absent" state is considered the "highest" state, --- so the loop will break if, for instance, the transaction state goes from "committed" to "absent". +-- | Poll the transaction state continuously until it is "at least" the provided one. +-- Note that the "absent" state is considered the "highest" state, +-- so the loop will break if, for instance, the transaction state goes from "committed" to "absent". awaitState :: (TransactionStatusQuery m) => Int -> TransactionState -> Types.TransactionHash -> m TransactionStatusResult awaitState t s hash = do status <- queryTransactionStatus hash @@ -903,14 +903,14 @@ awaitState t s hash = do wait t awaitState t s hash --- |Function type for computing the transaction energy cost for a given number of keys. --- Returns Nothing if the cost cannot be computed. +-- | Function type for computing the transaction energy cost for a given number of keys. +-- Returns Nothing if the cost cannot be computed. type ComputeEnergyCost = Int -> Types.Energy --- |Function for computing a cost function based on the resolved account config. +-- | Function for computing a cost function based on the resolved account config. type GetComputeEnergyCost = EncryptedSigningData -> IO (Maybe ComputeEnergyCost) --- |Resolved configuration common to all transaction types. +-- | Resolved configuration common to all transaction types. data TransactionConfig = TransactionConfig { tcEncryptedSigningData :: EncryptedSigningData, tcNonce :: Maybe Types.Nonce, @@ -919,10 +919,10 @@ data TransactionConfig = TransactionConfig tcAlias :: Maybe Word } --- |Resolve transaction config based on persisted config and CLI flags. --- If an energy cost function is provided and it returns a value which --- is different from the specified energy allocation, a warning is logged. --- If the energy allocation is too low, the user is prompted to increase it. +-- | Resolve transaction config based on persisted config and CLI flags. +-- If an energy cost function is provided and it returns a value which +-- is different from the specified energy allocation, a warning is logged. +-- If the energy allocation is too low, the user is prompted to increase it. getTransactionCfg :: BaseConfig -> TransactionOpts (Maybe Types.Energy) -> GetComputeEnergyCost -> IO TransactionConfig getTransactionCfg baseCfg txOpts getEnergyCostFunc = do encSignData <- getAccountCfgFromTxOpts baseCfg txOpts @@ -964,8 +964,8 @@ getTransactionCfg baseCfg txOpts getEnergyCostFunc = do return energy | otherwise = return energy --- |Resolve transaction config based on persisted config and CLI flags. --- Used for transactions where a specification of maxEnergy is required. +-- | Resolve transaction config based on persisted config and CLI flags. +-- Used for transactions where a specification of maxEnergy is required. getRequiredEnergyTransactionCfg :: BaseConfig -> TransactionOpts Types.Energy -> IO TransactionConfig getRequiredEnergyTransactionCfg baseCfg txOpts = do encSignData <- getAccountCfgFromTxOpts baseCfg txOpts @@ -983,8 +983,8 @@ getRequiredEnergyTransactionCfg baseCfg txOpts = do tcAlias = toAlias txOpts } --- |Warn if expiry is in the past or very near or distant future. --- As the timestamps are unsigned, taking the simple difference might cause underflow. +-- | Warn if expiry is in the past or very near or distant future. +-- As the timestamps are unsigned, taking the simple difference might cause underflow. warnSuspiciousExpiry :: Types.TransactionExpiryTime -> Types.TransactionExpiryTime -> IO () warnSuspiciousExpiry expiryArg now | expiryArg < now = @@ -1001,7 +1001,7 @@ warnSuspiciousExpiry expiryArg now logWarn ["expiration time is in more than one hour"] | otherwise = return () --- |Get accountCfg from the config folder and return EncryptedSigningData or logFatal if the keys are not provided in txOpts. +-- | Get accountCfg from the config folder and return EncryptedSigningData or logFatal if the keys are not provided in txOpts. getAccountCfgFromTxOpts :: BaseConfig -> TransactionOpts energyOrMaybe -> IO EncryptedSigningData getAccountCfgFromTxOpts baseCfg txOpts = do keysArg <- case toKeys txOpts of @@ -1047,14 +1047,14 @@ getAccountCfgFromTxOpts baseCfg txOpts = do chosenKeys return EncryptedSigningData{esdKeys = filteredKeys, esdAddress = acAddr accCfg, esdEncryptionKey = acEncryptionKey accCfg} --- |Resolved configuration for a transfer transaction. +-- | Resolved configuration for a transfer transaction. data TransferTransactionConfig = TransferTransactionConfig { ttcTransactionCfg :: TransactionConfig, ttcReceiver :: NamedAddress, ttcAmount :: Types.Amount } --- |Resolved configuration for a transfer transaction. +-- | Resolved configuration for a transfer transaction. data TransferWithScheduleTransactionConfig = TransferWithScheduleTransactionConfig { twstcTransactionCfg :: TransactionConfig, twstcReceiver :: NamedAddress, @@ -1107,7 +1107,7 @@ getEncryptedAmountTransferData senderAddr ettReceiver ettAmount idx secretKey = Nothing -> logFatal ["Could not create transfer. Likely the provided secret key is incorrect."] Just ettTransferData -> return ettTransferData --- |Returns the UTCTime date when the baker cooldown on reducing stake/removing a baker will end, using on chain parameters +-- | Returns the UTCTime date when the baker cooldown on reducing stake/removing a baker will end, using on chain parameters getBakerCooldown :: Queries.EChainParametersAndKeys -> ClientMonad IO UTCTime getBakerCooldown (Queries.EChainParametersAndKeys (ecpParams :: ChainParameters' cpv) _) = do cooldownTime <- case Types.chainParametersVersion @cpv of @@ -1128,7 +1128,7 @@ getBakerCooldown (Queries.EChainParametersAndKeys (ecpParams :: ChainParameters' cooldownEpochsV0 ups = toInteger $ ups ^. cpCooldownParameters . cpBakerExtraCooldownEpochs --- |Returns the UTCTime date when the delegator cooldown on reducing stake/removing delegation will end, using on chain parameters +-- | Returns the UTCTime date when the delegator cooldown on reducing stake/removing delegation will end, using on chain parameters getDelegatorCooldown :: Queries.EChainParametersAndKeys -> IO (Maybe UTCTime) getDelegatorCooldown (Queries.EChainParametersAndKeys (ecpParams :: ChainParameters' cpv) _) = do case Types.chainParametersVersion @cpv of @@ -1143,8 +1143,8 @@ getDelegatorCooldown (Queries.EChainParametersAndKeys (ecpParams :: ChainParamet let cooldownTime = fromIntegral . Types.durationSeconds $ ecpParams ^. cpCooldownParameters . cpDelegatorCooldown return $ Just $ addUTCTime cooldownTime currTime --- |Query the chain for the given account. --- Die printing an error message containing the nature of the error if such occured. +-- | Query the chain for the given account. +-- Die printing an error message containing the nature of the error if such occured. getAccountInfoOrDie :: (MonadIO m) => Types.AccountIdentifier -> BlockHashInput -> ClientMonad m Types.AccountInfo getAccountInfoOrDie sender bhInput = do res <- getAccountInfo sender bhInput @@ -1157,8 +1157,8 @@ getAccountInfoOrDie sender bhInput = do StatusInvalid -> logFatal ["GRPC response contained an invalid status code."] RequestFailed err -> logFatal ["I/O error: " <> err] --- |Query the chain for the given pool. --- Die printing an error message containing the nature of the error if such occured. +-- | Query the chain for the given pool. +-- Die printing an error message containing the nature of the error if such occured. getPoolStatusOrDie :: Maybe Types.BakerId -> ClientMonad IO Queries.PoolStatus getPoolStatusOrDie mbid = do psRes <- case mbid of @@ -1188,20 +1188,20 @@ data AccountUpdateCredentialsTransactionCfg = AccountUpdateCredentialsTransactio auctcNewThreshold :: ID.AccountThreshold } --- |Resolved configuration for transferring from public to encrypted balance. +-- | Resolved configuration for transferring from public to encrypted balance. data AccountEncryptTransactionConfig = AccountEncryptTransactionConfig { aeTransactionCfg :: TransactionConfig, aeAmount :: Types.Amount } --- |Resolved configuration for transferring from encrypted to public balance. +-- | Resolved configuration for transferring from encrypted to public balance. data AccountDecryptTransactionConfig = AccountDecryptTransactionConfig { adTransactionCfg :: TransactionConfig, adTransferData :: Enc.SecToPubAmountTransferData } --- |Resolve configuration for transferring an amount from public to encrypted --- balance of an account. +-- | Resolve configuration for transferring an amount from public to encrypted +-- balance of an account. getAccountEncryptTransactionCfg :: BaseConfig -> TransactionOpts (Maybe Types.Energy) -> Types.Amount -> Types.PayloadSize -> IO AccountEncryptTransactionConfig getAccountEncryptTransactionCfg baseCfg txOpts aeAmount payloadSize = do aeTransactionCfg <- getTransactionCfg baseCfg txOpts nrgCost @@ -1209,8 +1209,8 @@ getAccountEncryptTransactionCfg baseCfg txOpts aeAmount payloadSize = do where nrgCost _ = return $ Just $ accountEncryptEnergyCost payloadSize --- |Resolve configuration for transferring an amount from encrypted to public --- balance of an account. +-- | Resolve configuration for transferring an amount from encrypted to public +-- balance of an account. getAccountDecryptTransferData :: ID.AccountAddress -> Types.Amount -> ElgamalSecretKey -> Maybe Int -> ClientMonad IO Enc.SecToPubAmountTransferData getAccountDecryptTransferData senderAddr adAmount secretKey idx = do bbHash <- extractResponseValueOrDie Queries.biBlockHash =<< getBlockInfo Best @@ -1245,8 +1245,8 @@ getAccountDecryptTransferData senderAddr adAmount secretKey idx = do Nothing -> logFatal ["Could not create transfer. Likely the provided secret key is incorrect."] Just adTransferData -> return adTransferData --- |Query the chain for cryptographic parameters in a given block. --- Die printing an error message containing the nature of the error if such occured. +-- | Query the chain for cryptographic parameters in a given block. +-- Die printing an error message containing the nature of the error if such occured. getCryptographicParametersOrDie :: BlockHashInput -> ClientMonad IO GlobalContext getCryptographicParametersOrDie bhInput = do blockRes <- getBlockInfo bhInput @@ -1265,8 +1265,8 @@ getCryptographicParametersOrDie bhInput = do StatusInvalid -> logFatal ["GRPC response contained an invalid status code."] RequestFailed err -> logFatal ["I/O error: " <> err] --- |Convert transfer transaction config into a valid payload, --- optionally asking the user for confirmation. +-- | Convert transfer transaction config into a valid payload, +-- optionally asking the user for confirmation. transferTransactionConfirm :: TransferTransactionConfig -> Bool -> IO () transferTransactionConfirm ttxCfg confirm = do let TransferTransactionConfig @@ -1290,8 +1290,8 @@ transferTransactionConfirm ttxCfg confirm = do confirmed <- askConfirmation Nothing unless confirmed exitTransactionCancelled --- |Convert transfer transaction config into a valid payload, --- optionally asking the user for confirmation. +-- | Convert transfer transaction config into a valid payload, +-- optionally asking the user for confirmation. transferWithScheduleTransactionConfirm :: TransferWithScheduleTransactionConfig -> Bool -> IO () transferWithScheduleTransactionConfirm ttxCfg confirm = do let TransferWithScheduleTransactionConfig @@ -1316,7 +1316,7 @@ transferWithScheduleTransactionConfirm ttxCfg confirm = do confirmed <- askConfirmation Nothing unless confirmed exitTransactionCancelled -encryptedTransferTransactionConfirm :: MonadIO m => EncryptedTransferTransactionConfig -> Bool -> m () +encryptedTransferTransactionConfirm :: (MonadIO m) => EncryptedTransferTransactionConfig -> Bool -> m () encryptedTransferTransactionConfirm EncryptedTransferTransactionConfig{..} confirm = do let TransactionConfig { tcEnergy = energy, @@ -1335,8 +1335,8 @@ encryptedTransferTransactionConfirm EncryptedTransferTransactionConfig{..} confi confirmed <- askConfirmation Nothing unless confirmed exitTransactionCancelled --- |Query the chain for the minimum baker stake threshold. --- Die printing an error message containing the nature of the error if such occured. +-- | Query the chain for the minimum baker stake threshold. +-- Die printing an error message containing the nature of the error if such occured. getBakerStakeThresholdOrDie :: ClientMonad IO Types.Amount getBakerStakeThresholdOrDie = do bcpRes <- getBlockChainParameters Best @@ -1441,7 +1441,7 @@ accountEncryptTransactionConfirm AccountEncryptTransactionConfig{..} confirm = d confirmed <- askConfirmation Nothing unless confirmed exitTransactionCancelled -accountDecryptTransactionConfirm :: MonadIO m => AccountDecryptTransactionConfig -> Bool -> m () +accountDecryptTransactionConfirm :: (MonadIO m) => AccountDecryptTransactionConfig -> Bool -> m () accountDecryptTransactionConfirm AccountDecryptTransactionConfig{..} confirm = do let TransactionConfig { tcEnergy = energy, @@ -1460,9 +1460,9 @@ accountDecryptTransactionConfirm AccountDecryptTransactionConfig{..} confirm = d confirmed <- askConfirmation Nothing unless confirmed exitTransactionCancelled --- |Encode, sign, and send transaction off to the baker. --- If confirmNonce is set, the user is asked to confirm using the next nonce --- if there are pending transactions. +-- | Encode, sign, and send transaction off to the baker. +-- If confirmNonce is set, the user is asked to confirm using the next nonce +-- if there are pending transactions. startTransaction :: (MonadFail m, MonadIO m) => TransactionConfig -> @@ -1498,11 +1498,11 @@ startTransaction txCfg pl confirmNonce maybeAccKeys = do Left err -> logFatal ["Transaction not accepted by the baker: " <> err] Right _ -> return tx --- |Fetch next nonces relative to the account's most recently committed and --- pending transactions, respectively. --- If they match, the nonce is returned. --- If they don't match, optionally ask the user to confirm proceeding with the latter nonce. --- If rejected, the process is cancelled (exit with code 0). +-- | Fetch next nonces relative to the account's most recently committed and +-- pending transactions, respectively. +-- If they match, the nonce is returned. +-- If they don't match, optionally ask the user to confirm proceeding with the latter nonce. +-- If rejected, the process is cancelled (exit with code 0). getNonce :: (MonadFail m, MonadIO m) => Types.AccountAddress -> Maybe Types.Nonce -> Bool -> ClientMonad m Types.Nonce getNonce sender nonce confirm = case nonce of @@ -1521,7 +1521,7 @@ getNonce sender nonce confirm = return nextNonce Just v -> return v --- |Send a transaction and optionally tail it (see 'tailTransaction' below). +-- | Send a transaction and optionally tail it (see 'tailTransaction' below). sendAndTailTransaction_ :: (MonadIO m, MonadFail m) => -- | Whether the output should be verbose @@ -1535,9 +1535,9 @@ sendAndTailTransaction_ :: ClientMonad m () sendAndTailTransaction_ verbose txCfg pl intOpts = void $ sendAndTailTransaction verbose txCfg pl intOpts --- |Send a transaction and optionally tail it (see 'tailTransaction' below). --- If tailed, it returns the TransactionStatusResult of the finalized status, --- otherwise the return value is @Nothing@. +-- | Send a transaction and optionally tail it (see 'tailTransaction' below). +-- If tailed, it returns the TransactionStatusResult of the finalized status, +-- otherwise the return value is @Nothing@. sendAndTailTransaction :: (MonadIO m, MonadFail m) => -- | Whether the output should be verbose @@ -1557,12 +1557,12 @@ sendAndTailTransaction verbose txCfg pl intOpts = do then Just <$> tailTransaction verbose hash else return Nothing --- |Continuously query and display transaction status until the transaction is finalized. +-- | Continuously query and display transaction status until the transaction is finalized. tailTransaction_ :: (MonadIO m) => Bool -> Types.TransactionHash -> ClientMonad m () tailTransaction_ verbose hash = void $ tailTransaction verbose hash --- |Continuously query and display transaction status until the transaction is finalized. --- Returns the TransactionStatusResult of the finalized status. +-- | Continuously query and display transaction status until the transaction is finalized. +-- Returns the TransactionStatusResult of the finalized status. tailTransaction :: (MonadIO m) => Bool -> Types.TransactionHash -> ClientMonad m TransactionStatusResult tailTransaction verbose hash = do logInfo @@ -1615,7 +1615,7 @@ tailTransaction verbose hash = do where getLocalTimeOfDayFormatted = showTimeOfDay <$> getLocalTimeOfDay --- |@read@ input or fail if the input could not be @read@. +-- | @read@ input or fail if the input could not be @read@. readOrFail :: (MonadIO m, Read a) => Text -> m a readOrFail t = case readEither s of @@ -1624,20 +1624,20 @@ readOrFail t = where s = Text.unpack t --- |Reads a blockhash wrapped in a @Maybe@. --- If the provided value is @Nothing@, a default value provided in the first parameter --- is returned. If the provided value is @Just s@, @readOrFail s@ is returned. Fails if --- @s@ is not a valid blockhash. +-- | Reads a blockhash wrapped in a @Maybe@. +-- If the provided value is @Nothing@, a default value provided in the first parameter +-- is returned. If the provided value is @Just s@, @readOrFail s@ is returned. Fails if +-- @s@ is not a valid blockhash. readBlockHashOrDefault :: (MonadIO m) => BlockHashInput -> Maybe Text -> m BlockHashInput readBlockHashOrDefault d Nothing = return d readBlockHashOrDefault _ (Just s) = readOrFail s >>= return . Given --- |Parse an 'Queries.EpochRequest' from an 'EpochSpecifier'. +-- | Parse an 'Queries.EpochRequest' from an 'EpochSpecifier'. parseEpochRequest :: (MonadIO m) => - -- |Optional value to use if no arguments are specified. + -- | Optional value to use if no arguments are specified. Maybe Queries.EpochRequest -> - -- |Input specifying the epoch + -- | Input specifying the epoch EpochSpecifier -> m Queries.EpochRequest parseEpochRequest @@ -1659,7 +1659,7 @@ parseEpochRequest parseEpochRequest _ _ = logFatal [[i|Invalid arguments: either a genesis index and an epoch number should be supplied, or a block hash.|]] --- |Process an 'account ...' command. +-- | Process an 'account ...' command. processAccountCmd :: AccountCmd -> Maybe FilePath -> Verbose -> Backend -> IO () processAccountCmd action baseCfgDir verbose backend = case action of @@ -1846,7 +1846,7 @@ processAccountCmd action baseCfgDir verbose backend = Right namedAddr -> putStrLn [i|The requested alias for address #{naAddr namedAddr} is #{Types.createAlias (naAddr namedAddr) alias}|] --- |Process a 'module ...' command. +-- | Process a 'module ...' command. processModuleCmd :: ModuleCmd -> Maybe FilePath -> Verbose -> Backend -> IO () processModuleCmd action baseCfgDir verbose backend = case action of @@ -1967,7 +1967,7 @@ getModuleDeployTransactionCfg baseCfg txOpts moduleFile mWasmVersion = do txCfg <- getTransactionCfg baseCfg txOpts $ moduleDeployEnergyCost wasmModule return $ ModuleDeployTransactionCfg txCfg wasmModule --- |Calculate the energy cost of deploying a module. +-- | Calculate the energy cost of deploying a module. moduleDeployEnergyCost :: Wasm.WasmModule -> EncryptedSigningData -> IO (Maybe (Int -> Types.Energy)) moduleDeployEnergyCost wasmMod encSignData = pure . Just . const $ @@ -1977,17 +1977,17 @@ moduleDeployEnergyCost wasmMod encSignData = payloadSize = Types.payloadSize . Types.encodePayload . Types.DeployModule $ wasmMod data ModuleDeployTransactionCfg = ModuleDeployTransactionCfg - { -- |Configuration for the transaction. + { -- | Configuration for the transaction. mdtcTransactionCfg :: !TransactionConfig, - -- |The WASM module to deploy. + -- | The WASM module to deploy. mdtcModule :: !Wasm.WasmModule } moduleDeployTransactionPayload :: ModuleDeployTransactionCfg -> Types.Payload moduleDeployTransactionPayload ModuleDeployTransactionCfg{..} = Types.DeployModule mdtcModule --- |Checks if the given receive name is valid and if so, returns it back --- or otherwise a fallback receive name for v1 contracts. +-- | Checks if the given receive name is valid and if so, returns it back +-- or otherwise a fallback receive name for v1 contracts. checkAndGetContractReceiveName :: CI.ContractInfo -> Text -> IO Text checkAndGetContractReceiveName contrInfo receiveName = do if CI.hasReceiveMethod receiveName contrInfo @@ -2013,7 +2013,7 @@ checkAndGetContractReceiveName contrInfo receiveName = do unless confirmed $ logFatal ["aborting..."] return receiveName --- |Process a 'contract ...' command. +-- | Process a 'contract ...' command. processContractCmd :: ContractCmd -> Maybe FilePath -> Verbose -> Backend -> IO () processContractCmd action baseCfgDir verbose backend = case action of @@ -2317,7 +2317,9 @@ processContractCmd action baseCfgDir verbose backend = mkReturnValueMsg rvBytes schemaFile modSchema contractName receiveName isError = case rvBytes of Nothing -> return Text.empty Just rv -> case modSchema >>= \modSchema' -> lookupSchema modSchema' (CS.ReceiveFuncName contractName receiveName) of - Nothing -> return [i|\n - #{valueType} value (raw):\n #{BS.unpack rv}\n|] -- Schema not provided or it doesn't contain the return value for this func. + Nothing -> do + -- Schema not provided or it doesn't contain the return value for this func. + return [i|\n - #{valueType} value (raw):\n #{BS.unpack rv}\n|] Just schemaForFunc -> case S.runGet (CP.getJSONUsingSchema schemaForFunc) rv of Left err -> do logWarn [[i|Could not parse the returned bytes using the schema:\n#{err}|]] @@ -2329,8 +2331,8 @@ processContractCmd action baseCfgDir verbose backend = where (lookupSchema, valueType) = if isError then (CS.lookupErrorSchema, "Error" :: Text) else (CS.lookupReturnValueSchema, "Return" :: Text) --- |Try to fetch info about the contract. --- Or, log fatally with appropriate error messages if anything goes wrong. +-- | Try to fetch info about the contract. +-- Or, log fatally with appropriate error messages if anything goes wrong. getContractInfo :: (MonadIO m) => NamedContractAddress -> BlockHashInput -> ClientMonad m CI.ContractInfo getContractInfo namedContrAddr bhInput = do blockRes <- getBlockInfo bhInput @@ -2351,7 +2353,7 @@ getContractInfo namedContrAddr bhInput = do StatusInvalid -> logFatal ["GRPC response contained an invalid status code."] RequestFailed err -> logFatal ["I/O error: " <> err] --- |Display contract info, optionally using a schema to decode the contract state. +-- | Display contract info, optionally using a schema to decode the contract state. displayContractInfo :: Maybe CS.ModuleSchema -> CI.ContractInfo -> NamedAddress -> NamedModuleRef -> ClientMonad IO () displayContractInfo schema contrInfo namedOwner namedModRef = do cInfo <- case schema of @@ -2363,10 +2365,10 @@ displayContractInfo schema contrInfo namedOwner namedModRef = do Nothing -> return contrInfo runPrinter $ printContractInfo cInfo namedOwner namedModRef --- |Attempts to acquire the needed parts for updating a contract. --- The two primary parts are a contract address, which is acquired using @getNamedContractAddress@, --- and a @Wasm.Parameter@ which is acquired using @getWasmParameter@. --- It will log fatally if one of the two cannot be acquired. +-- | Attempts to acquire the needed parts for updating a contract. +-- The two primary parts are a contract address, which is acquired using @getNamedContractAddress@, +-- and a @Wasm.Parameter@ which is acquired using @getWasmParameter@. +-- It will log fatally if one of the two cannot be acquired. getContractUpdateTransactionCfg :: Backend -> BaseConfig -> @@ -2419,25 +2421,25 @@ contractUpdateTransactionPayload ContractUpdateTransactionCfg{..} = Types.Update cutcAmount cutcAddress cutcReceiveName cutcParams data ContractUpdateTransactionCfg = ContractUpdateTransactionCfg - { -- |Configuration for the transaction. + { -- | Configuration for the transaction. cutcTransactionCfg :: !TransactionConfig, - -- |The address of the contract to invoke. + -- | The address of the contract to invoke. cutcAddress :: !Types.ContractAddress, - -- |Name of the contract that is being updated. - -- This is resolved from the chain. + -- | Name of the contract that is being updated. + -- This is resolved from the chain. cutcContrName :: !Text, - -- |Name of the receive method to invoke. + -- | Name of the receive method to invoke. cutcReceiveName :: !Wasm.ReceiveName, - -- |Parameters to the receive method. + -- | Parameters to the receive method. cutcParams :: !Wasm.Parameter, - -- |Amount to transfer to the contract. + -- | Amount to transfer to the contract. cutcAmount :: !Types.Amount } --- |Attempts to acquire the needed parts for initializing a contract. --- The two primary parts are a module reference, which can be acquired in one of three ways --- (see the arguments for details), and a @Wasm.Parameter@, which is acquired using @getWasmParameter@. --- It will log fatally if one of the two cannot be acquired. +-- | Attempts to acquire the needed parts for initializing a contract. +-- The two primary parts are a module reference, which can be acquired in one of three ways +-- (see the arguments for details), and a @Wasm.Parameter@, which is acquired using @getWasmParameter@. +-- It will log fatally if one of the two cannot be acquired. getContractInitTransactionCfg :: Backend -> BaseConfig -> @@ -2467,14 +2469,14 @@ getContractInitTransactionCfg backend baseCfg txOpts modTBD isPath mWasmVersion params <- getWasmParameter paramsFile schema (CS.InitFuncName contrName) return $ ContractInitTransactionCfg txCfg amount (nmrRef namedModRef) (Wasm.InitName [i|init_#{contrName}|]) params --- |Query the node for a module reference, and parse the result. --- Terminate program execution if either the module cannot be obtained, --- or the result cannot be parsed. +-- | Query the node for a module reference, and parse the result. +-- Terminate program execution if either the module cannot be obtained, +-- or the result cannot be parsed. getWasmModule :: (MonadIO m) => - -- |On-chain reference of the module. + -- | On-chain reference of the module. NamedModuleRef -> - -- |The block to query in. + -- | The block to query in. BlockHashInput -> ClientMonad m Wasm.WasmModule getWasmModule namedModRef bhInput = do @@ -2497,15 +2499,15 @@ getWasmModule namedModRef bhInput = do RequestFailed err -> logFatal ["I/O error: " <> err] data ContractInitTransactionCfg = ContractInitTransactionCfg - { -- |Configuration for the transaction. + { -- | Configuration for the transaction. citcTransactionCfg :: !TransactionConfig, - -- |Initial amount on the contract's account. + -- | Initial amount on the contract's account. citcAmount :: !Types.Amount, - -- |Reference of the module (on-chain) in which the contract exist. + -- | Reference of the module (on-chain) in which the contract exist. citcModuleRef :: !Types.ModuleRef, - -- |Name of the init method to invoke in that module. + -- | Name of the init method to invoke in that module. citcInitName :: !Wasm.InitName, - -- |Parameters to the init method. + -- | Parameters to the init method. citcParams :: !Wasm.Parameter } @@ -2513,10 +2515,10 @@ contractInitTransactionPayload :: ContractInitTransactionCfg -> Types.Payload contractInitTransactionPayload ContractInitTransactionCfg{..} = Types.InitContract citcAmount citcModuleRef citcInitName citcParams --- |Load a WasmModule from the specified file path. --- The module will be prefixed with the wasmVersion and moduleSize if wasmVersion is provided. --- This enables the use of wasm modules compiled with cargo-concordium version < 2, and modules compiled --- without cargo-concordium version >= 2. +-- | Load a WasmModule from the specified file path. +-- The module will be prefixed with the wasmVersion and moduleSize if wasmVersion is provided. +-- This enables the use of wasm modules compiled with cargo-concordium version < 2, and modules compiled +-- without cargo-concordium version >= 2. getWasmModuleFromFile :: -- | The module file. FilePath -> @@ -2556,10 +2558,10 @@ getWasmModuleFromFile moduleFile mWasmVersion = do wasmMagicValue = BS.pack [0x00, 0x61, 0x73, 0x6D] getMagicBytes = S.getByteString 4 --- |Load @Wasm.Parameter@ through one of several ways, dependent on the arguments: --- * If binary file provided -> Read the file and wrap its contents in @Wasm.Parameter@. --- * If JSON file provided -> Try to use the schema to encode the parameters into a @Wasm.Parameter@. --- If invalid arguments are provided or something fails, appropriate warning or error messages are logged. +-- | Load @Wasm.Parameter@ through one of several ways, dependent on the arguments: +-- * If binary file provided -> Read the file and wrap its contents in @Wasm.Parameter@. +-- * If JSON file provided -> Try to use the schema to encode the parameters into a @Wasm.Parameter@. +-- If invalid arguments are provided or something fails, appropriate warning or error messages are logged. getWasmParameter :: -- | Optional parameter file in JSON or binary format. Maybe ParameterFileInput -> @@ -2588,12 +2590,12 @@ getWasmParameter paramsFile schema funcName = emptyParams = pure . Wasm.Parameter $ BSS.empty binaryParams file = Wasm.Parameter . BS.toShort <$> handleReadFile BS.readFile file --- |Get a schema from a file or, alternatively, try to extract an embedded schema from a module. --- The schema from the file will take precedence over an embedded schema in the module. +-- | Get a schema from a file or, alternatively, try to extract an embedded schema from a module. +-- The schema from the file will take precedence over an embedded schema in the module. -- --- Can logWarn and logFatal in the following situations: --- - Invalid schemafile: logs fatally. --- - No schemafile and invalid embedded schema: logs a warning and returns @Nothing@. +-- Can logWarn and logFatal in the following situations: +-- - Invalid schemafile: logs fatally. +-- - No schemafile and invalid embedded schema: logs a warning and returns @Nothing@. getSchemaFromFileOrModule :: (MonadIO m) => -- | Optional schema file. @@ -2614,7 +2616,7 @@ getSchemaFromFileOrModule schemaFile namedModRef block = do Right schema -> return schema Just schemaFile' -> liftIO (Just <$> getSchemaFromFile (Wasm.wasmVersion wasmModule) schemaFile') --- |Try to load and decode a schema from a file. Logs fatally if the file is not a valid Wasm module. +-- | Try to load and decode a schema from a file. Logs fatally if the file is not a valid Wasm module. getSchemaFromFile :: Wasm.WasmVersion -> FilePath -> IO CS.ModuleSchema getSchemaFromFile wasmVersion schemaFile = do schema <- CS.decodeModuleSchema wasmVersion <$> handleReadFile BS.readFile schemaFile @@ -2622,10 +2624,10 @@ getSchemaFromFile wasmVersion schemaFile = do Left err -> logFatal [[i|Could not decode schema from file '#{schemaFile}':|], err] Right schema' -> pure schema' --- |Get a schema and a list of exported function names from an optional schema file and a module. --- Logs fatally if an invalid schema is found (either from a file or embedded). --- The schema from the file will take precedence over an embedded schema in the module. --- It will only return `(Nothing, _)` if no schemafile is provided and no embedded schema was found in the module. +-- | Get a schema and a list of exported function names from an optional schema file and a module. +-- Logs fatally if an invalid schema is found (either from a file or embedded). +-- The schema from the file will take precedence over an embedded schema in the module. +-- It will only return `(Nothing, _)` if no schemafile is provided and no embedded schema was found in the module. getSchemaAndExports :: -- | Optional schema file. Maybe FilePath -> @@ -2646,20 +2648,20 @@ getSchemaAndExports schemaFile wasmModule = do Left err -> logFatal [[i|Could not parse embedded schema or exports from module:|], err] Right schemaAndExports -> return schemaAndExports --- |Try to parse the input as a module reference and assume it is a path if it fails. +-- | Try to parse the input as a module reference and assume it is a path if it fails. getModuleRefFromRefOrFile :: String -> Maybe Wasm.WasmVersion -> IO Types.ModuleRef getModuleRefFromRefOrFile modRefOrFile mWasmVersion = case readMaybe modRefOrFile of Just modRef -> pure modRef Nothing -> getModuleRefFromFile modRefOrFile mWasmVersion --- |Load the module file and compute its hash, which is the reference. +-- | Load the module file and compute its hash, which is the reference. getModuleRefFromFile :: String -> Maybe Wasm.WasmVersion -> IO Types.ModuleRef getModuleRefFromFile file mWasmVersion = Types.ModuleRef . getHash <$> getWasmModuleFromFile file mWasmVersion --- |Get a NamedContractAddress from either a name or index and an optional subindex. --- LogWarn if subindex is provided with a contract name. --- LogFatal if it is neither an index nor a contract name. -getNamedContractAddress :: MonadIO m => ContractNameMap -> Text -> Maybe Word64 -> m NamedContractAddress +-- | Get a NamedContractAddress from either a name or index and an optional subindex. +-- LogWarn if subindex is provided with a contract name. +-- LogFatal if it is neither an index nor a contract name. +getNamedContractAddress :: (MonadIO m) => ContractNameMap -> Text -> Maybe Word64 -> m NamedContractAddress getNamedContractAddress nameMap indexOrName subindex = case readMaybe $ Text.unpack indexOrName of Just index -> return $ NamedContractAddress{ncaAddr = mkContractAddress index subindex, ncaNames = []} Nothing -> do @@ -2668,24 +2670,24 @@ getNamedContractAddress nameMap indexOrName subindex = case readMaybe $ Text.unp Just addr -> return $ NamedContractAddress{ncaAddr = addr, ncaNames = [indexOrName]} Nothing -> logFatal [[i|'#{indexOrName}' is neither the address index nor the name of a contract|]] --- |Get a NamedModuleRef from either a name or a module reference. --- LogFatal if it is neither a module reference nor a module name. -getNamedModuleRef :: MonadIO m => ModuleNameMap -> Text -> m NamedModuleRef +-- | Get a NamedModuleRef from either a name or a module reference. +-- LogFatal if it is neither a module reference nor a module name. +getNamedModuleRef :: (MonadIO m) => ModuleNameMap -> Text -> m NamedModuleRef getNamedModuleRef nameMap modRefOrName = case readMaybe $ Text.unpack modRefOrName of Just modRef -> return $ NamedModuleRef{nmrRef = modRef, nmrNames = []} Nothing -> case Map.lookup modRefOrName nameMap of Just modRef -> return $ NamedModuleRef{nmrRef = modRef, nmrNames = [modRefOrName]} Nothing -> logFatal [[i|'#{modRefOrName}' is neither the reference nor the name of a module|]] --- |Make a contract address from an index and an optional subindex (default: 0). +-- | Make a contract address from an index and an optional subindex (default: 0). mkContractAddress :: Word64 -> Maybe Word64 -> Types.ContractAddress mkContractAddress index subindex = Types.ContractAddress (Types.ContractIndex index) (Types.ContractSubindex subindex') where subindex' = fromMaybe 0 subindex --- |Try to extract event information from a TransactionStatusResult. --- The Maybe returned by the supplied function is mapped to Either with an error message. --- 'Nothing' is mapped to 'Nothing' +-- | Try to extract event information from a TransactionStatusResult. +-- The Maybe returned by the supplied function is mapped to Either with an error message. +-- 'Nothing' is mapped to 'Nothing' extractFromTsr :: (Types.Event -> Maybe a) -> Maybe TransactionStatusResult -> Maybe (Either String a) extractFromTsr _ Nothing = Nothing -- occurs when ioTail is disabled. extractFromTsr eventMatcher (Just tsr) = Just $ case parseTransactionBlockResult tsr of @@ -2701,7 +2703,7 @@ extractFromTsr eventMatcher (Just tsr) = Just $ case parseTransactionBlockResult maybeToRight _ (Just x) = Right x maybeToRight y Nothing = Left y --- |Process a 'consensus ...' command. +-- | Process a 'consensus ...' command. processConsensusCmd :: ConsensusCmd -> Maybe FilePath -> Verbose -> Backend -> IO () processConsensusCmd action _baseCfgDir verbose backend = case action of @@ -2814,7 +2816,7 @@ processConsensusCmd action _baseCfgDir verbose backend = when (ioTail intOpts) $ tailTransaction_ verbose hash --- |Process a 'block ...' command. +-- | Process a 'block ...' command. processBlockCmd :: BlockCmd -> Verbose -> Backend -> IO () processBlockCmd action _ backend = case action of @@ -2834,7 +2836,7 @@ processBlockCmd action _ backend = Left err -> logFatal ["Error getting block info: " <> err] Right bi -> runPrinter $ printBlockInfo bi --- |Generate a fresh set of baker keys. +-- | Generate a fresh set of baker keys. generateBakerKeys :: Maybe Types.BakerId -> IO BakerKeys generateBakerKeys bkBakerId = do -- Aggr/bls keys. @@ -2868,31 +2870,31 @@ getNrgGtuRate = do Right (Queries.EChainParametersAndKeys (ecpParams :: ChainParameters' cpv) _) -> do return $ ecpParams ^. energyRate --- |Process the 'baker configure ...' command. +-- | Process the 'baker configure ...' command. processBakerConfigureCmd :: Maybe FilePath -> Verbose -> Backend -> TransactionOpts (Maybe Types.Energy) -> - -- |Whether this was called via `baker configure` + -- | Whether this was called via `baker configure` Bool -> - -- |New stake/capital. + -- | New stake/capital. Maybe Types.Amount -> - -- |Select whether to restake earnings. + -- | Select whether to restake earnings. Maybe Bool -> - -- |Open for delegation status. + -- | Open for delegation status. Maybe Types.OpenStatus -> - -- |URL to metadata about baker. + -- | URL to metadata about baker. Maybe String -> - -- |Transaction fee commission. + -- | Transaction fee commission. Maybe Types.AmountFraction -> - -- |Baking reward commission. + -- | Baking reward commission. Maybe Types.AmountFraction -> - -- |Finalization commission. + -- | Finalization commission. Maybe Types.AmountFraction -> - -- |File to read baker keys from. + -- | File to read baker keys from. Maybe FilePath -> - -- |File to write baker keys to. + -- | File to write baker keys to. Maybe FilePath -> IO () processBakerConfigureCmd baseCfgDir verbose backend txOpts isBakerConfigure cbCapital cbRestakeEarnings cbOpenForDelegation metadataURL cbTransactionFeeCommission cbBakingRewardCommission cbFinalizationRewardCommission inputKeysFile outputKeysFile = do @@ -3128,19 +3130,19 @@ processBakerConfigureCmd baseCfgDir verbose backend txOpts isBakerConfigure cbCa Just x -> return x Nothing -> logFatal [err] --- |Process the old 'baker add ...' command to add a baker in protocol version < 4. +-- | Process the old 'baker add ...' command to add a baker in protocol version < 4. processBakerAddCmd :: Maybe FilePath -> Verbose -> Backend -> TransactionOpts (Maybe Types.Energy) -> - -- |New stake/capital. + -- | New stake/capital. Types.Amount -> - -- |Select whether to restake earnings. + -- | Select whether to restake earnings. Bool -> - -- |File to read baker keys from. + -- | File to read baker keys from. FilePath -> - -- |File to write baker keys to. + -- | File to write baker keys to. Maybe FilePath -> IO () processBakerAddCmd baseCfgDir verbose backend txOpts abBakingStake abRestakeEarnings inputKeysFile outputKeysFile = do @@ -3293,15 +3295,15 @@ processBakerAddCmd baseCfgDir verbose backend txOpts abBakingStake abRestakeEarn Just x -> return x Nothing -> logFatal [err] --- |Process the old 'baker set-key ...' command to set baker keys in protocol version < 4. +-- | Process the old 'baker set-key ...' command to set baker keys in protocol version < 4. processBakerSetKeysCmd :: Maybe FilePath -> Verbose -> Backend -> TransactionOpts (Maybe Types.Energy) -> - -- |File to read baker keys from. + -- | File to read baker keys from. FilePath -> - -- |File to write baker keys to. + -- | File to write baker keys to. Maybe FilePath -> IO () processBakerSetKeysCmd baseCfgDir verbose backend txOpts inputKeysFile outputKeysFile = do @@ -3413,7 +3415,7 @@ processBakerSetKeysCmd baseCfgDir verbose backend txOpts inputKeysFile outputKey Just x -> return x Nothing -> logFatal [err] --- |Process the old 'baker set-key ...' command to set baker keys in protocol version < 4. +-- | Process the old 'baker set-key ...' command to set baker keys in protocol version < 4. processBakerRemoveCmd :: Maybe FilePath -> Verbose -> @@ -3460,13 +3462,13 @@ processBakerRemoveCmd baseCfgDir verbose backend txOpts = do putStrLn "" return (txCfg, payload) --- |Process the old 'baker update-stake ...' command in protocol version < 4. +-- | Process the old 'baker update-stake ...' command in protocol version < 4. processBakerUpdateStakeBeforeP4Cmd :: Maybe FilePath -> Verbose -> Backend -> TransactionOpts (Maybe Types.Energy) -> - -- |New stake + -- | New stake Types.Amount -> IO () processBakerUpdateStakeBeforeP4Cmd baseCfgDir verbose backend txOpts ubsStake = do @@ -3550,13 +3552,13 @@ processBakerUpdateStakeBeforeP4Cmd baseCfgDir verbose backend txOpts ubsStake = putStrLn "" return (txCfg, payload) --- |Process the old 'baker update-restake ...' command in protocol version < 4. +-- | Process the old 'baker update-restake ...' command in protocol version < 4. processBakerUpdateRestakeCmd :: Maybe FilePath -> Verbose -> Backend -> TransactionOpts (Maybe Types.Energy) -> - -- |Whether to restake earnings + -- | Whether to restake earnings Bool -> IO () processBakerUpdateRestakeCmd baseCfgDir verbose backend txOpts ubreRestakeEarnings = do @@ -3583,13 +3585,13 @@ processBakerUpdateRestakeCmd baseCfgDir verbose backend txOpts ubreRestakeEarnin putStrLn "" return (txCfg, payload) --- |Process the 'baker update-stake ...' command. +-- | Process the 'baker update-stake ...' command. processBakerUpdateStakeCmd :: Maybe FilePath -> Verbose -> Backend -> TransactionOpts (Maybe Types.Energy) -> - -- |New stake + -- | New stake Types.Amount -> IO () processBakerUpdateStakeCmd baseCfgDir verbose backend txOpts newStake = do @@ -3602,7 +3604,7 @@ processBakerUpdateStakeCmd baseCfgDir verbose backend txOpts newStake = do when ok $ processBakerConfigureCmd baseCfgDir verbose backend txOpts False (Just newStake) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing --- |Process a 'baker ...' command. +-- | Process a 'baker ...' command. processBakerCmd :: BakerCmd -> Maybe FilePath -> Verbose -> Backend -> IO () processBakerCmd action baseCfgDir verbose backend = case action of @@ -3737,17 +3739,17 @@ processBakerCmd action baseCfgDir verbose backend = then polling newLen 0 =<< getWinTimestamp else polling newLen (lastPoll + 1) winTimestamp --- |Process a 'delegator configure ...' command. +-- | Process a 'delegator configure ...' command. processDelegatorConfigureCmd :: Maybe FilePath -> Verbose -> Backend -> TransactionOpts (Maybe Types.Energy) -> - -- |New stake/capital. + -- | New stake/capital. Maybe Types.Amount -> - -- |Select whether to restake earnings. + -- | Select whether to restake earnings. Maybe Bool -> - -- |Delegation target: baker or passive delegation. + -- | Delegation target: baker or passive delegation. Maybe Types.DelegationTarget -> IO () processDelegatorConfigureCmd baseCfgDir verbose backend txOpts cdCapital cdRestakeEarnings cdDelegationTarget = do @@ -3879,7 +3881,7 @@ processDelegatorConfigureCmd baseCfgDir verbose backend txOpts cdCapital cdResta Just Types.DelegatePassive -> ["stake will be delegated passively"] Just (Types.DelegateToBaker bid) -> [printf "stake will be delegated to baker %s" (show bid)] --- |Process a 'delegator ...' command. +-- | Process a 'delegator ...' command. processDelegatorCmd :: DelegatorCmd -> Maybe FilePath -> Verbose -> Backend -> IO () processDelegatorCmd action baseCfgDir verbose backend = case action of @@ -3938,7 +3940,7 @@ processIdentityShowCmd action backend = >>= getResponseValueOrDie >>= runPrinter . printAnonymityRevokers . toList --- |Process a "legacy" command. +-- | Process a "legacy" command. processLegacyCmd :: LegacyCmd -> Backend -> IO () processLegacyCmd action backend = case action of @@ -4217,12 +4219,12 @@ processLegacyCmd action backend = Left _ -> logFatal ["Unable to parse account address."] Right a -> return a --- |Helper function to specialize the type, avoiding the need for type --- annotations in many places. +-- | Helper function to specialize the type, avoiding the need for type +-- annotations in many places. getBlockItemHash :: Types.BareBlockItem -> Types.TransactionHash getBlockItemHash = getHash -printPeerData :: MonadIO m => Bool -> [Queries.PeerInfo] -> Queries.NodeInfo -> m () +printPeerData :: (MonadIO m) => Bool -> [Queries.PeerInfo] -> Queries.NodeInfo -> m () printPeerData bootstrapper pInfos Queries.NodeInfo{..} = let Queries.NetworkInfo{..} = networkInfo -- Filter bootstrappers. @@ -4272,7 +4274,7 @@ printPeerData bootstrapper pInfos Queries.NodeInfo{..} = Queries.ActiveBaker -> "in current baking committee)" Queries.ActiveFinalizer -> "in current baking and finalizer committee)" -printNodeInfo :: MonadIO m => Queries.NodeInfo -> m () +printNodeInfo :: (MonadIO m) => Queries.NodeInfo -> m () printNodeInfo Queries.NodeInfo{..} = liftIO $ let Queries.NetworkInfo{..} = networkInfo @@ -4347,9 +4349,9 @@ printNodeInfo Queries.NodeInfo{..} = Queries.NodeActive (Queries.BakerConsensusInfo bId Queries.ActiveFinalizer) -> "In current finalizer committee with baker ID " <> show bId <> "'." --- |Process a transaction from JSON payload given as a byte string --- and with keys given explicitly. --- The transaction is signed with all the provided keys. +-- | Process a transaction from JSON payload given as a byte string +-- and with keys given explicitly. +-- The transaction is signed with all the provided keys. processTransaction :: (MonadFail m, MonadIO m) => BSL.ByteString -> @@ -4359,8 +4361,8 @@ processTransaction source = Left err -> fail $ "Error decoding JSON: " ++ err Right t -> processTransaction_ t True --- |Process a transaction with unencrypted keys given explicitly. --- The transaction is signed with all the provided keys. +-- | Process a transaction with unencrypted keys given explicitly. +-- The transaction is signed with all the provided keys. processTransaction_ :: (MonadFail m, MonadIO m) => TransactionJSON -> @@ -4396,7 +4398,7 @@ processTransaction_ transaction _verbose = do Left err -> logFatal ["Transaction not accepted by the baker: " <> err] Right _ -> return tx --- |Read a versioned credential from the bytestring, failing if any errors occur. +-- | Read a versioned credential from the bytestring, failing if any errors occur. processCredential :: (MonadFail m, MonadIO m) => BSL.ByteString -> @@ -4422,7 +4424,7 @@ processCredential source = | otherwise -> fail $ "Unsupported credential version: " ++ show (vVersion vCred) --- |Convert JSON-based transaction type to one which is ready to be encoded, signed and sent. +-- | Convert JSON-based transaction type to one which is ready to be encoded, signed and sent. convertTransactionJsonPayload :: (MonadFail m) => CT.TransactionJSONPayload -> ClientMonad m Types.Payload convertTransactionJsonPayload = \case (CT.DeployModule _) -> @@ -4441,8 +4443,8 @@ convertTransactionJsonPayload = \case CT.TransferToEncrypted{..} -> return $ Types.TransferToEncrypted{..} CT.EncryptedAmountTransfer{..} -> return Types.EncryptedAmountTransfer{..} --- |Sign a transaction payload and configuration into a "normal" transaction, --- which is ready to be sent. +-- | Sign a transaction payload and configuration into a "normal" transaction, +-- which is ready to be sent. encodeAndSignTransaction :: Types.Payload -> Types.AccountAddress -> @@ -4453,8 +4455,8 @@ encodeAndSignTransaction :: Types.BareBlockItem encodeAndSignTransaction txPayload = signEncodedTransaction (Types.encodePayload txPayload) --- |Sign an encoded transaction payload and a configuration into a "normal" transaction, --- which is ready to be sent. +-- | Sign an encoded transaction payload and a configuration into a "normal" transaction, +-- which is ready to be sent. signEncodedTransaction :: Types.EncodedPayload -> Types.AccountAddress -> diff --git a/src/Concordium/Client/Runner/Helper.hs b/src/Concordium/Client/Runner/Helper.hs index 66f1e669..2b992888 100644 --- a/src/Concordium/Client/Runner/Helper.hs +++ b/src/Concordium/Client/Runner/Helper.hs @@ -34,14 +34,14 @@ import qualified Network.URI.Encode (decode, decodeBSToText) import Text.Read (readEither) import Prelude --- |The response contains headers and a response value. +-- | The response contains headers and a response value. data GRPCResponse a = GRPCResponse { grpcHeaders :: GRPCHeaderList, grpcResponseVal :: a } deriving (Show, Functor) --- |Result of running a GRPC request. +-- | Result of running a GRPC request. data GRPCResult a = -- | The request was successful with status code 'OK', and a response is available. StatusOk (GRPCResponse a) @@ -53,22 +53,22 @@ data GRPCResult a RequestFailed String deriving (Functor) --- |Headers in GRPC call response. +-- | Headers in GRPC call response. type GRPCHeaderList = CIHeaderList --- |GRPC call helper output type, with variants corresponding to the result of a unary or streaming call. --- This is here due to the differing output types of the GRPC helpers @rawUnary@ and @rawStreamServer@, --- that we use to invoke the GRPC procedure. For more info, see the documentation at: --- http://hackage.haskell.org/package/http2-client-grpc-0.7.0.0/docs/Network-GRPC-Client-Helpers.html +-- | GRPC call helper output type, with variants corresponding to the result of a unary or streaming call. +-- This is here due to the differing output types of the GRPC helpers @rawUnary@ and @rawStreamServer@, +-- that we use to invoke the GRPC procedure. For more info, see the documentation at: +-- http://hackage.haskell.org/package/http2-client-grpc-0.7.0.0/docs/Network-GRPC-Client-Helpers.html data GRPCOutput a - = -- |The output returned by invoking a GRPC procedure using 'rawUnary'. + = -- | The output returned by invoking a GRPC procedure using 'rawUnary'. RawUnaryOutput (RawReply a) - | -- |The output returned by invoking a GRPC procedure using 'rawStreamServer'. - -- The second and third element of the triple represents the response headers, - -- respectively trailers. + | -- | The output returned by invoking a GRPC procedure using 'rawStreamServer'. + -- The second and third element of the triple represents the response headers, + -- respectively trailers. ServerStreamOutput (a, HeaderList, HeaderList) --- |Convert a GRPC helper output to a unified result type. +-- | Convert a GRPC helper output to a unified result type. toGRPCResult' :: GRPCOutput t -> GRPCResult t toGRPCResult' = \case @@ -117,27 +117,27 @@ toGRPCResult' = let hs = map (\(hn, hv) -> (CI.mk hn, hv)) hds in StatusOk (GRPCResponse hs t) --- |Convert a GRPC helper output to a unified result type. +-- | Convert a GRPC helper output to a unified result type. toGRPCResult :: Maybe (GRPCOutput t) -> GRPCResult t toGRPCResult ret = case ret of Nothing -> RequestFailed "Cannot connect to GRPC server." Just v -> toGRPCResult' v -printJSON :: MonadIO m => Either String Value -> m () +printJSON :: (MonadIO m) => Either String Value -> m () printJSON v = case v of Left err -> liftIO $ putStrLn err Right jsonVals -> printJSONValues jsonVals -printJSONValues :: MonadIO m => Value -> m () +printJSONValues :: (MonadIO m) => Value -> m () printJSONValues = liftIO . BSL8.putStrLn . encodePretty --- |Extract the response value of a @GRPCResult@, if present, and return it --- under the provided mapping. --- Returns a @Left@ wrapping an error string describing its nature if the --- request could not be made, or if the GRPC status code was not 'OK', or a --- @Right@ wrapping the response value under the provided mapping otherwise. +-- | Extract the response value of a @GRPCResult@, if present, and return it +-- under the provided mapping. +-- Returns a @Left@ wrapping an error string describing its nature if the +-- request could not be made, or if the GRPC status code was not 'OK', or a +-- @Right@ wrapping the response value under the provided mapping otherwise. extractResponseValue :: (a -> b) -> GRPCResult (Either String a) -> Either (Maybe GRPCStatusCode, String) b extractResponseValue f res = case res of @@ -149,16 +149,16 @@ extractResponseValue f res = StatusInvalid -> Left (Nothing, "A GRPC error occurred: Response contained an invalid return code.") RequestFailed err -> Left (Nothing, "The GRPC request failed: " <> err) --- |Get the response value of a @GRPCResult@, if present. --- Returns a @Left@ wrapping an error string describing its nature if the --- request could not be made, or if the GRPC status code was not 'OK', or a --- @Right@ wrapping the response value otherwise. +-- | Get the response value of a @GRPCResult@, if present. +-- Returns a @Left@ wrapping an error string describing its nature if the +-- request could not be made, or if the GRPC status code was not 'OK', or a +-- @Right@ wrapping the response value otherwise. getResponseValue :: GRPCResult (Either String a) -> Either (Maybe GRPCStatusCode, String) a getResponseValue = extractResponseValue id --- |Extract the response value of a @GRPCResult@, if present, and return it --- under the provided mapping, or fail printing the cause if the result --- contains an error. +-- | Extract the response value of a @GRPCResult@, if present, and return it +-- under the provided mapping, or fail printing the cause if the result +-- contains an error. extractResponseValueOrDie :: (MonadIO m) => (a -> b) -> @@ -169,18 +169,18 @@ extractResponseValueOrDie f res = Left err -> logFatal [snd err] Right v -> return v --- |Get the response value of a @GRPCResult@ if present, or fail printing the --- cause if the result contains an error. +-- | Get the response value of a @GRPCResult@ if present, or fail printing the +-- cause if the result contains an error. getResponseValueOrDie :: (MonadIO m) => GRPCResult (Either String a) -> m a getResponseValueOrDie = extractResponseValueOrDie id --- |Get the response value and the headers of a @GRPCResult@, if present. --- Returns a @Left@ wrapping the @GRPCResult@ if it is not of the variant --- @StatusOk@ and a @Right@ wrapping a pair of the response value and a --- @CIHeaderList@ otherwise. +-- | Get the response value and the headers of a @GRPCResult@, if present. +-- Returns a @Left@ wrapping the @GRPCResult@ if it is not of the variant +-- @StatusOk@ and a @Right@ wrapping a pair of the response value and a +-- @CIHeaderList@ otherwise. getResponseValueAndHeaders :: GRPCResult a -> Either (GRPCResult b) (a, CIHeaderList) getResponseValueAndHeaders res = case res of @@ -189,11 +189,11 @@ getResponseValueAndHeaders res = StatusInvalid -> Left StatusInvalid RequestFailed err -> Left $ RequestFailed err --- |Get the 'blockhash' header value of a @CIHeaderList@ if present. --- Fails with an error message if the header was not present in the --- list of headers or if the header value could not be @read@ into a --- @BlockHash@. Returns a @BlockHash@ @read@ from the header value --- otherwise. +-- | Get the 'blockhash' header value of a @CIHeaderList@ if present. +-- Fails with an error message if the header was not present in the +-- list of headers or if the header value could not be @read@ into a +-- @BlockHash@. Returns a @BlockHash@ @read@ from the header value +-- otherwise. getBlockHashHeader :: (MonadFail m) => CIHeaderList -> m Types.BlockHash getBlockHashHeader hs = case List.find (("blockhash" ==) . fst) hs of diff --git a/src/Concordium/Client/Types/Account.hs b/src/Concordium/Client/Types/Account.hs index 5c51e5a8..bedd5341 100644 --- a/src/Concordium/Client/Types/Account.hs +++ b/src/Concordium/Client/Types/Account.hs @@ -78,20 +78,20 @@ instance AE.FromJSON EncryptedAccountKeyPair where case schemeId of SigScheme.Ed25519 -> return EncryptedAccountKeyPairEd25519{..} --- |Full map of plaintext account signing keys. +-- | Full map of plaintext account signing keys. type AccountKeyMap = Map.Map ID.CredentialIndex (Map.Map ID.KeyIndex AccountKeyPair) --- |Encrypted analogue of 'AccountKeyMap' +-- | Encrypted analogue of 'AccountKeyMap' type EncryptedAccountKeyMap = Map.Map ID.CredentialIndex (Map.Map ID.KeyIndex EncryptedAccountKeyPair) type EncryptedAccountEncryptionSecretKey = EncryptedText --- |Get the number of keys in the key map. +-- | Get the number of keys in the key map. mapNumKeys :: Map.Map ID.CredentialIndex (Map.Map ID.KeyIndex a) -> Int mapNumKeys = sum . fmap Map.size --- |Information about a given account sufficient to sign transactions. --- This includes the plain signing keys. +-- | Information about a given account sufficient to sign transactions. +-- This includes the plain signing keys. data AccountSigningData = AccountSigningData { asdAddress :: !Types.AccountAddress, asdKeys :: !AccountKeyMap, @@ -99,9 +99,9 @@ data AccountSigningData = AccountSigningData } deriving (Show) --- |Selected keys resolved from the account config for the specific interaction. --- In contrast to the account config this will only contain the keys the user selected. --- The keys are still encrypted. They will only be decrypted when they will be used. +-- | Selected keys resolved from the account config for the specific interaction. +-- In contrast to the account config this will only contain the keys the user selected. +-- The keys are still encrypted. They will only be decrypted when they will be used. data EncryptedSigningData = EncryptedSigningData { esdAddress :: !NamedAddress, esdKeys :: !EncryptedAccountKeyMap, @@ -150,11 +150,11 @@ decryptAccountKeyMap :: decryptAccountKeyMap encryptedKeyMap pwd = runExceptT $ sequence $ Map.map (sequence . Map.mapWithKey (decryptAccountKeyPair pwd)) encryptedKeyMap --- |Encrypt, with the given password, the secret key for decrypting encrypted amounts +-- | Encrypt, with the given password, the secret key for decrypting encrypted amounts encryptAccountEncryptionSecretKey :: Password -> CryptoFFI.ElgamalSecretKey -> IO EncryptedAccountEncryptionSecretKey encryptAccountEncryptionSecretKey pwd secret = encryptText AES256 PBKDF2SHA256 (encode secret) pwd --- |Attempt to decrypt, with the given password, the secret key for decrypting encrypted amounts +-- | Attempt to decrypt, with the given password, the secret key for decrypting encrypted amounts decryptAccountEncryptionSecretKey :: Password -> EncryptedAccountEncryptionSecretKey -> IO (Either String CryptoFFI.ElgamalSecretKey) decryptAccountEncryptionSecretKey pwd secret = either (Left . displayException) decode <$> runExceptT (decryptText secret pwd :: ExceptT DecryptionFailure IO ByteString) diff --git a/src/Concordium/Client/Types/Contract/Info.hs b/src/Concordium/Client/Types/Contract/Info.hs index f3403ca3..ac71ee0a 100644 --- a/src/Concordium/Client/Types/Contract/Info.hs +++ b/src/Concordium/Client/Types/Contract/Info.hs @@ -48,21 +48,21 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Word (Word32) --- |Try to include extra information in the contract info from the module schema. --- For V0 contracts: --- - Try to decode the state, if the state schema is available. --- - Include all available parameter schemas for receive methods. --- For V1 contracts: --- - Include all available function schemas for receive methods. --- - In case of a V3 schema, include event schema. +-- | Try to include extra information in the contract info from the module schema. +-- For V0 contracts: +-- - Try to decode the state, if the state schema is available. +-- - Include all available parameter schemas for receive methods. +-- For V1 contracts: +-- - Include all available function schemas for receive methods. +-- - In case of a V3 schema, include event schema. -- --- Logs warnings if: --- - The contract is not included in the module schema. --- - The state could not be parsed using the schema (only for v0 contracts). +-- Logs warnings if: +-- - The contract is not included in the module schema. +-- - The state could not be parsed using the schema (only for v0 contracts). -- --- Logs fatally on internal errors that should never occur, namely: --- - Schema data has already been added. --- - The version of module schema and contract info does not match. +-- Logs fatally on internal errors that should never occur, namely: +-- - Schema data has already been added. +-- - The version of module schema and contract info does not match. addSchemaData :: (MonadIO m) => ContractInfo -> CS.ModuleSchema -> ClientMonad m (Maybe ContractInfo) addSchemaData cInfo@ContractInfoV1{..} moduleSchema = case moduleSchema of @@ -158,9 +158,9 @@ addSchemaData cInfo@ContractInfoV0{..} moduleSchema = let mSchema = CS.lookupParameterSchema moduleSchema (CS.ReceiveFuncName ciName rcvName) in (rcvName, mSchema) --- |Get a contract name from an InitName, i.e. extracting the text and removing the "init_" prefix. --- If stripping the prefix fails, it simply returns the extracted text --- (this should never happen, unless the InitName was incorrectly constructed). +-- | Get a contract name from an InitName, i.e. extracting the text and removing the "init_" prefix. +-- If stripping the prefix fails, it simply returns the extracted text +-- (this should never happen, unless the InitName was incorrectly constructed). contractNameFromInitName :: Wasm.InitName -> Text contractNameFromInitName initName = case Text.stripPrefix "init_" initNameText of Nothing -> initNameText @@ -168,8 +168,8 @@ contractNameFromInitName initName = case Text.stripPrefix "init_" initNameText o where initNameText = Wasm.initName initName --- |Get a method name from a Receive name, i.e. extracting the text and removing the "." prefix. --- If the receiveName does not have the prefix, it simply returns the extracted text. +-- | Get a method name from a Receive name, i.e. extracting the text and removing the "." prefix. +-- If the receiveName does not have the prefix, it simply returns the extracted text. methodNameFromReceiveName :: Wasm.ReceiveName -> Text methodNameFromReceiveName rcvName = case Text.split (== '.') receiveNameText of [_contrName, methodName] -> methodName @@ -177,7 +177,7 @@ methodNameFromReceiveName rcvName = case Text.split (== '.') receiveNameText of where receiveNameText = Wasm.receiveName rcvName --- |Check whether the receive method exists in the contract. +-- | Check whether the receive method exists in the contract. hasReceiveMethod :: Text -> ContractInfo -> Bool hasReceiveMethod rcvName cInfo = rcvName `elem` methods where @@ -191,20 +191,20 @@ hasReceiveMethod rcvName cInfo = rcvName `elem` methods WithSchemaV2{..} -> map fst ws2Methods WithSchemaV3{..} -> map fst ws3Methods --- |Get the contract name (without the 'init_' prefix). +-- | Get the contract name (without the 'init_' prefix). getContractName :: ContractInfo -> Text getContractName = \case ContractInfoV0{..} -> ciName ContractInfoV1{..} -> ciName --- |Returns True if the contract has fallback entrypoint support, --- False otherwise. +-- | Returns True if the contract has fallback entrypoint support, +-- False otherwise. hasFallbackReceiveSupport :: ContractInfo -> Bool hasFallbackReceiveSupport = \case ContractInfoV0{} -> False ContractInfoV1{} -> True --- |Get the event schema of a contract. +-- | Get the event schema of a contract. getEventSchema :: ContractInfo -> Maybe CS.SchemaType getEventSchema = \case ContractInfoV0{} -> Nothing @@ -214,7 +214,7 @@ getEventSchema = \case WithSchemaV2 _ -> Nothing WithSchemaV3{..} -> ws3Event --- |Get the parameter schema for a receive method. +-- | Get the parameter schema for a receive method. getParameterSchema :: ContractInfo -> Text -> Maybe CS.SchemaType getParameterSchema ci rcvName = case ci of ContractInfoV0{..} -> case ciMethodsAndState of @@ -230,40 +230,40 @@ getParameterSchema ci rcvName = case ci of Nothing -> Nothing Just (_, v) -> v --- |This is returned by the node and specified in Concordium.Getters (from prototype repo). --- Must stay in sync. +-- | This is returned by the node and specified in Concordium.Getters (from prototype repo). +-- Must stay in sync. data ContractInfo - = -- |Info about a contract. + = -- | Info about a contract. ContractInfoV0 - { -- |The contract balance. + { -- | The contract balance. ciAmount :: !T.Amount, - -- |The owner of the contract. + -- | The owner of the contract. ciOwner :: !T.AccountAddress, - -- |The size of the contract state in bytes. + -- | The size of the contract state in bytes. ciSize :: !Int, - -- |The corresponding source module. + -- | The corresponding source module. ciSourceModule :: !T.ModuleRef, - -- |The contract name. + -- | The contract name. ciName :: !Text, - -- |The methods and state of the contract. + -- | The methods and state of the contract. ciMethodsAndState :: !MethodsAndState } | ContractInfoV1 - { -- |The contract balance. + { -- | The contract balance. ciAmount :: !T.Amount, - -- |The owner of the contract. + -- | The owner of the contract. ciOwner :: !T.AccountAddress, - -- |The contract name. + -- | The contract name. ciName :: !Text, - -- |The corresponding source module. + -- | The corresponding source module. ciSourceModule :: !T.ModuleRef, - -- |The methods of the contract. + -- | The methods of the contract. ciMethods :: !Methods } deriving (Eq, Show) --- |Methods and State for V0 Contracts. --- Additional information from the schema can be added with `addSchemaData`. +-- | Methods and State for V0 Contracts. +-- Additional information from the schema can be added with `addSchemaData`. data MethodsAndState = NoSchemaV0 { ns0State :: !ByteString, @@ -275,10 +275,10 @@ data MethodsAndState } deriving (Eq, Show) --- |Method and event schemas for V1 Contracts. --- Additional information from the schema can be added with `addSchemaData`. --- The schemas can be either of version 1, 2 or 3. --- Event schemas are only present in V3 schemas. +-- | Method and event schemas for V1 Contracts. +-- Additional information from the schema can be added with `addSchemaData`. +-- The schemas can be either of version 1, 2 or 3. +-- Event schemas are only present in V3 schemas. data Methods = NoSchemaV1 {ns1Methods :: ![Text]} | WithSchemaV1 {ws1Methods :: ![(Text, Maybe CS.FunctionSchemaV1)]} @@ -286,17 +286,17 @@ data Methods | WithSchemaV3 {ws3Methods :: ![(Text, Maybe CS.FunctionSchemaV2)], ws3Event :: !(Maybe CS.EventSchemaV3)} deriving (Eq, Show) --- |Contract state for a V0 contract. --- Can either be the raw bytes or a JSON value with the parsed state (parsed with a schema). +-- | Contract state for a V0 contract. +-- Can either be the raw bytes or a JSON value with the parsed state (parsed with a schema). data ContractStateV0 = Cs0Bytes !ByteString | Cs0JSON !AE.Value deriving (Eq, Show) --- |Convert an @InstanceInfo@ into a @ContractInfo@. --- The schema in the returned @ContractInfo@ value will always be of --- the @NoSchemaV0@ variant. Schema informaton can be included by --- manually augmenting the result e.g. by using @addSchemaData@. +-- | Convert an @InstanceInfo@ into a @ContractInfo@. +-- The schema in the returned @ContractInfo@ value will always be of +-- the @NoSchemaV0@ variant. Schema informaton can be included by +-- manually augmenting the result e.g. by using @addSchemaData@. instanceInfoToContractInfo :: Wasm.InstanceInfo -> ContractInfo instanceInfoToContractInfo iInfo = case iInfo of @@ -352,15 +352,15 @@ instance AE.FromJSON ContractInfo where -- | Version of a module schema. data ModuleSchemaVersion = SchemaV0 | SchemaV1 | SchemaV2 | SchemaV3 --- |Construct module inspect info. --- Works by: --- - Creating ModuleInspectSigs from the list of exported function names. --- - Inserting the signatures from the moduleSchema into the ModuleInspectSigs --- - And collect the function names for /extraneous/ schemas, --- - i.e. schemas for functions that are not exported in the module. +-- | Construct module inspect info. +-- Works by: +-- - Creating ModuleInspectSigs from the list of exported function names. +-- - Inserting the signatures from the moduleSchema into the ModuleInspectSigs +-- - And collect the function names for /extraneous/ schemas, +-- - i.e. schemas for functions that are not exported in the module. -- --- If a schema is provided, it will create the corresponding version of ModuleInspectInfo. --- Otherwise, it will create ModuleInspectInfoV0 for V0 contracts and V2 for V1 contracts. +-- If a schema is provided, it will create the corresponding version of ModuleInspectInfo. +-- Otherwise, it will create ModuleInspectInfoV0 for V0 contracts and V2 for V1 contracts. constructModuleInspectInfo :: Config.NamedModuleRef -> Wasm.WasmVersion -> @@ -657,7 +657,7 @@ constructModuleInspectInfo namedModRef wasmVersion moduleSchema exportedFuncName in CS.ReceiveFuncName cname fnameWithoutDot : toFuncNames remaining | otherwise = toFuncNames remaining -- Ignore other types of exported functions. --- |Data type with information used by 'module inspect' command. +-- | Data type with information used by 'module inspect' command. data ModuleInspectInfo = ModuleInspectInfo { miiNamedModRef :: Config.NamedModuleRef, miiWasmVersion :: Wasm.WasmVersion, @@ -665,19 +665,19 @@ data ModuleInspectInfo = ModuleInspectInfo miiExtraneousSchemas :: [CS.FuncName] } --- |Module signatures of a smart contract module with event schema V*. --- Identical to `ModuleSchema` in that it uses `ContractSigsV*` instead of `ContractV*` (see their definition). +-- | Module signatures of a smart contract module with event schema V*. +-- Identical to `ModuleSchema` in that it uses `ContractSigsV*` instead of `ContractV*` (see their definition). data ModuleInspectSigs = ModuleInspectSigsV0 {mis0ContractSigs :: Map.Map Text ContractSigsV0} | ModuleInspectSigsV1 {mis1ContractSigs :: Map.Map Text ContractSigsV1} | ModuleInspectSigsV2 {mis2ContractSigs :: Map.Map Text ContractSigsV2} | ModuleInspectSigsV3 {mis3ContractSigs :: Map.Map Text ContractSigsV3} --- |Function signatures of a smart contract with event schema V0. --- Identical to `ContractSchemaV0`, except that the values of `csv0ReceiveSigs` are wrapped in `Maybe` to --- indicate, whether a schema specifying the type of the the receive function is present. This is needed --- as `csv0ReceiveSigs` may contain receive function names for which a schema was neither provided in the --- contract module nor user schema file. +-- | Function signatures of a smart contract with event schema V0. +-- Identical to `ContractSchemaV0`, except that the values of `csv0ReceiveSigs` are wrapped in `Maybe` to +-- indicate, whether a schema specifying the type of the the receive function is present. This is needed +-- as `csv0ReceiveSigs` may contain receive function names for which a schema was neither provided in the +-- contract module nor user schema file. data ContractSigsV0 = ContractSigsV0 { -- | Possibly a type signature for the init function. csv0InitSig :: Maybe CS.SchemaType, @@ -685,11 +685,11 @@ data ContractSigsV0 = ContractSigsV0 csv0ReceiveSigs :: Map.Map Text (Maybe CS.SchemaType) } --- |Function signatures of a smart contract with event schema V1. --- Identical to `ContractSchemaV1`, except that the values of `csv1ReceiveSigs` are wrapped in `Maybe` to --- indicate, whether a schema specifying the type of the the receive function is present. This is needed --- as `csv1ReceiveSigs` may contain receive function names for which a schema was neither provided in the --- contract module nor user schema file. +-- | Function signatures of a smart contract with event schema V1. +-- Identical to `ContractSchemaV1`, except that the values of `csv1ReceiveSigs` are wrapped in `Maybe` to +-- indicate, whether a schema specifying the type of the the receive function is present. This is needed +-- as `csv1ReceiveSigs` may contain receive function names for which a schema was neither provided in the +-- contract module nor user schema file. data ContractSigsV1 = ContractSigsV1 { -- | Possibly a schema for the init function. csv1InitSig :: Maybe CS.FunctionSchemaV1, @@ -697,11 +697,11 @@ data ContractSigsV1 = ContractSigsV1 csv1ReceiveSigs :: Map.Map Text (Maybe CS.FunctionSchemaV1) } --- |Function signatures of a smart contract with event schema V2. --- Identical to `ContractSchemaV2`, except that the values of `csv2ReceiveSigs` are wrapped in `Maybe` to --- indicate, whether a schema specifying the type of the the receive function is present. This is needed --- as `csv2ReceiveSigs` may contain receive function names for which a schema was neither provided in the --- contract module nor user schema file. +-- | Function signatures of a smart contract with event schema V2. +-- Identical to `ContractSchemaV2`, except that the values of `csv2ReceiveSigs` are wrapped in `Maybe` to +-- indicate, whether a schema specifying the type of the the receive function is present. This is needed +-- as `csv2ReceiveSigs` may contain receive function names for which a schema was neither provided in the +-- contract module nor user schema file. data ContractSigsV2 = ContractSigsV2 { -- | Possibly a schema for the init function. csv2InitSig :: Maybe CS.FunctionSchemaV2, @@ -709,11 +709,11 @@ data ContractSigsV2 = ContractSigsV2 csv2ReceiveSigs :: Map.Map Text (Maybe CS.FunctionSchemaV2) } --- |Function and event signatures of a smart contract with event schema V3. --- Identical to ContractSchemaV3, except that the values of `csv3ReceiveSigs` are wrapped in `Maybe` to --- indicate, whether a schema specifying the type of the the receive function is present. This is needed --- as `csv3ReceiveSigs` may contain receive function names for which a schema was neither provided in the --- contract module nor user schema file. +-- | Function and event signatures of a smart contract with event schema V3. +-- Identical to ContractSchemaV3, except that the values of `csv3ReceiveSigs` are wrapped in `Maybe` to +-- indicate, whether a schema specifying the type of the the receive function is present. This is needed +-- as `csv3ReceiveSigs` may contain receive function names for which a schema was neither provided in the +-- contract module nor user schema file. data ContractSigsV3 = ContractSigsV3 { -- | Possibly a schema for the init function. csv3InitSig :: Maybe CS.FunctionSchemaV2, diff --git a/src/Concordium/Client/Types/Contract/Parameter.hs b/src/Concordium/Client/Types/Contract/Parameter.hs index a4cb8743..dd962664 100644 --- a/src/Concordium/Client/Types/Contract/Parameter.hs +++ b/src/Concordium/Client/Types/Contract/Parameter.hs @@ -41,13 +41,13 @@ import GHC.Integer (modInteger, remInteger) import Lens.Micro.Platform (ix, (^?)) import Text.Read (readMaybe) --- |Serialize JSON parameter to binary using `SchemaType` or fail with an error message. +-- | Serialize JSON parameter to binary using `SchemaType` or fail with an error message. serializeWithSchema :: SchemaType -> AE.Value -> Either String ByteString serializeWithSchema typ params = S.runPut <$> putJSONUsingSchema typ params --- |Deserialize bytestring to JSON using `SchemaType` or fail with an error message --- if either the bytestring could not be parsed, or if a non-empty tail of the --- bytestring was not consumed. +-- | Deserialize bytestring to JSON using `SchemaType` or fail with an error message +-- if either the bytestring could not be parsed, or if a non-empty tail of the +-- bytestring was not consumed. deserializeWithSchema :: SchemaType -> ByteString -> Either String AE.Value deserializeWithSchema typ = S.runGet $ do json <- getJSONUsingSchema typ @@ -55,10 +55,10 @@ deserializeWithSchema typ = S.runGet $ do unless theEnd $ fail "Could not parse entire bytestring using schema." return json --- |Create a `Serialize.Get` for decoding binary as specified by a `SchemaType` into JSON. --- The `SchemaType` is pattern matched and for each variant, the corresponding binary --- deserialization is used followed by the corresponding JSON serialization. --- The Value that is returned should match what is expected from `putJSONUsingSchema` when using the same schema. +-- | Create a `Serialize.Get` for decoding binary as specified by a `SchemaType` into JSON. +-- The `SchemaType` is pattern matched and for each variant, the corresponding binary +-- deserialization is used followed by the corresponding JSON serialization. +-- The Value that is returned should match what is expected from `putJSONUsingSchema` when using the same schema. getJSONUsingSchema :: SchemaType -> S.Get AE.Value getJSONUsingSchema typ = case typ of Unit -> return AE.Null @@ -186,11 +186,11 @@ getJSONUsingSchema typ = case typ of Left _ -> fail "String is not valid UTF-8." Right str -> return str --- |Create a `Serialize.Put` for JSON using a `SchemaType`. --- It goes through the JSON and SchemaType recursively, and --- deserializes the JSON before serializing the values to binary. --- A descriptive error message is shown if the JSON does not match --- the expected format as specified by the `SchemaType`. +-- | Create a `Serialize.Put` for JSON using a `SchemaType`. +-- It goes through the JSON and SchemaType recursively, and +-- deserializes the JSON before serializing the values to binary. +-- A descriptive error message is shown if the JSON does not match +-- the expected format as specified by the `SchemaType`. putJSONUsingSchema :: SchemaType -> AE.Value -> Either String S.Put putJSONUsingSchema typ json = case (typ, json) of (Unit, AE.Null) -> pure mempty @@ -440,7 +440,7 @@ putJSONUsingSchema typ json = case (typ, json) of where name = AE.toText key - lookupItemAndIndex :: Eq a => a -> [(a, b)] -> Maybe (b, Int) + lookupItemAndIndex :: (Eq a) => a -> [(a, b)] -> Maybe (b, Int) lookupItemAndIndex item thePairs = go item thePairs 0 where go _ [] _ = Nothing @@ -481,9 +481,9 @@ putJSONUsingSchema typ json = case (typ, json) of millis = numerator frac `div` denominator frac timeString = Text.unpack s --- |Wrapper for Concordium.Types.Amount that uses a little-endian encoding --- for binary serialization. Show and JSON instances are inherited from --- the Amount type. +-- | Wrapper for Concordium.Types.Amount that uses a little-endian encoding +-- for binary serialization. Show and JSON instances are inherited from +-- the Amount type. newtype AmountLE = AmountLE T.Amount deriving (Eq) deriving newtype (FromJSON, Show, ToJSON) diff --git a/src/Concordium/Client/Types/Contract/Schema.hs b/src/Concordium/Client/Types/Contract/Schema.hs index 0673ce24..9e6d9e32 100644 --- a/src/Concordium/Client/Types/Contract/Schema.hs +++ b/src/Concordium/Client/Types/Contract/Schema.hs @@ -53,26 +53,26 @@ import qualified Data.Vector as V import Data.Word (Word16, Word32, Word64, Word8) import GHC.Generics --- |Try to find an embedded schema in a module and decode it. +-- | Try to find an embedded schema in a module and decode it. decodeEmbeddedSchema :: Wasm.WasmModule -> Either String (Maybe ModuleSchema) decodeEmbeddedSchema = fmap fst . decodeEmbeddedSchemaAndExports --- |Decode a `ModuleSchema`. +-- | Decode a `ModuleSchema`. decodeModuleSchema :: Wasm.WasmVersion -> BS.ByteString -> Either String ModuleSchema decodeModuleSchema wasmVersion = S.runGet $ getModuleSchema wasmVersion --- |Decode a `ModuleSchema` that is explicitly versioned. +-- | Decode a `ModuleSchema` that is explicitly versioned. decodeVersionedModuleSchema :: BS.ByteString -> Either String ModuleSchema decodeVersionedModuleSchema = S.runGet getVersionedModuleSchema --- |Try to find an embedded schema and a list of exported function names and decode them. +-- | Try to find an embedded schema and a list of exported function names and decode them. decodeEmbeddedSchemaAndExports :: Wasm.WasmModule -> Either String (Maybe ModuleSchema, [Text]) decodeEmbeddedSchemaAndExports wasmModule = S.runGet (getEmbeddedSchemaAndExportsFromModule wasmVersion) moduleSource where moduleSource = Wasm.wasmSource wasmModule wasmVersion = Wasm.wasmVersion wasmModule --- |Lookup schema for the parameter of a function. +-- | Lookup schema for the parameter of a function. lookupParameterSchema :: ModuleSchema -> FuncName -> Maybe SchemaType lookupParameterSchema moduleSchema funcName = case moduleSchema of @@ -97,8 +97,8 @@ lookupParameterSchema moduleSchema funcName = contract <- Map.lookup contrName ms3ContractSchemas Map.lookup receiveName (cs3ReceiveSigs contract) >>= getParameterSchemaV2 --- |Lookup schema for the return value of a function. --- Always returns Nothing on V0 contracts as they do not have return values. +-- | Lookup schema for the return value of a function. +-- Always returns Nothing on V0 contracts as they do not have return values. lookupReturnValueSchema :: ModuleSchema -> FuncName -> Maybe SchemaType lookupReturnValueSchema moduleSchema funcName = case moduleSchema of @@ -119,8 +119,8 @@ lookupReturnValueSchema moduleSchema funcName = contrSchema <- Map.lookup contrName ms3ContractSchemas lookupFunctionSchemaV3 contrSchema funcName >>= getReturnValueSchemaV2 --- |Lookup schema for the error of a function. --- Always returns Nothing on schemas with version < 2 as they don't have error schemas. +-- | Lookup schema for the error of a function. +-- Always returns Nothing on schemas with version < 2 as they don't have error schemas. lookupErrorSchema :: ModuleSchema -> FuncName -> Maybe SchemaType lookupErrorSchema moduleSchema funcName = case moduleSchema of @@ -137,8 +137,8 @@ lookupErrorSchema moduleSchema funcName = contrSchema <- Map.lookup contrName ms3ContractSchemas lookupFunctionSchemaV3 contrSchema funcName >>= getErrorSchemaV2 --- |Lookup event schema for a contract --- Always returns Nothing on schemas with version < 3 as they don't have event schemas. +-- | Lookup event schema for a contract +-- Always returns Nothing on schemas with version < 3 as they don't have event schemas. lookupEventSchema :: ModuleSchema -> Text -> Maybe SchemaType lookupEventSchema moduleSchema contrName = case moduleSchema of @@ -147,27 +147,27 @@ lookupEventSchema moduleSchema contrName = ModuleSchemaV2{} -> Nothing ModuleSchemaV3{..} -> Map.lookup contrName ms3ContractSchemas >>= cs3EventSchema --- |Lookup the 'FunctionSchemaV1' of a 'ContractSchemaV1'. +-- | Lookup the 'FunctionSchemaV1' of a 'ContractSchemaV1'. lookupFunctionSchemaV1 :: ContractSchemaV1 -> FuncName -> Maybe FunctionSchemaV1 lookupFunctionSchemaV1 ContractSchemaV1{..} = \case InitFuncName _ -> cs1InitSig ReceiveFuncName _ rcvName -> Map.lookup rcvName cs1ReceiveSigs --- |Lookup the 'FunctionSchemaV2' of a 'ContractSchemaV2'. +-- | Lookup the 'FunctionSchemaV2' of a 'ContractSchemaV2'. lookupFunctionSchemaV2 :: ContractSchemaV2 -> FuncName -> Maybe FunctionSchemaV2 lookupFunctionSchemaV2 ContractSchemaV2{..} = \case InitFuncName _ -> cs2InitSig ReceiveFuncName _ rcvName -> Map.lookup rcvName cs2ReceiveSigs --- |Look up either the schema of an init or a receive function. +-- | Look up either the schema of an init or a receive function. lookupFunctionSchemaV3 :: ContractSchemaV3 -> FuncName -> Maybe FunctionSchemaV2 lookupFunctionSchemaV3 ContractSchemaV3{..} = \case InitFuncName _ -> cs3InitSig ReceiveFuncName _ rcvName -> Map.lookup rcvName cs3ReceiveSigs --- |Represents the schema for a module. --- V0 is a parallel to `Module` defined in concordium-contracts-common version <= 2. --- V1 is a parallel to `Module` defined in concordium-contracts-common version > 2. +-- | Represents the schema for a module. +-- V0 is a parallel to `Module` defined in concordium-contracts-common version <= 2. +-- V1 is a parallel to `Module` defined in concordium-contracts-common version > 2. data ModuleSchema = ModuleSchemaV0 {ms0ContractSchemas :: Map Text ContractSchemaV0} | ModuleSchemaV1 {ms1ContractSchemas :: Map Text ContractSchemaV1} @@ -175,9 +175,9 @@ data ModuleSchema | ModuleSchemaV3 {ms3ContractSchemas :: Map Text ContractSchemaV3} deriving (Eq, Show, Generic) --- |Create a getter based on the wasm version. --- Will first attempt to parse the module schema as versioned and if it fails, --- it will attempt parsing based on the wasmVersion. +-- | Create a getter based on the wasm version. +-- Will first attempt to parse the module schema as versioned and if it fails, +-- it will attempt parsing based on the wasmVersion. getModuleSchema :: Wasm.WasmVersion -> S.Get ModuleSchema getModuleSchema wasmVersion = S.label "ModuleSchema" $ do prefix :: Word16 <- S.lookAhead S.get @@ -185,7 +185,7 @@ getModuleSchema wasmVersion = S.label "ModuleSchema" $ do then getVersionedModuleSchema else getUnversionedModuleSchema wasmVersion --- |Getter for module schema with magic prefix and version. +-- | Getter for module schema with magic prefix and version. getVersionedModuleSchema :: S.Get ModuleSchema getVersionedModuleSchema = S.label "ModuleSchema" $ do prefix :: Word16 <- S.get @@ -200,15 +200,15 @@ getVersionedModuleSchema = S.label "ModuleSchema" $ do 3 -> ModuleSchemaV3 <$> getMapOfWithSizeLen Four getText S.get v -> fail $ "Unsupported schema version: " ++ show v --- |Create a getter based on the wasm version. +-- | Create a getter based on the wasm version. getUnversionedModuleSchema :: Wasm.WasmVersion -> S.Get ModuleSchema getUnversionedModuleSchema wasmVersion = S.label "ModuleSchema" $ case wasmVersion of Wasm.V0 -> ModuleSchemaV0 <$> getMapOfWithSizeLen Four getText S.get Wasm.V1 -> ModuleSchemaV1 <$> getMapOfWithSizeLen Four getText S.get --- |Function signatures of a smart contract with event schema V0. --- Parallel to schema::ContractV0 defined in concordium-contracts-common (Rust) version <= 2. +-- | Function signatures of a smart contract with event schema V0. +-- Parallel to schema::ContractV0 defined in concordium-contracts-common (Rust) version <= 2. data ContractSchemaV0 = -- | Describes the schemas of a V0 smart contract. ContractSchemaV0 @@ -223,8 +223,8 @@ data ContractSchemaV0 instance AE.ToJSON ContractSchemaV0 --- |Function signatures of a smart contract with event schema V1. --- Parallel to schema::ContractV1 defined in concordium-contracts-common (Rust) version > 2. +-- | Function signatures of a smart contract with event schema V1. +-- Parallel to schema::ContractV1 defined in concordium-contracts-common (Rust) version > 2. data ContractSchemaV1 = -- | Describes the schemas of a V1 smart contract. ContractSchemaV1 @@ -237,8 +237,8 @@ data ContractSchemaV1 instance AE.ToJSON ContractSchemaV1 --- |Function signatures of a smart contract with event schema V2. --- Parallel to schema::ContractV2 defined in concordium-contracts-common (Rust) version > 2. +-- | Function signatures of a smart contract with event schema V2. +-- Parallel to schema::ContractV2 defined in concordium-contracts-common (Rust) version > 2. data ContractSchemaV2 = -- | Describes the schemas of a V1 smart contract. ContractSchemaV2 @@ -251,8 +251,8 @@ data ContractSchemaV2 instance AE.ToJSON ContractSchemaV2 --- |Function and event signatures of a smart contract with event schema V3. --- Parallel to schema::ContractV3 defined in concordium-contracts-common (Rust) version >= 5. +-- | Function and event signatures of a smart contract with event schema V3. +-- Parallel to schema::ContractV3 defined in concordium-contracts-common (Rust) version >= 5. data ContractSchemaV3 = -- | Describes the schemas of a V1 smart contract. ContractSchemaV3 @@ -297,9 +297,9 @@ instance S.Serialize ContractSchemaV3 where pure ContractSchemaV3{..} put ContractSchemaV3{..} = S.put cs3InitSig <> putMapOfWithSizeLen Four putText S.put cs3ReceiveSigs --- |V1 Schema for a function in a V1 smart contract. --- Can contain a schema for the parameter, return value, or both. --- Parallel to the schema::FunctionV1 defined in concordium-contract-common (Rust). +-- | V1 Schema for a function in a V1 smart contract. +-- Can contain a schema for the parameter, return value, or both. +-- Parallel to the schema::FunctionV1 defined in concordium-contract-common (Rust). data FunctionSchemaV1 = Parameter SchemaType | ReturnValue SchemaType @@ -311,14 +311,14 @@ data FunctionSchemaV1 instance AE.ToJSON FunctionSchemaV1 --- |Try to get the parameter schema of a FunctionSchemaV1. +-- | Try to get the parameter schema of a FunctionSchemaV1. getParameterSchemaV1 :: FunctionSchemaV1 -> Maybe SchemaType getParameterSchemaV1 = \case Parameter schemaType -> Just schemaType ReturnValue _ -> Nothing Both{..} -> Just fs1Parameter --- |Try to get the return value schema of a FunctionSchemaV1. +-- | Try to get the return value schema of a FunctionSchemaV1. getReturnValueSchemaV1 :: FunctionSchemaV1 -> Maybe SchemaType getReturnValueSchemaV1 = \case Parameter _ -> Nothing @@ -341,9 +341,9 @@ instance S.Serialize FunctionSchemaV1 where ReturnValue schemaType -> S.putWord8 1 <> S.put schemaType Both{..} -> S.putWord8 2 <> S.put fs1Parameter <> S.put fs1ReturnValue --- |V2 Schema for a function in a V1 smart contract. --- Can contain a schema for the parameter, return value, error, or a combination of these. --- Parallel to the schema::FunctionV2 defined in concordium-contract-common (Rust). +-- | V2 Schema for a function in a V1 smart contract. +-- Can contain a schema for the parameter, return value, error, or a combination of these. +-- Parallel to the schema::FunctionV2 defined in concordium-contract-common (Rust). data FunctionSchemaV2 = Param SchemaType | Rv SchemaType @@ -367,24 +367,24 @@ data FunctionSchemaV2 } deriving (Eq, Show, Generic) --- |V3 Schema for events in a V1 smart contract. +-- | V3 Schema for events in a V1 smart contract. type EventSchemaV3 = SchemaType instance AE.ToJSON FunctionSchemaV2 --- |Try to get the parameter schema of a FunctionSchemaV2. +-- | Try to get the parameter schema of a FunctionSchemaV2. getParameterSchemaV2 :: FunctionSchemaV2 -> Maybe SchemaType getParameterSchemaV2 fs = let (param, _, _) = getMaybeSchemas fs in param --- |Try to get the return value schema of a FunctionSchemaV2. +-- | Try to get the return value schema of a FunctionSchemaV2. getReturnValueSchemaV2 :: FunctionSchemaV2 -> Maybe SchemaType getReturnValueSchemaV2 fs = let (_, rv, _) = getMaybeSchemas fs in rv --- |Try to get the error schema of a FunctionSchemaV2. +-- | Try to get the error schema of a FunctionSchemaV2. getErrorSchemaV2 :: FunctionSchemaV2 -> Maybe SchemaType getErrorSchemaV2 fs = let (_, _, err) = getMaybeSchemas fs in err --- |Get the schemas for parameter, return value, and error as a triple of Maybes. +-- | Get the schemas for parameter, return value, and error as a triple of Maybes. getMaybeSchemas :: FunctionSchemaV2 -> (Maybe SchemaType, Maybe SchemaType, Maybe SchemaType) getMaybeSchemas = \case Param param -> (Just param, Nothing, Nothing) @@ -429,8 +429,8 @@ instance S.Serialize FunctionSchemaV2 where RvError{..} -> S.putWord8 5 <> S.put fs2ReturnValue <> S.put fs2Error ParamRvError{..} -> S.putWord8 6 <> S.put fs2Parameter <> S.put fs2ReturnValue <> S.put fs2Error --- |Parallel to Fields defined in contracts-common (Rust). --- Must stay in sync. +-- | Parallel to Fields defined in contracts-common (Rust). +-- Must stay in sync. data Fields = -- | Represents a named enum or struct. Named [(Text, SchemaType)] @@ -461,8 +461,8 @@ instance S.Serialize Fields where Unnamed types -> S.putWord8 1 <> putListOfWithSizeLen Four S.put types None -> S.putWord8 2 --- |Parallel to Type defined in contracts-common (Rust). --- Must stay in sync. +-- | Parallel to Type defined in contracts-common (Rust). +-- Must stay in sync. data SchemaType = Unit | Bool @@ -500,14 +500,14 @@ data SchemaType instance Hashable SchemaType --- |This should _mostly_ match the format used in `getJSONUsingSchema` so the --- user can copy this and use it for creating a parameter file in json format. --- It differs from the expected parameter format in the following ways: --- - Enums are shown with all of its variants in a list, --- but only one variant should be used in the parameter file. --- - All placeholders are surrounded with <> and shown as strings, --- even when the expected value is not a string. --- For example: "" which should be replaced with an unquoted number. +-- | This should _mostly_ match the format used in `getJSONUsingSchema` so the +-- user can copy this and use it for creating a parameter file in json format. +-- It differs from the expected parameter format in the following ways: +-- - Enums are shown with all of its variants in a list, +-- but only one variant should be used in the parameter file. +-- - All placeholders are surrounded with <> and shown as strings, +-- even when the expected value is not a string. +-- For example: "" which should be replaced with an unquoted number. instance AE.ToJSON SchemaType where toJSON = \case Unit -> AE.Array . V.fromList $ [] @@ -630,8 +630,8 @@ instance S.Serialize SchemaType where ByteArray sl -> S.putWord8 30 <> S.putWord32le sl TaggedEnum m -> S.putWord8 31 <> putMapOfWithSizeLen Four S.putWord8 (S.putTwoOf putText S.put) m --- |Parallel to SizeLength defined in contracts-common (Rust). --- Must stay in sync. +-- | Parallel to SizeLength defined in contracts-common (Rust). +-- Must stay in sync. data SizeLength = One | Two @@ -663,7 +663,7 @@ instance S.Serialize SizeLength where Four -> S.putWord8 2 Eight -> S.putWord8 3 --- |A function name for a function inside a smart contract. +-- | A function name for a function inside a smart contract. data FuncName = -- | Name of an init function. InitFuncName !Text @@ -671,8 +671,8 @@ data FuncName ReceiveFuncName !Text !Text deriving (Eq) --- |Try to find and decode an embedded `ModuleSchema` and a list of exported function --- names from inside a Wasm module. +-- | Try to find and decode an embedded `ModuleSchema` and a list of exported function +-- names from inside a Wasm module. getEmbeddedSchemaAndExportsFromModule :: Wasm.WasmVersion -> S.Get (Maybe ModuleSchema, [Text]) getEmbeddedSchemaAndExportsFromModule wasmVersion = do mhBs <- S.getByteString 4 @@ -783,7 +783,7 @@ getEmbeddedSchemaAndExportsFromModule wasmVersion = do wasmSpecVersion :: BS.ByteString wasmSpecVersion = BS.pack [0x01, 0x00, 0x00, 0x00] --- |The four types of exports allowed in WASM. +-- | The four types of exports allowed in WASM. data ExportDescription = Func | Table @@ -825,7 +825,7 @@ putLenWithSizeLen sl len = case sl of -- * Map * --- |Get a map with a specified size length. Fails if the predicate is false when applied to the list of tuples in the map. +-- | Get a map with a specified size length. Fails if the predicate is false when applied to the list of tuples in the map. getMapOfWithSizeLenAndPred :: (Ord k) => ([(k, v)] -> Bool) -> SizeLength -> S.Get k -> S.Get v -> S.Get (Map k v) getMapOfWithSizeLenAndPred p sl gt gv = do ls <- getListOfWithSizeLen sl (S.getTwoOf gt gv) @@ -833,11 +833,11 @@ getMapOfWithSizeLenAndPred p sl gt gv = do then S.label "Map" $ pure $ Map.fromList ls else fail "Predicate failed in deserialization of map." --- |Get a map with a specified size length. +-- | Get a map with a specified size length. getMapOfWithSizeLen :: (Ord k) => SizeLength -> S.Get k -> S.Get v -> S.Get (Map k v) getMapOfWithSizeLen = getMapOfWithSizeLenAndPred (const True) --- |Put a map with a specified size length. +-- | Put a map with a specified size length. putMapOfWithSizeLen :: SizeLength -> S.Putter k -> S.Putter v -> S.Putter (Map k v) putMapOfWithSizeLen sl pv pk = putListOfWithSizeLen sl (S.putTwoOf pv pk) . Map.toList diff --git a/src/Concordium/Client/Types/Transaction.hs b/src/Concordium/Client/Types/Transaction.hs index 450e07f3..ac89e661 100644 --- a/src/Concordium/Client/Types/Transaction.hs +++ b/src/Concordium/Client/Types/Transaction.hs @@ -31,12 +31,12 @@ minimumCost psize numSigs = Cost.baseCost totalSize numSigs -- the total size of the transaction. The +1 is for the payload tag. totalSize = fromIntegral psize + Types.transactionHeaderSize --- |Cost of a simple transfer transaction. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost of a simple transfer transaction. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost simpleTransferEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy simpleTransferEnergyCost psize numSigs = minimumCost psize numSigs + Cost.simpleTransferCost @@ -44,12 +44,12 @@ simpleTransferEnergyCost psize numSigs = minimumCost psize numSigs + Cost.simple simpleTransferPayloadSize :: PayloadSize simpleTransferPayloadSize = 41 --- |Cost of an encrypted transfer transaction. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost of an encrypted transfer transaction. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost encryptedTransferEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy encryptedTransferEnergyCost psize numSigs = minimumCost psize numSigs + Cost.encryptedTransferCost @@ -57,10 +57,10 @@ encryptedTransferEnergyCost psize numSigs = minimumCost psize numSigs + Cost.enc encryptedTransferPayloadSize :: PayloadSize encryptedTransferPayloadSize = 2617 --- |Cost of updating the account keys. --- This must be kept in sync with Concordium.Scheduler.Cost +-- | Cost of updating the account keys. +-- This must be kept in sync with Concordium.Scheduler.Cost accountUpdateKeysEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> -- | The number of credentials on the account at the time of the update. Int -> @@ -71,8 +71,8 @@ accountUpdateKeysEnergyCost :: Energy accountUpdateKeysEnergyCost psize credentialCount keyCount numSigs = minimumCost psize numSigs + Cost.updateCredentialKeysCost credentialCount keyCount --- |Cost of updating the credentials. --- This must be kept in sync with Concordium.Scheduler.Cost +-- | Cost of updating the credentials. +-- This must be kept in sync with Concordium.Scheduler.Cost accountUpdateCredentialsEnergyCost :: -- | Size of the entire payload PayloadSize -> @@ -85,51 +85,51 @@ accountUpdateCredentialsEnergyCost :: Energy accountUpdateCredentialsEnergyCost psize credentialCount keyCountList numSigs = minimumCost psize numSigs + Cost.updateCredentialsCost credentialCount keyCountList --- |Cost of a baker add transaction. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost of a baker add transaction. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost bakerAddEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy bakerAddEnergyCost psize numSigs = minimumCost psize numSigs + Cost.addBakerCost --- |Cost of a baker configure transaction without keys. +-- | Cost of a baker configure transaction without keys. bakerConfigureEnergyCostWithoutKeys :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy bakerConfigureEnergyCostWithoutKeys psize numSigs = minimumCost psize numSigs + Cost.configureBakerCostWithoutKeys --- |Cost of a baker configure transaction with keys. +-- | Cost of a baker configure transaction with keys. bakerConfigureEnergyCostWithKeys :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy bakerConfigureEnergyCostWithKeys psize numSigs = minimumCost psize numSigs + Cost.configureBakerCostWithKeys --- |The payload size of a configure baker transaction. +-- | The payload size of a configure baker transaction. bakerConfigurePayloadSize :: - -- |Capital + -- | Capital Bool -> - -- |Restake earnings + -- | Restake earnings Bool -> - -- |Pool open status + -- | Pool open status Bool -> - -- |Keys + -- | Keys Bool -> - -- |Metadata length + -- | Metadata length Maybe Int -> - -- |Transaction fee commission + -- | Transaction fee commission Bool -> - -- |Baking reward commission + -- | Baking reward commission Bool -> - -- |Finalization reward commission + -- | Finalization reward commission Bool -> PayloadSize bakerConfigurePayloadSize hasCapital hasRestake hasPoolOpen hasKeys mMetadata hasTCom hasBCom hasFCom = @@ -143,72 +143,72 @@ bakerConfigurePayloadSize hasCapital hasRestake hasPoolOpen hasKeys mMetadata ha + (if hasBCom then 4 else 0) + (if hasFCom then 4 else 0) --- |Cost of a baker set account transaction. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost of a baker set account transaction. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost bakerSetKeysEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy bakerSetKeysEnergyCost psize numSigs = minimumCost psize numSigs + Cost.updateBakerKeysCost --- |Cost of a baker remove transaction. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost of a baker remove transaction. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost bakerRemoveEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy bakerRemoveEnergyCost psize numSigs = minimumCost psize numSigs + Cost.removeBakerCost --- |Cost to update a baker's stake. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost to update a baker's stake. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost bakerUpdateStakeEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy bakerUpdateStakeEnergyCost psize numSigs = minimumCost psize numSigs + Cost.updateBakerStakeCost --- |Cost to update a baker's re-staking option. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost to update a baker's re-staking option. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost bakerUpdateRestakeEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy bakerUpdateRestakeEnergyCost psize numSigs = minimumCost psize numSigs + Cost.updateBakerRestakeCost --- |Cost of a delegation configure transaction. +-- | Cost of a delegation configure transaction. delegationConfigureEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy delegationConfigureEnergyCost psize numSigs = minimumCost psize numSigs + Cost.configureDelegationCost --- |Payload size for a register delegation transaction +-- | Payload size for a register delegation transaction registerDelegationPayloadSize :: - -- |Whether delegation is passive + -- | Whether delegation is passive Bool -> PayloadSize registerDelegationPayloadSize True = 13 registerDelegationPayloadSize False = 21 --- |Payload size for an update delegation transaction +-- | Payload size for an update delegation transaction updateDelegationPayloadSize :: - -- |Whether the amount is updated + -- | Whether the amount is updated Bool -> - -- |Whether the restake is updated + -- | Whether the restake is updated Bool -> - -- |Whether the target is updated + -- | Whether the target is updated Bool -> - -- |Whether the target is passive delegation + -- | Whether the target is passive delegation Bool -> PayloadSize updateDelegationPayloadSize updAmt updRestake updTarget targetPassiveDelegation = 3 + amt + restake + target @@ -217,16 +217,16 @@ updateDelegationPayloadSize updAmt updRestake updTarget targetPassiveDelegation restake = if updRestake then 1 else 0 target = if updTarget then (if targetPassiveDelegation then 1 else 9) else 0 --- |Payload size for a remove delegation transaction +-- | Payload size for a remove delegation transaction removeDelegationPayloadSize :: PayloadSize removeDelegationPayloadSize = 11 --- |Cost of moving funds from public to encrypted amount of an account. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost of moving funds from public to encrypted amount of an account. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost accountEncryptEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy accountEncryptEnergyCost psize numSigs = minimumCost psize numSigs + Cost.transferToEncryptedCost @@ -234,12 +234,12 @@ accountEncryptEnergyCost psize numSigs = minimumCost psize numSigs + Cost.transf accountEncryptPayloadSize :: PayloadSize accountEncryptPayloadSize = 9 --- |Cost of moving funds from encrypted to public balance of an account. --- This must be kept in sync with the cost in Concordium.Scheduler.Cost +-- | Cost of moving funds from encrypted to public balance of an account. +-- This must be kept in sync with the cost in Concordium.Scheduler.Cost accountDecryptEnergyCost :: - -- |Size of the payload + -- | Size of the payload PayloadSize -> - -- |Number of signatures + -- | Number of signatures Int -> Energy accountDecryptEnergyCost psize numSigs = minimumCost psize numSigs + Cost.transferToPublicCost @@ -247,13 +247,13 @@ accountDecryptEnergyCost psize numSigs = minimumCost psize numSigs + Cost.transf accountDecryptPayloadSize :: PayloadSize accountDecryptPayloadSize = 1405 --- |The cost of transfer with schedule. +-- | The cost of transfer with schedule. transferWithScheduleEnergyCost :: - -- |Size of the payload. + -- | Size of the payload. PayloadSize -> -- | Number of releases. Int -> - -- |Number of signatures. + -- | Number of signatures. Int -> Energy transferWithScheduleEnergyCost psize numRels numSigs = minimumCost psize numSigs + Cost.scheduledTransferCost numRels @@ -264,17 +264,17 @@ transferWithSchedulePayloadSize :: PayloadSize transferWithSchedulePayloadSize numRels = 32 + 1 + 1 + fromIntegral numRels * 16 --- |Transaction header type --- To be populated when deserializing a JSON object. +-- | Transaction header type +-- To be populated when deserializing a JSON object. data TransactionJSONHeader = TransactionJSONHeader - { -- |Address of the sender. + { -- | Address of the sender. thSenderAddress :: IDTypes.AccountAddress, - -- |Nonce of the account. If not present it should be derived - -- from the context or queried to the state + -- | Nonce of the account. If not present it should be derived + -- from the context or queried to the state thNonce :: Maybe Nonce, - -- |Amount dedicated for the execution of this transaction. + -- | Amount dedicated for the execution of this transaction. thEnergyAmount :: Energy, - -- |Absolute time after which transaction will not be executed. + -- | Absolute time after which transaction will not be executed. thExpiry :: TransactionExpiryTime } deriving (Eq, Show) @@ -284,7 +284,7 @@ data ModuleSource | FromSource Text deriving (Eq, Show) --- |Payload of a transaction +-- | Payload of a transaction data TransactionJSONPayload = -- | Deploys a blockchain-ready version of the module, as retrieved from the Context DeployModule @@ -311,11 +311,11 @@ data TransactionJSONPayload } | RemoveBaker | TransferToEncrypted - { -- |Amount to transfer from public to encrypted balance of the account. + { -- | Amount to transfer from public to encrypted balance of the account. tteAmount :: !Amount } | TransferToPublic - { -- |Amount the user wishes to transfer to the public balance. + { -- | Amount the user wishes to transfer to the public balance. ttpData :: !SecToPubAmountTransferData } | EncryptedAmountTransfer @@ -331,7 +331,7 @@ AETH.deriveFromJSON ) ''TransactionJSONPayload --- |Transaction as retrieved from a JSON object +-- | Transaction as retrieved from a JSON object data TransactionJSON = TransactionJSON { metadata :: TransactionJSONHeader, payload :: TransactionJSONPayload, diff --git a/src/Concordium/Client/Types/TransactionStatus.hs b/src/Concordium/Client/Types/TransactionStatus.hs index 17559f7a..75398d42 100644 --- a/src/Concordium/Client/Types/TransactionStatus.hs +++ b/src/Concordium/Client/Types/TransactionStatus.hs @@ -29,10 +29,10 @@ data TransactionStatusResult' a = TransactionStatusResult type TransactionStatusResult = TransactionStatusResult' ValidResult --- |Convert a @TransactionStatus@ instance into a @TransactionStatusResult@ instance. --- Returns a @Left@ wrapping an error message if either the transaction summary contained in the --- input is @Nothing@, or the input is of variant @Committed@ or @Finalized@. Returns a @Right@ --- wrapping the corresponding @TransactionStatusResult@ otherwise. +-- | Convert a @TransactionStatus@ instance into a @TransactionStatusResult@ instance. +-- Returns a @Left@ wrapping an error message if either the transaction summary contained in the +-- input is @Nothing@, or the input is of variant @Committed@ or @Finalized@. Returns a @Right@ +-- wrapping the corresponding @TransactionStatusResult@ otherwise. transactionStatusToTransactionStatusResult :: Queries.TransactionStatus -> Either String TransactionStatusResult transactionStatusToTransactionStatusResult tStatus = do (tsrState, tsrResults) <- do @@ -59,14 +59,14 @@ transactionStatusToTransactionStatusResult tStatus = do where err bh = Left $ "Transaction summary missing for blockhash '" <> show bh <> "'." -instance FromJSON a => FromJSON (TransactionStatusResult' a) where +instance (FromJSON a) => FromJSON (TransactionStatusResult' a) where parseJSON Null = return TransactionStatusResult{tsrState = Absent, tsrResults = Map.empty} parseJSON v = flip (withObject "Transaction status") v $ \obj -> do tsrState <- obj .: "status" tsrResults <- obj .:? "outcomes" .!= Map.empty return $ TransactionStatusResult{..} -instance ToJSON a => ToJSON (TransactionStatusResult' a) where +instance (ToJSON a) => ToJSON (TransactionStatusResult' a) where toJSON TransactionStatusResult{..} = object $ ("status" .= tsrState) : mapObject where diff --git a/src/Concordium/Client/Utils.hs b/src/Concordium/Client/Utils.hs index 713b9caf..f2c8abfb 100644 --- a/src/Concordium/Client/Utils.hs +++ b/src/Concordium/Client/Utils.hs @@ -19,18 +19,18 @@ import Text.Read -- | In the 'Left' case of an 'Either', transform the error using the given function and -- "rethrow" it in the current 'MonadError'. -embedErr :: MonadError e m => Either e' a -> (e' -> e) -> m a +embedErr :: (MonadError e m) => Either e' a -> (e' -> e) -> m a embedErr (Left x) f = throwError (f x) embedErr (Right a) _ = return a -- | In the 'Left' case of an 'Either', transform the error using the given function and -- "rethrow" it in the current 'MonadError'. -failWith :: MonadError e m => m (Either e' a) -> (e' -> e) -> m a +failWith :: (MonadError e m) => m (Either e' a) -> (e' -> e) -> m a failWith act f = act >>= flip embedErr f --- |Like 'failWith', but use MonadFail and just fail with the given message --- without tranforming it. -failOnError :: MonadFail m => m (Either String a) -> m a +-- | Like 'failWith', but use MonadFail and just fail with the given message +-- without tranforming it. +failOnError :: (MonadFail m) => m (Either String a) -> m a failOnError act = act >>= \case @@ -48,9 +48,9 @@ embedErrIOM action f = do v <- action v `embedErrIO` f --- |Try to parse an amount from a string, and if failing, try to inform the user --- what the expected format is. This is intended to be used by the options --- parsers. +-- | Try to parse an amount from a string, and if failing, try to inform the user +-- what the expected format is. This is intended to be used by the options +-- parsers. amountFromStringInform :: String -> Either String Amount amountFromStringInform s = case amountFromString s of @@ -63,9 +63,9 @@ amountFractionFromStringInform s = Just a -> Right a Nothing -> Left $ "Invalid decimal fraction '" ++ s ++ "'. A decimal fractions must be a decimal number n.m between 0 and 1 (both inclusive), and with at most 5 digits of precision." --- |Try to parse a KeyIndex from a string, and if failing, try to inform the user --- what the expected format is. This is intended to be used by the options --- parsers. +-- | Try to parse a KeyIndex from a string, and if failing, try to inform the user +-- what the expected format is. This is intended to be used by the options +-- parsers. indexFromStringInform :: String -> Either String IDTypes.KeyIndex indexFromStringInform s = case readMaybe s :: Maybe Integer of @@ -74,18 +74,18 @@ indexFromStringInform s = where errString = "Invalid KeyIndex. A KeyIndex must be an integer between 0 and 255 inclusive." --- |Try to parse a credential id from string, and if failing, try to inform the user --- what the expected format is. This is intended to be used by the options --- parsers. +-- | Try to parse a credential id from string, and if failing, try to inform the user +-- what the expected format is. This is intended to be used by the options +-- parsers. credIdFromStringInform :: String -> Either String IDTypes.CredentialRegistrationID credIdFromStringInform s = case deserializeBase16 (Text.pack s) of Just a -> Right a Nothing -> Left $ "Invalid credential registration ID." --- |Try to parse `Energy` from a string, and, if failing, inform the user --- what the expected format and bounds are. --- This is intended to be used by the options parsers. +-- | Try to parse `Energy` from a string, and, if failing, inform the user +-- what the expected format and bounds are. +-- This is intended to be used by the options parsers. energyFromStringInform :: String -> Either String Energy energyFromStringInform s = -- Reading negative numbers directly to Energy (i.e. Word64) silently underflows, so this approach is necessary. @@ -100,9 +100,9 @@ energyFromStringInform s = nrgMinBound = 0 nrgMaxBound = fromIntegral (maxBound :: Energy) --- |Try to parse an account alias counter from a string, and, if failing, inform --- the user what the expected format and bounds are. This is intended to be used --- by the options parsers. +-- | Try to parse an account alias counter from a string, and, if failing, inform +-- the user what the expected format and bounds are. This is intended to be used +-- by the options parsers. aliasFromStringInform :: String -> Either String Word aliasFromStringInform s = -- Reading negative numbers directly to Word silently underflows, so this approach is necessary. @@ -117,7 +117,7 @@ aliasFromStringInform s = aliasMinBound = 0 aliasMaxBound = 2 ^ (8 * (IDTypes.accountAddressSize - accountAddressPrefixSize)) - 1 --- |Try to parse the signature threshold from string with a meaningful error message if unsuccessful. +-- | Try to parse the signature threshold from string with a meaningful error message if unsuccessful. thresholdFromStringInform :: String -> Either String IDTypes.SignatureThreshold thresholdFromStringInform s = case readMaybe s :: Maybe Integer of @@ -126,7 +126,7 @@ thresholdFromStringInform s = where errString = "Invalid signature threshold. A signature threshold must be an integer between 1 and 255 inclusive." --- |Try to parse the account threshold from string with a meaningful error message if unsuccessful. +-- | Try to parse the account threshold from string with a meaningful error message if unsuccessful. accountThresholdFromStringInform :: String -> Either String IDTypes.AccountThreshold accountThresholdFromStringInform s = case readMaybe s :: Maybe Integer of @@ -135,7 +135,7 @@ accountThresholdFromStringInform s = where errString = "Invalid account threshold. A signature threshold must be an integer between 1 and 255 inclusive." --- |Try to parse the credential index +-- | Try to parse the credential index credentialIndexFromStringInform :: String -> Either String IDTypes.CredentialIndex credentialIndexFromStringInform s = case readMaybe s :: Maybe Integer of @@ -145,7 +145,7 @@ credentialIndexFromStringInform s = | otherwise -> Left "Credential index must be non-negative." Nothing -> Left "Credential index must be an integer between 0 and 255 (inclusive)." --- |Try to parse a WasmVersion. +-- | Try to parse a WasmVersion. contractVersionFromStringInform :: String -> Either String Wasm.WasmVersion contractVersionFromStringInform s = case s of @@ -171,11 +171,11 @@ hrInMs = 60 * minInMs dayInMs :: Word64 dayInMs = 24 * hrInMs --- |Convert a duration in milliseconds into text with a list of duration measures separated by a space. --- A measure is a non-negative integer followed by the unit (with no whitespace in between). --- The support units are: days (d), hours (h), minutes (m), seconds (s), milliseconds (ms). --- Measures that are 0 are omitted from the output (see example, where 'd' and 'ms' are omitted). --- Example: 5022000 -> "1h 23m 42s". +-- | Convert a duration in milliseconds into text with a list of duration measures separated by a space. +-- A measure is a non-negative integer followed by the unit (with no whitespace in between). +-- The support units are: days (d), hours (h), minutes (m), seconds (s), milliseconds (ms). +-- Measures that are 0 are omitted from the output (see example, where 'd' and 'ms' are omitted). +-- Example: 5022000 -> "1h 23m 42s". durationToText :: Word64 -> Text.Text durationToText t = Text.intercalate " " . mapMaybe showTimeUnit $ @@ -193,12 +193,12 @@ durationToText t = then Nothing else Just [i|#{value}#{unit}|] --- |Parse a string containing a list of duration measures separated by --- spaces. A measure is a non-negative integer followed by a unit (no whitespace is allowed in between). --- Every measure is accumulated into a duration. The string is allowed to contain --- any number of measures with the same unit in no particular order. --- The support units are: days (d), hours (h), minutes (m), seconds (s), milliseconds (ms). --- Example: "1d 2h 3m 2d 1h" -> Right 270180000 +-- | Parse a string containing a list of duration measures separated by +-- spaces. A measure is a non-negative integer followed by a unit (no whitespace is allowed in between). +-- Every measure is accumulated into a duration. The string is allowed to contain +-- any number of measures with the same unit in no particular order. +-- The support units are: days (d), hours (h), minutes (m), seconds (s), milliseconds (ms). +-- Example: "1d 2h 3m 2d 1h" -> Right 270180000 textToDuration :: Text.Text -> Either String Word64 textToDuration t = mapM measureToMs measures >>= Right . sum where diff --git a/test/SimpleClientTests/BackupSpec.hs b/test/SimpleClientTests/BackupSpec.hs index 189108ba..f9608b8c 100644 --- a/test/SimpleClientTests/BackupSpec.hs +++ b/test/SimpleClientTests/BackupSpec.hs @@ -41,7 +41,7 @@ someCredId = (error "unable to decode") $ AE.decode "\"96f89a557352b0aa7596b12f3ccf4cc5973066e31e2c57a8b9dc096fdcff6dd8967e27a7a6e9d41fcc0d553b62650148\"" --- |dummy accountconfig, for testing export/import +-- | dummy accountconfig, for testing export/import exampleAccountConfigWithKeysAndName :: AccountConfig exampleAccountConfigWithKeysAndName = AccountConfig