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

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

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

  -- * @octez-client@ api
  , signBytes
  , rememberContract
  , importKey
  , genKey
  , genFreshKey
  , revealKey
  , ResolveError(..)
  , Resolve(..)
  , resolveAddress
  , resolveAddressMaybe
  , getAlias
  , getAliasMaybe
  , getPublicKey
  , getSecretKey
  , getTezosClientConfig
  , calcTransferFee
  , calcOriginationFee
  , calcRevealFee
  , getKeyPassword
  , registerDelegate
  , getAliasesAndAddresses

  -- * Internals
  , findAddress
  , FindAddressResult(..)
  , CallMode(..)
  , callTezosClient
  , callTezosClientStrict
  ) 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 Data.Constraint ((\\))
import Data.Singletons (demote)
import Lorentz.Value
import Morley.Client.Logging
import Morley.Client.RPC.Types
import Morley.Client.TezosClient.Class (AliasBehavior(..))
import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(..))
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.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Crypto
import Morley.Util.Interpolate (itu)
import Morley.Util.Peano
import Morley.Util.Sing (castSing)
import Morley.Util.SizedList.Types

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

-- | A data type for all /predicatable/ errors that can happen during
-- @octez-client@ usage.
data TezosClientError =
    UnexpectedClientFailure
    -- ^ @octez-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.
  | AlreadyRevealed
    -- ^ Public key of the given address is already revealed.
      ImplicitAlias -- ^ 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 @octez-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 @octez-client@ or just didn't consider some case.
  -- Another possible reason that a broken @octez-client@ is used.
  | ConfigParseError String
  -- ^ A parse error occurred during config parsing.
  | TezosClientCryptoParseError Text CryptoParseError
  -- ^ @octez-client@ produced a cryptographic primitive that we can't parse.
  | TezosClientParseAddressError Text ParseAddressError
  -- ^ @octez-client@ produced an address that we can't parse.
  | TezosClientParseFeeError Text Text
  -- ^ @octez-client@ produced invalid output for parsing baker fee
  | TezosClientUnexpectedOutputFormat Text
  -- ^ @octez-client@ printed a string that doesn't match the format we expect.
  | CantRevealContract
    -- ^ Given alias is a contract and cannot be revealed.
    ImplicitAlias -- ^ Address alias of implicit account
  | ContractSender ContractAddress Text
    -- ^ Given contract is a source of a transfer or origination operation.
  | EmptyImplicitContract
    -- ^ Given alias is an empty implicit contract.
    ImplicitAlias -- ^ Address alias of implicit contract
  | TezosClientUnexpectedSignatureOutput Text
  -- ^ @octez-client sign bytes@ produced unexpected output format
  | TezosClientParseEncryptionTypeError Text Text
  -- ^ @octez-client@ produced invalid output for parsing secret key encryption type.
  | DuplicateAlias Text
  -- ^ Tried to save alias, but such alias already exists.
  | AmbiguousAlias Text ContractAddress ImplicitAddress
  -- ^ Expected an alias to be associated with either an implicit address or a
  -- contract address, but it was associated with both.
  | AliasTxRollup Text (KindedAddress 'AddressKindTxRollup)
  -- ^ Expected an alias to be associated with either
  -- an implicit address or a contract address,
  -- but it was associated with a transaction rollup address.
  | ResolveError ResolveError

deriving stock instance Show TezosClientError

instance Exception TezosClientError where
  displayException :: TezosClientError -> FilePath
displayException = TezosClientError -> FilePath
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
"`octez-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
""
    AlreadyRevealed ImplicitAlias
alias ->
      Builder
"The address alias " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Builder
forall p. Buildable p => p -> Builder
build ImplicitAlias
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
"`octez-client` call failed with 'Unix.ECONNRESET' error."
    ConfigParseError FilePath
err ->
      Builder
"A parse error occurred during config parsing: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
forall p. Buildable p => p -> Builder
build FilePath
err
    TezosClientCryptoParseError Text
txt CryptoParseError
err ->
      Builder
"`octez-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
"`octez-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
"`octez-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
"`octez-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 ImplicitAlias
alias ->
      Builder
"Contracts (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Builder
forall p. Buildable p => p -> Builder
build ImplicitAlias
alias Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") cannot be revealed"
    ContractSender ContractAddress
addr Text
opName ->
      Builder
"Contract (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Builder
forall p. Buildable p => p -> Builder
build ContractAddress
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 ImplicitAlias
alias ->
      Builder
"Empty implicit contract (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Builder
forall p. Buildable p => p -> Builder
build ImplicitAlias
alias Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
    TezosClientUnexpectedSignatureOutput Text
txt ->
      Builder
"`octez-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
"`octez-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
""
    DuplicateAlias Text
alias -> Builder
"Attempted to save alias '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
alias Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"', but it already exists"
    AmbiguousAlias Text
aliasText ContractAddress
contractAddr ImplicitAddress
implicitAddr ->
      [itu|
        The alias '#{aliasText}' is assigned to both:
          * a contract address: #{contractAddr}
          * and an implicit address: #{implicitAddr}
        Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.
        |]
    AliasTxRollup Text
aliasText KindedAddress 'AddressKindTxRollup
txRollupAddr ->
      [itu|
        Expected the alias '#{aliasText}' to be assigned to either a contract or an implicit account,
        but it's assigned to a transaction rollup address: #{txRollupAddr}.
        |]
    ResolveError ResolveError
err -> ResolveError -> Builder
forall p. Buildable p => p -> Builder
build ResolveError
err

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

-- Note: if we try to sign with an unknown alias, @octez-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 @octez-client@.
-- Secret key of the address corresponding to give 'AddressOrAlias' must be known.
signBytes
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m)
  => ImplicitAddressOrAlias
  -> Maybe ScrubbedBytes
  -> ByteString
  -> m Signature
signBytes :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m, HasTezosClient m) =>
ImplicitAddressOrAlias
-> Maybe ScrubbedBytes -> ByteString -> m Signature
signBytes ImplicitAddressOrAlias
signer Maybe ScrubbedBytes
mbPassword ByteString
opHash = do
  ImplicitAlias
signerAlias <- ImplicitAddressOrAlias -> m (ResolvedAlias ImplicitAddressOrAlias)
forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, WithClientLog env m, MonadThrow m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAlias addressOrAlias)
getAlias ImplicitAddressOrAlias
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
<> ImplicitAddressOrAlias -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ImplicitAddressOrAlias
signer
  Text
output <- [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [FilePath
"sign", FilePath
"bytes", ByteString -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ByteString
opHash, FilePath
"for", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
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 :: forall (m :: * -> *). MonadCatch m => 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)
  => ImplicitAlias
  -> m ImplicitAddress
genKey :: forall (m :: * -> *) env.
(MonadThrow m, MonadCatch m, WithClientLog env m,
 HasTezosClientEnv env, MonadIO m, HasTezosClient m) =>
ImplicitAlias -> m ImplicitAddress
genKey ImplicitAlias
name = do
  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)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall {f :: * -> *} {p}. Applicative f => p -> Text -> f Bool
