module Morley.Client.Util
( epNameToTezosEp
, extractAddressesFromValue
, disableAlphanetWarning
, runContract
, RunContractParameters(..)
, runContractParameters
, withBalance
, withAmount
, withSender
, withSource
, 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, MaybeRPC, 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 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, 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
_ -> []
data RunContractParameters cp st = RunContractParameters
{ RunContractParameters cp st -> Contract cp st
rcpContract :: T.Contract cp st
, RunContractParameters cp st -> MaybeRPC (Value cp)
rcpParameter :: MaybeRPC (T.Value cp)
, RunContractParameters cp st -> MaybeRPC (Value st)
rcpStorage :: MaybeRPC (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
}
runContractParameters
:: T.Contract cp st -> MaybeRPC (T.Value cp) -> MaybeRPC (T.Value st)
-> RunContractParameters cp st
runContractParameters :: Contract cp st
-> MaybeRPC (Value cp)
-> MaybeRPC (Value st)
-> RunContractParameters cp st
runContractParameters Contract cp st
contract MaybeRPC (Value cp)
cp MaybeRPC (Value st)
st =
RunContractParameters :: forall (cp :: T) (st :: T).
Contract cp st
-> MaybeRPC (Value cp)
-> MaybeRPC (Value st)
-> Mutez
-> Mutez
-> Maybe Address
-> Maybe Address
-> RunContractParameters cp st
RunContractParameters
{ rcpContract :: Contract cp st
rcpContract = Contract cp st
contract
, rcpParameter :: MaybeRPC (Value cp)
rcpParameter = MaybeRPC (Value cp)
cp
, rcpStorage :: MaybeRPC (Value st)
rcpStorage = MaybeRPC (Value st)
st
, rcpBalance :: Mutez
rcpBalance = Mutez
zeroMutez
, rcpAmount :: Mutez
rcpAmount = Mutez
zeroMutez
, rcpSender :: Maybe Address
rcpSender = Maybe Address
forall a. Maybe a
Nothing
, rcpSource :: Maybe Address
rcpSource = Maybe Address
forall a. Maybe a
Nothing
}
makeLensesFor
[ ("rcpBalance", "withBalance")
, ("rcpAmount", "withAmount")
, ("rcpSender", "withSender")
, ("rcpSource", "withSource")
]
''RunContractParameters
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
Contract cp st
MaybeRPC (Value cp)
MaybeRPC (Value st)
rcpSource :: Maybe Address
rcpSender :: Maybe Address
rcpAmount :: Mutez
rcpBalance :: Mutez
rcpStorage :: MaybeRPC (Value st)
rcpParameter :: MaybeRPC (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 -> MaybeRPC (Value st)
rcpParameter :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> MaybeRPC (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 = MaybeRPC (Value st) -> Expression
forall a. ToExpression a => a -> Expression
toExpression MaybeRPC (Value st)
rcpStorage
, rcInput :: Expression
rcInput = MaybeRPC (Value cp) -> Expression
forall a. ToExpression a => a -> Expression
toExpression MaybeRPC (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 (TAsRPC st)))
-> m (Value (TAsRPC st)))
-> m (Either FromExpressionError (Value (TAsRPC st)))
-> m (Value (TAsRPC st))
forall a b. (a -> b) -> a -> b
$ Either FromExpressionError (Value (TAsRPC st))
-> m (Either FromExpressionError (Value (TAsRPC st)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FromExpressionError (Value (TAsRPC st))
-> m (Either FromExpressionError (Value (TAsRPC st))))
-> Either FromExpressionError (Value (TAsRPC st))
-> m (Either FromExpressionError (Value (TAsRPC 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 (TAsRPC st) =>
Either FromExpressionError (Value (TAsRPC st)))
-> (StorageScope st :- StorageScope (TAsRPC st))
-> Either FromExpressionError (Value (TAsRPC st))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ StorageScope st :- StorageScope (TAsRPC st)
forall (t :: T). StorageScope t :- StorageScope (TAsRPC t)
rpcStorageScopeEvi @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