-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Interface to the @tezos-client@ executable expressed in Haskell types.

module Morley.Client.TezosClient.Impl
  ( TezosClientError (..)

  -- * @tezos-client@ api
  , signBytes
  , waitForOperationInclusion
  , rememberContract
  , importKey
  , genKey
  , genFreshKey
  , revealKey
  , resolveAddressMaybe
  , resolveAddress
  , getAlias
  , getPublicKey
  , getTezosClientConfig
  , calcTransferFee
  , calcOriginationFee
  , calcRevealFee
  , getKeyPassword
  , registerDelegate

  -- * Internals
  , callTezosClient
  , callTezosClientStrict
  , prefixName
  , prefixNameM
  ) where

import Unsafe qualified ((!!))

import Colourista (formatWith, red)
import Control.Exception (IOException, throwIO)
import Data.Aeson (eitherDecodeStrict, encode)
import Data.ByteArray (ScrubbedBytes)
import Data.ByteString.Lazy.Char8 qualified as C (unpack)
import Data.Text qualified as T
import Fmt (Buildable(..), pretty, (+|), (|+))
import System.Exit (ExitCode(..))
import System.Process (readProcessWithExitCode)
import Text.Printf (printf)
import UnliftIO.IO (hGetEcho, hSetEcho)

import Lorentz.Value
import Morley.Client.Logging
import Morley.Client.RPC.Types
import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(resolveAddressMaybe))
import Morley.Client.TezosClient.Parser
import Morley.Client.TezosClient.Types
import Morley.Client.Util (readScrubbedBytes, scrubbedBytesToString)
import Morley.Micheline
import Morley.Michelson.Typed.Scope
import Morley.Tezos.Address
import Morley.Tezos.Crypto
import Morley.Util.Peano
import Morley.Util.SizedList.Types

----------------------------------------------------------------------------
-- Errors
----------------------------------------------------------------------------

-- | A data type for all /predicatable/ errors that can happen during
-- @tezos-client@ usage.
data TezosClientError =
    UnexpectedClientFailure
    -- ^ @tezos-client@ call unexpectedly failed (returned non-zero exit code).
    -- The error contains the error code, stdout and stderr contents.
      Int -- ^ Exit code
      Text -- ^ stdout
      Text -- ^ stderr

  -- These errors represent specific known scenarios.
  | UnknownAddressAlias
    -- ^ Could not find an address with given name.
      Alias -- ^ Name of address which is eventually used
  | UnknownAddress
    -- ^ Could not find an address.
      Address -- ^ Address that is not present in local tezos cache
  | AlreadyRevealed
    -- ^ Public key of the given address is already revealed.
      Alias -- ^ Address alias that has already revealed its key
  | InvalidOperationHash
    -- ^ Can't wait for inclusion of operation with given hash because
    -- the hash is invalid.
      OperationHash
  | CounterIsAlreadyUsed
    -- ^ Error that indicates when given counter is already used for
    -- given contract.
    Text -- ^ Raw counter
    Text -- ^ Raw address
  | EConnreset
    -- ^ Network error with which @tezos-client@ fails from time to time.

  -- Note: the errors below most likely indicate that something is wrong in our code.
  -- Maybe we made a wrong assumption about tezos-client or just didn't consider some case.
  -- Another possible reason that a broken tezos-client is used.
  | ConfigParseError String
  -- ^ A parse error occurred during config parsing.
  | TezosClientCryptoParseError Text CryptoParseError
  -- ^ @tezos-client@ produced a cryptographic primitive that we can't parse.
  | TezosClientParseAddressError Text ParseAddressError
  -- ^ @tezos-client@ produced an address that we can't parse.
  | TezosClientParseFeeError Text Text
  -- ^ @tezos-client@ produced invalid output for parsing baker fee
  | TezosClientUnexpectedOutputFormat Text
  -- ^ @tezos-client@ printed a string that doesn't match the format we expect.
  | CantRevealContract
    -- ^ Given alias is a contract and cannot be revealed.
    Alias -- ^ Address alias of implicit account
  | ContractSender Address Text
    -- ^ Given contract is a source of a transfer or origination operation.
  | EmptyImplicitContract
    -- ^ Given alias is an empty implicit contract.
    Alias -- ^ Address alias of implicit contract
  | TezosClientUnexpectedSignatureOutput Text
  -- ^ @tezos-client sign bytes@ produced unexpected output format
  | TezosClientParseEncryptionTypeError Text Text
  -- ^ @tezos-client@ produced invalid output for parsing secret key encryption type.
  deriving stock (Int -> TezosClientError -> ShowS
[TezosClientError] -> ShowS
TezosClientError -> String
(Int -> TezosClientError -> ShowS)
-> (TezosClientError -> String)
-> ([TezosClientError] -> ShowS)
-> Show TezosClientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TezosClientError] -> ShowS
$cshowList :: [TezosClientError] -> ShowS
show :: TezosClientError -> String
$cshow :: TezosClientError -> String
showsPrec :: Int -> TezosClientError -> ShowS
$cshowsPrec :: Int -> TezosClientError -> ShowS
Show, TezosClientError -> TezosClientError -> Bool
(TezosClientError -> TezosClientError -> Bool)
-> (TezosClientError -> TezosClientError -> Bool)
-> Eq TezosClientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TezosClientError -> TezosClientError -> Bool
$c/= :: TezosClientError -> TezosClientError -> Bool
== :: TezosClientError -> TezosClientError -> Bool
$c== :: TezosClientError -> TezosClientError -> Bool
Eq)

instance Exception TezosClientError where
  displayException :: TezosClientError -> String
displayException = TezosClientError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

instance Buildable TezosClientError where
  build :: TezosClientError -> Builder
build = \case
    UnexpectedClientFailure Int
errCode Text
output Text
errOutput ->
      Builder
"tezos-client unexpectedly failed with error code " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
errCode Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
      Builder
". Stdout:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
output Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\nStderr:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
errOutput Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    UnknownAddressAlias Alias
name ->
      Builder
"Could not find an address with name " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Alias -> Builder
forall p. Buildable p => p -> Builder
build Alias
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
    UnknownAddress Address
uaddr ->
      Builder
"Could not find an associated name for the given address " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Address -> Builder
forall p. Buildable p => p -> Builder
build Address
uaddr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
    AlreadyRevealed Alias
alias ->
      Builder
"The address alias " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Alias -> Builder
forall p. Buildable p => p -> Builder
build Alias
alias Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" is already revealed"
    InvalidOperationHash OperationHash
