-- 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
  , getBigMapValue
  , getBigMapValues
  , getHeadBlock
  , getCounter
  , getProtocolParameters
  , runOperation
  , preApplyOperations
  , forgeOperation
  , getContractScript
  , getContractBigMap
  , getBalance
  , getDelegate
  , runCode
  , getManagerKey
  ) 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, niceUnpackedValueEvi, valueToScriptExpr)
import Lorentz.Value
import Morley.Micheline
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 Address
  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
showList :: [ContractGetCounterAttempt] -> ShowS
$cshowList :: [ContractGetCounterAttempt] -> ShowS
show :: ContractGetCounterAttempt -> String
$cshow :: ContractGetCounterAttempt -> String
showsPrec :: Int -> ContractGetCounterAttempt -> ShowS
$cshowsPrec :: Int -> ContractGetCounterAttempt -> ShowS
Show)
instance Exception ContractGetCounterAttempt
instance Buildable ContractGetCounterAttempt where
  build :: ContractGetCounterAttempt -> Builder
build (ContractGetCounterAttempt Address
addr) =
    Builder
"Failed to get counter of contract '" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"', " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
"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
showList :: [ValueDecodeFailure] -> ShowS
$cshowList :: [ValueDecodeFailure] -> ShowS
show :: ValueDecodeFailure -> String
$cshow :: ValueDecodeFailure -> String
showsPrec :: Int -> ValueDecodeFailure -> ShowS
$cshowsPrec :: Int -> ValueDecodeFailure -> ShowS
Show)
instance Exception ValueDecodeFailure
instance Buildable ValueDecodeFailure where
  build :: ValueDecodeFailure -> Builder
build (ValueDecodeFailure Text
desc T
ty) =
    Builder
"Failed to decode value with expected type " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> T -> Builder
forall p. Buildable p => p -> Builder
build T
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" \
    \for '" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
desc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"

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
showList :: [ValueNotFound] -> ShowS
$cshowList :: [ValueNotFound] -> ShowS
show :: ValueNotFound -> String
$cshow :: ValueNotFound -> String
showsPrec :: Int -> ValueNotFound -> ShowS
$cshowsPrec :: Int -> ValueNotFound -> ShowS
Show)
instance Exception ValueNotFound
instance Buildable ValueNotFound where
  build :: ValueNotFound -> Builder
build ValueNotFound
ValueNotFound =
    Builder
"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)
  => Address -> Value k -> m (Value v)
readContractBigMapValue :: Address -> Value k -> m (Value v)
readContractBigMapValue Address
contract Value k
key = do
  let
    req :: GetBigMap
req = GetBigMap :: Expression -> Expression -> GetBigMap
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 ((SingKind T, SingI k) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @k)
      }
  Expression
