-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Some read-only actions (wrappers over RPC calls).

module Morley.Client.RPC.Getters
  ( ValueDecodeFailure (..)
  , ValueNotFound (..)

  , readAllBigMapValues
  , readAllBigMapValuesMaybe
  , readContractBigMapValue
  , readBigMapValueMaybe
  , readBigMapValue
  , getContract
  , getImplicitContractCounter
  , getContractsParameterTypes
  , getContractStorage
  , getScriptSize
  , getBigMapValue
  , getBigMapValues
  , getHeadBlock
  , getCounter
  , getProtocolParameters
  , runOperation
  , preApplyOperations
  , forgeOperation
  , getContractScript
  , getContractBigMap
  , getBalance
  , getDelegate
  , runCode
  , getManagerKey
  , contractStateResolver
  , getTicketBalance
  , getAllTicketBalances
  ) where

import Data.Map as Map (fromList)
import Data.Singletons (demote)
import Fmt (Buildable(..), pretty, (+|), (|+))
import Network.HTTP.Types.Status (statusCode)
import Servant.Client (ClientError(..), responseStatusCode)

import Lorentz (NicePackedValue, NiceUnpackedValue, valueToScriptExpr)
import Lorentz.Value
import Morley.Micheline
import Morley.Michelson.Runtime.GState (ContractState(..))
import Morley.Michelson.TypeCheck (typeCheckContract, typeCheckingWith)
import Morley.Michelson.TypeCheck.TypeCheck
  (SomeParamType(..), TcOriginatedContracts, mkSomeParamType)
import Morley.Michelson.Typed
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Crypto (encodeBase58Check)
import Morley.Util.ByteString
import Morley.Util.Exception (throwLeft)

import Morley.Client.RPC.Class
import Morley.Client.RPC.Types

data ContractGetCounterAttempt = ContractGetCounterAttempt ContractAddress
  deriving stock (Int -> ContractGetCounterAttempt -> ShowS
[ContractGetCounterAttempt] -> ShowS
ContractGetCounterAttempt -> String
(Int -> ContractGetCounterAttempt -> ShowS)
-> (ContractGetCounterAttempt -> String)
-> ([ContractGetCounterAttempt] -> ShowS)
-> Show ContractGetCounterAttempt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractGetCounterAttempt -> ShowS
showsPrec :: Int -> ContractGetCounterAttempt -> ShowS
$cshow :: ContractGetCounterAttempt -> String
show :: ContractGetCounterAttempt -> String
$cshowList :: [ContractGetCounterAttempt] -> ShowS
showList :: [ContractGetCounterAttempt] -> ShowS
Show)
instance Exception ContractGetCounterAttempt
instance Buildable ContractGetCounterAttempt where
  build :: ContractGetCounterAttempt -> Doc
build (ContractGetCounterAttempt ContractAddress
addr) =
    Doc
"Failed to get counter of contract '" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Doc
forall a. Buildable a => a -> Doc
build ContractAddress
addr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"', " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    Doc
"this operation is allowed only for implicit contracts"

-- | Failed to decode received value to the given type.
data ValueDecodeFailure = ValueDecodeFailure Text T
  deriving stock (Int -> ValueDecodeFailure -> ShowS
[ValueDecodeFailure] -> ShowS
ValueDecodeFailure -> String
(Int -> ValueDecodeFailure -> ShowS)
-> (ValueDecodeFailure -> String)
-> ([ValueDecodeFailure] -> ShowS)
-> Show ValueDecodeFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueDecodeFailure -> ShowS
showsPrec :: Int -> ValueDecodeFailure -> ShowS
$cshow :: ValueDecodeFailure -> String
show :: ValueDecodeFailure -> String
$cshowList :: [ValueDecodeFailure] -> ShowS
showList :: [ValueDecodeFailure] -> ShowS
Show)
instance Exception ValueDecodeFailure
instance Buildable ValueDecodeFailure where
  build :: ValueDecodeFailure -> Doc
build (ValueDecodeFailure Text
desc T
ty) =
    Doc
"Failed to decode value with expected type " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> T -> Doc
forall a. Buildable a => a -> Doc
build T
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" \
    \for '" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