hash ->
      Builder
"Can't wait for inclusion of operation " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OperationHash -> Builder
forall p. Buildable p => p -> Builder
build OperationHash
hash Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
" because this hash is invalid."
    CounterIsAlreadyUsed Text
counter Text
addr ->
      Builder
"Counter " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
counter Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" already used for " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
addr Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"."
    TezosClientError
EConnreset -> Builder
"tezos-client call failed with 'Unix.ECONNRESET' error."
    ConfigParseError String
err ->
      Builder
"A parse error occurred during config parsing: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall p. Buildable p => p -> Builder
build String
err
    TezosClientCryptoParseError Text
txt CryptoParseError
err ->
      Builder
"tezos-client produced a cryptographic primitive that we can't parse: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n The error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| CryptoParseError
err CryptoParseError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"."
    TezosClientParseAddressError Text
txt ParseAddressError
err ->
      Builder
"tezos-client produced an address that we can't parse: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n The error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ParseAddressError
err ParseAddressError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"."
    TezosClientParseFeeError Text
txt Text
err ->
      Builder
"tezos-client produced invalid output for parsing baker fee: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n Parsing error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
err Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    TezosClientUnexpectedOutputFormat Text
txt ->
      Builder
"tezos-client printed a string that doesn't match the format we expect:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Text -> Builder
forall p. Buildable p => p -> Builder
build Text
txt
    CantRevealContract Alias
alias ->
      Builder
"Contracts (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Alias -> Builder
forall p. Buildable p => p -> Builder
build Alias
alias Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") cannot be revealed"
    ContractSender Address
addr Text
opName ->
      Builder
"Contract (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") cannot be source of " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
opName Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    EmptyImplicitContract Alias
alias ->
      Builder
"Empty implicit contract (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Alias -> Builder
forall p. Buildable p => p -> Builder
build Alias
alias Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
    TezosClientUnexpectedSignatureOutput Text
txt ->
      Builder
"'tezos-client sign bytes' call returned a signature in format we don't expect:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Text -> Builder
forall p. Buildable p => p -> Builder
build Text
txt
    TezosClientParseEncryptionTypeError Text
txt Text
err ->
      Builder
"tezos-client produced invalid output for parsing secret key encryption type: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n Parsing error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
err Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

----------------------------------------------------------------------------
-- API
----------------------------------------------------------------------------

-- Note: if we try to sign with an unknown alias, tezos-client will
-- report a fatal error (assert failure) to stdout. It's bad. It's
-- reported in two issues: https://gitlab.com/tezos/tezos/-/issues/653
-- and https://gitlab.com/tezos/tezos/-/issues/813.
-- I (@gromak) currently think it's better to wait for it to be resolved upstream.
-- Currently we will throw 'TezosClientUnexpectedOutputFormat' error.
-- | Sign an arbtrary bytestring using @tezos-client@.
-- Secret key of the address corresponding to give 'AddressOrAlias' must be known.
signBytes
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => AddressOrAlias
  -> Maybe ScrubbedBytes
  -> ByteString
  -> m Signature
signBytes :: AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature
signBytes AddressOrAlias
signer Maybe ScrubbedBytes
mbPassword ByteString
opHash = do
  Alias
signerAlias <- AddressOrAlias -> m Alias
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
AddressOrAlias -> m Alias
getAlias AddressOrAlias
signer
  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Signing for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddressOrAlias -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AddressOrAlias
signer
  Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [String
"sign", String
"bytes", ByteString -> String
forall a. CmdArg a => a -> String
toCmdArg ByteString
opHash, String
"for", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
signerAlias] CallMode
MockupMode Maybe ScrubbedBytes
mbPassword
  IO Signature -> m Signature
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case Text -> Text -> Maybe Text
T.stripPrefix Text
"Signature: " Text
output of
    Maybe Text
Nothing ->
      -- There is additional noise in the stdout in case key is password protected
      case Text -> Text -> Maybe Text
T.stripPrefix Text
"Enter password for encrypted key: Signature: " Text
output of
        Maybe Text
Nothing -> TezosClientError -> IO Signature
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO Signature)
-> TezosClientError -> IO Signature
forall a b. (a -> b) -> a -> b
$ Text -> TezosClientError
TezosClientUnexpectedSignatureOutput Text
output
        Just Text
signatureTxt -> Text -> IO Signature
forall (m :: * -> *). MonadCatch m => Text -> m Signature
txtToSignature Text
signatureTxt
    Just Text
signatureTxt -> Text -> IO Signature
forall (m :: * -> *). MonadCatch m => Text -> m Signature
txtToSignature Text
signatureTxt
  where
    txtToSignature :: MonadCatch m => Text -> m Signature
    txtToSignature :: Text -> m Signature
txtToSignature Text
signatureTxt = (CryptoParseError -> m Signature)
-> (Signature -> m Signature)
-> Either CryptoParseError Signature
-> m Signature
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> m Signature
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m Signature)
-> (CryptoParseError -> TezosClientError)
-> CryptoParseError
-> m Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CryptoParseError -> TezosClientError
TezosClientCryptoParseError Text
signatureTxt) Signature -> m Signature
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CryptoParseError Signature -> m Signature)
-> Either CryptoParseError Signature -> m Signature
forall a b. (a -> b) -> a -> b
$
      Text -> Either CryptoParseError Signature
parseSignature (Text -> Either CryptoParseError Signature)
-> (Text -> Text) -> Text -> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Either CryptoParseError Signature)
-> Text -> Either CryptoParseError Signature
forall a b. (a -> b) -> a -> b
$ Text
signatureTxt

-- | Generate a new secret key and save it with given alias.
-- If an address with given alias already exists, it will be returned
-- and no state will be changed.
genKey
  :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m
     , Class.HasTezosClient m)
  => AliasOrAliasHint
  -> m Address
genKey :: AliasOrAliasHint -> m Address
genKey AliasOrAliasHint
originatorAlias = do
  Alias
name <- AliasOrAliasHint -> m Alias
forall env (m :: * -> *).
(HasTezosClientEnv env, MonadReader env m) =>
AliasOrAliasHint -> m Alias
prefixNameM AliasOrAliasHint
originatorAlias
  let
    isAlreadyExistsError :: Text -> Bool
    -- We can do a bit better here using more complex parsing if necessary.
    isAlreadyExistsError :: Text -> Bool
isAlreadyExistsError = Text -> Text -> Bool
T.isInfixOf Text
"already exists."

    errHandler :: p -> Text -> f Bool
