{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Polkadot.Rpc.Contracts where
import Data.ByteArray.HexString (HexString)
import Data.Text (Text)
import Network.JsonRpc.TinyClient (JsonRpc (..))
import Network.Polkadot.Rpc.Types (ContractCall, ContractExecResult)
call :: JsonRpc m
=> ContractCall
-> Maybe HexString
-> m ContractExecResult
{-# INLINE call #-}
call :: forall (m :: * -> *).
JsonRpc m =>
ContractCall -> Maybe HexString -> m ContractExecResult
call = MethodName
-> ContractCall -> Maybe HexString -> m ContractExecResult
forall a. Remote m a => MethodName -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => MethodName -> a
remote MethodName
"contracts_call"
getStorage :: JsonRpc m
=> Text
-> HexString
-> Maybe HexString
-> m (Maybe HexString)
{-# INLINE getStorage #-}
getStorage :: forall (m :: * -> *).
JsonRpc m =>
MethodName -> HexString -> Maybe HexString -> m (Maybe HexString)
getStorage = MethodName
-> MethodName
-> HexString
-> Maybe HexString
-> m (Maybe HexString)
forall a. Remote m a => MethodName -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => MethodName -> a
remote MethodName
"contracts_getStorage"
rentProjection :: JsonRpc m
=> Text
-> Maybe HexString
-> m (Maybe Int)
{-# INLINE rentProjection #-}
rentProjection :: forall (m :: * -> *).
JsonRpc m =>
MethodName -> Maybe HexString -> m (Maybe Int)
rentProjection = MethodName -> MethodName -> Maybe HexString -> m (Maybe Int)
forall a. Remote m a => MethodName -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => MethodName -> a
remote MethodName
"contracts_rentProjection"