forall a. Buildable a => a -> Doc
build Text
desc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"'"

data ValueNotFound = ValueNotFound
  deriving stock (Int -> ValueNotFound -> ShowS
[ValueNotFound] -> ShowS
ValueNotFound -> String
(Int -> ValueNotFound -> ShowS)
-> (ValueNotFound -> String)
-> ([ValueNotFound] -> ShowS)
-> Show ValueNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueNotFound -> ShowS
showsPrec :: Int -> ValueNotFound -> ShowS
$cshow :: ValueNotFound -> String
show :: ValueNotFound -> String
$cshowList :: [ValueNotFound] -> ShowS
showList :: [ValueNotFound] -> ShowS
Show)
instance Exception ValueNotFound
instance Buildable ValueNotFound where
  build :: ValueNotFound -> Doc
build ValueNotFound
ValueNotFound =
    Doc
"Value with such coordinates is not found in contract big maps"

-- | Read big_map value of given contract by key.
--
-- If the contract contains several @big_map@s with given key type, only one
-- of them will be considered.
readContractBigMapValue
  :: forall k v m.
     (PackedValScope k, HasTezosRpc m, SingI v)
  => ContractAddress -> Value k -> m (Value v)
readContractBigMapValue :: forall (k :: T) (v :: T) (m :: * -> *).
(PackedValScope k, HasTezosRpc m, SingI v) =>
ContractAddress -> Value k -> m (Value v)
readContractBigMapValue ContractAddress
contract Value k
key = do
  let
    req :: GetBigMap
req = GetBigMap
      { bmKey :: Expression
bmKey = Value k -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value k
key
      , bmType :: Expression
bmType = T -> Expression
forall a. ToExpression a => a -> Expression
toExpression (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @k)
      }
  Expression
res <- ContractAddress -> GetBigMap -> m GetBigMapResult
forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> GetBigMap -> m GetBigMapResult
getContractBigMap ContractAddress
contract GetBigMap
req m GetBigMapResult
-> (GetBigMapResult -> m Expression) -> m Expression
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    GetBigMapResult Expression
res -> Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
res
    GetBigMapResult
GetBigMapNotFound -> ValueNotFound -> m Expression
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ValueNotFound
ValueNotFound
  Expression -> Either FromExpressionError (Value v)
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression Expression
res
    Either FromExpressionError (Value v)