errHandler p
_ Text
errOut = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Bool
isAlreadyExistsError Text
errOut)

  Text
_ <-
    (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall (f :: * -> *) p. Applicative f => p -> Text -> f Bool
errHandler
    [String
"gen", String
"keys", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
name] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  AddressOrAlias -> m Address
forall (m :: * -> *).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias -> m Address
resolveAddress (Alias -> AddressOrAlias
AddressAlias Alias
name)

-- | Generate a new secret key and save it with given alias.
-- If an address with given alias already exists, it will be removed
-- and replaced with a fresh one.
genFreshKey
  :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m
     , Class.HasTezosClient m)
  => AliasOrAliasHint
  -> m Address
genFreshKey :: AliasOrAliasHint -> m Address
genFreshKey AliasOrAliasHint
originatorAlias = do
  Alias
name <- AliasOrAliasHint -> m Alias
forall env (m :: * -> *).
(HasTezosClientEnv env, MonadReader env m) =>
AliasOrAliasHint -> m Alias
prefixNameM AliasOrAliasHint
originatorAlias
  let
    isNoAliasError :: Text -> Bool
    -- We can do a bit better here using more complex parsing if necessary.
    isNoAliasError :: Text -> Bool
isNoAliasError = Text -> Text -> Bool
T.isInfixOf Text
"no public key hash alias named"

    errHandler :: p -> Text -> f Bool
errHandler p
_ Text
errOutput = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Bool
isNoAliasError Text
errOutput)

  Text
_ <-
    (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall (f :: * -> *) p. Applicative f => p -> Text -> f Bool
errHandler
    [String
"forget", String
"address", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
name, String
"--force"] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [String
"gen", String
"keys", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
name] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  AddressOrAlias -> m Address
forall (m :: * -> *).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias -> m Address
resolveAddress (Alias -> AddressOrAlias
AddressAlias Alias
name)

-- | Reveal public key corresponding to the given alias.
-- Fails if it's already revealed.
revealKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => Alias
  -> Maybe ScrubbedBytes
  -> m ()
revealKey :: Alias -> Maybe ScrubbedBytes -> m ()
revealKey Alias
alias Maybe ScrubbedBytes
mbPassword = do
  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Revealing key for " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
alias Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
  let
    alreadyRevealed :: Text -> Bool
alreadyRevealed = Text -> Text -> Bool
T.isInfixOf Text
"previously revealed"
    revealedImplicitAccount :: Text -> Bool
revealedImplicitAccount = Text -> Text -> Bool
T.isInfixOf Text
"only implicit accounts can be revealed"
    emptyImplicitContract :: Text -> Bool
emptyImplicitContract = Text -> Text -> Bool
T.isInfixOf Text
"Empty implicit contract"
    errHandler :: Text -> Text -> IO Bool
errHandler Text
_ Text
errOut =
      Bool
False Bool -> IO () -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
alreadyRevealed Text
errOut) (TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Alias -> TezosClientError
AlreadyRevealed Alias
alias))
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
revealedImplicitAccount Text
errOut) (TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Alias -> TezosClientError
CantRevealContract Alias
alias))
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
emptyImplicitContract Text
errOut) (TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Alias -> TezosClientError
EmptyImplicitContract Alias
alias))

  Text
_ <-
    (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler
    [String
"reveal", String
"key", String
"for", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
alias] CallMode
ClientMode Maybe ScrubbedBytes
mbPassword

  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Successfully revealed key for " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
alias Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

-- | Register alias as delegate
registerDelegate
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => AliasOrAliasHint
  -> Maybe ScrubbedBytes
  -> m ()
registerDelegate :: AliasOrAliasHint -> Maybe ScrubbedBytes -> m ()
registerDelegate AliasOrAliasHint
addressOrAliasHint Maybe ScrubbedBytes
mbPassword = do
  Alias
alias <- AliasOrAliasHint -> m Alias
forall env (m :: * -> *).
(HasTezosClientEnv env, MonadReader env m) =>
AliasOrAliasHint -> m Alias
prefixNameM AliasOrAliasHint
addressOrAliasHint
  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Registering " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
alias Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" as delegate"
  let
    emptyImplicitContract :: Text -> Bool
emptyImplicitContract = Text -> Text -> Bool
T.isInfixOf Text
"Empty implicit contract"
    errHandler :: Text -> Text -> IO Bool
errHandler Text
_ Text
errOut =
      Bool
False Bool -> IO () -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
emptyImplicitContract Text
errOut) (TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Alias -> TezosClientError
EmptyImplicitContract Alias
alias))

  Text
_ <-
    (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler
    [String
"register", String
"key", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
alias, String
"as", String
"delegate"] CallMode
ClientMode Maybe ScrubbedBytes
mbPassword

  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Successfully registered " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
alias Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" as delegate"

-- | Return 'Address' corresponding to given 'AddressOrAlias', covered in @Maybe@.
-- Return @Nothing@ if address alias is unknown
resolveAddressMaybe
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => AddressOrAlias
  -> m (Maybe Address)
resolveAddressMaybe :: AddressOrAlias -> m (Maybe Address)
resolveAddressMaybe AddressOrAlias
addressOrAlias = case AddressOrAlias
addressOrAlias of
  AddressResolved Address
addr -> (Maybe Address -> m (Maybe Address)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Address -> m (Maybe Address))
-> (Address -> Maybe Address) -> Address -> m (Maybe Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe Address
forall a. a -> Maybe a
Just) Address
addr
  AddressAlias Alias
originatorName -> do
    Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Resolving " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
originatorName Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [String
"list", String
"known", String
"contracts"] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
    let parse :: Text -> Maybe Text
parse = Text -> Text -> Maybe Text
T.stripPrefix (Alias -> Text
unsafeGetAliasText Alias
originatorName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ")
    IO (Maybe Address) -> m (Maybe Address)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case [Text] -> Maybe Text
forall t. Container t => t -> Maybe (Element t)
safeHead ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Text
parse ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
output of
      Maybe Text
Nothing -> Maybe Address -> IO (Maybe Address)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Address
forall a. Maybe a
Nothing
      Just Text
addrText ->
        (ParseAddressError -> IO (Maybe Address))
-> (Address -> IO (Maybe Address))
-> Either ParseAddressError Address
-> IO (Maybe Address)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> IO (Maybe Address)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO (Maybe Address))
-> (ParseAddressError -> TezosClientError)
-> ParseAddressError
-> IO (Maybe Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseAddressError -> TezosClientError
TezosClientParseAddressError Text
addrText) (Maybe Address -> IO (Maybe Address)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Address -> IO (Maybe Address))
-> (Address -> Maybe Address) -> Address -> IO (Maybe Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe Address
forall a. a -> Maybe a
Just) (Either ParseAddressError Address -> IO (Maybe Address))
-> Either ParseAddressError Address -> IO (Maybe Address)
forall a b. (a -> b) -> a -> b
$
        Text -> Either ParseAddressError Address
parseAddress Text
addrText

-- | Return 'Alias' corresponding to given 'AddressOrAlias'.
getAlias
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => AddressOrAlias
  -> m Alias
getAlias :: AddressOrAlias -> m Alias
getAlias = \case
  AddressAlias Alias
alias -> Alias -> m Alias
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alias
alias
  AddressResolved Address
senderAddress -> do
    Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Getting an alias for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
senderAddress
    Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [String
"list", String
"known", String
"contracts"] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
    let parse :: Text -> Maybe Text
parse = Text -> Text -> Maybe Text
T.stripSuffix (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
senderAddress)
    IO Alias -> m Alias
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case [Text] -> Maybe Text
forall t. Container t => t -> Maybe (Element t)
safeHead ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Text
parse ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
output of
      Maybe Text
Nothing -> TezosClientError -> IO Alias
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO Alias) -> TezosClientError -> IO Alias
forall a b. (a -> b) -> a -> b
$ Address -> TezosClientError
UnknownAddress Address
senderAddress
      Just Text