errHandler
    [FilePath
"gen", FilePath
"keys", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
name] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  ImplicitAddressOrAlias
-> m (ResolvedAddress ImplicitAddressOrAlias)
forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAddress addressOrAlias)
resolveAddress (ImplicitAlias -> ImplicitAddressOrAlias
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias ImplicitAlias
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)
  => ImplicitAlias
  -> m ImplicitAddress
genFreshKey :: forall (m :: * -> *) env.
(MonadThrow m, MonadCatch m, WithClientLog env m,
 HasTezosClientEnv env, MonadIO m, HasTezosClient m) =>
ImplicitAlias -> m ImplicitAddress
genFreshKey ImplicitAlias
name = do
  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)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall {f :: * -> *} {p}. Applicative f => p -> Text -> f Bool
errHandler
    [FilePath
"forget", FilePath
"address", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
name, FilePath
"--force"] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [FilePath
"gen", FilePath
"keys", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
name] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  ImplicitAddressOrAlias
-> m (ResolvedAddress ImplicitAddressOrAlias)
forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAddress addressOrAlias)
resolveAddress (ImplicitAlias -> ImplicitAddressOrAlias
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias ImplicitAlias
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)
  => ImplicitAlias
  -> Maybe ScrubbedBytes
  -> m ()
revealKey :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
ImplicitAlias -> Maybe ScrubbedBytes -> m ()
revealKey ImplicitAlias
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
+| ImplicitAlias
alias ImplicitAlias -> 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 (ImplicitAlias -> TezosClientError
AlreadyRevealed ImplicitAlias
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 (ImplicitAlias -> TezosClientError
CantRevealContract ImplicitAlias
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 (ImplicitAlias -> TezosClientError
EmptyImplicitContract ImplicitAlias
alias))

  Text
_ <-
    (Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler
    [FilePath
"reveal", FilePath
"key", FilePath
"for", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
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
+| ImplicitAlias
alias ImplicitAlias -> 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)
  => ImplicitAlias
  -> Maybe ScrubbedBytes
  -> m ()
registerDelegate :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
ImplicitAlias -> Maybe ScrubbedBytes -> m ()
registerDelegate ImplicitAlias
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
"Registering " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAlias
alias ImplicitAlias -> 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 (ImplicitAlias -> TezosClientError
EmptyImplicitContract ImplicitAlias
alias))

  Text
_ <-
    (Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler
    [FilePath
"register", FilePath
"key", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
alias, FilePath
"as", FilePath
"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
+| ImplicitAlias
alias ImplicitAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" as delegate"

-- | Call @octez-client@ to list known addresses or contracts
callListKnown
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => String -> m Text
callListKnown :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
FilePath -> m Text
callListKnown FilePath
objects =
  [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [FilePath
"list", FilePath
"known", FilePath
objects] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing

-- | Return 'PublicKey' corresponding to given 'AddressOrAlias'.
getPublicKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m)
  => ImplicitAddressOrAlias
  -> m PublicKey
getPublicKey :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m, HasTezosClient m) =>
ImplicitAddressOrAlias -> m PublicKey
getPublicKey ImplicitAddressOrAlias
addrOrAlias = do
  ImplicitAlias
alias <- ImplicitAddressOrAlias -> m (ResolvedAlias ImplicitAddressOrAlias)
forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, WithClientLog env m, MonadThrow m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAlias addressOrAlias)
getAlias ImplicitAddressOrAlias
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
+| ImplicitAlias
alias ImplicitAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" public key"
  Text
output <- [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [FilePath
"show", FilePath
"address", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
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

-- | Return 'SecretKey' corresponding to given 'AddressOrAlias'.
getSecretKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m)
  => ImplicitAddressOrAlias
  -> m SecretKey
getSecretKey :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m, HasTezosClient m) =>
ImplicitAddressOrAlias -> m SecretKey
getSecretKey ImplicitAddressOrAlias
addrOrAlias = do
  ImplicitAlias
alias <- ImplicitAddressOrAlias -> m (ResolvedAlias ImplicitAddressOrAlias)
forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, WithClientLog env m, MonadThrow m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAlias addressOrAlias)
getAlias ImplicitAddressOrAlias
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
+| ImplicitAlias
alias ImplicitAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" secret key"
  Text
output <- [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [FilePath
"show", FilePath
"address", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
alias, FilePath
"--show-secret"] CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  IO SecretKey -> m SecretKey
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case Text -> [Text]
lines Text
output of
    Text
_ : Text
_ : [Text
rawSK] -> do
      Text
skText <- 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
rawSK) Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Text -> Text -> Maybe Text
T.stripPrefix Text
"Secret Key: " Text
rawSK)
      (CryptoParseError -> IO SecretKey)
-> (SecretKey -> IO SecretKey)
-> Either CryptoParseError SecretKey
-> IO SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> IO SecretKey
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO SecretKey)
-> (CryptoParseError -> TezosClientError)
-> CryptoParseError
-> IO SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CryptoParseError -> TezosClientError
TezosClientCryptoParseError Text
skText) SecretKey -> IO SecretKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CryptoParseError SecretKey -> IO SecretKey)
-> Either CryptoParseError SecretKey -> IO SecretKey
forall a b. (a -> b) -> a -> b
$
        Text -> Either CryptoParseError SecretKey
parseSecretKey Text
skText
    [Text]
_ -> TezosClientError -> IO SecretKey
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO SecretKey)
-> TezosClientError -> IO SecretKey
forall a b. (a -> b) -> a -> b
$ Text -> TezosClientError
TezosClientUnexpectedOutputFormat Text
output

-- | 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)
  => AliasBehavior
  -> ContractAddress
  -> ContractAlias
  -> m ()
rememberContract :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
AliasBehavior -> ContractAddress -> ContractAlias -> m ()
rememberContract AliasBehavior
aliasBehavior ContractAddress
address ContractAlias
alias = case AliasBehavior
aliasBehavior of
  AliasBehavior
DontSaveAlias ->
    Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Not saving " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
address ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" as " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAlias
alias ContractAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" as requested"
  AliasBehavior
OverwriteDuplicateAlias ->
    m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient (\Text
_ Text
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) ([FilePath]
args [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
"--force"]) CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  AliasBehavior
_ -> do
    let errHandler :: Text -> Text -> IO Bool
errHandler Text
_ Text
errOut
          | Text -> Bool
isAlreadyExistsError Text
errOut = case AliasBehavior
aliasBehavior of
              AliasBehavior
KeepDuplicateAlias -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
              AliasBehavior
ForbidDuplicateAlias -> TezosClientError -> IO Bool
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO Bool) -> TezosClientError -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> TezosClientError
DuplicateAlias (Text -> TezosClientError) -> Text -> TezosClientError
forall a b. (a -> b) -> a -> b
$ ContractAlias -> Text
forall (kind :: AddressKind). Alias kind -> Text
unAlias ContractAlias
alias
          | Bool
otherwise = Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler [FilePath]
args CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  where
    args :: [FilePath]
args = [FilePath
"remember", FilePath
"contract", ContractAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ContractAlias
alias, ContractAddress -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ContractAddress
address]
    isAlreadyExistsError :: Text -> Bool
isAlreadyExistsError = Text -> Text -> Bool
T.isInfixOf Text
"already exists"

importKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => Bool
  -> ImplicitAlias
  -> SecretKey
  -> m ImplicitAlias
importKey :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
Bool -> ImplicitAlias -> SecretKey -> m ImplicitAlias
importKey Bool
replaceExisting ImplicitAlias
name SecretKey
key = do
  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 :: [FilePath]
args = [FilePath
"import", FilePath
"secret", FilePath
"key", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
name, SecretKey -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg SecretKey
key]
  Text
_ <-
    (Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall {f :: * -> *} {p}. Applicative f => p -> Text -> f Bool
errHandler
    (if Bool
replaceExisting then [FilePath]
args [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
"--force"] else [FilePath]
args)
    CallMode
MockupMode Maybe ScrubbedBytes
forall a. Maybe a
Nothing
  pure ImplicitAlias
name

-- | Read @octez-client@ configuration.
getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig
getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig
getTezosClientConfig FilePath
client Maybe FilePath
mbDataDir = do
  (ExitCode, FilePath, FilePath)
t <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode' FilePath
client
    ([FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
dir -> [FilePath
"-d", FilePath
dir]) Maybe FilePath
mbDataDir [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++  [FilePath
"config", FilePath
"show"]) FilePath
""
  case (ExitCode, FilePath, FilePath)
t of
    (ExitCode
ExitSuccess, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
output, FilePath
_) -> case ByteString -> Either FilePath TezosClientConfig
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecodeStrict (ByteString -> Either FilePath TezosClientConfig)
-> (Text -> ByteString)
-> Text
-> Either FilePath 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 FilePath TezosClientConfig)
-> Text -> Either FilePath 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 FilePath
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
$ FilePath -> TezosClientError
ConfigParseError FilePath
err
    (ExitFailure Int
errCode, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
output, FilePath -> 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 @octez-client@.
calcTransferFee
  :: ( WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => AddressOrAlias kind
  -> Maybe ScrubbedBytes
  -> TezosInt64
  -> [CalcTransferFeeData]
  -> m [TezosMutez]
calcTransferFee :: forall env (m :: * -> *) (kind :: AddressKind).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
AddressOrAlias kind
-> Maybe ScrubbedBytes
-> TezosInt64
-> [CalcTransferFeeData]
-> m [TezosMutez]
calcTransferFee AddressOrAlias kind
from Maybe ScrubbedBytes
mbPassword TezosInt64
burnCap [CalcTransferFeeData]
transferFeeDatas = do
  Text
output <- [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [ FilePath
"multiple", FilePath
"transfers", FilePath
"from", AddressOrAlias kind -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AddressOrAlias kind
from, FilePath
"using"
    , ByteString -> FilePath
C.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ [CalcTransferFeeData] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [CalcTransferFeeData]
transferFeeDatas, FilePath
"--burn-cap", TezosInt64 -> FilePath
showBurnCap TezosInt64
burnCap, FilePath
"--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
<$> 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 @octez-client@.
calcOriginationFee
  :: ( UntypedValScope st, WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => CalcOriginationFeeData cp st -> m TezosMutez
calcOriginationFee :: forall (st :: T) env (m :: * -> *) (cp :: T).
(UntypedValScope st, WithClientLog env m, HasTezosClientEnv env,
 MonadIO m, MonadCatch m) =>
CalcOriginationFeeData cp st -> m TezosMutez
calcOriginationFee CalcOriginationFeeData{Maybe ScrubbedBytes
AddressOrAlias kind
TezosInt64
TezosMutez
Contract cp st
Value st
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 :: ()
cofdBurnCap :: TezosInt64
cofdStorage :: Value st
cofdContract :: Contract cp st
cofdMbFromPassword :: Maybe ScrubbedBytes
cofdBalance :: TezosMutez
cofdFrom :: AddressOrAlias kind
..} = do
  Text
output <- [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [ FilePath
"originate", FilePath
"contract", FilePath
"-", FilePath
"transferring"
    , TezosMutez -> FilePath
showTez TezosMutez
cofdBalance
    , FilePath
"from", AddressOrAlias kind -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AddressOrAlias kind
cofdFrom, FilePath
"running"
    , Contract cp st -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg Contract cp st
cofdContract, FilePath
"--init"
    , Value st -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg Value st
cofdStorage, FilePath
"--burn-cap"
    , TezosInt64 -> FilePath
showBurnCap TezosInt64
cofdBurnCap, FilePath
"--dry-run"
    ] CallMode
ClientMode Maybe ScrubbedBytes
cofdMbFromPassword
  SizedList' ('S 'Z) TezosMutez
fees <- 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 @octez-client@.
--
-- Note that @octez-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
     )
  => ImplicitAlias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez
calcRevealFee :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
ImplicitAlias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez
calcRevealFee ImplicitAlias
alias Maybe ScrubbedBytes
mbPassword TezosInt64
burnCap = do
  Text
output <- [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict
    [ FilePath
"reveal", FilePath
"key", FilePath
"for", ImplicitAlias -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg ImplicitAlias
alias
    , FilePath
"--burn-cap", TezosInt64 -> FilePath
showBurnCap TezosInt64
burnCap
    , FilePath
"--dry-run"
    ] CallMode
ClientMode Maybe ScrubbedBytes
mbPassword
  SizedList' ('S 'Z) TezosMutez
fees <- 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 :: forall (n :: Nat) (m :: * -> *).
(SingIPeano n, MonadIO m, MonadThrow m) =>
Text -> m (SizedList n TezosMutez)
feeOutputParser Text
output =
  case 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 -> FilePath
showBurnCap TezosInt64
x = FilePath -> Float -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.6f" (Float -> FilePath) -> Float -> FilePath
forall a b. (a -> b) -> a -> b
$ (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 -> FilePath
showTez = Mutez -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg (Mutez -> FilePath)
-> (TezosMutez -> Mutez) -> TezosMutez -> FilePath
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, Class.HasTezosClient m)
  => ImplicitAddress -> m (Maybe ScrubbedBytes)
getKeyPassword :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadMask m, HasTezosClient m) =>
ImplicitAddress -> m (Maybe ScrubbedBytes)
getKeyPassword ImplicitAddress
key = (ImplicitAddressOrAlias -> m (ResolvedAlias ImplicitAddressOrAlias)
forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, WithClientLog env m, MonadThrow m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAlias addressOrAlias)
getAlias (ImplicitAddressOrAlias
 -> m (ResolvedAlias ImplicitAddressOrAlias))
-> ImplicitAddressOrAlias
-> m (ResolvedAlias ImplicitAddressOrAlias)
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
key) m ImplicitAlias
-> (ImplicitAlias -> m (Maybe ScrubbedBytes))
-> m (Maybe ScrubbedBytes)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ImplicitAlias -> m (Maybe ScrubbedBytes)
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m, MonadMask m) =>
ImplicitAlias -> m (Maybe ScrubbedBytes)
getKeyPassword'
  where
    getKeyPassword'
      :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, MonadMask m)
      => ImplicitAlias -> m (Maybe ScrubbedBytes)
    getKeyPassword' :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m, MonadMask m) =>
ImplicitAlias -> m (Maybe ScrubbedBytes)
getKeyPassword' ImplicitAlias
alias = do
      Text
output <- [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [ FilePath
"show", FilePath
"address", ImplicitAlias -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ImplicitAlias
alias, FilePath
"-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
<> ImplicitAlias -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ImplicitAlias
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 :: forall (m :: * -> *) a. (MonadIO m, MonadMask m) => 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 @octez-client@ functionality is supposed to be
-- exported as functions with types closely resembling inputs of
-- respective @octez-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
-- @octez-client@ call.
----------------------------------------------------------------------------

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

-- | Call @octez-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 :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler [FilePath]
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 {FilePath
Maybe FilePath
BaseUrl
tceMbTezosClientDataDir :: TezosClientEnv -> Maybe FilePath
tceTezosClientPath :: TezosClientEnv -> FilePath
tceEndpointUrl :: TezosClientEnv -> BaseUrl
tceMbTezosClientDataDir :: Maybe FilePath
tceTezosClientPath :: FilePath
tceEndpointUrl :: BaseUrl
..} <- 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 :: [FilePath]
extraArgs = [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat
      [ [FilePath
"-E", BaseUrl -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg BaseUrl
tceEndpointUrl]
      , [FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
dir -> [FilePath
"-d", FilePath
dir]) Maybe FilePath
tceMbTezosClientDataDir
      , [FilePath
"--mode", case CallMode
mode of
            CallMode
MockupMode -> FilePath
"mockup"
            CallMode
ClientMode -> FilePath
"client"
        ]
      ]

    allArgs :: [FilePath]
allArgs = [FilePath]
extraArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
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 (FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
tceTezosClientPathFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
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, FilePath, FilePath)
-> m (ExitCode, FilePath, FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode' FilePath
tceTezosClientPath [FilePath]
allArgs
          (FilePath
-> (ScrubbedBytes -> FilePath) -> Maybe ScrubbedBytes -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ScrubbedBytes -> FilePath
scrubbedBytesToString Maybe ScrubbedBytes
mbInput)) m (ExitCode, FilePath, FilePath)
-> ((ExitCode, FilePath, FilePath) -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (ExitCode
ExitSuccess, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
output, FilePath -> 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, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
output, FilePath -> 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 @octez-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 :: forall a. 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 :: forall a. 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 @octez-client@ and expect success.
callTezosClientStrict
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict [FilePath]
args CallMode
mode Maybe ScrubbedBytes
mbInput = (Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall {f :: * -> *} {p} {p}. Applicative f => p -> p -> f Bool
errHandler [FilePath]
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' :: FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode' FilePath
fp [FilePath]
args FilePath
inp =
  IO (ExitCode, FilePath, FilePath)
-> (IOException -> IO (ExitCode, FilePath, FilePath))
-> IO (ExitCode, FilePath, FilePath)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
    (FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
fp [FilePath]
args FilePath
inp) IOException -> IO (ExitCode, FilePath, FilePath)
handler
  where
    handler :: IOException -> IO (ExitCode, String, String)
    handler :: IOException -> IO (ExitCode, FilePath, FilePath)
handler IOException
e = do
      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, FilePath, FilePath)
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
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` program. Is the \
      \ executable available in PATH ?"

data ResolveError where
  REAliasNotFound :: Text -> ResolveError
  -- ^ Could not find an address with given alias.
  REWrongKind :: Alias expectedKind -> Address -> ResolveError
  -- ^ Expected an alias to be associated with an implicit address, but it was
  -- associated with a contract address, or vice-versa.
  REAddressNotFound :: KindedAddress kind -> ResolveError
  -- ^ Could not find an alias with given address.

deriving stock instance Show ResolveError

instance Buildable ResolveError where
  build :: ResolveError -> Builder
build = \case
    REWrongKind (Alias expectedKind
alias :: Alias expectedKind) (Constrained (KindedAddress a
addr :: KindedAddress actualKind)) ->
      [itu|
        Expected the alias '#{alias}' to be assigned to an address of kind '#{demotedExpectedKind}',
        but it's assigned to an address of kind '#{demotedActualKind}': #{addr}.
        |]
      where
        demotedExpectedKind :: AddressKind
demotedExpectedKind = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: AddressKind).
(SingKind AddressKind, SingI a) =>
Demote AddressKind
demote @expectedKind ((L1AddressKind expectedKind, SingI expectedKind) => AddressKind)
-> Dict (L1AddressKind expectedKind, SingI expectedKind)
-> AddressKind
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Alias expectedKind
-> Dict (L1AddressKind expectedKind, SingI expectedKind)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias expectedKind
alias :: AddressKind
        demotedActualKind :: AddressKind
demotedActualKind = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: AddressKind).
(SingKind AddressKind, SingI a) =>
Demote AddressKind
demote @actualKind (SingI a => AddressKind) -> Dict (SingI a) -> AddressKind
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress a -> Dict (SingI a)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress a
addr :: AddressKind
    REAliasNotFound Text
aliasText ->
      [itu|Could not find the alias '#{aliasText}'.|]
    REAddressNotFound KindedAddress kind
addr ->
      [itu|Could not find an alias for the address '#{addr}'.|]

class Resolve addressOrAlias where
  type ResolvedAddress addressOrAlias :: Type
  type ResolvedAlias addressOrAlias :: Type

  -- | Looks up the address associated with the given @addressOrAlias@.
  --
  -- When the alias is associated with __both__ an implicit and a contract address:
  --
  -- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
  --   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  -- * The 'AddressOrAlias' instance will return the address with the requested kind.
  resolveAddressEither
    :: forall m env
     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => addressOrAlias
    -> m (Either ResolveError (ResolvedAddress addressOrAlias))

  {- | Looks up the alias associated with the given @addressOrAlias@.

  When the alias is associated with __both__ an implicit and a contract address:

  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  * The 'AddressOrAlias' instance will return the alias of the address with the requested kind.

  The primary (and probably only) reason this function exists is that
  @octez-client sign@ command only works with aliases. It was
  reported upstream: <https://gitlab.com/tezos/tezos/-/issues/836>.
  -}
  getAliasEither
    :: forall m env
     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => addressOrAlias
    -> m (Either ResolveError (ResolvedAlias addressOrAlias))

instance Resolve (AddressOrAlias kind) where
  type ResolvedAddress (AddressOrAlias kind) = KindedAddress kind
  type ResolvedAlias (AddressOrAlias kind) = Alias kind

  resolveAddressEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind))
  resolveAddressEither :: forall (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m) =>
AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind))
resolveAddressEither = \case
    AddressResolved KindedAddress kind
addr -> Either ResolveError (KindedAddress kind)
-> m (Either ResolveError (KindedAddress kind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResolveError (KindedAddress kind)
 -> m (Either ResolveError (KindedAddress kind)))
-> Either ResolveError (KindedAddress kind)
-> m (Either ResolveError (KindedAddress kind))
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Either ResolveError (KindedAddress kind)
forall a b. b -> Either a b
Right KindedAddress kind
addr
    aoa :: AddressOrAlias kind
aoa@(AddressAlias Alias kind
alias) -> do
      Text -> m FindAddressResult
forall (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m) =>
Text -> m FindAddressResult
findAddress (Alias kind -> Text
forall (kind :: AddressKind). Alias kind -> Text
unAlias Alias kind
alias) m FindAddressResult
-> (FindAddressResult
    -> m (Either ResolveError (KindedAddress kind)))
-> m (Either ResolveError (KindedAddress kind))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        FindAddressResult
FARNone -> Either ResolveError (KindedAddress kind)
-> m (Either ResolveError (KindedAddress kind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResolveError (KindedAddress kind)
 -> m (Either ResolveError (KindedAddress kind)))
-> Either ResolveError (KindedAddress kind)
-> m (Either ResolveError (KindedAddress kind))
forall a b. (a -> b) -> a -> b
$ ResolveError -> Either ResolveError (KindedAddress kind)
forall a b. a -> Either a b
Left (ResolveError -> Either ResolveError (KindedAddress kind))
-> ResolveError -> Either ResolveError (KindedAddress kind)
forall a b. (a -> b) -> a -> b
$ Text -> ResolveError
REAliasNotFound (AddressOrAlias kind -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AddressOrAlias kind
aoa)
        FARUnambiguous (Constrained KindedAddress a
addr) ->
          Either ResolveError (KindedAddress kind)
-> m (Either ResolveError (KindedAddress kind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResolveError (KindedAddress kind)
 -> m (Either ResolveError (KindedAddress kind)))
-> Either ResolveError (KindedAddress kind)
-> m (Either ResolveError (KindedAddress kind))
forall a b. (a -> b) -> a -> b
$ ResolveError
-> Maybe (KindedAddress kind)
-> Either ResolveError (KindedAddress kind)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Alias kind -> Address -> ResolveError
forall (kind :: AddressKind). Alias kind -> Address -> ResolveError
REWrongKind Alias kind
alias (KindedAddress a -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress a
addr)) (Maybe (KindedAddress kind)
 -> Either ResolveError (KindedAddress kind))
-> Maybe (KindedAddress kind)
-> Either ResolveError (KindedAddress kind)
forall a b. (a -> b) -> a -> b
$
            KindedAddress a -> Maybe (KindedAddress kind)
forall {k} (a :: k) (b :: k) (t :: k -> *).
(SingI a, SingI b, SDecide k) =>
t a -> Maybe (t b)
castSing KindedAddress a
addr (SingI a => Maybe (KindedAddress kind))
-> Dict (SingI a) -> Maybe (KindedAddress kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress a -> Dict (SingI a)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress a
addr ((L1AddressKind kind, SingI kind) => Maybe (KindedAddress kind))
-> Dict (L1AddressKind kind, SingI kind)
-> Maybe (KindedAddress kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Alias kind -> Dict (L1AddressKind kind, SingI kind)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias kind
alias
        FARAmbiguous ContractAddress
contractAddr ImplicitAddress
implicitAddr ->
          Dict (L1AddressKind kind, SingI kind)
-> ((L1AddressKind kind, SingI kind) =>
    m (Either ResolveError (KindedAddress kind)))
-> m (Either ResolveError (KindedAddress kind))
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Alias kind -> Dict (L1AddressKind kind, SingI kind)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias kind
alias) (((L1AddressKind kind, SingI kind) =>
  m (Either ResolveError (KindedAddress kind)))
 -> m (Either ResolveError (KindedAddress kind)))
-> ((L1AddressKind kind, SingI kind) =>
    m (Either ResolveError (KindedAddress kind)))
-> m (Either ResolveError (KindedAddress kind))
forall a b. (a -> b) -> a -> b
$
            forall (kind :: AddressKind) a. L1AddressKind kind => a -> a
usingImplicitOrContractKind @kind
              case forall {k} (a :: k). SingI a => Sing a
forall (a :: AddressKind). SingI a => Sing a
sing @kind of
                Sing kind
SingAddressKind kind
SAddressKindContract -> Either ResolveError ContractAddress
-> m (Either ResolveError ContractAddress)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResolveError ContractAddress
 -> m (Either ResolveError ContractAddress))
-> Either ResolveError ContractAddress
-> m (Either ResolveError ContractAddress)
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Either ResolveError ContractAddress
forall a b. b -> Either a b
Right ContractAddress
contractAddr
                Sing kind
SingAddressKind kind
SAddressKindImplicit -> Either ResolveError ImplicitAddress
-> m (Either ResolveError ImplicitAddress)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResolveError ImplicitAddress
 -> m (Either ResolveError ImplicitAddress))
-> Either ResolveError ImplicitAddress
-> m (Either ResolveError ImplicitAddress)
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> Either ResolveError ImplicitAddress
forall a b. b -> Either a b
Right ImplicitAddress
implicitAddr

  getAliasEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => AddressOrAlias kind -> m (Either ResolveError (Alias kind))
  getAliasEither :: forall (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m) =>
AddressOrAlias kind -> m (Either ResolveError (Alias kind))
getAliasEither = \case
    aoa :: AddressOrAlias kind
aoa@(AddressAlias Alias kind
alias) ->
      -- Check if the alias exists
      (Either ResolveError (KindedAddress kind)
-> Alias kind -> Either ResolveError (Alias kind)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Alias kind
alias) (Either ResolveError (KindedAddress kind)
 -> Either ResolveError (Alias kind))
-> m (Either ResolveError (KindedAddress kind))
-> m (Either ResolveError (Alias kind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressOrAlias kind
-> m (Either ResolveError (ResolvedAddress (AddressOrAlias kind)))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
resolveAddressEither AddressOrAlias kind
aoa
    AddressResolved KindedAddress kind
addr -> do
      [(Text, Text)]
aliasesAndAddresses <- m [(Text, Text)]
forall (m :: * -> *). HasTezosClient m => m [(Text, Text)]
Class.getAliasesAndAddresses
      case (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> Maybe (Text, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element [(Text, Text)] -> Bool)
-> [(Text, Text)] -> Maybe (Element [(Text, Text)])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\(Text
_, Text
addr') -> Text
addr' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== KindedAddress kind -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty KindedAddress kind
addr) [(Text, Text)]
aliasesAndAddresses of
        Maybe Text
Nothing -> Either ResolveError (Alias kind)
-> m (Either ResolveError (Alias kind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResolveError (Alias kind)
 -> m (Either ResolveError (Alias kind)))
-> Either ResolveError (Alias kind)
-> m (Either ResolveError (Alias kind))
forall a b. (a -> b) -> a -> b
$ ResolveError -> Either ResolveError (Alias kind)
forall a b. a -> Either a b
Left (ResolveError -> Either ResolveError (Alias kind))
-> ResolveError -> Either ResolveError (Alias kind)
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> ResolveError
forall (kind :: AddressKind). KindedAddress kind -> ResolveError
REAddressNotFound KindedAddress kind
addr
        Just Text
aliasText -> do
          -- This alias _might_ belong to both an implicit account and a contract,
          -- in which case it might be prefixed with "key".
          -- If so, we have to strip the prefix.
          let aliasTextWithoutPrefix :: Text
aliasTextWithoutPrefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
aliasText (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"key:" Text
aliasText
          Either ResolveError (Alias kind)
-> m (Either ResolveError (Alias kind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResolveError (Alias kind)
 -> m (Either ResolveError (Alias kind)))
-> Either ResolveError (Alias kind)
-> m (Either ResolveError (Alias kind))
forall a b. (a -> b) -> a -> b
$ Alias kind -> Either ResolveError (Alias kind)
forall a b. b -> Either a b
Right (Alias kind -> Either ResolveError (Alias kind))
-> Alias kind -> Either ResolveError (Alias kind)
forall a b. (a -> b) -> a -> b
$ forall (kind :: AddressKind).
(SingI kind, L1AddressKind kind) =>
Text -> Alias kind
mkAlias @kind Text
aliasTextWithoutPrefix (SingI kind => Alias kind) -> Dict (SingI kind) -> Alias kind
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress kind -> Dict (SingI kind)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress kind
addr

instance Resolve SomeAddressOrAlias where
  type ResolvedAddress SomeAddressOrAlias = L1Address
  type ResolvedAlias SomeAddressOrAlias = SomeAlias

  resolveAddressEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => SomeAddressOrAlias -> m (Either ResolveError L1Address)
  resolveAddressEither :: forall (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m) =>
SomeAddressOrAlias
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
resolveAddressEither = \case
    SAOAKindUnspecified Text
aliasText -> do
      Text -> m FindAddressResult
forall (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m) =>
Text -> m FindAddressResult
findAddress Text
aliasText m FindAddressResult
-> (FindAddressResult
    -> m (Either
            ResolveError
            (Constrained
               (ConstrainAddressKind
                  '[ 'AddressKindImplicit, 'AddressKindContract])
               KindedAddress)))
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        FindAddressResult
FARNone -> Either
  ResolveError
  (Constrained
     (ConstrainAddressKind
        '[ 'AddressKindImplicit, 'AddressKindContract])
     KindedAddress)
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ResolveError
   (Constrained
      (ConstrainAddressKind
         '[ 'AddressKindImplicit, 'AddressKindContract])
      KindedAddress)
 -> m (Either
         ResolveError
         (Constrained
            (ConstrainAddressKind
               '[ 'AddressKindImplicit, 'AddressKindContract])
            KindedAddress)))
-> Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall a b. (a -> b) -> a -> b
$ ResolveError
-> Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall a b. a -> Either a b
Left (ResolveError
 -> Either
      ResolveError
      (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress))
-> ResolveError
-> Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall a b. (a -> b) -> a -> b
$ Text -> ResolveError
REAliasNotFound Text
aliasText
        FARUnambiguous Constrained
  (ConstrainAddressKind
     '[ 'AddressKindImplicit, 'AddressKindContract])
  KindedAddress
addr -> Either
  ResolveError
  (Constrained
     (ConstrainAddressKind
        '[ 'AddressKindImplicit, 'AddressKindContract])
     KindedAddress)
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ResolveError
   (Constrained
      (ConstrainAddressKind
         '[ 'AddressKindImplicit, 'AddressKindContract])
      KindedAddress)
 -> m (Either
         ResolveError
         (Constrained
            (ConstrainAddressKind
               '[ 'AddressKindImplicit, 'AddressKindContract])
            KindedAddress)))
-> Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall a b. (a -> b) -> a -> b
$ Constrained
  (ConstrainAddressKind
     '[ 'AddressKindImplicit, 'AddressKindContract])
  KindedAddress
-> Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall a b. b -> Either a b
Right Constrained
  (ConstrainAddressKind
     '[ 'AddressKindImplicit, 'AddressKindContract])
  KindedAddress
addr
        FARAmbiguous ContractAddress
contractAddr ImplicitAddress
implicitAddr -> TezosClientError
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError
 -> m (Either
         ResolveError
         (Constrained
            (ConstrainAddressKind
               '[ 'AddressKindImplicit, 'AddressKindContract])
            KindedAddress)))
-> TezosClientError
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall a b. (a -> b) -> a -> b
$ Text -> ContractAddress -> ImplicitAddress -> TezosClientError
AmbiguousAlias Text
aliasText ContractAddress
contractAddr ImplicitAddress
implicitAddr
    SAOAKindSpecified AddressOrAlias kind
aoa ->
      (KindedAddress kind
 -> Constrained
      (ConstrainAddressKind
         '[ 'AddressKindImplicit, 'AddressKindContract])
      KindedAddress)
-> Either ResolveError (KindedAddress kind)
-> Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KindedAddress kind
-> Constrained
     (ConstrainAddressKind
        '[ 'AddressKindImplicit, 'AddressKindContract])
     KindedAddress
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained (Either ResolveError (KindedAddress kind)
 -> Either
      ResolveError
      (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress))
-> m (Either ResolveError (KindedAddress kind))
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressOrAlias kind
-> m (Either ResolveError (ResolvedAddress (AddressOrAlias kind)))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
resolveAddressEither AddressOrAlias kind
aoa ((L1AddressKind kind, SingI kind) =>
 m (Either
      ResolveError
      (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress)))
-> Dict (L1AddressKind kind, SingI kind)
-> m (Either
        ResolveError
        (Constrained
           (ConstrainAddressKind
              '[ 'AddressKindImplicit, 'AddressKindContract])
           KindedAddress))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ AddressOrAlias kind -> Dict (L1AddressKind kind, SingI kind)
forall (kind :: AddressKind).
AddressOrAlias kind -> Dict (L1AddressKind kind, SingI kind)
addressOrAliasKindSanity AddressOrAlias kind
aoa

  getAliasEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => SomeAddressOrAlias -> m (Either ResolveError SomeAlias)
  getAliasEither :: forall (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m) =>
SomeAddressOrAlias -> m (Either ResolveError SomeAlias)
getAliasEither = \case
    SAOAKindSpecified AddressOrAlias kind
aoa -> do
      (Alias kind -> SomeAlias)
-> Either ResolveError (Alias kind)
-> Either ResolveError SomeAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Alias kind -> SomeAlias
forall (a :: AddressKind). Alias a -> SomeAlias
SomeAlias
        (Either ResolveError (Alias kind) -> Either ResolveError SomeAlias)
-> m (Either ResolveError (Alias kind))
-> m (Either ResolveError SomeAlias)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressOrAlias kind
-> m (Either ResolveError (ResolvedAlias (AddressOrAlias kind)))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAlias addressOrAlias))
getAliasEither AddressOrAlias kind
aoa ((L1AddressKind kind, SingI kind) =>
 m (Either ResolveError SomeAlias))
-> Dict (L1AddressKind kind, SingI kind)
-> m (Either ResolveError SomeAlias)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ AddressOrAlias kind -> Dict (L1AddressKind kind, SingI kind)
forall (kind :: AddressKind).
AddressOrAlias kind -> Dict (L1AddressKind kind, SingI kind)
addressOrAliasKindSanity AddressOrAlias kind
aoa
    aoa :: SomeAddressOrAlias
aoa@(SAOAKindUnspecified Text
aliasText) -> do
      -- Find out whether this alias is associated with an implicit address or a contract,
      -- and return an @Alias kind@ of the correct kind.
      SomeAddressOrAlias
-> m (Either ResolveError (ResolvedAddress SomeAddressOrAlias))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
resolveAddressEither SomeAddressOrAlias
aoa m (Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress))
-> (Either
      ResolveError
      (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress)
    -> Either ResolveError SomeAlias)
-> m (Either ResolveError SomeAlias)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Constrained
   (ConstrainAddressKind
      '[ 'AddressKindImplicit, 'AddressKindContract])
   KindedAddress
 -> SomeAlias)
-> Either
     ResolveError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
-> Either ResolveError SomeAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        \(Constrained (KindedAddress a
addr :: KindedAddress kind)) ->
          Alias a -> SomeAlias
forall (a :: AddressKind). Alias a -> SomeAlias
SomeAlias (Alias a -> SomeAlias) -> Alias a -> SomeAlias
forall a b. (a -> b) -> a -> b
$ forall (kind :: AddressKind).
(SingI kind, L1AddressKind kind) =>
Text -> Alias kind
mkAlias @kind Text
aliasText (SingI a => Alias a) -> Dict (SingI a) -> Alias a
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress a -> Dict (SingI a)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress a
addr

-- | Looks up the address associated with the given @addressOrAlias@.
--
-- Will throw a 'TezosClientError' if @addressOrAlias@ is an alias and:
--
-- * the alias does not exist.
-- * the alias exists but its address is of the wrong kind.
--
-- When the alias is associated with __both__ an implicit and a contract address:
--
-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
--   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
-- * The 'AddressOrAlias' instance will return the address with the requested kind.
resolveAddress
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (ResolvedAddress addressOrAlias)
resolveAddress :: forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAddress addressOrAlias)
resolveAddress = addressOrAlias
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
resolveAddressEither (addressOrAlias
 -> m (Either ResolveError (ResolvedAddress addressOrAlias)))
-> (Either ResolveError (ResolvedAddress addressOrAlias)
    -> m (ResolvedAddress addressOrAlias))
-> addressOrAlias
-> m (ResolvedAddress addressOrAlias)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ResolveError -> m (ResolvedAddress addressOrAlias))
-> (ResolvedAddress addressOrAlias
    -> m (ResolvedAddress addressOrAlias))
-> Either ResolveError (ResolvedAddress addressOrAlias)
-> m (ResolvedAddress addressOrAlias)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> m (ResolvedAddress addressOrAlias)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m (ResolvedAddress addressOrAlias))
-> (ResolveError -> TezosClientError)
-> ResolveError
-> m (ResolvedAddress addressOrAlias)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolveError -> TezosClientError
ResolveError) ResolvedAddress addressOrAlias
-> m (ResolvedAddress addressOrAlias)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Looks up the address associated with the given @addressOrAlias@.
--
-- Will return 'Nothing' if @addressOrAlias@ is an alias and:
--
-- * the alias does not exist.
-- * the alias exists but its address is of the wrong kind.
--
-- When the alias is associated with __both__ an implicit and a contract address:
--
-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
--   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
-- * The 'AddressOrAlias' instance will return the address with the requested kind.
resolveAddressMaybe
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (Maybe (ResolvedAddress addressOrAlias))
resolveAddressMaybe :: forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (Maybe (ResolvedAddress addressOrAlias))
resolveAddressMaybe addressOrAlias
aoa =
  Either ResolveError (ResolvedAddress addressOrAlias)
-> Maybe (ResolvedAddress addressOrAlias)
forall l r. Either l r -> Maybe r
rightToMaybe (Either ResolveError (ResolvedAddress addressOrAlias)
 -> Maybe (ResolvedAddress addressOrAlias))
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
-> m (Maybe (ResolvedAddress addressOrAlias))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> addressOrAlias
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAddress addressOrAlias))
resolveAddressEither addressOrAlias
aoa

{- | Looks up the alias associated with the given @addressOrAlias@.

Will throw a 'TezosClientError' if @addressOrAlias@:

  * is an address that is not associated with any alias.
  * is an alias that does not exist.
  * is an alias that exists but its address is of the wrong kind.

When the alias is associated with __both__ an implicit and a contract address:

  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  * The 'AddressOrAlias' instance will return the alias.
-}
getAlias
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (ResolvedAlias addressOrAlias)
getAlias :: forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, WithClientLog env m, MonadThrow m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAlias addressOrAlias)
getAlias = addressOrAlias
-> m (Either ResolveError (ResolvedAlias addressOrAlias))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAlias addressOrAlias))
getAliasEither (addressOrAlias
 -> m (Either ResolveError (ResolvedAlias addressOrAlias)))
-> (Either ResolveError (ResolvedAlias addressOrAlias)
    -> m (ResolvedAlias addressOrAlias))
-> addressOrAlias
-> m (ResolvedAlias addressOrAlias)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ResolveError -> m (ResolvedAlias addressOrAlias))
-> (ResolvedAlias addressOrAlias
    -> m (ResolvedAlias addressOrAlias))
-> Either ResolveError (ResolvedAlias addressOrAlias)
-> m (ResolvedAlias addressOrAlias)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> m (ResolvedAlias addressOrAlias)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m (ResolvedAlias addressOrAlias))
-> (ResolveError -> TezosClientError)
-> ResolveError
-> m (ResolvedAlias addressOrAlias)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolveError -> TezosClientError
ResolveError) ResolvedAlias addressOrAlias -> m (ResolvedAlias addressOrAlias)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{- | Looks up the alias associated with the given @addressOrAlias@.

Will return 'Nothing' if @addressOrAlias@:

  * is an address that is not associated with any alias.
  * is an alias that does not exist.
  * is an alias that exists but its address is of the wrong kind.

When the alias is associated with __both__ an implicit and a contract address:

  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  * The 'AddressOrAlias' instance will return the alias.
-}
getAliasMaybe
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (Maybe (ResolvedAlias addressOrAlias))
getAliasMaybe :: forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, WithClientLog env m, MonadThrow m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (Maybe (ResolvedAlias addressOrAlias))
getAliasMaybe addressOrAlias
aoa =
  Either ResolveError (ResolvedAlias addressOrAlias)
-> Maybe (ResolvedAlias addressOrAlias)
forall l r. Either l r -> Maybe r
rightToMaybe (Either ResolveError (ResolvedAlias addressOrAlias)
 -> Maybe (ResolvedAlias addressOrAlias))
-> m (Either ResolveError (ResolvedAlias addressOrAlias))
-> m (Maybe (ResolvedAlias addressOrAlias))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> addressOrAlias
-> m (Either ResolveError (ResolvedAlias addressOrAlias))
forall addressOrAlias (m :: * -> *) env.
(Resolve addressOrAlias, HasTezosClient m, MonadThrow m,
 WithClientLog env m) =>
addressOrAlias
-> m (Either ResolveError (ResolvedAlias addressOrAlias))
getAliasEither addressOrAlias
aoa

{- | Finds the implicit/contract addresses assigned to the given alias.

Note that an alias can be ambiguous: it can refer to __both__ a contract and an
implicit account. When an alias "abc" is ambiguous, @octez-client list known
contracts@ will return two entries with the following format:

> abc: KT1...
> key:abc: tz1...

So, in order to check whether the alias is ambiguous, we check whether both
"abc" and "key:abc" are present in the output.

If only "abc" is present, then we know it's not ambiguous (and it refers to
__either__ a contract or an implicit account).
-}
findAddress
  :: forall m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
  => Text
  -> m FindAddressResult
findAddress :: forall (m :: * -> *) env.
(HasTezosClient m, MonadThrow m, WithClientLog env m) =>
Text -> m FindAddressResult
findAddress Text
aliasText = 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
+| Text
aliasText Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
  [(Text, Text)]
aliasesAndAddresses <- m [(Text, Text)]
forall (m :: * -> *). HasTezosClient m => m [(Text, Text)]
Class.getAliasesAndAddresses

  let find' :: Text -> Maybe Text
find' Text
alias = (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> Maybe (Text, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element [(Text, Text)] -> Bool)
-> [(Text, Text)] -> Maybe (Element [(Text, Text)])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\(Text
alias', Text
_) -> Text
alias' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
alias) [(Text, Text)]
aliasesAndAddresses

  case (Text -> Maybe Text
find' Text
aliasText, Text -> Maybe Text
find' (Text
"key:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aliasText)) of
    (Maybe Text
Nothing, Maybe Text
_) -> FindAddressResult -> m FindAddressResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure FindAddressResult
FARNone
    (Just Text
firstMatch, Maybe Text
Nothing) -> Constrained
  (ConstrainAddressKind
     '[ 'AddressKindImplicit, 'AddressKindContract])
  KindedAddress
-> FindAddressResult
FARUnambiguous (Constrained
   (ConstrainAddressKind
      '[ 'AddressKindImplicit, 'AddressKindContract])
   KindedAddress
 -> FindAddressResult)
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
-> m FindAddressResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
parseL1Address Text
firstMatch
    (Just Text
contractAddrText, Just Text
implicitAddrText) -> do
      ContractAddress
contractAddr <-
        (ParseAddressError -> m ContractAddress)
-> (ContractAddress -> m ContractAddress)
-> Either ParseAddressError ContractAddress
-> m ContractAddress
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> m ContractAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m ContractAddress)
-> (ParseAddressError -> TezosClientError)
-> ParseAddressError
-> m ContractAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseAddressError -> TezosClientError
TezosClientParseAddressError Text
contractAddrText) ContractAddress -> m ContractAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseAddressError ContractAddress -> m ContractAddress)
-> Either ParseAddressError ContractAddress -> m ContractAddress
forall a b. (a -> b) -> a -> b
$
          forall (kind :: AddressKind).
SingI kind =>
Text -> Either ParseAddressError (KindedAddress kind)
parseKindedAddress @'AddressKindContract Text
contractAddrText
      ImplicitAddress
implicitAddr <-
        (ParseAddressError -> m ImplicitAddress)
-> (ImplicitAddress -> m ImplicitAddress)
-> Either ParseAddressError ImplicitAddress
-> m ImplicitAddress
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> m ImplicitAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m ImplicitAddress)
-> (ParseAddressError -> TezosClientError)
-> ParseAddressError
-> m ImplicitAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseAddressError -> TezosClientError
TezosClientParseAddressError Text
implicitAddrText) ImplicitAddress -> m ImplicitAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseAddressError ImplicitAddress -> m ImplicitAddress)
-> Either ParseAddressError ImplicitAddress -> m ImplicitAddress
forall a b. (a -> b) -> a -> b
$
          forall (kind :: AddressKind).
SingI kind =>
Text -> Either ParseAddressError (KindedAddress kind)
parseKindedAddress @'AddressKindImplicit Text
implicitAddrText
      pure $ ContractAddress -> ImplicitAddress -> FindAddressResult
FARAmbiguous ContractAddress
contractAddr ImplicitAddress
implicitAddr
  where
    parseL1Address :: Text -> m L1Address
    parseL1Address :: Text
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
parseL1Address Text
addrText =
      (ParseAddressError
 -> m (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress))
-> (Constrained
      (ConstrainAddressKind
         '[ 'AddressKindImplicit, 'AddressKindContract])
      KindedAddress
    -> m (Constrained
            (ConstrainAddressKind
               '[ 'AddressKindImplicit, 'AddressKindContract])
            KindedAddress))
-> Either
     ParseAddressError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError
 -> m (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress))
-> (ParseAddressError -> TezosClientError)
-> ParseAddressError
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseAddressError -> TezosClientError
TezosClientParseAddressError Text
addrText) Constrained
  (ConstrainAddressKind
     '[ 'AddressKindImplicit, 'AddressKindContract])
  KindedAddress
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ParseAddressError
   (Constrained
      (ConstrainAddressKind
         '[ 'AddressKindImplicit, 'AddressKindContract])
      KindedAddress)
 -> m (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress))
-> (Text
    -> Either
         ParseAddressError
         (Constrained
            (ConstrainAddressKind
               '[ 'AddressKindImplicit, 'AddressKindContract])
            KindedAddress))
-> Text
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Text
-> Either
     ParseAddressError
     (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall (kinds :: [AddressKind]).
SingI kinds =>
Text -> Either ParseAddressError (ConstrainedAddress kinds)
parseConstrainedAddress (Text
 -> m (Constrained
         (ConstrainAddressKind
            '[ 'AddressKindImplicit, 'AddressKindContract])
         KindedAddress))
-> Text
-> m (Constrained
        (ConstrainAddressKind
           '[ 'AddressKindImplicit, 'AddressKindContract])
        KindedAddress)
forall a b. (a -> b) -> a -> b
$ Text
addrText

-- | Whether an alias is associated with an implicit address, a contract address, or both.
data FindAddressResult
  = FARUnambiguous L1Address
  | FARAmbiguous ContractAddress ImplicitAddress
  | FARNone

{- | Calls @octez-client list known contracts@ and returns
a list of @(alias, address)@ pairs.

Note that an alias can be ambiguous: it can refer to __both__ a contract and an implicit account.
When an alias "abc" is ambiguous, the list will contain two entries:

> ("abc", "KT1...")
> ("key:abc", "tz1...")
-}
getAliasesAndAddresses
  :: forall m env
   . (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => m [(Text, Text)]
getAliasesAndAddresses :: forall (m :: * -> *) env.
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
m [(Text, Text)]
getAliasesAndAddresses =
  Text -> [(Text, Text)]
parseOutput (Text -> [(Text, Text)]) -> m Text -> m [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
FilePath -> m Text
callListKnown FilePath
"contracts"
  where
    parseOutput :: Text -> [(Text, Text)]
    parseOutput :: Text -> [(Text, Text)]
parseOutput = (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> (Text, Text)
parseLine ([Text] -> [(Text, Text)])
-> (Text -> [Text]) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines

    -- Note: each line has the format "<alias>: <address>"
    parseLine :: Text -> (Text, Text)
    parseLine :: Text -> (Text, Text)
parseLine = (Text -> Text) -> (Text, Text) -> (Text, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Text -> Text
T.dropEnd Int
2) ((Text, Text) -> (Text, Text))
-> (Text -> (Text, Text)) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
T.breakOnEnd Text
": "