-- 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 = pretty instance Buildable TezosClientError where build = \case UnexpectedClientFailure errCode output errOutput -> "`octez-client` unexpectedly failed with error code " +| errCode |+ ". Stdout:\n" +| output |+ "\nStderr:\n" +| errOutput |+ "" AlreadyRevealed alias -> "The address alias " <> build alias <> " is already revealed" InvalidOperationHash hash -> "Can't wait for inclusion of operation " <> build hash <> " because this hash is invalid." CounterIsAlreadyUsed counter addr -> "Counter " +| counter |+ " already used for " +| addr |+ "." EConnreset -> "`octez-client` call failed with 'Unix.ECONNRESET' error." ConfigParseError err -> "A parse error occurred during config parsing: " <> build err TezosClientCryptoParseError txt err -> "`octez-client` produced a cryptographic primitive that we can't parse: " +| txt |+ ".\n The error is: " +| err |+ "." TezosClientParseAddressError txt err -> "`octez-client` produced an address that we can't parse: " +| txt |+ ".\n The error is: " +| err |+ "." TezosClientParseFeeError txt err -> "`octez-client` produced invalid output for parsing baker fee: " +| txt |+ ".\n Parsing error is: " +| err |+ "" TezosClientUnexpectedOutputFormat txt -> "`octez-client` printed a string that doesn't match the format we expect:\n" <> build txt CantRevealContract alias -> "Contracts (" <> build alias <> ") cannot be revealed" ContractSender addr opName -> "Contract (" <> build addr <> ") cannot be source of " +| opName |+ "" EmptyImplicitContract alias -> "Empty implicit contract (" <> build alias <> ")" TezosClientUnexpectedSignatureOutput txt -> "`octez-client sign bytes` call returned a signature in format we don't expect:\n" <> build txt TezosClientParseEncryptionTypeError txt err -> "`octez-client` produced invalid output for parsing secret key encryption type: " +| txt |+ ".\n Parsing error is: " +| err |+ "" DuplicateAlias alias -> "Attempted to save alias '" +| alias |+ "', but it already exists" AmbiguousAlias aliasText contractAddr 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 aliasText 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 err -> build 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 signer mbPassword opHash = do signerAlias <- getAlias signer logDebug $ "Signing for " <> pretty signer output <- callTezosClientStrict ["sign", "bytes", toCmdArg opHash, "for", toCmdArg signerAlias] MockupMode mbPassword liftIO case T.stripPrefix "Signature: " output of Nothing -> -- There is additional noise in the stdout in case key is password protected case T.stripPrefix "Enter password for encrypted key: Signature: " output of Nothing -> throwM $ TezosClientUnexpectedSignatureOutput output Just signatureTxt -> txtToSignature signatureTxt Just signatureTxt -> txtToSignature signatureTxt where txtToSignature :: MonadCatch m => Text -> m Signature txtToSignature signatureTxt = either (throwM . TezosClientCryptoParseError signatureTxt) pure $ parseSignature . T.strip $ 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 name = do let isAlreadyExistsError :: Text -> Bool -- We can do a bit better here using more complex parsing if necessary. isAlreadyExistsError = T.isInfixOf "already exists." errHandler _ errOut = pure (isAlreadyExistsError errOut) _ <- callTezosClient errHandler ["gen", "keys", toCmdArg name] MockupMode Nothing resolveAddress (AddressAlias 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 name = do let isNoAliasError :: Text -> Bool -- We can do a bit better here using more complex parsing if necessary. isNoAliasError = T.isInfixOf "no public key hash alias named" errHandler _ errOutput = pure (isNoAliasError errOutput) _ <- callTezosClient errHandler ["forget", "address", toCmdArg name, "--force"] MockupMode Nothing callTezosClientStrict ["gen", "keys", toCmdArg name] MockupMode Nothing resolveAddress (AddressAlias 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 alias mbPassword = do logDebug $ "Revealing key for " +| alias |+ "" let alreadyRevealed = T.isInfixOf "previously revealed" revealedImplicitAccount = T.isInfixOf "only implicit accounts can be revealed" emptyImplicitContract = T.isInfixOf "Empty implicit contract" errHandler _ errOut = False <$ do when (alreadyRevealed errOut) (throwM (AlreadyRevealed alias)) when (revealedImplicitAccount errOut) (throwM (CantRevealContract alias)) when (emptyImplicitContract errOut) (throwM (EmptyImplicitContract alias)) _ <- callTezosClient errHandler ["reveal", "key", "for", toCmdArg alias] ClientMode mbPassword logDebug $ "Successfully revealed key for " +| alias |+ "" -- | Register alias as delegate registerDelegate :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) => ImplicitAlias -> Maybe ScrubbedBytes -> m () registerDelegate alias mbPassword = do logDebug $ "Registering " +| alias |+ " as delegate" let emptyImplicitContract = T.isInfixOf "Empty implicit contract" errHandler _ errOut = False <$ do when (emptyImplicitContract errOut) (throwM (EmptyImplicitContract alias)) _ <- callTezosClient errHandler ["register", "key", toCmdArg alias, "as", "delegate"] ClientMode mbPassword logDebug $ "Successfully registered " +| alias |+ " 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 objects = callTezosClientStrict ["list", "known", objects] MockupMode Nothing -- | Return 'PublicKey' corresponding to given 'AddressOrAlias'. getPublicKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m) => ImplicitAddressOrAlias -> m PublicKey getPublicKey addrOrAlias = do alias <- getAlias addrOrAlias logDebug $ "Getting " +| alias |+ " public key" output <- callTezosClientStrict ["show", "address", toCmdArg alias] MockupMode Nothing liftIO case lines output of _ : [rawPK] -> do pkText <- maybe (throwM $ TezosClientUnexpectedOutputFormat rawPK) pure (T.stripPrefix "Public Key: " rawPK) either (throwM . TezosClientCryptoParseError pkText) pure $ parsePublicKey pkText _ -> throwM $ TezosClientUnexpectedOutputFormat output -- | Return 'SecretKey' corresponding to given 'AddressOrAlias'. getSecretKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m) => ImplicitAddressOrAlias -> m SecretKey getSecretKey addrOrAlias = do alias <- getAlias addrOrAlias logDebug $ "Getting " +| alias |+ " secret key" output <- callTezosClientStrict ["show", "address", toCmdArg alias, "--show-secret"] MockupMode Nothing liftIO case lines output of _ : _ : [rawSK] -> do skText <- maybe (throwM $ TezosClientUnexpectedOutputFormat rawSK) pure (T.stripPrefix "Secret Key: " rawSK) either (throwM . TezosClientCryptoParseError skText) pure $ parseSecretKey skText _ -> throwM $ TezosClientUnexpectedOutputFormat 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 aliasBehavior address alias = case aliasBehavior of DontSaveAlias -> logInfo $ "Not saving " +| address |+ " as " +| alias |+ " as requested" OverwriteDuplicateAlias -> void $ callTezosClient (\_ _ -> pure False) (args <> ["--force"]) MockupMode Nothing _ -> do let errHandler _ errOut | isAlreadyExistsError errOut = case aliasBehavior of KeepDuplicateAlias -> pure True ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias | otherwise = pure False void $ callTezosClient errHandler args MockupMode Nothing where args = ["remember", "contract", toCmdArg alias, pretty address] isAlreadyExistsError = T.isInfixOf "already exists" importKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) => Bool -> ImplicitAlias -> SecretKey -> m ImplicitAlias importKey replaceExisting name key = do let isAlreadyExistsError = T.isInfixOf "already exists" errHandler _ errOut = pure (isAlreadyExistsError errOut) args = ["import", "secret", "key", toCmdArg name, toCmdArg key] _ <- callTezosClient errHandler (if replaceExisting then args <> ["--force"] else args) MockupMode Nothing pure name -- | Read @octez-client@ configuration. getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig getTezosClientConfig client mbDataDir = do t <- readProcessWithExitCode' client (maybe [] (\dir -> ["-d", dir]) mbDataDir ++ ["config", "show"]) "" case t of (ExitSuccess, toText -> output, _) -> case eitherDecodeStrict . encodeUtf8 . toText $ output of Right config -> pure config Left err -> throwM $ ConfigParseError err (ExitFailure errCode, toText -> output, toText -> errOutput) -> throwM $ UnexpectedClientFailure errCode output 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 from mbPassword burnCap transferFeeDatas = do output <- callTezosClientStrict [ "multiple", "transfers", "from", pretty from, "using" , C.unpack $ encode transferFeeDatas, "--burn-cap", showBurnCap burnCap, "--dry-run" ] ClientMode mbPassword withSomePeano (fromIntegralOverflowing $ length transferFeeDatas) $ \(_ :: Proxy n) -> toList <$> feeOutputParser @n 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 CalcOriginationFeeData{..} = do output <- callTezosClientStrict [ "originate", "contract", "-", "transferring" , showTez cofdBalance , "from", pretty cofdFrom, "running" , toCmdArg cofdContract, "--init" , toCmdArg cofdStorage, "--burn-cap" , showBurnCap cofdBurnCap, "--dry-run" ] ClientMode cofdMbFromPassword fees <- feeOutputParser @1 output case fees of singleFee :< Nil -> return 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 alias mbPassword burnCap = do output <- callTezosClientStrict [ "reveal", "key", "for", toCmdArg alias , "--burn-cap", showBurnCap burnCap , "--dry-run" ] ClientMode mbPassword fees <- feeOutputParser @1 output case fees of singleFee :< Nil -> return singleFee feeOutputParser :: forall n m. (SingIPeano n, MonadIO m, MonadThrow m) => Text -> m (SizedList n TezosMutez) feeOutputParser output = case parseBakerFeeFromOutput @n output of Right fee -> return fee Left err -> throwM $ TezosClientParseFeeError output $ pretty err showBurnCap :: TezosInt64 -> String showBurnCap x = printf "%.6f" $ (fromIntegralToRealFrac @TezosInt64 @Float x) / 1000 showTez :: TezosMutez -> String showTez = toCmdArg . 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 key = (getAlias $ AddressResolved key) >>= getKeyPassword' where getKeyPassword' :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, MonadMask m) => ImplicitAlias -> m (Maybe ScrubbedBytes) getKeyPassword' alias = do output <- callTezosClientStrict [ "show", "address", pretty alias, "-S"] MockupMode Nothing encryptionType <- case parseSecretKeyEncryption output of Right t -> return t Left err -> throwM $ TezosClientParseEncryptionTypeError output $ pretty err case encryptionType of EncryptedKey -> do putTextLn $ "Please enter password for '" <> pretty alias <> "':" Just <$> withoutEcho readScrubbedBytes _ -> pure Nothing -- Hide entered password withoutEcho :: (MonadIO m, MonadMask m) => m a -> m a withoutEcho action = do old <- hGetEcho stdin bracket_ (hSetEcho stdin False) (hSetEcho stdin old) 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 errHandler args mode mbInput = retryEConnreset mode $ do TezosClientEnv {..} <- view tezosClientEnvL let extraArgs :: [String] extraArgs = mconcat [ ["-E", toCmdArg tceEndpointUrl] , maybe [] (\dir -> ["-d", dir]) tceMbTezosClientDataDir , ["--mode", case mode of MockupMode -> "mockup" ClientMode -> "client" ] ] allArgs = extraArgs ++ args logDebug $ "Running: " <> unwords (toText <$> tceTezosClientPath:allArgs) let ifNotEmpty prefix output | null output = "" | otherwise = prefix <> ":\n" <> output logOutput :: Text -> Text -> m () logOutput output errOutput = logDebug $ ifNotEmpty "stdout" output <> ifNotEmpty "stderr" errOutput liftIO (readProcessWithExitCode' tceTezosClientPath allArgs (maybe "" scrubbedBytesToString mbInput)) >>= \case (ExitSuccess, toText -> output, toText -> errOutput) -> output <$ logOutput output errOutput (ExitFailure errCode, toText -> output, toText -> errOutput) -> do checkCounterError errOutput checkEConnreset errOutput liftIO $ unlessM (errHandler output errOutput) $ throwM $ UnexpectedClientFailure errCode output errOutput output <$ logOutput output errOutput where checkCounterError :: Text -> m () checkCounterError errOutput | "Counter" `T.isPrefixOf` errOutput && "already used for contract" `T.isInfixOf` errOutput = do let splittedErrOutput = words errOutput liftIO $ throwM $ CounterIsAlreadyUsed (splittedErrOutput Unsafe.!! 1) (splittedErrOutput Unsafe.!! 5) checkCounterError _ = pass checkEConnreset :: Text -> m () checkEConnreset errOutput | "Unix.ECONNRESET" `T.isInfixOf` errOutput = throwM EConnreset checkEConnreset _ = 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 MockupMode action = action retryEConnreset ClientMode action = retryEConnresetImpl 0 action retryEConnresetImpl :: Integer -> m a -> m a retryEConnresetImpl attempt action = action `catch` \err -> do case err of EConnreset -> if attempt >= maxRetryAmount then throwM err else retryEConnresetImpl (attempt + 1) action anotherErr -> throwM anotherErr maxRetryAmount = 5 -- | Call @octez-client@ and expect success. callTezosClientStrict :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text callTezosClientStrict args mode mbInput = callTezosClient errHandler args mode mbInput where errHandler _ _ = pure 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' fp args inp = catch (readProcessWithExitCode fp args inp) handler where handler :: IOException -> IO (ExitCode, String, String) handler e = do hPutStrLn @Text stderr $ formatWith [red] errorMsg throwIO e errorMsg = "ERROR!! There was an error in executing `" <> toText fp <> "` 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 = \case REWrongKind (alias :: Alias expectedKind) (Constrained (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 = demote @expectedKind \\ aliasKindSanity alias :: AddressKind demotedActualKind = demote @actualKind \\ addressKindSanity addr :: AddressKind REAliasNotFound aliasText -> [itu|Could not find the alias '#{aliasText}'.|] REAddressNotFound 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: . -} 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 = \case AddressResolved addr -> pure $ Right addr aoa@(AddressAlias alias) -> do findAddress (unAlias alias) >>= \case FARNone -> pure $ Left $ REAliasNotFound (pretty aoa) FARUnambiguous (Constrained addr) -> pure $ maybeToRight (REWrongKind alias (Constrained addr)) $ castSing addr \\ addressKindSanity addr \\ aliasKindSanity alias FARAmbiguous contractAddr implicitAddr -> withDict (aliasKindSanity alias) $ usingImplicitOrContractKind @kind case sing @kind of SAddressKindContract -> pure $ Right contractAddr SAddressKindImplicit -> pure $ Right implicitAddr getAliasEither :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) => AddressOrAlias kind -> m (Either ResolveError (Alias kind)) getAliasEither = \case aoa@(AddressAlias alias) -> -- Check if the alias exists ($> alias) <$> resolveAddressEither aoa AddressResolved addr -> do aliasesAndAddresses <- Class.getAliasesAndAddresses case fst <$> find (\(_, addr') -> addr' == pretty addr) aliasesAndAddresses of Nothing -> pure $ Left $ REAddressNotFound addr Just 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 = fromMaybe aliasText $ T.stripPrefix "key:" aliasText pure $ Right $ mkAlias @kind aliasTextWithoutPrefix \\ addressKindSanity 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 = \case SAOAKindUnspecified aliasText -> do findAddress aliasText >>= \case FARNone -> pure $ Left $ REAliasNotFound aliasText FARUnambiguous addr -> pure $ Right addr FARAmbiguous contractAddr implicitAddr -> throwM $ AmbiguousAlias aliasText contractAddr implicitAddr SAOAKindSpecified aoa -> fmap Constrained <$> resolveAddressEither aoa \\ addressOrAliasKindSanity aoa getAliasEither :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) => SomeAddressOrAlias -> m (Either ResolveError SomeAlias) getAliasEither = \case SAOAKindSpecified aoa -> do fmap SomeAlias <$> getAliasEither aoa \\ addressOrAliasKindSanity aoa aoa@(SAOAKindUnspecified 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. resolveAddressEither aoa <&> fmap \(Constrained (addr :: KindedAddress kind)) -> SomeAlias $ mkAlias @kind aliasText \\ addressKindSanity 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 = resolveAddressEither >=> either (throwM . ResolveError) 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 aoa = rightToMaybe <$> resolveAddressEither 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 = getAliasEither >=> either (throwM . ResolveError) 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 aoa = rightToMaybe <$> getAliasEither 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 aliasText = do logDebug $ "Resolving " +| aliasText |+ "" aliasesAndAddresses <- Class.getAliasesAndAddresses let find' alias = snd <$> find (\(alias', _) -> alias' == alias) aliasesAndAddresses case (find' aliasText, find' ("key:" <> aliasText)) of (Nothing, _) -> pure FARNone (Just firstMatch, Nothing) -> FARUnambiguous <$> parseL1Address firstMatch (Just contractAddrText, Just implicitAddrText) -> do contractAddr <- either (throwM . TezosClientParseAddressError contractAddrText) pure $ parseKindedAddress @'AddressKindContract contractAddrText implicitAddr <- either (throwM . TezosClientParseAddressError implicitAddrText) pure $ parseKindedAddress @'AddressKindImplicit implicitAddrText pure $ FARAmbiguous contractAddr implicitAddr where parseL1Address :: Text -> m L1Address parseL1Address addrText = either (throwM . TezosClientParseAddressError addrText) pure . parseConstrainedAddress $ 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 = parseOutput <$> callListKnown "contracts" where parseOutput :: Text -> [(Text, Text)] parseOutput = fmap parseLine . lines -- Note: each line has the format ":
" parseLine :: Text -> (Text, Text) parseLine = first (T.dropEnd 2) . T.breakOnEnd ": "