alias -> Alias -> IO Alias
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Alias
mkAlias Text
alias)

-- | Return 'PublicKey' corresponding to given 'AddressOrAlias'.
getPublicKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => AddressOrAlias
  -> m PublicKey
getPublicKey :: AddressOrAlias -> m PublicKey
getPublicKey AddressOrAlias
addrOrAlias = do
  Alias
alias <- AddressOrAlias -> m Alias
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
AddressOrAlias -> m Alias
getAlias AddressOrAlias
addrOrAlias
  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Getting " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
alias Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" public key"
  Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [String
"show", String
"address", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
alias] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  IO PublicKey -> m PublicKey
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case Text -> [Text]
lines Text
output of
    Text
_ : [Text
rawPK] -> do
      Text
pkText <- IO Text -> (Text -> IO Text) -> Maybe Text -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (TezosClientError -> IO Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO Text) -> TezosClientError -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> TezosClientError
TezosClientUnexpectedOutputFormat Text
rawPK) Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Text -> Text -> Maybe Text
T.stripPrefix Text
"Public Key: " Text
rawPK)
      (CryptoParseError -> IO PublicKey)
-> (PublicKey -> IO PublicKey)
-> Either CryptoParseError PublicKey
-> IO PublicKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> IO PublicKey
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO PublicKey)
-> (CryptoParseError -> TezosClientError)
-> CryptoParseError
-> IO PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CryptoParseError -> TezosClientError
TezosClientCryptoParseError Text
pkText) PublicKey -> IO PublicKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CryptoParseError PublicKey -> IO PublicKey)
-> Either CryptoParseError PublicKey -> IO PublicKey
forall a b. (a -> b) -> a -> b
$
        Text -> Either CryptoParseError PublicKey
parsePublicKey Text
pkText
    [Text]
_ -> TezosClientError -> IO PublicKey
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO PublicKey)
-> TezosClientError -> IO PublicKey
forall a b. (a -> b) -> a -> b
$ Text -> TezosClientError
TezosClientUnexpectedOutputFormat Text
output

-- | This function blocks until operation with given hash is included into blockchain.
waitForOperationInclusion
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => OperationHash
  -> m ()
waitForOperationInclusion :: OperationHash -> m ()
waitForOperationInclusion OperationHash
op = m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void do
  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Waiting for operation " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| OperationHash
op OperationHash -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" to be included..."
  (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler
    [String
"wait", String
"for", OperationHash -> String
forall a. CmdArg a => a -> String
toCmdArg OperationHash
op, String
"to", String
"be", String
"included"] CallMode
ClientMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  where
    errHandler :: Text -> Text -> IO Bool
errHandler Text
_ Text
errOutput =
      Bool
False Bool -> IO () -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"Invalid operation hash:" Text -> Text -> Bool
`T.isInfixOf` Text
errOutput)
      (TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO ()) -> TezosClientError -> IO ()
forall a b. (a -> b) -> a -> b
$ OperationHash -> TezosClientError
InvalidOperationHash OperationHash
op)

-- | Save a contract with given address and alias.
-- If @replaceExisting@ is @False@ and a contract with given alias
-- already exists, this function does nothing.
rememberContract
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => Bool
  -> Address
  -> AliasOrAliasHint
  -> m ()
rememberContract :: Bool -> Address -> AliasOrAliasHint -> m ()
rememberContract Bool
replaceExisting Address
contractAddress AliasOrAliasHint
newAlias = do
  Alias
name <- AliasOrAliasHint -> m Alias
forall env (m :: * -> *).
(HasTezosClientEnv env, MonadReader env m) =>
AliasOrAliasHint -> m Alias
prefixNameM AliasOrAliasHint
newAlias
  let
    isAlreadyExistsError :: Text -> Bool
isAlreadyExistsError = Text -> Text -> Bool
T.isInfixOf Text
"already exists"
    errHandler :: p -> Text -> f Bool
errHandler p
_ Text
errOut = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Bool
isAlreadyExistsError Text
errOut)
    args :: [String]
args = [String
"remember", String
"contract", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
name, Address -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
contractAddress]
  Text
