module Morley.Client.Action.Common
( OperationConstants(..)
, TD (..)
, TransactionData(..)
, OriginationData(..)
, TransferTicketData(..)
, RevealData(..)
, DelegationData(..)
, ClientInput
, addOperationPrefix
, buildTxDataWithAlias
, buildTxTicketDataWithAlias
, getAppliedResults
, computeFee
, computeStorageLimit
, convergingFee
, preProcessOperation
, stubSignature
, prepareOpForInjection
, updateCommonData
, toParametersInternals
, mkOriginationScript
, handleOperationResult
, runErrorsToClientError
) where
import Control.Lens (Prism')
import Data.ByteString (cons)
import Data.Default (def)
import Fmt (Buildable(..), Doc, (+|), (|+))
import Morley.Client.RPC.Class
import Morley.Client.RPC.Error
import Morley.Client.RPC.Getters
import Morley.Client.RPC.Types
import Morley.Client.TezosClient
import Morley.Client.Types
import Morley.Client.Util
import Morley.Micheline (TezosInt64, TezosMutez(..), toExpression)
import Morley.Micheline.Expression (expressionString)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Untyped.Entrypoints
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core
import Morley.Tezos.Crypto
data OperationConstants = OperationConstants
{ OperationConstants -> BlockHash
ocLastBlockHash :: BlockHash
, OperationConstants -> BlockConstants
ocBlockConstants :: BlockConstants
, OperationConstants -> FeeConstants
ocFeeConstants :: FeeConstants
, OperationConstants -> StringEncode Int64
ocCounter :: TezosInt64
}
data TD (t :: Type) = TD
{ forall t. TD t -> L1Address
tdReceiver :: L1Address
, forall t. TD t -> Mutez
tdAmount :: Mutez
, forall t. TD t -> EpName
tdEpName :: EpName
, forall t. TD t -> t
tdParam :: t
, forall t. TD t -> Maybe Mutez
tdMbFee :: Maybe Mutez
}
data TransactionData where
TransactionData ::
forall (t :: T.T). ParameterScope t =>
TD (T.Value t) -> TransactionData
instance Buildable TransactionData where
build :: TransactionData -> Doc
build = Maybe SomeAlias -> TransactionData -> Doc
buildTxDataWithAlias Maybe SomeAlias
forall a. Maybe a
Nothing
buildTxDataWithAlias :: Maybe SomeAlias -> TransactionData -> Doc
buildTxDataWithAlias :: Maybe SomeAlias -> TransactionData -> Doc
buildTxDataWithAlias Maybe SomeAlias
mbAlias (TransactionData TD{Maybe Mutez
EpName
Mutez
L1Address
Value t
tdReceiver :: forall t. TD t -> L1Address
tdAmount :: forall t. TD t -> Mutez
tdEpName :: forall t. TD t -> EpName
tdParam :: forall t. TD t -> t
tdMbFee :: forall t. TD t -> Maybe Mutez
tdReceiver :: L1Address
tdAmount :: Mutez
tdEpName :: EpName
tdParam :: Value t
tdMbFee :: Maybe Mutez
..}) =
Doc
"To: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| L1Address
tdReceiver L1Address -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Maybe SomeAlias -> Doc
buildMbAlias Maybe SomeAlias
mbAlias Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
". EP: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| EpName
tdEpName EpName -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+
Doc
". Parameter: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Value t
tdParam Value t -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
". Amount: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
tdAmount Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
where
buildMbAlias :: Maybe SomeAlias -> Doc
buildMbAlias :: Maybe SomeAlias -> Doc
buildMbAlias = Doc -> (SomeAlias -> Doc) -> Maybe SomeAlias -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"" ((SomeAlias -> Doc) -> Maybe SomeAlias -> Doc)
-> (SomeAlias -> Doc) -> Maybe SomeAlias -> Doc
forall a b. (a -> b) -> a -> b
$ \SomeAlias
a -> Doc
" (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| SomeAlias
a SomeAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
")"
buildTxTicketDataWithAlias :: Maybe SomeAlias -> TransferTicketData -> Doc
buildTxTicketDataWithAlias :: Maybe SomeAlias -> TransferTicketData -> Doc
buildTxTicketDataWithAlias Maybe SomeAlias
mbAlias
(TransferTicketData Value t
contents Address
ticketer Natural
amount Address
dest EpName
ep Maybe Mutez
_mbFee) =
Doc
"To: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Address
dest Address -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Maybe SomeAlias -> Doc
buildMbAlias Maybe SomeAlias
mbAlias Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
". EP: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| EpName
ep
EpName -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
". Ticketer: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Address
ticketer
Address -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" contents: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Value t
contents
Value t -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" amount: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Natural
amount
Natural -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
where
buildMbAlias :: Maybe SomeAlias -> Doc
buildMbAlias :: Maybe SomeAlias -> Doc
buildMbAlias = Doc -> (SomeAlias -> Doc) -> Maybe SomeAlias -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"" ((SomeAlias -> Doc) -> Maybe SomeAlias -> Doc)
-> (SomeAlias -> Doc) -> Maybe SomeAlias -> Doc
forall a b. (a -> b) -> a -> b
$ \SomeAlias
a -> Doc
" (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| SomeAlias
a SomeAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
")"
data OriginationData =
forall cp st. (ParameterScope cp, StorageScope st) => OriginationData
{ OriginationData -> AliasBehavior
odAliasBehavior :: AliasBehavior
, OriginationData -> ContractAlias
odName :: ContractAlias
, OriginationData -> Mutez
odBalance :: Mutez
, ()
odContract :: T.Contract cp st
, ()
odStorage :: T.Value st
, OriginationData -> Maybe KeyHash
odDelegate :: Maybe KeyHash
, OriginationData -> Maybe Mutez
odMbFee :: Maybe Mutez
}
data DelegationData = DelegationData
{ DelegationData -> Maybe KeyHash
ddDelegate :: Maybe KeyHash
, DelegationData -> Maybe Mutez
ddMbFee :: Maybe Mutez
}
data RevealData = RevealData
{ RevealData -> PublicKey
rdPublicKey :: PublicKey
, RevealData -> Maybe Mutez
rdMbFee :: Maybe Mutez
}
data TransferTicketData = forall t. (ParameterScope t, Comparable t) => TransferTicketData
{ ()
ttdTicketContents :: T.Value t
, TransferTicketData -> Address
ttdTicketTicketer :: Address
, TransferTicketData -> Natural
ttdTicketAmount :: Natural
, TransferTicketData -> Address
ttdDestination :: Address
, TransferTicketData -> EpName
ttdEntrypoint :: EpName
, TransferTicketData -> Maybe Mutez
ttdMbFee :: Maybe Mutez
}
data ClientInput
instance OperationInfoDescriptor ClientInput where
type TransferInfo ClientInput = TransactionData
type TransferTicketInfo ClientInput = TransferTicketData
type OriginationInfo ClientInput = OriginationData
type RevealInfo ClientInput = RevealData
type DelegationInfo ClientInput = DelegationData
toParametersInternals
:: ParameterScope t
=> EpName
-> T.Value t
-> ParametersInternal
toParametersInternals :: forall (t :: T).
ParameterScope t =>
EpName -> Value t -> ParametersInternal
toParametersInternals EpName
epName Value t
epParam = ParametersInternal
{ piEntrypoint :: Text
piEntrypoint = EpName -> Text
epNameToTezosEp EpName
epName
, piValue :: Expression
piValue = Value t -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value t
epParam
}
mkOriginationScript
:: T.Contract cp st -> T.Value st -> OriginationScript
mkOriginationScript :: forall (cp :: T) (st :: T).
Contract cp st -> Value st -> OriginationScript
mkOriginationScript contract :: Contract cp st
contract@T.Contract{} Value st
initialStorage = OriginationScript
{ osCode :: Expression
osCode = Contract cp st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract cp st
contract
, osStorage :: Expression
osStorage = Value st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value st
initialStorage
}
preProcessOperation
:: (HasTezosRpc m) => ImplicitAddress -> m OperationConstants
preProcessOperation :: forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m OperationConstants
preProcessOperation ImplicitAddress
sourceAddr = do
BlockHash
ocLastBlockHash <- BlockId -> m BlockHash
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockHash
getBlockHash BlockId
FinalHeadId
BlockConstants
ocBlockConstants <- BlockId -> m BlockConstants
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockConstants
getBlockConstants (BlockHash -> BlockId
BlockHashId BlockHash
ocLastBlockHash)
let ocFeeConstants :: FeeConstants
ocFeeConstants = FeeConstants
forall a. Default a => a
def
StringEncode Int64
ocCounter <- ImplicitAddress -> m (StringEncode Int64)
forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m (StringEncode Int64)
getImplicitContractCounter ImplicitAddress
sourceAddr
pure OperationConstants{StringEncode Int64
FeeConstants
BlockHash
BlockConstants
ocLastBlockHash :: BlockHash
ocBlockConstants :: BlockConstants
ocFeeConstants :: FeeConstants
ocCounter :: StringEncode Int64
ocLastBlockHash :: BlockHash
ocBlockConstants :: BlockConstants
ocFeeConstants :: FeeConstants
ocCounter :: StringEncode Int64
..}
getAppliedResults
:: (HasTezosRpc m)
=> Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult, [OperationResp WithSource])
getAppliedResults :: forall (m :: * -> *).
HasTezosRpc m =>
Either RunOperation PreApplyOperation
-> m (NonEmpty AppliedResult, [OperationResp WithSource])
getAppliedResults Either RunOperation PreApplyOperation
op = do
(RunOperationResult
runResult, Int
expectedContentsSize) <- case Either RunOperation PreApplyOperation
op of
Left RunOperation
runOp ->
(, NonEmpty OperationInput -> Int
forall i a.
(Integral i, Container a,
DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length (NonEmpty OperationInput -> Int) -> NonEmpty OperationInput -> Int
forall a b. (a -> b) -> a -> b
$ RunOperationInternal -> NonEmpty OperationInput
roiContents (RunOperationInternal -> NonEmpty OperationInput)
-> RunOperationInternal -> NonEmpty OperationInput
forall a b. (a -> b) -> a -> b
$ RunOperation -> RunOperationInternal
roOperation RunOperation
runOp) (RunOperationResult -> (RunOperationResult, Int))
-> m RunOperationResult -> m (RunOperationResult, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunOperation -> m RunOperationResult
forall (m :: * -> *).
HasTezosRpc m =>
RunOperation -> m RunOperationResult
runOperation RunOperation
runOp
Right PreApplyOperation
preApplyOp -> do
[RunOperationResult]
results <- [PreApplyOperation] -> m [RunOperationResult]
forall (m :: * -> *).
HasTezosRpc m =>
[PreApplyOperation] -> m [RunOperationResult]
preApplyOperations [PreApplyOperation
preApplyOp]
case [RunOperationResult]
results of
[RunOperationResult
result] -> (RunOperationResult, Int) -> m (RunOperationResult, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunOperationResult
result, NonEmpty OperationInput -> Int
forall i a.
(Integral i, Container a,
DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length (NonEmpty OperationInput -> Int) -> NonEmpty OperationInput -> Int
forall a b. (a -> b) -> a -> b
$ PreApplyOperation -> NonEmpty OperationInput
paoContents PreApplyOperation
preApplyOp)
[RunOperationResult]
_ -> IncorrectRpcResponse -> m (RunOperationResult, Int)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IncorrectRpcResponse -> m (RunOperationResult, Int))
-> IncorrectRpcResponse -> m (RunOperationResult, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IncorrectRpcResponse
RpcUnexpectedSize Int
1 ([RunOperationResult] -> Int
forall i a.
(Integral i, Container a,
DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [RunOperationResult]
results)
RunOperationResult
-> Int -> m (NonEmpty AppliedResult, [OperationResp WithSource])
forall (m :: * -> *).
MonadThrow m =>
RunOperationResult
-> Int -> m (NonEmpty AppliedResult, [OperationResp WithSource])
handleOperationResult RunOperationResult
runResult Int
expectedContentsSize
handleOperationResult
:: MonadThrow m
=> RunOperationResult -> Int -> m (NonEmpty AppliedResult, [OperationResp WithSource])
handleOperationResult :: forall (m :: * -> *).
MonadThrow m =>
RunOperationResult
-> Int -> m (NonEmpty AppliedResult, [OperationResp WithSource])
handleOperationResult RunOperationResult{NonEmpty OperationContent
rrOperationContents :: NonEmpty OperationContent
rrOperationContents :: RunOperationResult -> NonEmpty OperationContent
..} Int
expectedContentsSize = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty OperationContent -> Int
forall i a.
(Integral i, Container a,
DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length NonEmpty OperationContent
rrOperationContents Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expectedContentsSize) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IncorrectRpcResponse -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IncorrectRpcResponse -> m ()) -> IncorrectRpcResponse -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IncorrectRpcResponse
RpcUnexpectedSize Int
expectedContentsSize (NonEmpty OperationContent -> Int
forall i a.
(Integral i, Container a,
DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length NonEmpty OperationContent
rrOperationContents)
let (NonEmpty AppliedResult
appliedResults, Maybe [RunError]
runErrors) =
NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError])
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError]))
-> NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError])
forall a b. (a -> b) -> a -> b
$ (AppliedResult -> NonEmpty AppliedResult)
-> (AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AppliedResult -> NonEmpty AppliedResult
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError]))
-> (OperationContent -> (AppliedResult, Maybe [RunError]))
-> OperationContent
-> (NonEmpty AppliedResult, Maybe [RunError])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationContent -> (AppliedResult, Maybe [RunError])
collectResults (OperationContent -> (NonEmpty AppliedResult, Maybe [RunError]))
-> NonEmpty OperationContent
-> NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty OperationContent
rrOperationContents
ioDatas :: [OperationResp WithSource]
ioDatas = (Element [OperationContent] -> [OperationResp WithSource])
-> [OperationContent] -> [OperationResp WithSource]
forall c b. Container c => (Element c -> [b]) -> c -> [b]
concatMap ((InternalOperation -> OperationResp WithSource)
-> [InternalOperation] -> [OperationResp WithSource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map InternalOperation -> OperationResp WithSource
ioData ([InternalOperation] -> [OperationResp WithSource])
-> (OperationContent -> [InternalOperation])
-> OperationContent
-> [OperationResp WithSource]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunMetadata -> [InternalOperation]
rmInternalOperationResults (RunMetadata -> [InternalOperation])
-> (OperationContent -> RunMetadata)
-> OperationContent
-> [InternalOperation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationContent -> RunMetadata
ocMetadata)
([OperationContent] -> [OperationResp WithSource])
-> [OperationContent] -> [OperationResp WithSource]
forall a b. (a -> b) -> a -> b
$ NonEmpty OperationContent -> [Element (NonEmpty OperationContent)]
forall t. Container t => t -> [Element t]
toList NonEmpty OperationContent
rrOperationContents
ops :: NonEmpty (OperationResp WithSource)
ops = NonEmpty (NonEmpty (OperationResp WithSource))
-> NonEmpty (OperationResp WithSource)
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty (OperationResp WithSource))
-> NonEmpty (OperationResp WithSource))
-> NonEmpty (NonEmpty (OperationResp WithSource))
-> NonEmpty (OperationResp WithSource)
forall a b. (a -> b) -> a -> b
$ NonEmpty OperationContent
rrOperationContents NonEmpty OperationContent
-> (OperationContent -> NonEmpty (OperationResp WithSource))
-> NonEmpty (NonEmpty (OperationResp WithSource))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \OperationContent
op ->
OperationContent -> OperationResp WithSource
ocOperation OperationContent
op OperationResp WithSource
-> [OperationResp WithSource]
-> NonEmpty (OperationResp WithSource)
forall a. a -> [a] -> NonEmpty a
:| ((InternalOperation -> OperationResp WithSource)
-> [InternalOperation] -> [OperationResp WithSource]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InternalOperation -> OperationResp WithSource
ioData ([InternalOperation] -> [OperationResp WithSource])
-> [InternalOperation] -> [OperationResp WithSource]
forall a b. (a -> b) -> a -> b
$ RunMetadata -> [InternalOperation]
rmInternalOperationResults (RunMetadata -> [InternalOperation])
-> RunMetadata -> [InternalOperation]
forall a b. (a -> b) -> a -> b
$ OperationContent -> RunMetadata
ocMetadata OperationContent
op)
Maybe [RunError] -> ([RunError] -> m ()) -> m ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe [RunError]
runErrors (([RunError] -> m ()) -> m ()) -> ([RunError] -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ NonEmpty (OperationResp WithSource) -> [RunError] -> m ()
forall (m :: * -> *) a.
MonadThrow m =>
NonEmpty (OperationResp WithSource) -> [RunError] -> m a
handleErrors NonEmpty (OperationResp WithSource)
ops
pure (NonEmpty AppliedResult
appliedResults, [OperationResp WithSource]
ioDatas)
where
collectResults :: OperationContent -> (AppliedResult, Maybe [RunError])
collectResults :: OperationContent -> (AppliedResult, Maybe [RunError])
collectResults (OperationContent OperationResp WithSource
_ (RunMetadata OperationResult
res [InternalOperation]
internalOps)) =
OperationResult
res OperationResult -> [OperationResult] -> [OperationResult]
forall a. a -> [a] -> [a]
: (InternalOperation -> OperationResult)
-> [InternalOperation] -> [OperationResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map InternalOperation -> OperationResult
ioResult [InternalOperation]
internalOps
[OperationResult]
-> ([OperationResult] -> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
forall a b. a -> (a -> b) -> b
& ((OperationResult
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
-> [OperationResult]
-> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
-> (OperationResult
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError]))
-> [OperationResult]
-> (AppliedResult, Maybe [RunError])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Element [OperationResult]
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
-> [OperationResult]
-> (AppliedResult, Maybe [RunError])
(OperationResult
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
-> [OperationResult]
-> (AppliedResult, Maybe [RunError])
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
forall b.
(Element [OperationResult] -> b -> b)
-> b -> [OperationResult] -> b
foldr (AppliedResult
forall a. Monoid a => a
mempty, Maybe [RunError]
forall a. Maybe a
Nothing) \case
OperationApplied AppliedResult
result -> (AppliedResult -> AppliedResult)
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AppliedResult
result AppliedResult -> AppliedResult -> AppliedResult
forall a. Semigroup a => a -> a -> a
<>)
OperationFailed [RunError]
errors -> (Maybe [RunError] -> Maybe [RunError])
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([RunError] -> Maybe [RunError]
forall a. a -> Maybe a
Just [RunError]
errors Maybe [RunError] -> Maybe [RunError] -> Maybe [RunError]
forall a. Semigroup a => a -> a -> a
<>)
handleErrors :: MonadThrow m => NonEmpty (OperationResp WithSource) -> [RunError] -> m a
handleErrors :: forall (m :: * -> *) a.
MonadThrow m =>
NonEmpty (OperationResp WithSource) -> [RunError] -> m a
handleErrors NonEmpty (OperationResp WithSource)
iops [RunError]
errs
| Just ClientRpcError
err <- [RunError] -> Maybe ClientRpcError
runErrorsToClientError [RunError]
errs = ClientRpcErrorWithStack ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcErrorWithStack ClientRpcError -> m a)
-> ClientRpcErrorWithStack ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (OperationResp WithSource)
-> ClientRpcError -> ClientRpcErrorWithStack ClientRpcError
forall a.
NonEmpty (OperationResp WithSource)
-> a -> ClientRpcErrorWithStack a
ClientRpcErrorWithStack NonEmpty (OperationResp WithSource)
iops ClientRpcError
err
| Bool
otherwise = ClientRpcErrorWithStack UnexpectedErrors -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcErrorWithStack UnexpectedErrors -> m a)
-> ClientRpcErrorWithStack UnexpectedErrors -> m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (OperationResp WithSource)
-> UnexpectedErrors -> ClientRpcErrorWithStack UnexpectedErrors
forall a.
NonEmpty (OperationResp WithSource)
-> a -> ClientRpcErrorWithStack a
ClientRpcErrorWithStack NonEmpty (OperationResp WithSource)
iops (UnexpectedErrors -> ClientRpcErrorWithStack UnexpectedErrors)
-> UnexpectedErrors -> ClientRpcErrorWithStack UnexpectedErrors
forall a b. (a -> b) -> a -> b
$ [RunError] -> UnexpectedErrors
UnexpectedRunErrors [RunError]
errs
runErrorsToClientError :: [RunError] -> Maybe ClientRpcError
runErrorsToClientError :: [RunError] -> Maybe ClientRpcError
runErrorsToClientError [RunError]
errs
| Just ContractAddress
address <- Prism' RunError ContractAddress -> Maybe ContractAddress
forall a. Prism' RunError a -> Maybe a
findError p ContractAddress (f ContractAddress) -> p RunError (f RunError)
Prism' RunError ContractAddress
_RuntimeError
, Just Expression
expr <- Prism' RunError Expression -> Maybe Expression
forall a. Prism' RunError a -> Maybe a
findError p Expression (f Expression) -> p RunError (f RunError)
Prism' RunError Expression
_ScriptRejected
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Expression -> ClientRpcError
ContractFailed ContractAddress
address Expression
expr
| Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError p Address (f Address) -> p RunError (f RunError)
Prism' RunError Address
_BadContractParameter
, Just (Expression
_, Expression
expr) <- Prism' RunError (Expression, Expression)
-> Maybe (Expression, Expression)
forall a. Prism' RunError a -> Maybe a
findError p (Expression, Expression) (f (Expression, Expression))
-> p RunError (f RunError)
Prism' RunError (Expression, Expression)
_InvalidSyntacticConstantError
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
BadParameter Address
address Expression
expr
| Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError p Address (f Address) -> p RunError (f RunError)
Prism' RunError Address
_BadContractParameter
, Just (Expression
_, Expression
expr) <- Prism' RunError (Expression, Expression)
-> Maybe (Expression, Expression)
forall a. Prism' RunError a -> Maybe a
findError p (Expression, Expression) (f (Expression, Expression))
-> p RunError (f RunError)
Prism' RunError (Expression, Expression)
_InvalidConstant
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
BadParameter Address
address Expression
expr
| Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError p Address (f Address) -> p RunError (f RunError)
Prism' RunError Address
_BadContractParameter
, Just Text
notation <- Prism' RunError Text -> Maybe Text
forall a. Prism' RunError a -> Maybe a
findError p Text (f Text) -> p RunError (f RunError)
Prism' RunError Text
_InvalidContractNotation
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
BadParameter Address
address (Text -> Expression
expressionString Text
notation)
| Just ImplicitAddress
address <- Prism' RunError ImplicitAddress -> Maybe ImplicitAddress
forall a. Prism' RunError a -> Maybe a
findError p ImplicitAddress (f ImplicitAddress) -> p RunError (f RunError)
Prism' RunError ImplicitAddress
_REEmptyTransaction
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ClientRpcError
EmptyTransaction ImplicitAddress
address
| Just ContractAddress
address <- Prism' RunError ContractAddress -> Maybe ContractAddress
forall a. Prism' RunError a -> Maybe a
findError p ContractAddress (f ContractAddress) -> p RunError (f RunError)
Prism' RunError ContractAddress
_RuntimeError
, Just ()
_ <- Prism' RunError () -> Maybe ()
forall a. Prism' RunError a -> Maybe a
findError p () (f ()) -> p RunError (f RunError)
Prism' RunError ()
_ScriptOverflow
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ContractAddress -> ClientRpcError
ShiftOverflow ContractAddress
address
| Just ContractAddress
address <- Prism' RunError ContractAddress -> Maybe ContractAddress
forall a. Prism' RunError a -> Maybe a
findError p ContractAddress (f ContractAddress) -> p RunError (f RunError)
Prism' RunError ContractAddress
_RuntimeError
, Just ()
_ <- Prism' RunError () -> Maybe ()
forall a. Prism' RunError a -> Maybe a
findError p () (f ()) -> p RunError (f RunError)
Prism' RunError ()
_GasExhaustedOperation
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ContractAddress -> ClientRpcError
GasExhaustion ContractAddress
address
| Just ImplicitAddress
address <- Prism' RunError ImplicitAddress -> Maybe ImplicitAddress
forall a. Prism' RunError a -> Maybe a
findError p ImplicitAddress (f ImplicitAddress) -> p RunError (f RunError)
Prism' RunError ImplicitAddress
_PreviouslyRevealedKey
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ClientRpcError
KeyAlreadyRevealed ImplicitAddress
address
| Just ImplicitAddress
address <- Prism' RunError ImplicitAddress -> Maybe ImplicitAddress
forall a. Prism' RunError a -> Maybe a
findError p ImplicitAddress (f ImplicitAddress) -> p RunError (f RunError)
Prism' RunError ImplicitAddress
_UnregisteredDelegate
= ClientRpcError -> Maybe ClientRpcError
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ClientRpcError
DelegateNotRegistered ImplicitAddress
address
| Bool
otherwise = Maybe ClientRpcError
forall a. Maybe a
Nothing
where
findError :: Prism' RunError a -> Maybe a
findError :: forall a. Prism' RunError a -> Maybe a
findError Prism' RunError a
prism = (NonEmpty a -> a) -> Maybe (NonEmpty a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> a
forall a. NonEmpty a -> a
head (Maybe (NonEmpty a) -> Maybe a)
-> ([RunError] -> Maybe (NonEmpty a)) -> [RunError] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([a] -> Maybe (NonEmpty a))
-> ([RunError] -> [a]) -> [RunError] -> Maybe (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunError -> Maybe a) -> [RunError] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Getting (First a) RunError a -> RunError -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First a) RunError a
Prism' RunError a
prism) ([RunError] -> Maybe a) -> [RunError] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [RunError]
errs
computeFee :: FeeConstants -> Int -> TezosInt64 -> Mutez
computeFee :: FeeConstants -> Int -> StringEncode Int64 -> Mutez
computeFee FeeConstants{Milli
Mutez
fcBase :: Mutez
fcMutezPerGas :: Milli
fcMutezPerOpByte :: Milli
fcBase :: FeeConstants -> Mutez
fcMutezPerGas :: FeeConstants -> Milli
fcMutezPerOpByte :: FeeConstants -> Milli
..} Int
opSize StringEncode Int64
gasLimit =
Either Text Mutez -> Mutez
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text Mutez -> Mutez)
-> ([Ratio Integer] -> Either Text Mutez)
-> [Ratio Integer]
-> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> Either Text Mutez
mkMutez @Word64 (Word64 -> Either Text Mutez)
-> ([Ratio Integer] -> Word64)
-> [Ratio Integer]
-> Either Text Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Integer -> Word64
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer -> Word64)
-> ([Ratio Integer] -> Ratio Integer) -> [Ratio Integer] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ratio Integer] -> Ratio Integer
[Ratio Integer] -> Element [Ratio Integer]
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([Ratio Integer] -> Mutez) -> [Ratio Integer] -> Mutez
forall a b. (a -> b) -> a -> b
$
[ Word63 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Word63 -> Ratio Integer) -> Word63 -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ Mutez -> Word63
unMutez Mutez
fcBase
, Milli -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Milli
fcMutezPerOpByte Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Int -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Int
opSize
, Milli -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Milli
fcMutezPerGas Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* StringEncode Int64 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational StringEncode Int64
gasLimit
]
convergingFee
:: forall op extra m. Monad m
=> (Mutez -> m op)
-> (op -> m (Mutez, extra))
-> m (Mutez, op, extra)
convergingFee :: forall op extra (m :: * -> *).
Monad m =>
(Mutez -> m op) -> (op -> m (Mutez, extra)) -> m (Mutez, op, extra)
convergingFee Mutez -> m op
mkOperation op -> m (Mutez, extra)
countFee = Word -> Mutez -> m (Mutez, op, extra)
iterateFee Word
5 Mutez
assessedMinimalFee
where
assessedMinimalFee :: Mutez
assessedMinimalFee = Mutez
zeroMutez
iterateFee :: Word -> Mutez -> m (Mutez, op, extra)
iterateFee :: Word -> Mutez -> m (Mutez, op, extra)
iterateFee Word
0 Mutez
_ = Text -> m (Mutez, op, extra)
forall a. HasCallStack => Text -> a
error Text
"Failed to converge at some fee"
iterateFee Word
countdown Mutez
curFee = do
op
op <- Mutez -> m op
mkOperation Mutez
curFee
(Mutez
requiredFee, extra
extra) <- op -> m (Mutez, extra)
countFee op
op
if Mutez
requiredFee Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
<= Mutez
curFee
then (Mutez, op, extra) -> m (Mutez, op, extra)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutez
curFee, op
op, extra
extra)
else Word -> Mutez -> m (Mutez, op, extra)
iterateFee (Word
countdown Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Mutez
requiredFee
computeStorageLimit :: [AppliedResult] -> ProtocolParameters -> TezosInt64
computeStorageLimit :: [AppliedResult] -> ProtocolParameters -> StringEncode Int64
computeStorageLimit [AppliedResult]
appliedResults ProtocolParameters
pp = [StringEncode Int64] -> Element [StringEncode Int64]
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([StringEncode Int64] -> Element [StringEncode Int64])
-> [StringEncode Int64] -> Element [StringEncode Int64]
forall a b. (a -> b) -> a -> b
$ (AppliedResult -> StringEncode Int64)
-> [AppliedResult] -> [StringEncode Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\AppliedResult
ar -> [StringEncode Int64] -> Element [StringEncode Int64]
forall t. (Container t, Num (Element t)) => t -> Element t
sum
[ AppliedResult -> StringEncode Int64
arPaidStorageDiff AppliedResult
ar
, (AppliedResult -> StringEncode Int64
arAllocatedDestinationContracts AppliedResult
ar) StringEncode Int64 -> StringEncode Int64 -> StringEncode Int64
forall a. Num a => a -> a -> a
* Int -> StringEncode Int64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (ProtocolParameters -> Int
ppOriginationSize ProtocolParameters
pp)
, [ContractAddress] -> StringEncode Int64
forall i a.
(Integral i, Container a,
DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length (AppliedResult -> [ContractAddress]
arOriginatedContracts AppliedResult
ar) StringEncode Int64 -> StringEncode Int64 -> StringEncode Int64
forall a. Num a => a -> a -> a
* Int -> StringEncode Int64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (ProtocolParameters -> Int
ppOriginationSize ProtocolParameters
pp)
]) [AppliedResult]
appliedResults
updateCommonData
:: TezosInt64 -> TezosInt64 -> TezosMutez
-> CommonOperationData -> CommonOperationData
updateCommonData :: StringEncode Int64
-> StringEncode Int64
-> TezosMutez
-> CommonOperationData
-> CommonOperationData
updateCommonData StringEncode Int64
gasLimit StringEncode Int64
storageLimit TezosMutez
fee CommonOperationData
commonData =
CommonOperationData
commonData
{ codGasLimit :: StringEncode Int64
codGasLimit = StringEncode Int64
gasLimit
, codStorageLimit :: StringEncode Int64
codStorageLimit = StringEncode Int64
storageLimit
, codFee :: TezosMutez
codFee = TezosMutez
fee
}
stubSignature :: Signature
stubSignature :: Signature
stubSignature = Either CryptoParseError Signature -> Signature
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either CryptoParseError Signature -> Signature)
-> Either CryptoParseError Signature -> Signature
forall a b. (a -> b) -> a -> b
$ Text -> Either CryptoParseError Signature
parseSignature
Text
"edsigtXomBKi5CTRf5cjATJWSyaRvhfYNHqSUGrn4SdbYRcGwQrUGjzEfQDTuqHhuA8b2d8NarZjz8TRf65WkpQmo423BtomS8Q"
addOperationPrefix :: ByteString -> ByteString
addOperationPrefix :: ByteString -> ByteString
addOperationPrefix = Word8 -> ByteString -> ByteString
cons Word8
0x03
prepareOpForInjection :: ByteString -> Signature -> ByteString
prepareOpForInjection :: ByteString -> Signature -> ByteString
prepareOpForInjection ByteString
operationHex Signature
signature' =
ByteString
operationHex ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Signature -> ByteString
forall ba. ByteArray ba => Signature -> ba
signatureToBytes Signature
signature'
where
prefix :: ByteString
prefix
| SignatureBLS{} <- Signature
signature' = ByteString
"\xff\x03"
| Bool
otherwise = ByteString
forall a. Monoid a => a
mempty