module Morley.Client.TezosClient.Impl
( TezosClientError (..)
, signBytes
, rememberContract
, importKey
, genKey
, genFreshKey
, revealKey
, resolveAddressMaybe
, resolveAddress
, getAlias
, getPublicKey
, getSecretKey
, getTezosClientConfig
, calcTransferFee
, calcOriginationFee
, calcRevealFee
, getKeyPassword
, registerDelegate
, 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 Lorentz.Value
import Morley.Client.Logging
import Morley.Client.RPC.Types
import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(resolveAddressMaybe))
import Morley.Client.TezosClient.Parser
import Morley.Client.TezosClient.Types
import Morley.Client.Util (readScrubbedBytes, scrubbedBytesToString)
import Morley.Micheline
import Morley.Michelson.Typed.Scope
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Crypto
import Morley.Util.Peano
import Morley.Util.SizedList.Types
data TezosClientError =
UnexpectedClientFailure
Int
Text
Text
| UnknownAddressAlias
Text
| UnknownAddress
Address
| AlreadyRevealed
ImplicitAlias
| InvalidOperationHash
OperationHash
| CounterIsAlreadyUsed
Text
Text
| EConnreset
| ConfigParseError String
| TezosClientCryptoParseError Text CryptoParseError
| TezosClientParseAddressError Text ParseAddressError
| TezosClientParseFeeError Text Text
| TezosClientUnexpectedOutputFormat Text
| CantRevealContract
ImplicitAlias
| ContractSender ContractAddress Text
| EmptyImplicitContract
ImplicitAlias
| TezosClientUnexpectedSignatureOutput Text
| TezosClientParseEncryptionTypeError Text Text
deriving stock (Int -> TezosClientError -> ShowS
[TezosClientError] -> ShowS
TezosClientError -> FilePath
(Int -> TezosClientError -> ShowS)
-> (TezosClientError -> FilePath)
-> ([TezosClientError] -> ShowS)
-> Show TezosClientError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TezosClientError] -> ShowS
$cshowList :: [TezosClientError] -> ShowS
show :: TezosClientError -> FilePath
$cshow :: TezosClientError -> FilePath
showsPrec :: Int -> TezosClientError -> ShowS
$cshowsPrec :: Int -> TezosClientError -> ShowS
Show, TezosClientError -> TezosClientError -> Bool
(TezosClientError -> TezosClientError -> Bool)
-> (TezosClientError -> TezosClientError -> Bool)
-> Eq TezosClientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TezosClientError -> TezosClientError -> Bool
$c/= :: TezosClientError -> TezosClientError -> Bool
== :: TezosClientError -> TezosClientError -> Bool
$c== :: TezosClientError -> TezosClientError -> Bool
Eq)
instance Exception TezosClientError where
displayException :: TezosClientError -> 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
"tezos-client unexpectedly failed with error code " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
errCode Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
Builder
". Stdout:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
output Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\nStderr:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
errOutput Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
UnknownAddressAlias Text
name ->
Builder
"Could not find an address with name " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
UnknownAddress Address
uaddr ->
Builder
"Could not find an associated name for the given address " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Address -> Builder
forall p. Buildable p => p -> Builder
build Address
uaddr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
AlreadyRevealed 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
"tezos-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
"tezos-client produced a cryptographic primitive that we can't parse: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n The error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| CryptoParseError
err CryptoParseError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"."
TezosClientParseAddressError Text
txt ParseAddressError
err ->
Builder
"tezos-client produced an address that we can't parse: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n The error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ParseAddressError
err ParseAddressError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"."
TezosClientParseFeeError Text
txt Text
err ->
Builder
"tezos-client produced invalid output for parsing baker fee: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n Parsing error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
err Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
TezosClientUnexpectedOutputFormat Text
txt ->
Builder
"tezos-client printed a string that doesn't match the format we expect:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Builder
forall p. Buildable p => p -> Builder
build Text
txt
CantRevealContract 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
"'tezos-client sign bytes' call returned a signature in format we don't expect:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Builder
forall p. Buildable p => p -> Builder
build Text
txt
TezosClientParseEncryptionTypeError Text
txt Text
err ->
Builder
"tezos-client produced invalid output for parsing secret key encryption type: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
Text
txt Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
".\n Parsing error is: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
err Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
signBytes
:: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
=> ImplicitAddressOrAlias
-> Maybe ScrubbedBytes
-> ByteString
-> m Signature
signBytes :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
ImplicitAddressOrAlias
-> Maybe ScrubbedBytes -> ByteString -> m Signature
signBytes ImplicitAddressOrAlias
signer Maybe ScrubbedBytes
mbPassword ByteString
opHash = do
ImplicitAlias
signerAlias <- ImplicitAddressOrAlias -> m ImplicitAlias
forall (kind :: AddressKind) env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m, L1AddressKind kind) =>
AddressOrAlias kind -> m (Alias kind)
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 ->
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
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
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 ImplicitAddress
forall (m :: * -> *) (kind :: AddressKind).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias kind -> m (KindedAddress kind)
resolveAddress (ImplicitAlias -> ImplicitAddressOrAlias
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias ImplicitAlias
name)
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
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 ImplicitAddress
forall (m :: * -> *) (kind :: AddressKind).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias kind -> m (KindedAddress kind)
resolveAddress (ImplicitAlias -> ImplicitAddressOrAlias
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias ImplicitAlias
name)
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", FilePath
"key:" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> 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
""
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"
resolveAddressMaybe
:: forall env m kind. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
=> AddressOrAlias kind
-> m (Maybe (KindedAddress kind))
resolveAddressMaybe :: forall env (m :: * -> *) (kind :: AddressKind).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
AddressOrAlias kind -> m (Maybe (KindedAddress kind))
resolveAddressMaybe AddressOrAlias kind
addressOrAlias = case AddressOrAlias kind
addressOrAlias of
AddressResolved KindedAddress kind
addr -> Maybe (KindedAddress kind) -> m (Maybe (KindedAddress kind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (KindedAddress kind) -> m (Maybe (KindedAddress kind)))
-> (KindedAddress kind -> Maybe (KindedAddress kind))
-> KindedAddress kind
-> m (Maybe (KindedAddress kind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> Maybe (KindedAddress kind)
forall a. a -> Maybe a
Just (KindedAddress kind -> m (Maybe (KindedAddress kind)))
-> KindedAddress kind -> m (Maybe (KindedAddress kind))
forall a b. (a -> b) -> a -> b
$ KindedAddress kind
addr
AddressAlias Alias kind
alias -> do
Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Resolving " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias kind
alias Alias kind -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
let
parse :: Text -> Text -> Maybe Text
parse Text
alias' = Text -> Text -> Maybe Text
T.stripPrefix (Text
alias' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
findSatisfyingAddresses :: Text -> Text -> [Text]
findSatisfyingAddresses Text
alias' Text
output = (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
parse Text
alias') ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
output
aliasText :: Text
aliasText = Alias kind -> Text
forall (kind :: AddressKind). Alias kind -> Text
unAlias Alias kind
alias
Text
output <- case Alias kind
alias of
ImplicitAlias{} -> FilePath -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
FilePath -> m Text
callListKnown FilePath
"addresses"
ContractAlias{} -> FilePath -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
FilePath -> m Text
callListKnown FilePath
"contracts"
let
maybeAddress :: Maybe (Element [Text])
maybeAddress = [Text] -> Maybe (Element [Text])
forall t. Container t => t -> Maybe (Element t)
safeHead ([Text] -> Maybe (Element [Text]))
-> [Text] -> Maybe (Element [Text])
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
findSatisfyingAddresses Text
aliasText Text
output
IO (Maybe (KindedAddress kind)) -> m (Maybe (KindedAddress kind))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case Maybe Text
maybeAddress of
Maybe Text
Nothing -> Maybe (KindedAddress kind) -> IO (Maybe (KindedAddress kind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (KindedAddress kind)
forall a. Maybe a
Nothing
Just Text
addrPlainText -> KindedAddress kind -> Maybe (KindedAddress kind)
forall a. a -> Maybe a
Just (KindedAddress kind -> Maybe (KindedAddress kind))
-> IO (KindedAddress kind) -> IO (Maybe (KindedAddress kind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
let addrText :: Text
addrText = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
addrPlainText (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe (Element [Text])
forall t. Container t => t -> Maybe (Element t)
safeHead ([Text] -> Maybe (Element [Text]))
-> [Text] -> Maybe (Element [Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
words Text
addrPlainText
(ParseAddressError -> IO (KindedAddress kind))
-> (KindedAddress kind -> IO (KindedAddress kind))
-> Either ParseAddressError (KindedAddress kind)
-> IO (KindedAddress kind)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TezosClientError -> IO (KindedAddress kind)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO (KindedAddress kind))
-> (ParseAddressError -> TezosClientError)
-> ParseAddressError
-> IO (KindedAddress kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseAddressError -> TezosClientError
TezosClientParseAddressError Text
addrText) KindedAddress kind -> IO (KindedAddress kind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseAddressError (KindedAddress kind)
-> IO (KindedAddress kind))
-> Either ParseAddressError (KindedAddress kind)
-> IO (KindedAddress kind)
forall a b. (a -> b) -> a -> b
$ case Alias kind
alias of
ContractAlias{} -> forall (kind :: AddressKind).
SingI kind =>
Text -> Either ParseAddressError (KindedAddress kind)
parseKindedAddress @'AddressKindContract Text
addrText
ImplicitAlias{} -> forall (kind :: AddressKind).
SingI kind =>
Text -> Either ParseAddressError (KindedAddress kind)
parseKindedAddress @'AddressKindImplicit Text
addrText
getAlias
:: forall kind env m
. ( WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m
, L1AddressKind kind)
=> AddressOrAlias kind
-> m (Alias kind)
getAlias :: forall (kind :: AddressKind) env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m, L1AddressKind kind) =>
AddressOrAlias kind -> m (Alias kind)
getAlias = forall (kind :: AddressKind) a. L1AddressKind kind => a -> a
usingImplicitOrContractKind @kind ((AddressOrAlias kind -> m (Alias kind))
-> AddressOrAlias kind -> m (Alias kind))
-> (AddressOrAlias kind -> m (Alias kind))
-> AddressOrAlias kind
-> m (Alias kind)
forall a b. (a -> b) -> a -> b
$ \case
AddressAlias Alias kind
alias -> Alias kind -> m (Alias kind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alias kind
alias
AddressResolved KindedAddress kind
address -> do
Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Getting an alias for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KindedAddress kind -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty KindedAddress kind
address
Text
output <- case KindedAddress kind
address of
ImplicitAddress{} -> FilePath -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
FilePath -> m Text
callListKnown FilePath
"addresses"
ContractAddress{} -> FilePath -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
FilePath -> m Text
callListKnown FilePath
"contracts"
let
parse :: a -> Text -> Maybe Text
parse a
address' Text
line = case Text -> Text -> [Text]
T.splitOn (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty a
address') Text
line of
[Text
_noMatch] -> Maybe Text
forall a. Maybe a
Nothing
(Text
alias : [Text]
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
alias
[Text]
_ -> Maybe Text
forall a. Maybe a
Nothing
IO (Alias kind) -> m (Alias kind)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case [Text] -> Maybe Text
forall t. Container t => t -> Maybe (Element t)
safeHead ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (KindedAddress kind -> Text -> Maybe Text
parse KindedAddress kind
address)([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
output of
Maybe Text
Nothing -> TezosClientError -> IO (Alias kind)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO (Alias kind))
-> TezosClientError -> IO (Alias kind)
forall a b. (a -> b) -> a -> b
$ Address -> TezosClientError
UnknownAddress (Address -> TezosClientError) -> Address -> TezosClientError
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
address
Just Text
alias -> case KindedAddress kind
address of
ImplicitAddress{} -> ImplicitAlias -> IO ImplicitAlias
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImplicitAlias -> IO ImplicitAlias)
-> ImplicitAlias -> IO ImplicitAlias
forall a b. (a -> b) -> a -> b
$ Text -> ImplicitAlias
ImplicitAlias Text
alias
ContractAddress{} -> Alias 'AddressKindContract -> IO (Alias 'AddressKindContract)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Alias 'AddressKindContract -> IO (Alias 'AddressKindContract))
-> Alias 'AddressKindContract -> IO (Alias 'AddressKindContract)
forall a b. (a -> b) -> a -> b
$ Text -> Alias 'AddressKindContract
ContractAlias Text
alias
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
getPublicKey
:: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
=> ImplicitAddressOrAlias
-> m PublicKey
getPublicKey :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
ImplicitAddressOrAlias -> m PublicKey
getPublicKey ImplicitAddressOrAlias
addrOrAlias = do
ImplicitAlias
alias <- ImplicitAddressOrAlias -> m ImplicitAlias
forall (kind :: AddressKind) env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m, L1AddressKind kind) =>
AddressOrAlias kind -> m (Alias kind)
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
getSecretKey
:: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
=> ImplicitAddressOrAlias
-> m SecretKey
getSecretKey :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
ImplicitAddressOrAlias -> m SecretKey
getSecretKey ImplicitAddressOrAlias
addrOrAlias = do
ImplicitAlias
alias <- ImplicitAddressOrAlias -> m ImplicitAlias
forall (kind :: AddressKind) env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m, L1AddressKind kind) =>
AddressOrAlias kind -> m (Alias kind)
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
rememberContract
:: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
=> Bool
-> ContractAddress
-> ContractAlias
-> m ()
rememberContract :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m) =>
Bool -> ContractAddress -> Alias 'AddressKindContract -> m ()
rememberContract Bool
replaceExisting ContractAddress
contractAddress Alias 'AddressKindContract
name = 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
"remember", FilePath
"contract", Alias 'AddressKindContract -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg Alias 'AddressKindContract
name, ContractAddress -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ContractAddress
contractAddress]
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 ()
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
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
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
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
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
getKeyPassword
:: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m)
=> ImplicitAddress -> m (Maybe ScrubbedBytes)
getKeyPassword :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadMask m) =>
ImplicitAddress -> m (Maybe ScrubbedBytes)
getKeyPassword ImplicitAddress
key = (ImplicitAddressOrAlias -> m ImplicitAlias
forall (kind :: AddressKind) env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
MonadCatch m, L1AddressKind kind) =>
AddressOrAlias kind -> m (Alias kind)
getAlias (ImplicitAddressOrAlias -> m ImplicitAlias)
-> ImplicitAddressOrAlias -> m ImplicitAlias
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
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
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
data CallMode
= MockupMode
| ClientMode
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
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
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
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 ?"
resolveAddress
:: (MonadThrow m, Class.HasTezosClient m)
=> AddressOrAlias kind
-> m (KindedAddress kind)
resolveAddress :: forall (m :: * -> *) (kind :: AddressKind).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias kind -> m (KindedAddress kind)
resolveAddress AddressOrAlias kind
addr = case AddressOrAlias kind
addr of
AddressResolved KindedAddress kind
addrResolved -> KindedAddress kind -> m (KindedAddress kind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KindedAddress kind
addrResolved
alias :: AddressOrAlias kind
alias@(AddressAlias Alias kind
originatorName) ->
AddressOrAlias kind -> m (Maybe (KindedAddress kind))
forall (m :: * -> *) (kind :: AddressKind).
HasTezosClient m =>
AddressOrAlias kind -> m (Maybe (KindedAddress kind))
Class.resolveAddressMaybe AddressOrAlias kind
alias m (Maybe (KindedAddress kind))
-> (Maybe (KindedAddress kind) -> m (KindedAddress kind))
-> m (KindedAddress kind)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\case
Maybe (KindedAddress kind)
Nothing -> TezosClientError -> m (KindedAddress kind)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m (KindedAddress kind))
-> TezosClientError -> m (KindedAddress kind)
forall a b. (a -> b) -> a -> b
$ Text -> TezosClientError
UnknownAddressAlias (Alias kind -> Text
forall (kind :: AddressKind). Alias kind -> Text
unAlias Alias kind
originatorName)
Just KindedAddress kind
existingAddress -> KindedAddress kind -> m (KindedAddress kind)
forall (m :: * -> *) a. Monad m => a -> m a
return KindedAddress kind
existingAddress
)