_ <-
    (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall (f :: * -> *) p. Applicative f => p -> Text -> f Bool
errHandler
    (if Bool
replaceExisting then [String]
args [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--force"] else [String]
args)
    CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  pure ()

importKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => Bool
  -> AliasOrAliasHint
  -> SecretKey
  -> m Alias
importKey :: Bool -> AliasOrAliasHint -> SecretKey -> m Alias
importKey Bool
replaceExisting AliasOrAliasHint
alias SecretKey
key = do
  Alias
name <- AliasOrAliasHint -> m Alias
forall env (m :: * -> *).
(HasTezosClientEnv env, MonadReader env m) =>
AliasOrAliasHint -> m Alias
prefixNameM AliasOrAliasHint
alias
  let
    isAlreadyExistsError :: Text -> Bool
isAlreadyExistsError = Text -> Text -> Bool
T.isInfixOf Text
"already exists"
    errHandler :: p -> Text -> f Bool
errHandler p
_ Text
errOut = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Bool
isAlreadyExistsError Text
errOut)
    args :: [String]
args = [String
"import", String
"secret", String
"key", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
name, SecretKey -> String
forall a. CmdArg a => a -> String
toCmdArg SecretKey
key]
  Text
_ <-
    (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall (f :: * -> *) p. Applicative f => p -> Text -> f Bool
errHandler
    (if Bool
replaceExisting then [String]
args [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--force"] else [String]
args)
    CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  pure Alias
name

-- | Read @tezos-client@ configuration.
getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig
getTezosClientConfig :: String -> Maybe String -> IO TezosClientConfig
getTezosClientConfig String
client Maybe String
mbDataDir = do
  (ExitCode, String, String)
t <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode' String
client
    ([String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
dir -> [String
"-d", String
dir]) Maybe String
mbDataDir [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++  [String
"config", String
"show"]) String
""
  case (ExitCode, String, String)
t of
    (ExitCode
ExitSuccess, String -> Text
forall a. ToText a => a -> Text
toText -> Text
output, String
_) -> case ByteString -> Either String TezosClientConfig
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (ByteString -> Either String TezosClientConfig)
-> (Text -> ByteString) -> Text -> Either String TezosClientConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToText a => a -> Text
toText (Text -> Either String TezosClientConfig)
-> Text -> Either String TezosClientConfig
forall a b. (a -> b) -> a -> b
$ Text
output of
        Right TezosClientConfig
config -> TezosClientConfig -> IO TezosClientConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure TezosClientConfig
config
        Left String
err -> TezosClientError -> IO TezosClientConfig
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO TezosClientConfig)
-> TezosClientError -> IO TezosClientConfig
forall a b. (a -> b) -> a -> b
$ String -> TezosClientError
ConfigParseError String
err
    (ExitFailure Int
errCode, String -> Text
forall a. ToText a => a -> Text
toText -> Text
output, String -> Text
forall a. ToText a => a -> Text
toText -> Text
errOutput) ->
      TezosClientError -> IO TezosClientConfig
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO TezosClientConfig)
-> TezosClientError -> IO TezosClientConfig
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text -> TezosClientError
UnexpectedClientFailure Int
errCode Text
output Text
errOutput

-- | Calc baker fee for transfer using @tezos-client@.
calcTransferFee
  :: ( WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => AddressOrAlias -> Maybe ScrubbedBytes -> TezosInt64 -> [CalcTransferFeeData] -> m [TezosMutez]
calcTransferFee :: AddressOrAlias
-> Maybe ScrubbedBytes
-> TezosInt64
-> [CalcTransferFeeData]
-> m [TezosMutez]
calcTransferFee AddressOrAlias
from Maybe ScrubbedBytes
mbPassword TezosInt64
burnCap [CalcTransferFeeData]
transferFeeDatas = do
  Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [ String
"multiple", String
"transfers", String
"from", AddressOrAlias -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AddressOrAlias
from, String
"using"
    , ByteString -> String
C.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [CalcTransferFeeData] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [CalcTransferFeeData]
transferFeeDatas, String
"--burn-cap", TezosInt64 -> String
showBurnCap TezosInt64
burnCap, String
"--dry-run"
    ] CallMode
ClientMode Maybe ScrubbedBytes
mbPassword
  Natural
-> (forall (n :: Nat).
    (KnownNat n, SingIPeano n) =>
    Proxy n -> m [TezosMutez])
-> m [TezosMutez]
forall r.
Natural
-> (forall (n :: Nat). (KnownNat n, SingIPeano n) => Proxy n -> r)
-> r
withSomePeano (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegralOverflowing (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [CalcTransferFeeData] -> Int
forall t. Container t => t -> Int
length [CalcTransferFeeData]
transferFeeDatas) ((forall (n :: Nat).
  (KnownNat n, SingIPeano n) =>
  Proxy n -> m [TezosMutez])
 -> m [TezosMutez])
-> (forall (n :: Nat).
    (KnownNat n, SingIPeano n) =>
    Proxy n -> m [TezosMutez])
-> m [TezosMutez]
forall a b. (a -> b) -> a -> b
$
    \(Proxy n
_ :: Proxy n) -> SizedList' (ToPeano n) TezosMutez -> [TezosMutez]
forall t. Container t => t -> [Element t]
toList (SizedList' (ToPeano n) TezosMutez -> [TezosMutez])
-> m (SizedList' (ToPeano n) TezosMutez) -> m [TezosMutez]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (SizedList' (ToPeano n) TezosMutez)
forall (n :: Nat) (m :: * -> *).
(SingIPeano n, MonadIO m, MonadThrow m) =>
Text -> m (SizedList n TezosMutez)
feeOutputParser @n Text
output

-- | Calc baker fee for origination using @tezos-client@.
calcOriginationFee
  :: ( UntypedValScope st, WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => CalcOriginationFeeData cp st -> m TezosMutez
calcOriginationFee :: CalcOriginationFeeData cp st -> m TezosMutez
calcOriginationFee CalcOriginationFeeData{Maybe ScrubbedBytes
TezosInt64
TezosMutez
Contract cp st
Value st
AddressOrAlias
cofdBurnCap :: forall (cp :: T) (st :: T).
CalcOriginationFeeData cp st -> TezosInt64
cofdStorage :: forall (cp :: T) (st :: T).
CalcOriginationFeeData cp st -> Value st
cofdContract :: forall (cp :: T) (st :: T).
CalcOriginationFeeData cp st -> Contract cp st
cofdMbFromPassword :: forall (cp :: T) (st :: T).
CalcOriginationFeeData cp st -> Maybe ScrubbedBytes
cofdBalance :: forall (cp :: T) (st :: T).
CalcOriginationFeeData cp st -> TezosMutez
cofdFrom :: forall (cp :: T) (st :: T).
CalcOriginationFeeData cp st -> AddressOrAlias
cofdBurnCap :: TezosInt64
cofdStorage :: Value st
cofdContract :: Contract cp st
cofdMbFromPassword :: Maybe ScrubbedBytes
cofdBalance :: TezosMutez
cofdFrom :: AddressOrAlias
..} = do
  Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [ String
"originate", String
"contract", String
"-", String
"transferring"
    , TezosMutez -> String
showTez TezosMutez
cofdBalance
    , String
"from", AddressOrAlias -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AddressOrAlias
cofdFrom, String
"running"
    , Contract cp st -> String
forall a. CmdArg a => a -> String
toCmdArg Contract cp st
cofdContract, String
"--init"
    , Value st -> String
forall a. CmdArg a => a -> String
toCmdArg Value st
cofdStorage, String
"--burn-cap"
    , TezosInt64 -> String
showBurnCap TezosInt64
cofdBurnCap, String
"--dry-run"
    ] CallMode
ClientMode Maybe ScrubbedBytes
cofdMbFromPassword
  SizedList' ('S 'Z) TezosMutez
fees <- Text -> m (SizedList 1 TezosMutez)
forall (n :: Nat) (m :: * -> *).
(SingIPeano n, MonadIO m, MonadThrow m) =>
Text -> m (SizedList n TezosMutez)
feeOutputParser @1 Text
output
  case SizedList' ('S 'Z) TezosMutez
fees of
    TezosMutez
singleFee :< SizedList' n1 TezosMutez
Nil -> TezosMutez -> m TezosMutez
forall (m :: * -> *) a. Monad m => a -> m a
return TezosMutez
singleFee

-- | Calc baker fee for revealing using @tezos-client@.
--
-- Note that @tezos-client@ does not support passing an address here,
-- at least at the moment of writing.
calcRevealFee
  :: ( WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => Alias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez
calcRevealFee :: Alias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez
calcRevealFee Alias
alias Maybe ScrubbedBytes
mbPassword TezosInt64
burnCap = do
  Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [ String
"reveal", String
"key", String
"for", Alias -> String
forall a. CmdArg a => a -> String
toCmdArg Alias
alias
    , String
"--burn-cap", TezosInt64 -> String
showBurnCap TezosInt64
burnCap
    , String
"--dry-run"
    ] CallMode
ClientMode Maybe ScrubbedBytes
mbPassword
  SizedList' ('S 'Z) TezosMutez
fees <- Text -> m (SizedList 1 TezosMutez)
forall (n :: Nat) (m :: * -> *).
(SingIPeano n, MonadIO m, MonadThrow m) =>
Text -> m (SizedList n TezosMutez)
feeOutputParser @1 Text
output
  case SizedList' ('S 'Z) TezosMutez
fees of
    TezosMutez
singleFee :< SizedList' n1 TezosMutez
Nil -> TezosMutez -> m TezosMutez
forall (m :: * -> *) a. Monad m => a -> m a
return TezosMutez
singleFee

feeOutputParser :: forall n m. (SingIPeano n, MonadIO m, MonadThrow m) => Text -> m (SizedList n TezosMutez)
feeOutputParser :: Text -> m (SizedList n TezosMutez)
feeOutputParser Text
output =
  case Text -> Either FeeParserException (SizedList n TezosMutez)
forall (n :: Nat).
SingIPeano n =>
Text -> Either FeeParserException (SizedList n TezosMutez)
parseBakerFeeFromOutput @n Text
output of
    Right SizedList n TezosMutez
fee -> SizedList n TezosMutez -> m (SizedList n TezosMutez)
forall (m :: * -> *) a. Monad m => a -> m a
return SizedList n TezosMutez
fee
    Left FeeParserException
err -> TezosClientError -> m (SizedList n TezosMutez)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m (SizedList n TezosMutez))
-> TezosClientError -> m (SizedList n TezosMutez)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TezosClientError
TezosClientParseFeeError Text
output (Text -> TezosClientError) -> Text -> TezosClientError
forall a b. (a -> b) -> a -> b
$ FeeParserException -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty FeeParserException
err

showBurnCap :: TezosInt64 -> String
showBurnCap :: TezosInt64 -> String
showBurnCap TezosInt64
x = String -> Float -> String
forall r. PrintfType r => String -> r
printf String
"%.6f" (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ (TezosInt64 -> Float
forall a b.
(Integral a, RealFrac b, CheckIntSubType a Integer) =>
a -> b
fromIntegralToRealFrac @TezosInt64 @Float TezosInt64
x) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1000

showTez :: TezosMutez -> String
showTez :: TezosMutez -> String
showTez = Mutez -> String
forall a. CmdArg a => a -> String
toCmdArg (Mutez -> String) -> (TezosMutez -> Mutez) -> TezosMutez -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TezosMutez -> Mutez
unTezosMutez

-- | Get password for secret key associated with given address
-- in case this key is password-protected
getKeyPassword
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m)
  => Address -> m (Maybe ScrubbedBytes)
getKeyPassword :: Address -> m (Maybe ScrubbedBytes)
getKeyPassword = \case
  ContractAddress ContractHash
_ -> Maybe ScrubbedBytes -> m (Maybe ScrubbedBytes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  Address
keyAddr -> (AddressOrAlias -> m Alias
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
AddressOrAlias -> m Alias
getAlias (AddressOrAlias -> m Alias) -> AddressOrAlias -> m Alias
forall a b. (a -> b) -> a -> b
$ Address -> AddressOrAlias
AddressResolved Address
keyAddr) m Alias
-> (Alias -> m (Maybe ScrubbedBytes)) -> m (Maybe ScrubbedBytes)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Alias -> m (Maybe ScrubbedBytes)
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m, MonadMask m) =>
Alias -> m (Maybe ScrubbedBytes)
getKeyPassword'
  where
    getKeyPassword'
      :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, MonadMask m)
      => Alias -> m (Maybe ScrubbedBytes)
    getKeyPassword' :: Alias -> m (Maybe ScrubbedBytes)
getKeyPassword' Alias
alias = do
      Text
output <- [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [ String
"show", String
"address", Alias -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Alias
alias, String
"-S"] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
      SecretKeyEncryption
encryptionType <-
        case Text
-> Either SecretKeyEncryptionParserException SecretKeyEncryption
parseSecretKeyEncryption Text
output of
          Right SecretKeyEncryption
t -> SecretKeyEncryption -> m SecretKeyEncryption
forall (m :: * -> *) a. Monad m => a -> m a
return SecretKeyEncryption
t
          Left SecretKeyEncryptionParserException
err -> TezosClientError -> m SecretKeyEncryption
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m SecretKeyEncryption)
-> TezosClientError -> m SecretKeyEncryption
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TezosClientError
TezosClientParseEncryptionTypeError Text
output (Text -> TezosClientError) -> Text -> TezosClientError
forall a b. (a -> b) -> a -> b
$ SecretKeyEncryptionParserException -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty SecretKeyEncryptionParserException
err
      case SecretKeyEncryption
encryptionType of
        SecretKeyEncryption
EncryptedKey -> do
          Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Please enter password for '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Alias -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Alias
alias Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"':"
          ScrubbedBytes -> Maybe ScrubbedBytes
forall a. a -> Maybe a
Just (ScrubbedBytes -> Maybe ScrubbedBytes)
-> m ScrubbedBytes -> m (Maybe ScrubbedBytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ScrubbedBytes -> m ScrubbedBytes
forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
withoutEcho m ScrubbedBytes
forall (m :: * -> *). MonadIO m => m ScrubbedBytes
readScrubbedBytes
        SecretKeyEncryption
_ -> Maybe ScrubbedBytes -> m (Maybe ScrubbedBytes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ScrubbedBytes
forall a. Maybe a
Nothing

    -- | Hide entered password
    withoutEcho :: (MonadIO m, MonadMask m) => m a -> m a
    withoutEcho :: m a -> m a
withoutEcho m a
action = do
      Bool
old <- Handle -> m Bool
forall (m :: * -> *). MonadIO m => Handle -> m Bool
hGetEcho Handle
stdin
      m () -> m () -> m a -> m a
forall (m :: * -> *) a b c. MonadMask m => m a -> m b -> m c -> m c
bracket_ (Handle -> Bool -> m ()
forall (m :: * -> *). MonadIO m => Handle -> Bool -> m ()
hSetEcho Handle
stdin Bool
False) (Handle -> Bool -> m ()
forall (m :: * -> *). MonadIO m => Handle -> Bool -> m ()
hSetEcho Handle
stdin Bool
old) m a
action

----------------------------------------------------------------------------
-- Helpers
-- All interesting @tezos-client@ functionality is supposed to be
-- exported as functions with types closely resembling inputs of
-- respective @tezos-client@ functions. If something is not
-- available, consider adding it here. But if it is not feasible,
-- you can use these two functions directly to constructor a custom
-- @tezos-client@ call.
----------------------------------------------------------------------------

-- | Datatype that represents modes for calling node from @tezos-client@.
data CallMode
  = MockupMode
  -- ^ Mode in which @tezos-client@ doesn't perform any actual RPC calls to the node
  -- and use mock instead.
  | ClientMode
  -- ^ Normal mode in which @tezos-client@ performs all necessary RPC calls to the node.

-- | Call @tezos-client@ with given arguments. Arguments defined by
-- config are added automatically. The second argument specifies what
-- should be done in failure case. It takes stdout and stderr
-- output. Possible handling:
--
-- 1. Parse a specific error and throw it.
-- 2. Parse an expected error that shouldn't cause a failure.
-- Return @True@ in this case.
-- 3. Detect an unexpected error, return @False@.
-- In this case 'UnexpectedClientFailure' will be throw.
callTezosClient
  :: forall env m. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => (Text -> Text -> IO Bool) -> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient :: (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler [String]
args CallMode
mode Maybe ScrubbedBytes
mbInput = CallMode -> m Text -> m Text
forall a. CallMode -> m a -> m a
retryEConnreset CallMode
mode (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
  TezosClientEnv {String
Maybe String
Maybe Text
BaseUrl
tceMbTezosClientDataDir :: TezosClientEnv -> Maybe String
tceTezosClientPath :: TezosClientEnv -> String
tceEndpointUrl :: TezosClientEnv -> BaseUrl
tceAliasPrefix :: TezosClientEnv -> Maybe Text
tceMbTezosClientDataDir :: Maybe String
tceTezosClientPath :: String
tceEndpointUrl :: BaseUrl
tceAliasPrefix :: Maybe Text
..} <- Getting TezosClientEnv env TezosClientEnv -> m TezosClientEnv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TezosClientEnv env TezosClientEnv
forall env. HasTezosClientEnv env => Lens' env TezosClientEnv
tezosClientEnvL
  let
    extraArgs :: [String]
    extraArgs :: [String]
extraArgs = [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
      [ [String
"-E", BaseUrl -> String
forall a. CmdArg a => a -> String
toCmdArg BaseUrl
tceEndpointUrl]
      , [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
dir -> [String
"-d", String
dir]) Maybe String
tceMbTezosClientDataDir
      , [String
"--mode", case CallMode
mode of
            CallMode
MockupMode -> String
"mockup"
            CallMode
ClientMode -> String
"client"
        ]
      ]

    allArgs :: [String]
allArgs = [String]
extraArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args
  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Running: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unwords (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
tceTezosClientPathString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
allArgs)
  let
    ifNotEmpty :: p -> p -> p
ifNotEmpty p
prefix p
output
      | p -> Bool
forall t. Container t => t -> Bool
null p
output = p
""
      | Bool
otherwise = p
prefix p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
":\n" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
output
    logOutput :: Text -> Text -> m ()
    logOutput :: Text -> Text -> m ()
logOutput Text
output Text
errOutput = Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Text
forall p. (Container p, IsString p, Semigroup p) => p -> p -> p
ifNotEmpty Text
"stdout" Text
output Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text -> Text -> Text
forall p. (Container p, IsString p, Semigroup p) => p -> p -> p
ifNotEmpty Text
"stderr" Text
errOutput

  IO (ExitCode, String, String) -> m (ExitCode, String, String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode' String
tceTezosClientPath [String]
allArgs
          (String
-> (ScrubbedBytes -> String) -> Maybe ScrubbedBytes -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ScrubbedBytes -> String
scrubbedBytesToString Maybe ScrubbedBytes
mbInput)) m (ExitCode, String, String)
-> ((ExitCode, String, String) -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (ExitCode
ExitSuccess, String -> Text
forall a. ToText a => a -> Text
toText -> Text
output, String -> Text
forall a. ToText a => a -> Text
toText -> Text
errOutput) ->
      Text
output Text -> m () -> m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Text -> m ()
logOutput Text
output Text
errOutput
    (ExitFailure Int
errCode, String -> Text
forall a. ToText a => a -> Text
toText -> Text
output, String -> Text
forall a. ToText a => a -> Text
toText -> Text
errOutput) -> do
      Text -> m ()
checkCounterError Text
errOutput
      Text -> m ()
checkEConnreset Text
errOutput
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Text -> Text -> IO Bool
errHandler Text
output Text
errOutput) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO ()) -> TezosClientError -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text -> TezosClientError
UnexpectedClientFailure Int
errCode Text
output Text
errOutput

      Text
output Text -> m () -> m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Text -> m ()
logOutput Text
output Text
errOutput
  where
    checkCounterError
      :: Text -> m ()
    checkCounterError :: Text -> m ()
checkCounterError Text
errOutput |
      Text
"Counter" Text -> Text -> Bool
`T.isPrefixOf` Text
errOutput Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Text
"already used for contract" Text -> Text -> Bool
`T.isInfixOf` Text
errOutput = do
        let splittedErrOutput :: [Text]
splittedErrOutput = Text -> [Text]
words Text
errOutput
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO ()) -> TezosClientError -> IO ()
forall a b. (a -> b) -> a -> b
$
          Text -> Text -> TezosClientError
CounterIsAlreadyUsed ([Text]
splittedErrOutput [Text] -> Int -> Text
forall a. [a] -> Int -> a
Unsafe.!! Int
1) ([Text]
splittedErrOutput [Text] -> Int -> Text
forall a. [a] -> Int -> a
Unsafe.!! Int
5)
    checkCounterError Text
_ = m ()
forall (f :: * -> *). Applicative f => f ()
pass
    checkEConnreset :: Text -> m ()
    checkEConnreset :: Text -> m ()
checkEConnreset Text
errOutput
      | Text
"Unix.ECONNRESET" Text -> Text -> Bool
`T.isInfixOf` Text
errOutput = TezosClientError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TezosClientError
EConnreset
    checkEConnreset Text
_ = m ()
forall (f :: * -> *). Applicative f => f ()
pass

    -- | Helper function that retries @tezos-client@ call action in case of @ECONNRESET@.
    -- Note that this error cannot appear in case of 'MockupMode' call.
    retryEConnreset :: CallMode -> m a -> m a
    retryEConnreset :: CallMode -> m a -> m a
retryEConnreset CallMode
MockupMode m a
action = m a
action
    retryEConnreset CallMode
ClientMode m a
action = Integer -> m a -> m a
forall a. Integer -> m a -> m a
retryEConnresetImpl Integer
0 m a
action

    retryEConnresetImpl :: Integer -> m a -> m a
    retryEConnresetImpl :: Integer -> m a -> m a
retryEConnresetImpl Integer
attempt m a
action = m a
action m a -> (TezosClientError -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \TezosClientError
err -> do
      case TezosClientError
err of
        TezosClientError
EConnreset ->
          if Integer
attempt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
maxRetryAmount then TezosClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TezosClientError
err
          else Integer -> m a -> m a
forall a. Integer -> m a -> m a
retryEConnresetImpl (Integer
attempt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) m a
action
        TezosClientError
anotherErr -> TezosClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TezosClientError
anotherErr

    maxRetryAmount :: Integer
maxRetryAmount = Integer
5

-- | Call tezos-client and expect success.
callTezosClientStrict
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict :: [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [String]
args CallMode
mode Maybe ScrubbedBytes
mbInput = (Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall (f :: * -> *) p p. Applicative f => p -> p -> f Bool
errHandler [String]
args CallMode
mode Maybe ScrubbedBytes
mbInput
  where
    errHandler :: p -> p -> f Bool
errHandler p
_ p
_ = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Variant of @readProcessWithExitCode@ that prints a better error in case of
-- an exception in the inner @readProcessWithExitCode@ call.
readProcessWithExitCode'
  :: FilePath
  -> [String]
  -> String
  -> IO (ExitCode, String, String)
readProcessWithExitCode' :: String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode' String
fp [String]
args String
inp =
  IO (ExitCode, String, String)
-> (IOException -> IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
    (String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
fp [String]
args String
inp) IOException -> IO (ExitCode, String, String)
handler
  where
    handler :: IOException -> IO (ExitCode, String, String)
    handler :: IOException -> IO (ExitCode, String, String)
handler IOException
e = do
      Handle -> Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStrLn @Text Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
red] Text
errorMsg
      IOException -> IO (ExitCode, String, String)
forall e a. Exception e => e -> IO a
throwIO IOException
e

    errorMsg :: Text
errorMsg =
      Text
"ERROR!! There was an error in executing `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` program. Is the \
      \ executable available in PATH ?"

prefixName :: Maybe Text -> AliasOrAliasHint -> Alias
prefixName :: Maybe Text -> AliasOrAliasHint -> Alias
prefixName Maybe Text
_ (AnAlias Alias
x) = Alias
x
prefixName Maybe Text
mPrefix (AnAliasHint (AliasHint -> Text
unsafeGetAliasHintText -> Text
hint)) =
  Text -> Alias
mkAlias (Text -> Alias) -> Text -> Alias
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mPrefix of
    Just Text
prefix -> Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hint
    Maybe Text
Nothing -> Text
hint

-- | Prefix an alias with the value available in any 'HasTezosClientEnv'.
prefixNameM
  :: (HasTezosClientEnv env, MonadReader env m)
  => AliasOrAliasHint
  -> m Alias
prefixNameM :: AliasOrAliasHint -> m Alias
prefixNameM AliasOrAliasHint
alias = do
  Maybe Text
prefix <- TezosClientEnv -> Maybe Text
tceAliasPrefix (TezosClientEnv -> Maybe Text)
-> m TezosClientEnv -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting TezosClientEnv env TezosClientEnv -> m TezosClientEnv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TezosClientEnv env TezosClientEnv
forall env. HasTezosClientEnv env => Lens' env TezosClientEnv
tezosClientEnvL
  pure $ Maybe Text -> AliasOrAliasHint -> Alias
prefixName Maybe Text
prefix AliasOrAliasHint
alias

-- | Return 'Address' corresponding to given 'AddressOrAlias'.
resolveAddress
  :: (MonadThrow m, Class.HasTezosClient m)
  => AddressOrAlias
  -> m Address
resolveAddress :: AddressOrAlias -> m Address
resolveAddress AddressOrAlias
addr = case AddressOrAlias
addr of
   AddressResolved Address
addrResolved -> Address -> m Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure Address
addrResolved
   alias :: AddressOrAlias
alias@(AddressAlias Alias
originatorName) ->
     AddressOrAlias -> m (Maybe Address)
forall (m :: * -> *).
HasTezosClient m =>
AddressOrAlias -> m (Maybe Address)
Class.resolveAddressMaybe AddressOrAlias
alias m (Maybe Address) -> (Maybe Address -> m Address) -> m Address
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\case
       Maybe Address
Nothing -> TezosClientError -> m Address
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m Address) -> TezosClientError -> m Address
forall a b. (a -> b) -> a -> b
$ Alias -> TezosClientError
UnknownAddressAlias Alias
originatorName
       Just Address
existingAddress -> Address -> m Address
forall (m :: * -> *) a. Monad m => a -> m a
return Address
existingAddress
       )