module Morley.Client.Util
( epNameToTezosEp
, extractAddressesFromValue
, disableAlphanetWarning
, runContract
, runContractSimple
, RunContractParameters(..)
, scrubbedBytesToString
, readScrubbedBytes
) where
import Data.ByteArray (ScrubbedBytes, convert)
import qualified Data.ByteString as BS (getLine)
import Data.Constraint ((\\))
import Generics.SYB (everything, mkQ)
import System.Environment (setEnv)
import Morley.Client.RPC.AsRPC (AsRPC, rpcHasNoBigMapEvi, rpcStorageScopeEvi)
import Morley.Client.RPC.Class
import Morley.Client.RPC.Getters
import Morley.Client.RPC.Types
import Morley.Micheline
import Morley.Michelson.Text
import qualified Morley.Michelson.Typed as T (Contract, ParameterScope, StorageScope, Value)
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, zeroMutez)
import Morley.Util.Exception as E (throwLeft)
disableAlphanetWarning :: IO ()
disableAlphanetWarning :: IO ()
disableAlphanetWarning = String -> String -> IO ()
setEnv String
"TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" String
"YES"
epNameToTezosEp :: EpName -> Text
epNameToTezosEp :: EpName -> Text
epNameToTezosEp = \case
EpName
DefEpName -> Text
"default"
EpName
epName -> EpName -> Text
unEpName EpName
epName
extractAddressesFromValue :: Value -> [Address]
Value
val =
([Address] -> [Address] -> [Address])
-> GenericQ [Address] -> Value -> [Address]
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
(<>) ([Address] -> (Value -> [Address]) -> a -> [Address]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ [] Value -> [Address]
fetchAddress) Value
val
where
fetchAddress :: Value -> [Address]
fetchAddress :: Value -> [Address]
fetchAddress = \case
ValueString MText
s -> case Text -> Either ParseEpAddressError EpAddress
parseEpAddress (MText -> Text
unMText MText
s) of
Right EpAddress
addr -> [EpAddress -> Address
eaAddress EpAddress
addr]
Left ParseEpAddressError
_ -> []
ValueBytes (InternalByteString ByteString
b) -> case ByteString -> Either ParseAddressRawError Address
parseAddressRaw ByteString
b of
Right Address
addr -> [Address
addr]
Left ParseAddressRawError
_ -> []
Value
_ -> []
runContractSimple
:: forall cp st m. (HasTezosRpc m, T.ParameterScope cp, T.StorageScope st)
=> T.Contract cp st
-> T.Value cp
-> T.Value st
-> Mutez
-> m (AsRPC (T.Value st))
runContractSimple :: Contract cp st
-> Value cp -> Value st -> Mutez -> m (AsRPC (Value st))
runContractSimple Contract cp st
rcpContract Value cp
rcpParameter Value st
rcpStorage Mutez
rcpBalance =
let rcpSender :: Maybe a
rcpSender = Maybe a
forall a. Maybe a
Nothing
rcpSource :: Maybe a
rcpSource = Maybe a
forall a. Maybe a
Nothing
rcpAmount :: Mutez
rcpAmount = Mutez
zeroMutez
in RunContractParameters cp st -> m (AsRPC (Value st))
forall (cp :: T) (st :: T) (m :: * -> *).
(HasTezosRpc m, ParameterScope cp, StorageScope st) =>
RunContractParameters cp st -> m (AsRPC (Value st))
runContract RunContractParameters :: forall (cp :: T) (st :: T).
Contract cp st
-> Value cp
-> Value st
-> Mutez
-> Mutez
-> Maybe Address
-> Maybe Address
-> RunContractParameters cp st
RunContractParameters {Maybe Address
Mutez
Value cp
Value st
Contract cp st
forall a. Maybe a
rcpSource :: Maybe Address
rcpSender :: Maybe Address
rcpAmount :: Mutez
rcpBalance :: Mutez
rcpStorage :: Value st
rcpParameter :: Value cp
rcpContract :: Contract cp st
rcpAmount :: Mutez
rcpSource :: forall a. Maybe a
rcpSender :: forall a. Maybe a
rcpBalance :: Mutez
rcpStorage :: Value st
rcpParameter :: Value cp
rcpContract :: Contract cp st
..}
data RunContractParameters cp st = RunContractParameters
{ RunContractParameters cp st -> Contract cp st
rcpContract :: T.Contract cp st
, RunContractParameters cp st -> Value cp
rcpParameter :: T.Value cp
, RunContractParameters cp st -> Value st
rcpStorage :: T.Value st
, RunContractParameters cp st -> Mutez
rcpBalance :: Mutez
, RunContractParameters cp st -> Mutez
rcpAmount :: Mutez
, RunContractParameters cp st -> Maybe Address
rcpSender :: Maybe Address
, RunContractParameters cp st -> Maybe Address
rcpSource :: Maybe Address
}
runContract
:: forall cp st m. (HasTezosRpc m, T.ParameterScope cp, T.StorageScope st)
=> RunContractParameters cp st -> m (AsRPC (T.Value st))
runContract :: RunContractParameters cp st -> m (AsRPC (Value st))
runContract RunContractParameters{Maybe Address
Mutez
Value cp
Value st
Contract cp st
rcpSource :: Maybe Address
rcpSender :: Maybe Address
rcpAmount :: Mutez
rcpBalance :: Mutez
rcpStorage :: Value st
rcpParameter :: Value cp
rcpContract :: Contract cp st
rcpSource :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> Maybe Address
rcpSender :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> Maybe Address
rcpAmount :: forall (cp :: T) (st :: T). RunContractParameters cp st -> Mutez
rcpBalance :: forall (cp :: T) (st :: T). RunContractParameters cp st -> Mutez
rcpStorage :: forall (cp :: T) (st :: T). RunContractParameters cp st -> Value st
rcpParameter :: forall (cp :: T) (st :: T). RunContractParameters cp st -> Value cp
rcpContract :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> Contract cp st
..} = do
BlockConstants
headConstants <- BlockId -> m BlockConstants
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockConstants
getBlockConstants BlockId
HeadId
let args :: RunCode
args = RunCode :: Expression
-> Expression
-> Expression
-> TezosMutez
-> TezosMutez
-> Text
-> Maybe Address
-> Maybe Address
-> RunCode
RunCode
{ rcScript :: Expression
rcScript = Contract cp st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract cp st
rcpContract
, rcStorage :: Expression
rcStorage = Value st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value st
rcpStorage
, rcInput :: Expression
rcInput = Value cp -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value cp
rcpParameter
, rcAmount :: TezosMutez
rcAmount = Mutez -> TezosMutez
TezosMutez Mutez
rcpAmount
, rcBalance :: TezosMutez
rcBalance = Mutez -> TezosMutez
TezosMutez Mutez
rcpBalance
, rcChainId :: Text
rcChainId = BlockConstants -> Text
bcChainId BlockConstants
headConstants
, rcSource :: Maybe Address
rcSource = Maybe Address
rcpSender
, rcPayer :: Maybe Address
rcPayer = Maybe Address
rcpSource
}
RunCodeResult
res <- RunCode -> m RunCodeResult
forall (m :: * -> *). HasTezosRpc m => RunCode -> m RunCodeResult
runCode RunCode
args
forall a.
(MonadThrow m, Exception FromExpressionError) =>
m (Either FromExpressionError a) -> m a
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft @_ @FromExpressionError (m (Either FromExpressionError (Value' Instr (AsRPC st)))
-> m (Value' Instr (AsRPC st)))
-> m (Either FromExpressionError (Value' Instr (AsRPC st)))
-> m (Value' Instr (AsRPC st))
forall a b. (a -> b) -> a -> b
$ Either FromExpressionError (Value' Instr (AsRPC st))
-> m (Either FromExpressionError (Value' Instr (AsRPC st)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FromExpressionError (Value' Instr (AsRPC st))
-> m (Either FromExpressionError (Value' Instr (AsRPC st))))
-> Either FromExpressionError (Value' Instr (AsRPC st))
-> m (Either FromExpressionError (Value' Instr (AsRPC st)))
forall a b. (a -> b) -> a -> b
$
Expression -> Either FromExpressionError (AsRPC (Value st))
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @(AsRPC (T.Value st)) (RunCodeResult -> Expression
rcrStorage RunCodeResult
res)
(StorageScope (AsRPC st) =>
Either FromExpressionError (Value' Instr (AsRPC st)))
-> (StorageScope st :- StorageScope (AsRPC st))
-> Either FromExpressionError (Value' Instr (AsRPC st))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ StorageScope st :- StorageScope (AsRPC st)
forall (t :: T). StorageScope t :- StorageScope (AsRPC t)
rpcStorageScopeEvi @st
(HasNoBigMap (AsRPC st) =>
Either FromExpressionError (Value' Instr (AsRPC st)))
-> Dict (HasNoBigMap (AsRPC st))
-> Either FromExpressionError (Value' Instr (AsRPC st))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ SingI st => Dict (HasNoBigMap (AsRPC st))
forall (t :: T). SingI t => Dict (HasNoBigMap (AsRPC t))
rpcHasNoBigMapEvi @st
readScrubbedBytes :: MonadIO m => m ScrubbedBytes
readScrubbedBytes :: m ScrubbedBytes
readScrubbedBytes = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> ScrubbedBytes) -> m ByteString -> m ScrubbedBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
BS.getLine
scrubbedBytesToString :: ScrubbedBytes -> String
scrubbedBytesToString :: ScrubbedBytes -> String
scrubbedBytesToString = ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> String)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ScrubbedBytes, ByteArray ByteString) =>
ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert @ScrubbedBytes @ByteString