-- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA module Morley.Client.Util ( epNameToTezosEp , extractAddressesFromValue , disableAlphanetWarning -- * @runContract@ , runContract , RunContractParameters(..) , runContractParameters , withBalance , withAmount , withSender , withSource , withLevel , withNow -- * @octez-client@ password-related helpers , scrubbedBytesToString , readScrubbedBytes ) where import Control.Lens (makeLensesFor) import Data.ByteArray (ScrubbedBytes, convert) import Data.ByteString qualified as BS (getLine) import Data.Constraint ((\\)) import Generics.SYB (everything, mkQ) import System.Environment (setEnv) import Morley.AsRPC (AsRPC, rpcStorageScopeEvi) import Morley.Client.RPC.Class import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Micheline import Morley.Michelson.Text import Morley.Michelson.Typed (HasNoOp, untypeValue) import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Entrypoints (EpAddress(..), parseEpAddress) import Morley.Michelson.Untyped (InternalByteString(..), Value, Value'(..)) import Morley.Michelson.Untyped.Entrypoints (EpName(..), pattern DefEpName) import Morley.Tezos.Address import Morley.Tezos.Core (Mutez, Timestamp(..), zeroMutez) import Morley.Util.Exception as E (throwLeft) -- | Sets the environment variable for disabling @octez-client@'s -- "not a mainnet" warning disableAlphanetWarning :: IO () disableAlphanetWarning = setEnv "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" "YES" -- | Convert 'EpName' to the textual representation used by RPC and @octez-client@. epNameToTezosEp :: EpName -> Text epNameToTezosEp = \case DefEpName -> "default" epName -> unEpName epName -- | Extract all addresses value from given untyped 'Value'. -- -- Note that it returns all values that can be used as an address. -- However, some of fetched values can never be used as an address. extractAddressesFromValue :: Value -> [Address] extractAddressesFromValue val = everything (<>) (mkQ [] fetchAddress) val where fetchAddress :: Value -> [Address] fetchAddress = \case ValueString s -> case parseEpAddress (unMText s) of Right addr -> [eaAddress addr] Left _ -> [] ValueBytes (InternalByteString b) -> case parseAddressRaw b of Right addr -> [addr] Left _ -> [] _ -> [] -- | A structure with all the parameters for 'runContract' data RunContractParameters cp st = RunContractParameters { rcpContract :: T.Contract cp st , rcpParameter :: Value -- ^ The parameter value should have the same "structure" as @cp@, except it _may_ also have big_map IDs. -- E.g. if the contract's parameter is @pair (big_map string string) (big_map string string)@, -- then 'rcpParameter' may be one of: -- -- * @pair (big_map string string) (big_map string string)@ -- * @pair nat (big_map string string)@ -- * @pair (big_map string string) nat@ -- * @pair nat nat@ -- -- ... where @nat@ represents a big_map ID. , rcpStorage :: Value -- ^ The storage value should have the same "structure" as @st@, except it _may_ also have big_map IDs. -- See the documentation of 'rcpParameter'. , rcpBalance :: Mutez , rcpNow :: Maybe Timestamp , rcpLevel :: Maybe Natural , rcpAmount :: Mutez , rcpSender :: Maybe ImplicitAddress , rcpSource :: Maybe ImplicitAddress } -- | Initializes the parameters for `runContract` with sensible defaults. -- -- Use the @with*@ lenses to set any optional parameters. runContractParameters :: (HasNoOp cp, HasNoOp st) => T.Contract cp st -> T.Value cp -> T.Value st -> RunContractParameters cp st runContractParameters contract cp st = RunContractParameters { rcpContract = contract , rcpParameter = untypeValue cp , rcpStorage = untypeValue st , rcpBalance = zeroMutez , rcpAmount = zeroMutez , rcpNow = Nothing , rcpLevel = Nothing , rcpSender = Nothing , rcpSource = Nothing } makeLensesFor [ ("rcpBalance", "withBalance") , ("rcpAmount", "withAmount") , ("rcpSender", "withSender") , ("rcpSource", "withSource") , ("rcpLevel", "withLevel") , ("rcpNow", "withNow") ] ''RunContractParameters -- | Run contract with given parameter and storage and get new storage without -- injecting anything to the chain. runContract :: forall cp st m. (HasTezosRpc m, T.StorageScope st) => RunContractParameters cp st -> m (AsRPC (T.Value st)) runContract RunContractParameters{..} = do headConstants <- getBlockConstants HeadId let args = RunCode { rcScript = toExpression rcpContract , rcStorage = toExpression rcpStorage , rcInput = toExpression rcpParameter , rcAmount = TezosMutez rcpAmount , rcBalance = TezosMutez rcpBalance , rcChainId = bcChainId headConstants , rcNow = rcpNow <&> StringEncode . round . unTimestamp , rcLevel = StringEncode <$> rcpLevel -- Note: assigning source=sender and payer=source may seem like a bug, but it's not. -- For some reason, the /run_code uses a different naming scheme. -- What this endpoint calls 'source' is actually the address that will be returned by the `SENDER` instruction. -- See details here: https://gitlab.com/tezos/tezos/-/issues/710 , rcSource = rcpSender , rcPayer = rcpSource } res <- runCode args throwLeft @_ @FromExpressionError $ pure $ fromExpression @(AsRPC (T.Value st)) (rcrStorage res) \\ rpcStorageScopeEvi @st -- | Function for relatively safe getting password from stdin. -- After reading bytes are converted to @ScrubbedBytes@, thus it's harder -- to accidentally leak them. readScrubbedBytes :: MonadIO m => m ScrubbedBytes readScrubbedBytes = convert <$> liftIO BS.getLine -- | Convert @ScrubbedBytes@ to @String@, so that it can be passed to @octez-client@ -- as a stdin scrubbedBytesToString :: ScrubbedBytes -> String scrubbedBytesToString = decodeUtf8 . convert @ScrubbedBytes @ByteString