-> (Either FromExpressionError (Value v) -> m (Value v))
-> m (Value v)
forall a b. a -> (a -> b) -> b
& (FromExpressionError -> m (Value v))
-> (Value v -> m (Value v))
-> Either FromExpressionError (Value v)
-> m (Value v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (Value v) -> FromExpressionError -> m (Value v)
forall a b. a -> b -> a
const (m (Value v) -> FromExpressionError -> m (Value v))
-> m (Value v) -> FromExpressionError -> m (Value v)
forall a b. (a -> b) -> a -> b
$ ValueDecodeFailure -> m (Value v)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ValueDecodeFailure -> m (Value v))
-> ValueDecodeFailure -> m (Value v)
forall a b. (a -> b) -> a -> b
$ Text -> T -> ValueDecodeFailure
ValueDecodeFailure Text
"big map value" (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @k)) Value v -> m (Value v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Read big_map value, given it's ID and a key.
-- If the value is not of the expected type, a 'ValueDecodeFailure' will be thrown.
--
-- Returns 'Nothing' if a big_map with the given ID does not exist,
-- or it does exist but does not contain the given key.
readBigMapValueMaybe
  :: forall v k m.
     (NicePackedValue k, NiceUnpackedValue v, HasTezosRpc m)
  => BigMapId k v -> k -> m (Maybe v)
readBigMapValueMaybe :: forall v k (m :: * -> *).
(NicePackedValue k, NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k v -> k -> m (Maybe v)
readBigMapValueMaybe BigMapId k v
bigMapId k
key =
  Int -> m (Maybe v) -> m (Maybe v) -> m (Maybe v)
forall (m :: * -> *) a. MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode Int
404
    (Maybe v -> m (Maybe v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing)
    (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v) -> m v -> m (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BigMapId k v -> k -> m v
forall v k (m :: * -> *).
(NicePackedValue k, NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k v -> k -> m v
readBigMapValue BigMapId k v
bigMapId k
key)

-- | Read big_map value, given it's ID and a key.
-- If the value is not of the expected type, a 'ValueDecodeFailure' will be thrown.
readBigMapValue
  :: forall v k m.
     (NicePackedValue k, NiceUnpackedValue v, HasTezosRpc m)
  => BigMapId k v -> k -> m v
readBigMapValue :: forall v k (m :: * -> *).
(NicePackedValue k, NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k v -> k -> m v
readBigMapValue (BigMapId Natural
bigMapId) k
key =
  Natural -> Text -> m Expression
forall (m :: * -> *).
HasTezosRpc m =>
Natural -> Text -> m Expression
getBigMapValue Natural
bigMapId Text
scriptExpr m Expression -> (Expression -> m v) -> m v
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Expression
expr ->
    case Value (ToT v) -> v
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Value (ToT v) -> v)
-> Either FromExpressionError (Value (ToT v))
-> Either FromExpressionError v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Either FromExpressionError (Value (ToT v))
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression Expression
expr of
      Right v
v -> v -> m v
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v
      Left FromExpressionError
_ -> ValueDecodeFailure -> m v
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ValueDecodeFailure -> m v) -> ValueDecodeFailure -> m v
forall a b. (a -> b) -> a -> b
$ Text -> T -> ValueDecodeFailure
ValueDecodeFailure Text
"big map value" (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(ToT k))
  where
    scriptExpr :: Text
scriptExpr = ByteString -> Text
encodeBase58Check (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ k -> ByteString
forall t. NicePackedValue t => t -> ByteString
valueToScriptExpr k
key

-- | Read all big_map values, given it's ID.
-- If the values are not of the expected type, a 'ValueDecodeFailure' will be thrown.
--
-- Returns 'Nothing' if a big_map with the given ID does not exist.
readAllBigMapValuesMaybe
  :: forall v k m.
     (NiceUnpackedValue v, HasTezosRpc m)
  => BigMapId k v -> m (Maybe [v])
readAllBigMapValuesMaybe :: forall {k} v (k :: k) (m :: * -> *).
(NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k v -> m (Maybe [v])
readAllBigMapValuesMaybe BigMapId k v
bigMapId =
  Int -> m (Maybe [v]) -> m (Maybe [v]) -> m (Maybe [v])
forall (m :: * -> *) a. MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode Int
404
    (Maybe [v] -> m (Maybe [v])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [v]
forall a. Maybe a
Nothing)
    ([v] -> Maybe [v]
forall a. a -> Maybe a
Just ([v] -> Maybe [v]) -> m [v] -> m (Maybe [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BigMapId k v -> m [v]
forall {k} v (k :: k) (m :: * -> *).
(NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k v -> m [v]
readAllBigMapValues BigMapId k v
bigMapId)

-- | Read all big_map values, given it's ID.
-- If the values are not of the expected type, a 'ValueDecodeFailure' will be thrown.
readAllBigMapValues
  :: forall v k m.
     (NiceUnpackedValue v, HasTezosRpc m)
  => BigMapId k v -> m [v]
readAllBigMapValues :: forall {k} v (k :: k) (m :: * -> *).
(NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k v -> m [v]
readAllBigMapValues (BigMapId Natural
bigMapId) =
  Natural -> Maybe Natural -> Maybe Natural -> m Expression
forall (m :: * -> *).
HasTezosRpc m =>
Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValues Natural
bigMapId Maybe Natural
forall a. Maybe a
Nothing Maybe Natural
forall a. Maybe a
Nothing m Expression -> (Expression -> m [v]) -> m [v]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Expression
expr ->
    case Value (ToT [v]) -> [v]
Value ('TList (ToT v)) -> [v]
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Value ('TList (ToT v)) -> [v])
-> Either FromExpressionError (Value ('TList (ToT v)))
-> Either FromExpressionError [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Either FromExpressionError (Value ('TList (ToT v)))
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression Expression
expr of
      Right [v]
v -> [v] -> m [v]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v]
v
      Left FromExpressionError
_ -> ValueDecodeFailure -> m [v]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ValueDecodeFailure -> m [v]) -> ValueDecodeFailure -> m [v]
forall a b. (a -> b) -> a -> b
$ Text -> T -> ValueDecodeFailure
ValueDecodeFailure Text
"big map value " (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(ToT v))

data ContractNotFound = ContractNotFound ContractAddress
  deriving stock Int -> ContractNotFound -> ShowS
[ContractNotFound] -> ShowS
ContractNotFound -> String
(Int -> ContractNotFound -> ShowS)
-> (ContractNotFound -> String)
-> ([ContractNotFound] -> ShowS)
-> Show ContractNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractNotFound -> ShowS
showsPrec :: Int -> ContractNotFound -> ShowS
$cshow :: ContractNotFound -> String
show :: ContractNotFound -> String
$cshowList :: [ContractNotFound] -> ShowS
showList :: [ContractNotFound] -> ShowS
Show

instance Buildable ContractNotFound where
  build :: ContractNotFound -> Doc
build (ContractNotFound ContractAddress
addr) =
    Doc
"Smart contract " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ContractAddress
addr ContractAddress -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" was not found"

instance Exception ContractNotFound where
  displayException :: ContractNotFound -> String
displayException = ContractNotFound -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty

-- | Get originated t'U.Contract' for some address.
getContract :: (HasTezosRpc m) => ContractAddress -> m U.Contract
getContract :: forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m Contract
getContract ContractAddress
addr =
  Int -> m Contract -> m Contract -> m Contract
forall (m :: * -> *) a. MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode Int
404 (ContractNotFound -> m Contract
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ContractNotFound -> m Contract) -> ContractNotFound -> m Contract
forall a b. (a -> b) -> a -> b
$ ContractAddress -> ContractNotFound
ContractNotFound ContractAddress
addr) (m Contract -> m Contract) -> m Contract -> m Contract
forall a b. (a -> b) -> a -> b
$
  m (Either FromExpressionError Contract) -> m Contract
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either FromExpressionError Contract) -> m Contract)
-> m (Either FromExpressionError Contract) -> m Contract
forall a b. (a -> b) -> a -> b
$ Expression -> Either FromExpressionError Contract
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError Contract)
-> (OriginationScript -> Expression)
-> OriginationScript
-> Either FromExpressionError Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginationScript -> Expression
osCode (OriginationScript -> Either FromExpressionError Contract)
-> m OriginationScript -> m (Either FromExpressionError Contract)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContractAddress -> m OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m OriginationScript
getContractScript ContractAddress
addr

-- | Get counter value for given implicit address.
getImplicitContractCounter :: (HasTezosRpc m) => ImplicitAddress -> m TezosInt64
getImplicitContractCounter :: forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m TezosInt64
getImplicitContractCounter ImplicitAddress
addr = ImplicitAddress -> m TezosInt64
forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m TezosInt64
getCounter ImplicitAddress
addr

handleStatusCode :: MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode :: forall (m :: * -> *) a. MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode Int
code m a
onError m a
action = m a
action m a -> (ClientError -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch`
  \case FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp
          | Status -> Int
statusCode (Response -> Status
forall a. ResponseF a -> Status
responseStatusCode Response
resp) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
code -> m a
onError
        ClientError
e -> ClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientError
e

-- | Extract parameter types for all smart contracts' addresses and return mapping
-- from their hashes to their parameter types
getContractsParameterTypes
  :: HasTezosRpc m => [ContractAddress] -> m TcOriginatedContracts
getContractsParameterTypes :: forall (m :: * -> *).
HasTezosRpc m =>
[ContractAddress] -> m TcOriginatedContracts
getContractsParameterTypes [ContractAddress]
addrs =
  [(ContractHash, SomeParamType)] -> TcOriginatedContracts
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ContractHash, SomeParamType)] -> TcOriginatedContracts)
-> m [(ContractHash, SomeParamType)] -> m TcOriginatedContracts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ContractAddress -> m [(ContractHash, SomeParamType)])
-> [ContractAddress] -> m [(ContractHash, SomeParamType)]
forall (f :: * -> *) m (l :: * -> *) a.
(Applicative f, Monoid m, Container (l m), Element (l m) ~ m,
 Traversable l) =>
(a -> f m) -> l a -> f m
concatMapM ((Maybe (ContractHash, SomeParamType)
 -> [(ContractHash, SomeParamType)])
-> m (Maybe (ContractHash, SomeParamType))
-> m [(ContractHash, SomeParamType)]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (ContractHash, SomeParamType)
-> [(ContractHash, SomeParamType)]
forall a. Maybe a -> [a]
maybeToList (m (Maybe (ContractHash, SomeParamType))
 -> m [(ContractHash, SomeParamType)])
-> (ContractAddress -> m (Maybe (ContractHash, SomeParamType)))
-> ContractAddress
-> m [(ContractHash, SomeParamType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractAddress -> m (Maybe (ContractHash, SomeParamType))
forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m (Maybe (ContractHash, SomeParamType))
extractParameterType) [ContractAddress]
addrs
  where
    extractParameterType
      :: HasTezosRpc m => ContractAddress
      -> m (Maybe (ContractHash, SomeParamType))
    extractParameterType :: forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m (Maybe (ContractHash, SomeParamType))
extractParameterType addr :: ContractAddress
addr@(ContractAddress ContractHash
ch) =
      Int
-> m (Maybe (ContractHash, SomeParamType))
-> m (Maybe (ContractHash, SomeParamType))
-> m (Maybe (ContractHash, SomeParamType))
forall (m :: * -> *) a. MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode Int
404 (Maybe (ContractHash, SomeParamType)
-> m (Maybe (ContractHash, SomeParamType))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContractHash, SomeParamType)
forall a. Maybe a
Nothing) (m (Maybe (ContractHash, SomeParamType))
 -> m (Maybe (ContractHash, SomeParamType)))
-> m (Maybe (ContractHash, SomeParamType))
-> m (Maybe (ContractHash, SomeParamType))
forall a b. (a -> b) -> a -> b
$ do
        ParameterType
params <- (Contract -> ParameterType) -> m Contract -> m ParameterType
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Contract -> ParameterType
forall op. Contract' op -> ParameterType
U.contractParameter) (m Contract -> m ParameterType)
-> (m (Either FromExpressionError Contract) -> m Contract)
-> m (Either FromExpressionError Contract)
-> m ParameterType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either FromExpressionError Contract) -> m Contract
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either FromExpressionError Contract) -> m ParameterType)
-> m (Either FromExpressionError Contract) -> m ParameterType
forall a b. (a -> b) -> a -> b
$
            forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @U.Contract (Expression -> Either FromExpressionError Contract)
-> (OriginationScript -> Expression)
-> OriginationScript
-> Either FromExpressionError Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginationScript -> Expression
osCode (OriginationScript -> Either FromExpressionError Contract)
-> m OriginationScript -> m (Either FromExpressionError Contract)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContractAddress -> m OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m OriginationScript
getContractScript ContractAddress
addr
        (SomeParamType
paramNotes :: SomeParamType) <- m (Either TcTypeError SomeParamType) -> m SomeParamType
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either TcTypeError SomeParamType) -> m SomeParamType)
-> m (Either TcTypeError SomeParamType) -> m SomeParamType
forall a b. (a -> b) -> a -> b
$ Either TcTypeError SomeParamType
-> m (Either TcTypeError SomeParamType)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcTypeError SomeParamType
 -> m (Either TcTypeError SomeParamType))
-> Either TcTypeError SomeParamType
-> m (Either TcTypeError SomeParamType)
forall a b. (a -> b) -> a -> b
$ ParameterType -> Either TcTypeError SomeParamType
mkSomeParamType ParameterType
params
        pure $ (ContractHash, SomeParamType)
-> Maybe (ContractHash, SomeParamType)
forall a. a -> Maybe a
Just (ContractHash
ch, SomeParamType
paramNotes)

-- | 'getContractStorageAtBlock' applied to the head block.
getContractStorage :: HasTezosRpc m => ContractAddress -> m Expression
getContractStorage :: forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m Expression
getContractStorage = BlockId -> ContractAddress -> m Expression
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ContractAddress -> m Expression
getContractStorageAtBlock BlockId
HeadId

-- | 'getBigMapValueAtBlock' applied to the head block.
getBigMapValue :: HasTezosRpc m => Natural -> Text -> m Expression
getBigMapValue :: forall (m :: * -> *).
HasTezosRpc m =>
Natural -> Text -> m Expression
getBigMapValue = BlockId -> Natural -> Text -> m Expression
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> Natural -> Text -> m Expression
getBigMapValueAtBlock BlockId
HeadId

-- | 'getBigMapValuesAtBlock' applied to the head block.
getBigMapValues :: HasTezosRpc m => Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValues :: forall (m :: * -> *).
HasTezosRpc m =>
Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValues = BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
forall (m :: * -> *).
HasTezosRpc m =>
BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValuesAtBlock BlockId
HeadId

-- | Get hash of the current head block, this head hash is used in other
-- RPC calls.
getHeadBlock :: HasTezosRpc m => m BlockHash
getHeadBlock :: forall (m :: * -> *). HasTezosRpc m => m BlockHash
getHeadBlock = BlockId -> m BlockHash
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockHash
getBlockHash BlockId
HeadId

-- | 'getCounterAtBlock' applied to the head block.
getCounter :: HasTezosRpc m => ImplicitAddress -> m TezosInt64
getCounter :: forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m TezosInt64
getCounter = BlockId -> ImplicitAddress -> m TezosInt64
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ImplicitAddress -> m TezosInt64
getCounterAtBlock BlockId
HeadId

-- | 'getProtocolParametersAtBlock' applied to the head block.
getProtocolParameters :: HasTezosRpc m => m ProtocolParameters
getProtocolParameters :: forall (m :: * -> *). HasTezosRpc m => m ProtocolParameters
getProtocolParameters = BlockId -> m ProtocolParameters
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> m ProtocolParameters
getProtocolParametersAtBlock BlockId
HeadId

-- | 'runOperationAtBlock' applied to the head block.
runOperation :: HasTezosRpc m => RunOperation -> m RunOperationResult
runOperation :: forall (m :: * -> *).
HasTezosRpc m =>
RunOperation -> m RunOperationResult
runOperation = BlockId -> RunOperation -> m RunOperationResult
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> RunOperation -> m RunOperationResult
runOperationAtBlock BlockId
HeadId

-- | 'preApplyOperationsAtBlock' applied to the head block.
preApplyOperations :: HasTezosRpc m => [PreApplyOperation] -> m [RunOperationResult]
preApplyOperations :: forall (m :: * -> *).
HasTezosRpc m =>
[PreApplyOperation] -> m [RunOperationResult]
preApplyOperations = BlockId -> [PreApplyOperation] -> m [RunOperationResult]
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> [PreApplyOperation] -> m [RunOperationResult]
preApplyOperationsAtBlock BlockId
HeadId

-- | 'forgeOperationAtBlock' applied to the head block.
forgeOperation :: HasTezosRpc m => ForgeOperation -> m HexJSONByteString
forgeOperation :: forall (m :: * -> *).
HasTezosRpc m =>
ForgeOperation -> m HexJSONByteString
forgeOperation = BlockId -> ForgeOperation -> m HexJSONByteString
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ForgeOperation -> m HexJSONByteString
forgeOperationAtBlock BlockId
HeadId

-- | 'getContractScriptAtBlock' applied to the head block.
getContractScript :: HasTezosRpc m => ContractAddress -> m OriginationScript
getContractScript :: forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m OriginationScript
getContractScript = BlockId -> ContractAddress -> m OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ContractAddress -> m OriginationScript
getContractScriptAtBlock BlockId
HeadId

-- | 'getContractBigMapAtBlock' applied to the head block.
getContractBigMap :: HasTezosRpc m => ContractAddress -> GetBigMap -> m GetBigMapResult
getContractBigMap :: forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> GetBigMap -> m GetBigMapResult
getContractBigMap = BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
getContractBigMapAtBlock BlockId
HeadId

-- | 'getBalanceAtBlock' applied to the head block.
getBalance
  :: forall kind m. (HasTezosRpc m, L1AddressKind kind)
  => KindedAddress kind
  -> m Mutez
getBalance :: forall (kind :: AddressKind) (m :: * -> *).
(HasTezosRpc m, L1AddressKind kind) =>
KindedAddress kind -> m Mutez
getBalance = forall (kind :: AddressKind) a. L1AddressKind kind => a -> a
usingImplicitOrContractKind @kind ((KindedAddress kind -> m Mutez) -> KindedAddress kind -> m Mutez)
-> (KindedAddress kind -> m Mutez) -> KindedAddress kind -> m Mutez
forall a b. (a -> b) -> a -> b
$ BlockId -> Address -> m Mutez
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> Address -> m Mutez
getBalanceAtBlock BlockId
HeadId (Address -> m Mutez)
-> (KindedAddress kind -> Address) -> KindedAddress kind -> m Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress

-- | 'getScriptSizeAtBlock' applied to the head block.
getScriptSize :: HasTezosRpc m => CalcSize -> m ScriptSize
getScriptSize :: forall (m :: * -> *). HasTezosRpc m => CalcSize -> m ScriptSize
getScriptSize = BlockId -> CalcSize -> m ScriptSize
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> CalcSize -> m ScriptSize
getScriptSizeAtBlock BlockId
HeadId

-- | 'getDelegateAtBlock' applied to the head block.
getDelegate :: HasTezosRpc m => L1Address -> m (Maybe KeyHash)
getDelegate :: forall (m :: * -> *).
HasTezosRpc m =>
L1Address -> m (Maybe KeyHash)
getDelegate = BlockId -> L1Address -> m (Maybe KeyHash)
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> L1Address -> m (Maybe KeyHash)
getDelegateAtBlock BlockId
HeadId

-- | 'runCodeAtBlock' applied to the head block.
runCode :: HasTezosRpc m => RunCode -> m RunCodeResult
runCode :: forall (m :: * -> *). HasTezosRpc m => RunCode -> m RunCodeResult
runCode = BlockId -> RunCode -> m RunCodeResult
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> RunCode -> m RunCodeResult
runCodeAtBlock BlockId
HeadId

getManagerKey :: HasTezosRpc m => ImplicitAddress -> m (Maybe PublicKey)
getManagerKey :: forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m (Maybe PublicKey)
getManagerKey = BlockId -> ImplicitAddress -> m (Maybe PublicKey)
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ImplicitAddress -> m (Maybe PublicKey)
getManagerKeyAtBlock BlockId
HeadId

-- | Get 'ContractState' for a given t'ContractAddress' at a given 'BlockId'.
-- Can be used with the morley interpreter to add some network interoperability.
contractStateResolver :: HasTezosRpc m => BlockId -> ContractAddress -> m (Maybe ContractState)
contractStateResolver :: forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ContractAddress -> m (Maybe ContractState)
contractStateResolver BlockId
blkId ContractAddress
addr = Int
-> m (Maybe ContractState)
-> m (Maybe ContractState)
-> m (Maybe ContractState)
forall (m :: * -> *) a. MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode Int
404 (Maybe ContractState -> m (Maybe ContractState)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ContractState
forall a. Maybe a
Nothing) (m (Maybe ContractState) -> m (Maybe ContractState))
-> m (Maybe ContractState) -> m (Maybe ContractState)
forall a b. (a -> b) -> a -> b
$ ContractState -> Maybe ContractState
forall a. a -> Maybe a
Just (ContractState -> Maybe ContractState)
-> m ContractState -> m (Maybe ContractState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  BlockId
block <- BlockHash -> BlockId
BlockHashId (BlockHash -> BlockId) -> m BlockHash -> m BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockId -> m BlockHash
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockHash
getBlockHash BlockId
blkId
  Contract
uContract <- m (Either FromExpressionError Contract) -> m Contract
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either FromExpressionError Contract) -> m Contract)
-> m (Either FromExpressionError Contract) -> m Contract
forall a b. (a -> b) -> a -> b
$ Expression -> Either FromExpressionError Contract
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError Contract)
-> (OriginationScript -> Expression)
-> OriginationScript
-> Either FromExpressionError Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginationScript -> Expression
osCode (OriginationScript -> Either FromExpressionError Contract)
-> m OriginationScript -> m (Either FromExpressionError Contract)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockId -> ContractAddress -> m OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ContractAddress -> m OriginationScript
getContractScriptAtBlock BlockId
block ContractAddress
addr
  Mutez
csBalance <- BlockId -> Address -> m Mutez
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> Address -> m Mutez
getBalanceAtBlock BlockId
block (Address -> m Mutez) -> Address -> m Mutez
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
addr
  Maybe KeyHash
csDelegate <- BlockId -> L1Address -> m (Maybe KeyHash)
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> L1Address -> m (Maybe KeyHash)
getDelegateAtBlock BlockId
block (L1Address -> m (Maybe KeyHash)) -> L1Address -> m (Maybe KeyHash)
forall a b. (a -> b) -> a -> b
$ ContractAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
addr
  SomeContract csContract :: Contract cp st
csContract@Contract{} <-
    (TcError' ExpandedOp -> m SomeContract)
-> (SomeContract -> m SomeContract)
-> Either (TcError' ExpandedOp) SomeContract
-> m SomeContract
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError' ExpandedOp -> m SomeContract
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeContract -> m SomeContract
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TcError' ExpandedOp) SomeContract -> m SomeContract)
-> (TypeCheckResult ExpandedOp SomeContract
    -> Either (TcError' ExpandedOp) SomeContract)
-> TypeCheckResult ExpandedOp SomeContract
-> m SomeContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult ExpandedOp SomeContract
-> Either (TcError' ExpandedOp) SomeContract
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult ExpandedOp SomeContract -> m SomeContract)
-> TypeCheckResult ExpandedOp SomeContract -> m SomeContract
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult ExpandedOp SomeContract
typeCheckContract Contract
uContract
  Value' Instr st
csStorage <- m (Either FromExpressionError (Value' Instr st))
-> m (Value' Instr st)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either FromExpressionError (Value' Instr st))
 -> m (Value' Instr st))
-> m (Either FromExpressionError (Value' Instr st))
-> m (Value' Instr st)
forall a b. (a -> b) -> a -> b
$ Expression -> Either FromExpressionError (Value' Instr st)
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError (Value' Instr st))
-> m Expression -> m (Either FromExpressionError (Value' Instr st))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockId -> ContractAddress -> m Expression
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ContractAddress -> m Expression
getContractStorageAtBlock BlockId
block ContractAddress
addr
  pure ContractState{Maybe KeyHash
Mutez
Value' Instr st
Contract cp st
csBalance :: Mutez
csDelegate :: Maybe KeyHash
csContract :: Contract cp st
csStorage :: Value' Instr st
csBalance :: Mutez
csContract :: Contract cp st
csDelegate :: Maybe KeyHash
csStorage :: Value' Instr st
..}

getTicketBalance
  :: HasTezosRpc m
  => L1Address -- ^ Ticket owner
  -> GetTicketBalance -- ^ Ticket description
  -> m Natural
getTicketBalance :: forall (m :: * -> *).
HasTezosRpc m =>
L1Address -> GetTicketBalance -> m Natural
getTicketBalance = BlockId -> Address -> GetTicketBalance -> m Natural
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> Address -> GetTicketBalance -> m Natural
getTicketBalanceAtBlock BlockId
HeadId (Address -> GetTicketBalance -> m Natural)
-> (L1Address -> Address)
-> L1Address
-> GetTicketBalance
-> m Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L1Address -> Address
forall a. ToAddress a => a -> Address
toAddress

getAllTicketBalances
  :: HasTezosRpc m
  => ContractAddress -- ^ Ticket owner
  -> m [GetAllTicketBalancesResponse]
getAllTicketBalances :: forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m [GetAllTicketBalancesResponse]
getAllTicketBalances = BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse]
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse]
getAllTicketBalancesAtBlock BlockId
HeadId