res <- Address -> GetBigMap -> m GetBigMapResult
forall (m :: * -> *).
HasTezosRpc m =>
Address -> GetBigMap -> m GetBigMapResult
getContractBigMap Address
contract GetBigMap
req m GetBigMapResult
-> (GetBigMapResult -> m Expression) -> m Expression
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    GetBigMapResult Expression
res -> Expression -> m Expression
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.
FromExpression 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" ((SingKind T, SingI k) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @k)) Value v -> m (Value v)
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 :: 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 (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 :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Expression
expr ->
    ((((SingI (ToT v), WellTyped (ToT v),
    FailOnOperationFound (ContainsOp (ToT v)),
    FailOnBigMapFound (ContainsBigMap (ToT v)),
    FailOnTicketFound (ContainsTicket (ToT v)),
    FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
   (SingI (ToT v), WellTyped (ToT v),
    FailOnOperationFound (ContainsOp (ToT v)),
    FailOnBigMapFound (ContainsBigMap (ToT v)),
    FailOnContractFound (ContainsContract (ToT v)),
    FailOnTicketFound (ContainsTicket (ToT v)),
    FailOnSaplingStateFound (ContainsSaplingState (ToT v)))),
  KnownValue v)
 :- UnpackedValScope (ToT v))
-> (UnpackedValScope (ToT v) => m v) -> m v
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((((SingI (ToT v), WellTyped (ToT v),
   FailOnOperationFound (ContainsOp (ToT v)),
   FailOnBigMapFound (ContainsBigMap (ToT v)),
   FailOnTicketFound (ContainsTicket (ToT v)),
   FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
  (SingI (ToT v), WellTyped (ToT v),
   FailOnOperationFound (ContainsOp (ToT v)),
   FailOnBigMapFound (ContainsBigMap (ToT v)),
   FailOnContractFound (ContainsContract (ToT v)),
   FailOnTicketFound (ContainsTicket (ToT v)),
   FailOnSaplingStateFound (ContainsSaplingState (ToT v)))),
 KnownValue v)
:- UnpackedValScope (ToT v)
forall a. NiceUnpackedValue a :- UnpackedValScope (ToT a)
niceUnpackedValueEvi @v) ((UnpackedValScope (ToT v) => m v) -> m v)
-> (UnpackedValScope (ToT v) => m v) -> m v
forall a b. (a -> b) -> a -> b
$
      case Value' Instr (ToT v) -> v
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Value' Instr (ToT v) -> v)
-> Either FromExpressionError (Value' Instr (ToT v))
-> Either FromExpressionError v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Either FromExpressionError (Value' Instr (ToT v))
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
expr of
        Right v
v -> v -> m v
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" ((SingKind T, SingI (ToT k)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
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 :: 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 (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 :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Expression
expr ->
    ((((SingI (ToT v), WellTyped (ToT v),
    FailOnOperationFound (ContainsOp (ToT v)),
    FailOnBigMapFound (ContainsBigMap (ToT v)),
    FailOnTicketFound (ContainsTicket (ToT v)),
    FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
   (SingI (ToT v), WellTyped (ToT v),
    FailOnOperationFound (ContainsOp (ToT v)),
    FailOnBigMapFound (ContainsBigMap (ToT v)),
    FailOnContractFound (ContainsContract (ToT v)),
    FailOnTicketFound (ContainsTicket (ToT v)),
    FailOnSaplingStateFound (ContainsSaplingState (ToT v)))),
  KnownValue v)
 :- UnpackedValScope (ToT v))
-> (UnpackedValScope (ToT v) => m [v]) -> m [v]
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((((SingI (ToT v), WellTyped (ToT v),
   FailOnOperationFound (ContainsOp (ToT v)),
   FailOnBigMapFound (ContainsBigMap (ToT v)),
   FailOnTicketFound (ContainsTicket (ToT v)),
   FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
  (SingI (ToT v), WellTyped (ToT v),
   FailOnOperationFound (ContainsOp (ToT v)),
   FailOnBigMapFound (ContainsBigMap (ToT v)),
   FailOnContractFound (ContainsContract (ToT v)),
   FailOnTicketFound (ContainsTicket (ToT v)),
   FailOnSaplingStateFound (ContainsSaplingState (ToT v)))),
 KnownValue v)
:- UnpackedValScope (ToT v)
forall a. NiceUnpackedValue a :- UnpackedValScope (ToT a)
niceUnpackedValueEvi @v) ((UnpackedValScope (ToT v) => m [v]) -> m [v])
-> (UnpackedValScope (ToT v) => m [v]) -> m [v]
forall a b. (a -> b) -> a -> b
$
      case Value' Instr ('TList (ToT v)) -> [v]
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Value' Instr ('TList (ToT v)) -> [v])
-> Either FromExpressionError (Value' Instr ('TList (ToT v)))
-> Either FromExpressionError [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression
-> Either FromExpressionError (Value' Instr ('TList (ToT v)))
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
expr of
        Right [v]
v -> [v] -> m [v]
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 " ((SingKind T, SingI (ToT v)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @(ToT v))

data ContractNotFound = ContractNotFound Address
  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
showList :: [ContractNotFound] -> ShowS
$cshowList :: [ContractNotFound] -> ShowS
show :: ContractNotFound -> String
$cshow :: ContractNotFound -> String
showsPrec :: Int -> ContractNotFound -> ShowS
$cshowsPrec :: Int -> ContractNotFound -> ShowS
Show

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

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

-- | Get originated t'U.Contract' for some address.
getContract :: (HasTezosRpc m) => Address -> m U.Contract
getContract :: Address -> m Contract
getContract Address
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
$ Address -> ContractNotFound
ContractNotFound Address
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.
FromExpression 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
<$> Address -> m OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
Address -> m OriginationScript
getContractScript Address
addr

-- | Get counter value for given address.
--
-- Throws an error if given address is a contract address.
getImplicitContractCounter :: (HasTezosRpc m) => Address -> m TezosInt64
getImplicitContractCounter :: Address -> m TezosInt64
getImplicitContractCounter Address
addr = case Address
addr of
  KeyAddress KeyHash
_      -> Address -> m TezosInt64
forall (m :: * -> *). HasTezosRpc m => Address -> m TezosInt64
getCounter Address
addr
  ContractAddress ContractHash
_ -> ContractGetCounterAttempt -> m TezosInt64
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ContractGetCounterAttempt -> m TezosInt64)
-> ContractGetCounterAttempt -> m TezosInt64
forall a b. (a -> b) -> a -> b
$ Address -> ContractGetCounterAttempt
ContractGetCounterAttempt Address
addr

handleStatusCode :: MonadCatch m => Int -> m a -> m a -> m a
handleStatusCode :: 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 => [Address] -> m TcOriginatedContracts
getContractsParameterTypes :: [Address] -> m TcOriginatedContracts
getContractsParameterTypes [Address]
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
<$> (Address -> m [(ContractHash, SomeParamType)])
-> [Address] -> 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 (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)])
-> (Address -> m (Maybe (ContractHash, SomeParamType)))
-> Address
-> m [(ContractHash, SomeParamType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> m (Maybe (ContractHash, SomeParamType))
forall (m :: * -> *).
HasTezosRpc m =>
Address -> m (Maybe (ContractHash, SomeParamType))
extractParameterType) [Address]
addrs
  where
    extractParameterType
      :: HasTezosRpc m => Address
      -> m (Maybe (ContractHash, SomeParamType))
    extractParameterType :: Address -> m (Maybe (ContractHash, SomeParamType))
extractParameterType Address
addr = case Address
addr of
      KeyAddress KeyHash
_ -> Maybe (ContractHash, SomeParamType)
-> m (Maybe (ContractHash, SomeParamType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContractHash, SomeParamType)
forall a. Maybe a
Nothing
      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 (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 (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
$
              FromExpression Contract =>
Expression -> Either FromExpressionError Contract
forall a.
FromExpression 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
<$> Address -> m OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
Address -> m OriginationScript
getContractScript Address
addr
          (SomeParamType
paramNotes :: SomeParamType) <- m (Either TCError SomeParamType) -> m SomeParamType
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either TCError SomeParamType) -> m SomeParamType)
-> m (Either TCError SomeParamType) -> m SomeParamType
forall a b. (a -> b) -> a -> b
$ Either TCError SomeParamType -> m (Either TCError SomeParamType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TCError SomeParamType -> m (Either TCError SomeParamType))
-> Either TCError SomeParamType -> m (Either TCError SomeParamType)
forall a b. (a -> b) -> a -> b
$ ParameterType -> Either TCError 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 => Address -> m Expression
getContractStorage :: Address -> m Expression
getContractStorage = BlockId -> Address -> m Expression
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> Address -> m Expression
getContractStorageAtBlock BlockId
HeadId

-- | 'getBigMapValueAtBlock' applied to the head block.
getBigMapValue :: HasTezosRpc m => Natural -> Text -> m Expression
getBigMapValue :: 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 :: 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 Text
getHeadBlock :: m Text
getHeadBlock = BlockId -> m Text
forall (m :: * -> *). HasTezosRpc m => BlockId -> m Text
getBlockHash BlockId
HeadId

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

-- | 'getProtocolParametersAtBlock' applied to the head block.
getProtocolParameters :: HasTezosRpc m => m ProtocolParameters
getProtocolParameters :: 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 :: 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 :: [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 :: 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 => Address -> m OriginationScript
getContractScript :: Address -> m OriginationScript
getContractScript = BlockId -> Address -> m OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> Address -> m OriginationScript
getContractScriptAtBlock BlockId
HeadId

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

-- | 'getBalanceAtBlock' applied to the head block.
getBalance :: HasTezosRpc m => Address -> m Mutez
getBalance :: Address -> m Mutez
getBalance = BlockId -> Address -> m Mutez
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> Address -> m Mutez
getBalanceAtBlock BlockId
HeadId

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

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

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