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

-- | This module contains various types which are used in @octez-node@ RPC API.
--
-- Documentation for RPC API can be found e. g. [here](http://tezos.gitlab.io/010/rpc.html)
-- (010 is the protocol, change to the desired one).
--
-- Note that errors are reported a bit inconsistently by RPC.
-- For more information see
-- [this question](https://tezos.stackexchange.com/q/2656/342)
-- and [this issue](https://gitlab.com/metastatedev/tezos/-/issues/150).


module Morley.Client.RPC.Types
  ( AppliedResult (..)
  , BlockConstants (..)
  , BlockHash (..)
  , BlockHeaderNoHash (..)
  , BlockHeader (..)
  , FeeConstants (..)
  , BlockId (..)
  , BlockOperation (..)
  , CommonOperationData (..)
  , DelegationOperation (..)
  , ForgeOperation (..)
  , GetBigMap (..)
  , CalcSize(..)
  , ScriptSize(..)
  , GetBigMapResult (..)
  , InternalOperation (..)
  , InternalOperationData (..)
  , IntOpEvent (..)
  , OperationContent (..)
  , OperationHash (..)
  , OperationInput
  , OperationResp (..)
  , OperationRespWithMeta (..)
  , OperationMetadata (..)
  , OperationResult (..)
  , OriginationOperation (..)
  , OriginationScript (..)
  , ParametersInternal (..)
  , PreApplyOperation (..)
  , ProtocolParameters (..)
  , RevealOperation (..)
  , RunCode (..)
  , RunCodeResult (..)
  , RunMetadata (..)
  , RunOperation (..)
  , RunOperationInternal (..)
  , RunOperationResult (..)
  , RPCInput
  , TransactionOperation (..)
  , WithCommonOperationData (..)
  , MonitorHeadsStep(..)
  , mkCommonOperationData

  -- * Errors
  , RunError (..)
  , InternalError (..)

  -- * Prisms
  , _RuntimeError
  , _ScriptRejected
  , _BadContractParameter
  , _InvalidConstant
  , _InconsistentTypes
  , _InvalidPrimitive
  , _InvalidSyntacticConstantError
  , _InvalidExpressionKind
  , _InvalidContractNotation
  , _UnexpectedContract
  , _IllFormedType
  , _UnexpectedOperation
  , _REEmptyTransaction
  , _ScriptOverflow
  , _PreviouslyRevealedKey
  , _GasExhaustedOperation
  , _UnregisteredDelegate

  -- * Lenses
  , wcoCommonDataL
  ) where

import Control.Lens (makePrisms)
import Data.Aeson
  (FromJSON(..), Key, Object, ToJSON(..), Value(..), object, omitNothingFields, withObject, (.!=),
  (.:), (.:?), (.=))
import Data.Aeson.Key qualified as Key (toText)
import Data.Aeson.TH (deriveFromJSON, deriveJSON, deriveToJSON)
import Data.Default (Default(..))
import Data.Fixed (Milli)
import Data.List (isSuffixOf)
import Data.Ratio ((%))
import Data.Text qualified as T
import Data.Time (UTCTime)
import Fmt (Buildable(..), pretty, unwordsF, (+|), (|+))
import Servant.API (ToHttpApiData(..))

import Data.Aeson.Types (Parser)
import Morley.Client.RPC.Aeson (morleyClientAesonOptions)
import Morley.Client.Types
import Morley.Micheline
  (Expression, MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64,
  TezosMutez(..), TezosNat, expressionPrim)
import Morley.Michelson.Text (MText)
import Morley.Tezos.Address
import Morley.Tezos.Core (Mutez, tz, zeroMutez)
import Morley.Tezos.Crypto
  (KeyHash, PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature)
import Morley.Util.CLI (HasCLReader(..), eitherReader)
import Morley.Util.Named
import Morley.Util.Text (dquotes)

mergeObjects :: HasCallStack => Value -> Value -> Value
mergeObjects :: HasCallStack => Value -> Value -> Value
mergeObjects (Object Object
a) (Object Object
b) = Object -> Value
Object (Object
a Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
b)
mergeObjects (Object Object
_) Value
_ = Text -> Value
forall a. HasCallStack => Text -> a
error Text
"Right part is not an Object"
mergeObjects Value
_ Value
_ = Text -> Value
forall a. HasCallStack => Text -> a
error Text
"Left part is not an Object"

-- | Designates an input RPC data that we supply to perform an operation.
data RPCInput
instance OperationInfoDescriptor RPCInput where
  type TransferInfo RPCInput = TransactionOperation
  type OriginationInfo RPCInput = OriginationOperation
  type RevealInfo RPCInput = RevealOperation
  type DelegationInfo RPCInput = DelegationOperation

type OperationInput = WithCommonOperationData (OperationInfo RPCInput)

data ForgeOperation = ForgeOperation
  { ForgeOperation -> BlockHash
foBranch :: BlockHash
  , ForgeOperation -> NonEmpty OperationInput
foContents :: NonEmpty OperationInput
  }

data RunOperationInternal = RunOperationInternal
  { RunOperationInternal -> BlockHash
roiBranch :: BlockHash
  , RunOperationInternal -> NonEmpty OperationInput
roiContents :: NonEmpty OperationInput
  , RunOperationInternal -> Signature
roiSignature :: Signature
  }

data RunOperation = RunOperation
  { RunOperation -> RunOperationInternal
roOperation :: RunOperationInternal
  , RunOperation -> Text
roChainId :: Text
  }

data PreApplyOperation = PreApplyOperation
  { PreApplyOperation -> Text
paoProtocol :: Text
  , PreApplyOperation -> BlockHash
paoBranch :: BlockHash
  , PreApplyOperation -> NonEmpty OperationInput
paoContents :: NonEmpty OperationInput
  , PreApplyOperation -> Signature
paoSignature :: Signature
  }

data RunOperationResult = RunOperationResult
  { RunOperationResult -> NonEmpty OperationContent
rrOperationContents :: NonEmpty OperationContent
  }

instance FromJSON RunOperationResult where
  parseJSON :: Value -> Parser RunOperationResult
parseJSON = String
-> (Object -> Parser RunOperationResult)
-> Value
-> Parser RunOperationResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"preApplyRes" ((Object -> Parser RunOperationResult)
 -> Value -> Parser RunOperationResult)
-> (Object -> Parser RunOperationResult)
-> Value
-> Parser RunOperationResult
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    NonEmpty OperationContent -> RunOperationResult
RunOperationResult (NonEmpty OperationContent -> RunOperationResult)
-> Parser (NonEmpty OperationContent) -> Parser RunOperationResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (NonEmpty OperationContent)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents"

newtype OperationHash = OperationHash
  { OperationHash -> Text
unOperationHash :: Text
  }
  deriving stock (OperationHash -> OperationHash -> Bool
(OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool) -> Eq OperationHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationHash -> OperationHash -> Bool
$c/= :: OperationHash -> OperationHash -> Bool
== :: OperationHash -> OperationHash -> Bool
$c== :: OperationHash -> OperationHash -> Bool
Eq, Int -> OperationHash -> ShowS
[OperationHash] -> ShowS
OperationHash -> String
(Int -> OperationHash -> ShowS)
-> (OperationHash -> String)
-> ([OperationHash] -> ShowS)
-> Show OperationHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationHash] -> ShowS
$cshowList :: [OperationHash] -> ShowS
show :: OperationHash -> String
$cshow :: OperationHash -> String
showsPrec :: Int -> OperationHash -> ShowS
$cshowsPrec :: Int -> OperationHash -> ShowS
Show)
  deriving newtype (Value -> Parser [OperationHash]
Value -> Parser OperationHash
(Value -> Parser OperationHash)
-> (Value -> Parser [OperationHash]) -> FromJSON OperationHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [OperationHash]
$cparseJSONList :: Value -> Parser [OperationHash]
parseJSON :: Value -> Parser OperationHash
$cparseJSON :: Value -> Parser OperationHash
FromJSON, OperationHash -> Builder
(OperationHash -> Builder) -> Buildable OperationHash
forall p. (p -> Builder) -> Buildable p
build :: OperationHash -> Builder
$cbuild :: OperationHash -> Builder
Buildable)

newtype OperationContent = OperationContent { OperationContent -> RunMetadata
unOperationContent :: RunMetadata }

instance FromJSON OperationContent where
  parseJSON :: Value -> Parser OperationContent
parseJSON = String
-> (Object -> Parser OperationContent)
-> Value
-> Parser OperationContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"operationCostContent" ((Object -> Parser OperationContent)
 -> Value -> Parser OperationContent)
-> (Object -> Parser OperationContent)
-> Value
-> Parser OperationContent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    RunMetadata -> OperationContent
OperationContent (RunMetadata -> OperationContent)
-> Parser RunMetadata -> Parser OperationContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser RunMetadata
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metadata"

data RunMetadata = RunMetadata
  { RunMetadata -> OperationResult
rmOperationResult :: OperationResult
  , RunMetadata -> [InternalOperation]
rmInternalOperationResults :: [InternalOperation]
  }

instance FromJSON RunMetadata where
  parseJSON :: Value -> Parser RunMetadata
parseJSON = String
-> (Object -> Parser RunMetadata) -> Value -> Parser RunMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"metadata" ((Object -> Parser RunMetadata) -> Value -> Parser RunMetadata)
-> (Object -> Parser RunMetadata) -> Value -> Parser RunMetadata
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OperationResult -> [InternalOperation] -> RunMetadata
RunMetadata (OperationResult -> [InternalOperation] -> RunMetadata)
-> Parser OperationResult
-> Parser ([InternalOperation] -> RunMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser OperationResult
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"operation_result" Parser ([InternalOperation] -> RunMetadata)
-> Parser [InternalOperation] -> Parser RunMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Key -> Parser (Maybe [InternalOperation])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"internal_operation_results" Parser (Maybe [InternalOperation])
-> [InternalOperation] -> Parser [InternalOperation]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

data InternalOperation = InternalOperation
  { InternalOperation -> InternalOperationData
ioData :: InternalOperationData
  , InternalOperation -> OperationResult
ioResult :: OperationResult
  }

instance FromJSON InternalOperation where
  parseJSON :: Value -> Parser InternalOperation
parseJSON Value
json = Value
json Value
-> (Value -> Parser InternalOperation) -> Parser InternalOperation
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser InternalOperation)
-> Value
-> Parser InternalOperation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"internal_operation" \Object
o ->
    InternalOperationData -> OperationResult -> InternalOperation
InternalOperation (InternalOperationData -> OperationResult -> InternalOperation)
-> Parser InternalOperationData
-> Parser (OperationResult -> InternalOperation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InternalOperationData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json Parser (OperationResult -> InternalOperation)
-> Parser OperationResult -> Parser InternalOperation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser OperationResult
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"

data InternalOperationData
  = IODEvent IntOpEvent
  | IODIgnored

instance FromJSON InternalOperationData where
  parseJSON :: Value -> Parser InternalOperationData
parseJSON Value
json = Value
json Value
-> (Value -> Parser InternalOperationData)
-> Parser InternalOperationData
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser InternalOperationData)
-> Value
-> Parser InternalOperationData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"internal_operation_data" \Object
o -> do
    (Text
kind :: Text) <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    case Text
kind of
      Text
"event" -> IntOpEvent -> InternalOperationData
IODEvent (IntOpEvent -> InternalOperationData)
-> Parser IntOpEvent -> Parser InternalOperationData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser IntOpEvent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json
      Text
_ -> InternalOperationData -> Parser InternalOperationData
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalOperationData
IODIgnored

data IntOpEvent = IntOpEvent
  { IntOpEvent -> ContractAddress
ioeSource :: ContractAddress
  , IntOpEvent -> Expression
ioeType :: Expression
  , IntOpEvent -> Maybe MText
ioeTag :: Maybe MText
  , IntOpEvent -> Maybe Expression
ioePayload :: Maybe Expression
  }

instance Buildable IntOpEvent where
  build :: IntOpEvent -> Builder
build IntOpEvent{Maybe MText
Maybe Expression
ContractAddress
Expression
ioePayload :: Maybe Expression
ioeTag :: Maybe MText
ioeType :: Expression
ioeSource :: ContractAddress
ioePayload :: IntOpEvent -> Maybe Expression
ioeTag :: IntOpEvent -> Maybe MText
ioeType :: IntOpEvent -> Expression
ioeSource :: IntOpEvent -> ContractAddress
..} =
    Builder
"Contract event with source: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
ioeSource ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", tag: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Maybe MText
ioeTag Maybe MText -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", type: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
ioeType Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
    Builder
", and payload: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Maybe Expression
ioePayload Maybe Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

instance FromJSON IntOpEvent where
  parseJSON :: Value -> Parser IntOpEvent
parseJSON = String
-> (Object -> Parser IntOpEvent) -> Value -> Parser IntOpEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"internal_operation_data_event" \Object
o -> do
    ContractAddress
-> Expression -> Maybe MText -> Maybe Expression -> IntOpEvent
IntOpEvent (ContractAddress
 -> Expression -> Maybe MText -> Maybe Expression -> IntOpEvent)
-> Parser ContractAddress
-> Parser
     (Expression -> Maybe MText -> Maybe Expression -> IntOpEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ContractAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source" Parser
  (Expression -> Maybe MText -> Maybe Expression -> IntOpEvent)
-> Parser Expression
-> Parser (Maybe MText -> Maybe Expression -> IntOpEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" Parser (Maybe MText -> Maybe Expression -> IntOpEvent)
-> Parser (Maybe MText) -> Parser (Maybe Expression -> IntOpEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe MText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tag" Parser (Maybe Expression -> IntOpEvent)
-> Parser (Maybe Expression) -> Parser IntOpEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Expression)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload"

data BlockConstants = BlockConstants
  { BlockConstants -> Text
bcProtocol :: Text
  , BlockConstants -> Text
bcChainId :: Text
  , BlockConstants -> BlockHeaderNoHash
bcHeader :: BlockHeaderNoHash
  , BlockConstants -> BlockHash
bcHash :: BlockHash
  }

data BlockHeaderNoHash = BlockHeaderNoHash
  { BlockHeaderNoHash -> UTCTime
bhnhTimestamp :: UTCTime
  , BlockHeaderNoHash -> Int64
bhnhLevel :: Int64
  , BlockHeaderNoHash -> BlockHash
bhnhPredecessor :: BlockHash
  }

-- Consider merging this type with 'BlockHeaderNoHash' if it becomes larger (i. e.
-- if we need more data from it).
-- | The whole block header.
data BlockHeader = BlockHeader
  { BlockHeader -> UTCTime
bhTimestamp :: UTCTime
  , BlockHeader -> Int64
bhLevel :: Int64
  , BlockHeader -> BlockHash
bhPredecessor :: BlockHash
  , BlockHeader -> BlockHash
bhHash :: BlockHash
  }

newtype BlockHash = BlockHash { BlockHash -> Text
unBlockHash :: Text }
  deriving newtype (BlockHash -> BlockHash -> Bool
(BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool) -> Eq BlockHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockHash -> BlockHash -> Bool
$c/= :: BlockHash -> BlockHash -> Bool
== :: BlockHash -> BlockHash -> Bool
$c== :: BlockHash -> BlockHash -> Bool
Eq, Eq BlockHash
Eq BlockHash
-> (BlockHash -> BlockHash -> Ordering)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> BlockHash)
-> (BlockHash -> BlockHash -> BlockHash)
-> Ord BlockHash
BlockHash -> BlockHash -> Bool
BlockHash -> BlockHash -> Ordering
BlockHash -> BlockHash -> BlockHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockHash -> BlockHash -> BlockHash
$cmin :: BlockHash -> BlockHash -> BlockHash
max :: BlockHash -> BlockHash -> BlockHash
$cmax :: BlockHash -> BlockHash -> BlockHash
>= :: BlockHash -> BlockHash -> Bool
$c>= :: BlockHash -> BlockHash -> Bool
> :: BlockHash -> BlockHash -> Bool
$c> :: BlockHash -> BlockHash -> Bool
<= :: BlockHash -> BlockHash -> Bool
$c<= :: BlockHash -> BlockHash -> Bool
< :: BlockHash -> BlockHash -> Bool
$c< :: BlockHash -> BlockHash -> Bool
compare :: BlockHash -> BlockHash -> Ordering
$ccompare :: BlockHash -> BlockHash -> Ordering
Ord, Int -> BlockHash -> ShowS
[BlockHash] -> ShowS
BlockHash -> String
(Int -> BlockHash -> ShowS)
-> (BlockHash -> String)
-> ([BlockHash] -> ShowS)
-> Show BlockHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockHash] -> ShowS
$cshowList :: [BlockHash] -> ShowS
show :: BlockHash -> String
$cshow :: BlockHash -> String
showsPrec :: Int -> BlockHash -> ShowS
$cshowsPrec :: Int -> BlockHash -> ShowS
Show, BlockHash -> Builder
(BlockHash -> Builder) -> Buildable BlockHash
forall p. (p -> Builder) -> Buildable p
build :: BlockHash -> Builder
$cbuild :: BlockHash -> Builder
Buildable, [BlockHash] -> Encoding
[BlockHash] -> Value
BlockHash -> Encoding
BlockHash -> Value
(BlockHash -> Value)
-> (BlockHash -> Encoding)
-> ([BlockHash] -> Value)
-> ([BlockHash] -> Encoding)
-> ToJSON BlockHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BlockHash] -> Encoding
$ctoEncodingList :: [BlockHash] -> Encoding
toJSONList :: [BlockHash] -> Value
$ctoJSONList :: [BlockHash] -> Value
toEncoding :: BlockHash -> Encoding
$ctoEncoding :: BlockHash -> Encoding
toJSON :: BlockHash -> Value
$ctoJSON :: BlockHash -> Value
ToJSON, Value -> Parser [BlockHash]
Value -> Parser BlockHash
(Value -> Parser BlockHash)
-> (Value -> Parser [BlockHash]) -> FromJSON BlockHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BlockHash]
$cparseJSONList :: Value -> Parser [BlockHash]
parseJSON :: Value -> Parser BlockHash
$cparseJSON :: Value -> Parser BlockHash
FromJSON, BlockHash -> ByteString
BlockHash -> Builder
BlockHash -> Text
(BlockHash -> Text)
-> (BlockHash -> Builder)
-> (BlockHash -> ByteString)
-> (BlockHash -> Text)
-> ToHttpApiData BlockHash
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: BlockHash -> Text
$ctoQueryParam :: BlockHash -> Text
toHeader :: BlockHash -> ByteString
$ctoHeader :: BlockHash -> ByteString
toEncodedUrlPiece :: BlockHash -> Builder
$ctoEncodedUrlPiece :: BlockHash -> Builder
toUrlPiece :: BlockHash -> Text
$ctoUrlPiece :: BlockHash -> Text
ToHttpApiData)

data FeeConstants = FeeConstants
  { FeeConstants -> Mutez
fcBase :: Mutez
  , FeeConstants -> Milli
fcMutezPerGas :: Milli
  , FeeConstants -> Milli
fcMutezPerOpByte :: Milli
  }

-- | At the moment of writing, Tezos always uses these constants.
instance Default FeeConstants where
  def :: FeeConstants
def = FeeConstants :: Mutez -> Milli -> Milli -> FeeConstants
FeeConstants
    { fcBase :: Mutez
fcBase = [tz|100u|]
    , fcMutezPerGas :: Milli
fcMutezPerGas = Milli
0.1
    , fcMutezPerOpByte :: Milli
fcMutezPerOpByte = Milli
1
    }

-- | A block identifier as submitted to RPC.
--
-- A block can be referenced by @head@, @genesis@, level or block hash
data BlockId
  = HeadId
  -- ^ Identifier referring to the head block.
  | FinalHeadId
  -- ^ Identifier of the most recent block guaranteed to have been finalized.
  -- See: https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html#operations
  | GenesisId
  -- ^ Identifier referring to the genesis block.
  | LevelId Natural
  -- ^ Identifier referring to a block by its level.
  | BlockHashId BlockHash
  -- ^ Idenfitier referring to a block by its hash in Base58Check notation.
  | AtDepthId Natural
  -- ^ Identifier of a block at specific depth relative to @head@.
  deriving stock (Int -> BlockId -> ShowS
[BlockId] -> ShowS
BlockId -> String
(Int -> BlockId -> ShowS)
-> (BlockId -> String) -> ([BlockId] -> ShowS) -> Show BlockId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockId] -> ShowS
$cshowList :: [BlockId] -> ShowS
show :: BlockId -> String
$cshow :: BlockId -> String
showsPrec :: Int -> BlockId -> ShowS
$cshowsPrec :: Int -> BlockId -> ShowS
Show, BlockId -> BlockId -> Bool
(BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool) -> Eq BlockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockId -> BlockId -> Bool
$c/= :: BlockId -> BlockId -> Bool
== :: BlockId -> BlockId -> Bool
$c== :: BlockId -> BlockId -> Bool
Eq)

instance ToHttpApiData BlockId where
  toUrlPiece :: BlockId -> Text
toUrlPiece = \case
    BlockId
HeadId -> Text
"head"
    BlockId
FinalHeadId -> Text
"head~2"
    BlockId
GenesisId -> Text
"genesis"
    LevelId Natural
x -> Natural -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Natural
x
    BlockHashId BlockHash
hash -> BlockHash -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece BlockHash
hash
    AtDepthId Natural
depth -> Text
"head~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Natural -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Natural
depth

instance Buildable BlockId where
  build :: BlockId -> Builder
build = \case
    BlockId
HeadId -> Builder
"head"
    BlockId
FinalHeadId -> Builder
"head~2"
    BlockId
GenesisId -> Builder
"genesis"
    LevelId Natural
x -> Builder
"block at level " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
forall p. Buildable p => p -> Builder
build Natural
x
    BlockHashId BlockHash
hash -> Builder
"block with hash " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Builder
forall p. Buildable p => p -> Builder
build BlockHash
hash
    AtDepthId Natural
depth -> Builder
"block at depth " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
forall p. Buildable p => p -> Builder
build Natural
depth

-- | Parse 'BlockId' in its textual representation in the same format as
-- submitted via RPC.
parseBlockId :: Text -> Maybe BlockId
parseBlockId :: Text -> Maybe BlockId
parseBlockId Text
t
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"head" = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just BlockId
HeadId
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"head~2" = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just BlockId
FinalHeadId
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"genesis" = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just BlockId
GenesisId
  | Right Natural
lvl <- Text -> Either Text Natural
forall a b. (ToString a, Read b) => a -> Either Text b
readEither Text
t = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just (Natural -> BlockId
LevelId Natural
lvl)
  | Just Text
depthTxt <- Text
"head~" Text -> Text -> Maybe Text
`T.stripPrefix` Text
t
  , Right Natural
depth <- Text -> Either Text Natural
forall a b. (ToString a, Read b) => a -> Either Text b
readEither Text
depthTxt = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just (Natural -> BlockId
AtDepthId Natural
depth)
  | Right ByteString
_ <- ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix ByteString
blockPrefix Text
t = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just (BlockHash -> BlockId
BlockHashId (Text -> BlockHash
BlockHash Text
t))
  | Bool
otherwise = Maybe BlockId
forall a. Maybe a
Nothing

-- A magic prefix used by Tezos for block hashes
-- see https://gitlab.com/tezos/tezos/-/blob/v11-release/src/lib_crypto/base58.ml#L341
blockPrefix :: ByteString
blockPrefix :: ByteString
blockPrefix = ByteString
"\001\052"

instance HasCLReader BlockId where
  getReader :: ReadM BlockId
getReader = (String -> Either String BlockId) -> ReadM BlockId
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String BlockId
parseBlockId'
    where
      parseBlockId' :: String -> Either String BlockId
      parseBlockId' :: String -> Either String BlockId
parseBlockId' =
        String -> Maybe BlockId -> Either String BlockId
forall l r. l -> Maybe r -> Either l r
maybeToRight (String
"failed to parse block ID, try passing block's hash, level or 'head'") (Maybe BlockId -> Either String BlockId)
-> (String -> Maybe BlockId) -> String -> Either String BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Text -> Maybe BlockId
parseBlockId (Text -> Maybe BlockId)
-> (String -> Text) -> String -> Maybe BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText
  getMetavar :: String
getMetavar = String
"BLOCK_ID"

-- | Protocol-wide constants.
--
-- There are more constants, but currently, we are using only these
-- in our code.
data ProtocolParameters = ProtocolParameters
  { ProtocolParameters -> Int
ppOriginationSize :: Int
  -- ^ Byte size cost for originating new contract.
  , ProtocolParameters -> TezosInt64
ppHardGasLimitPerOperation :: TezosInt64
  -- ^ Gas limit for a single operation.
  , ProtocolParameters -> TezosInt64
ppHardStorageLimitPerOperation :: TezosInt64
  -- ^ Storage limit for a single operation.
  , ProtocolParameters -> TezosNat
ppMinimalBlockDelay :: TezosNat
  -- ^ Minimal delay between two blocks, this constant is new in V010.
  , ProtocolParameters -> TezosMutez
ppCostPerByte :: TezosMutez
  -- ^ Burn cost per storage byte
  , ProtocolParameters -> TezosInt64
ppHardGasLimitPerBlock :: TezosInt64
  -- ^ Gas limit for a single block.
  }

-- | Details of a @BadStack@ error.
data BadStackInformation = BadStackInformation
  { BadStackInformation -> Int
bsiLocation :: Int
  , BadStackInformation -> Int
bsiStackPortion :: Int
  , BadStackInformation -> Text
bsiPrim :: Text
  , BadStackInformation -> Expression
bsiStack :: Expression
  } deriving stock (BadStackInformation -> BadStackInformation -> Bool
(BadStackInformation -> BadStackInformation -> Bool)
-> (BadStackInformation -> BadStackInformation -> Bool)
-> Eq BadStackInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BadStackInformation -> BadStackInformation -> Bool
$c/= :: BadStackInformation -> BadStackInformation -> Bool
== :: BadStackInformation -> BadStackInformation -> Bool
$c== :: BadStackInformation -> BadStackInformation -> Bool
Eq, Int -> BadStackInformation -> ShowS
[BadStackInformation] -> ShowS
BadStackInformation -> String
(Int -> BadStackInformation -> ShowS)
-> (BadStackInformation -> String)
-> ([BadStackInformation] -> ShowS)
-> Show BadStackInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BadStackInformation] -> ShowS
$cshowList :: [BadStackInformation] -> ShowS
show :: BadStackInformation -> String
$cshow :: BadStackInformation -> String
showsPrec :: Int -> BadStackInformation -> ShowS
$cshowsPrec :: Int -> BadStackInformation -> ShowS
Show)

instance FromJSON BadStackInformation where
  parseJSON :: Value -> Parser BadStackInformation
parseJSON = String
-> (Object -> Parser BadStackInformation)
-> Value
-> Parser BadStackInformation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BadStack" ((Object -> Parser BadStackInformation)
 -> Value -> Parser BadStackInformation)
-> (Object -> Parser BadStackInformation)
-> Value
-> Parser BadStackInformation
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> Text -> Expression -> BadStackInformation
BadStackInformation
    (Int -> Int -> Text -> Expression -> BadStackInformation)
-> Parser Int
-> Parser (Int -> Text -> Expression -> BadStackInformation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location"
    Parser (Int -> Text -> Expression -> BadStackInformation)
-> Parser Int -> Parser (Text -> Expression -> BadStackInformation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relevant_stack_portion"
    Parser (Text -> Expression -> BadStackInformation)
-> Parser Text -> Parser (Expression -> BadStackInformation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"primitive_name"
    Parser (Expression -> BadStackInformation)
-> Parser Expression -> Parser BadStackInformation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"wrong_stack_type"

instance Buildable BadStackInformation where
  build :: BadStackInformation -> Builder
build (BadStackInformation Int
loc Int
stack_portion Text
prim Expression
stack_type) =
    Builder
"Bad Stack in location " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
loc Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" stack portion " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
stack_portion Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
    Builder
" on primitive " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
prim Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" with (wrong) stack type " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
stack_type Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

-- | Errors that are sent as part of operation result in an OK
-- response (status 200). They are semi-formally defined as errors
-- that can happen when a contract is executed and something goes
-- wrong.
data RunError
  = RuntimeError ContractAddress
  | ScriptRejected Expression
  | BadContractParameter Address
  | InvalidConstant Expression Expression
  | InvalidContract Address
  | InconsistentTypes Expression Expression
  | InvalidPrimitive [Text] Text
  | InvalidSyntacticConstantError Expression Expression
  | InvalidExpressionKind [Text] Text
  | InvalidContractNotation Text
  | UnexpectedContract
  | IllFormedType Expression
  | UnexpectedOperation
  | REEmptyTransaction
    -- ^ Transfer of 0 to an implicit account.
      ImplicitAddress -- ^ Receiver address.
  | ScriptOverflow
    -- ^ A contract failed due to the detection of an overflow.
    -- It seems to happen if a too big value is passed to shift instructions
    -- (as second argument).
  | GasExhaustedOperation
  | MutezAdditionOverflow [TezosInt64]
  | MutezSubtractionUnderflow [TezosInt64]
  | MutezMultiplicationOverflow TezosInt64 TezosInt64
  | CantPayStorageFee
  | BalanceTooLow ("balance" :! Mutez) ("required" :! Mutez)
  | PreviouslyRevealedKey ImplicitAddress
  | NonExistingContract Address
  | InvalidB58Check Text
  | UnregisteredDelegate ImplicitAddress
  | FailedUnDelegation ImplicitAddress
  | DelegateAlreadyActive
  | IllTypedContract Expression
  | IllTypedData Expression Expression
  | BadStack BadStackInformation
  | ForbiddenZeroAmountTicket
  deriving stock Int -> RunError -> ShowS
[RunError] -> ShowS
RunError -> String
(Int -> RunError -> ShowS)
-> (RunError -> String) -> ([RunError] -> ShowS) -> Show RunError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunError] -> ShowS
$cshowList :: [RunError] -> ShowS
show :: RunError -> String
$cshow :: RunError -> String
showsPrec :: Int -> RunError -> ShowS
$cshowsPrec :: Int -> RunError -> ShowS
Show

instance FromJSON RunError where
  parseJSON :: Value -> Parser RunError
parseJSON = String -> (Object -> Parser RunError) -> Value -> Parser RunError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"preapply error" ((Object -> Parser RunError) -> Value -> Parser RunError)
-> (Object -> Parser RunError) -> Value -> Parser RunError
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    String
id' <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    String -> [(String, Parser RunError)] -> Parser RunError
forall {m :: * -> *} {t} {a}.
(MonadFail m, Container t, Element t ~ (String, m a)) =>
String -> t -> m a
decode String
id'
      [ String
"runtime_error" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> ContractAddress -> RunError
RuntimeError (ContractAddress -> RunError)
-> Parser ContractAddress -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ContractAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract_handle"
      , String
"script_rejected" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Expression -> RunError
ScriptRejected (Expression -> RunError) -> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"with"
      , String
"bad_contract_parameter" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Address -> RunError
BadContractParameter (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Address
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract"
      , String
"invalid_constant" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Expression -> Expression -> RunError
InvalidConstant (Expression -> Expression -> RunError)
-> Parser Expression -> Parser (Expression -> RunError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expected_type" Parser (Expression -> RunError)
-> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"wrong_expression"
      , String
"invalid_contract" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Address -> RunError
InvalidContract (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
oObject -> Key -> Parser Address
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract"
      , String
"inconsistent_types" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Expression -> Expression -> RunError
InconsistentTypes (Expression -> Expression -> RunError)
-> Parser Expression -> Parser (Expression -> RunError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"first_type" Parser (Expression -> RunError)
-> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"other_type"
      , String
"invalid_primitive" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~>
          [Text] -> Text -> RunError
InvalidPrimitive ([Text] -> Text -> RunError)
-> Parser [Text] -> Parser (Text -> RunError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expected_primitive_names" Parser (Text -> RunError) -> Parser Text -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"wrong_primitive_name"
      , String
"invalidSyntacticConstantError" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~>
          Expression -> Expression -> RunError
InvalidSyntacticConstantError (Expression -> Expression -> RunError)
-> Parser Expression -> Parser (Expression -> RunError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expectedForm" Parser (Expression -> RunError)
-> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"wrongExpression"
      , String
"invalid_expression_kind" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~>
          [Text] -> Text -> RunError
InvalidExpressionKind ([Text] -> Text -> RunError)
-> Parser [Text] -> Parser (Text -> RunError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expected_kinds" Parser (Text -> RunError) -> Parser Text -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"wrong_kind"
      , String
"invalid_contract_notation" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Text -> RunError
InvalidContractNotation (Text -> RunError) -> Parser Text -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"notation"
      , String
"unexpected_contract" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
UnexpectedContract
      , String
"ill_formed_type" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Expression -> RunError
IllFormedType (Expression -> RunError) -> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ill_formed_expression"
      , String
"unexpected_operation" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
UnexpectedOperation
      , String
"empty_transaction" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> ImplicitAddress -> RunError
REEmptyTransaction (ImplicitAddress -> RunError)
-> Parser ImplicitAddress -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ImplicitAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract"
      , String
"script_overflow" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
ScriptOverflow
      , String
"gas_exhausted.operation" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
GasExhaustedOperation
      , String
"tez.addition_overflow" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> [TezosInt64] -> RunError
MutezAdditionOverflow ([TezosInt64] -> RunError)
-> Parser [TezosInt64] -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [TezosInt64]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amounts"
      , String
"tez.subtraction_underflow" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> [TezosInt64] -> RunError
MutezSubtractionUnderflow ([TezosInt64] -> RunError)
-> Parser [TezosInt64] -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [TezosInt64]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amounts"
      , String
"tez.multiplication_overflow" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~>
          TezosInt64 -> TezosInt64 -> RunError
MutezMultiplicationOverflow (TezosInt64 -> TezosInt64 -> RunError)
-> Parser TezosInt64 -> Parser (TezosInt64 -> RunError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TezosInt64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount" Parser (TezosInt64 -> RunError)
-> Parser TezosInt64 -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser TezosInt64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"multiplicator"
      , String
"cannot_pay_storage_fee" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
CantPayStorageFee
      , String
"balance_too_low"String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> do
          Mutez
balance <- TezosMutez -> Mutez
unTezosMutez (TezosMutez -> Mutez) -> Parser TezosMutez -> Parser Mutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TezosMutez
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"balance"
          Mutez
amount  <- TezosMutez -> Mutez
unTezosMutez (TezosMutez -> Mutez) -> Parser TezosMutez -> Parser Mutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TezosMutez
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount"
          return $ ("balance" :! Mutez) -> ("required" :! Mutez) -> RunError
BalanceTooLow (IsLabel "balance" (Name "balance")
Name "balance"
#balance Name "balance" -> Mutez -> "balance" :! Mutez
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Mutez
balance) (IsLabel "required" (Name "required")
Name "required"
#required Name "required" -> Mutez -> "required" :! Mutez
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Mutez
amount)
      , String
"previously_revealed_key" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> ImplicitAddress -> RunError
PreviouslyRevealedKey (ImplicitAddress -> RunError)
-> Parser ImplicitAddress -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ImplicitAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract"
      , String
"non_existing_contract" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Address -> RunError
NonExistingContract (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Address
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract"
      , String
"invalid_b58check" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Text -> RunError
InvalidB58Check (Text -> RunError) -> Parser Text -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"input"
      , String
"unregistered_delegate" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> ImplicitAddress -> RunError
UnregisteredDelegate (ImplicitAddress -> RunError)
-> Parser ImplicitAddress -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ImplicitAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hash"
      , String
"no_deletion" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> ImplicitAddress -> RunError
FailedUnDelegation (ImplicitAddress -> RunError)
-> Parser ImplicitAddress -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ImplicitAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delegate"
      , String
"delegate.already_active" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
DelegateAlreadyActive
      , String
"ill_typed_contract" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Expression -> RunError
IllTypedContract (Expression -> RunError) -> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ill_typed_code"
      , String
"ill_typed_data" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> Expression -> Expression -> RunError
IllTypedData (Expression -> Expression -> RunError)
-> Parser Expression -> Parser (Expression -> RunError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expected_type" Parser (Expression -> RunError)
-> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Expression
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ill_typed_expression"
      , String
"bad_stack" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> BadStackInformation -> RunError
BadStack (BadStackInformation -> RunError)
-> Parser BadStackInformation -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser BadStackInformation
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      , String
"forbidden_zero_amount_ticket" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
ForbiddenZeroAmountTicket
      ]
    where
      infix 0 ~>
      ~> :: a -> b -> (a, b)
(~>) = (,)
      decode :: String -> t -> m a
decode String
x t
xs = m a -> Maybe (m a) -> m a
forall a. a -> Maybe a -> a
fromMaybe (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"unknown id: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x) (Maybe (m a) -> m a) -> Maybe (m a) -> m a
forall a b. (a -> b) -> a -> b
$
        (String, m a) -> m a
forall a b. (a, b) -> b
snd ((String, m a) -> m a) -> Maybe (String, m a) -> Maybe (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element t -> Bool) -> t -> Maybe (Element t)
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\(String
k, m a
_) -> (Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: String
k) String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x) t
xs

instance Buildable RunError where
  build :: RunError -> Builder
build = \case
    RuntimeError ContractAddress
addr -> Builder
"Runtime error for contract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
addr ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    ScriptRejected Expression
expr -> Builder
"Script rejected with: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expr Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    BadContractParameter Address
addr -> Builder
"Bad contract parameter for: " 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
""
    InvalidConstant Expression
expectedType Expression
expr ->
      Builder
"Invalid type: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expectedType Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Builder
"For: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expr Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    InvalidContract Address
addr -> Builder
"Invalid 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
""
    InconsistentTypes Expression
type1 Expression
type2 ->
      Builder
"Inconsistent types: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
type1 Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" and " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
type2 Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    InvalidPrimitive [Text]
expectedPrimitives Text
wrongPrimitive ->
      Builder
"Invalid primitive: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
wrongPrimitive Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Builder
"Expecting one of: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (Text
" " :: Text) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty [Text]
expectedPrimitives) Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    InvalidSyntacticConstantError Expression
expectedForm Expression
wrongExpression ->
      Builder
"Invalid syntatic constant error, expecting: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expectedForm Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Builder
"But got: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
wrongExpression Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    InvalidExpressionKind [Text]
expectedKinds Text
wrongKind ->
      Builder
"Invalid expression kind, expecting expression of kind: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| [Text]
expectedKinds [Text] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Builder
"But got: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
wrongKind Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    InvalidContractNotation Text
notation ->
      Builder
"Invalid contract notation: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
notation Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    RunError
UnexpectedContract ->
      Builder
"When parsing script, a contract type was found in \
      \the storage or parameter field."
    IllFormedType Expression
expr ->
      Builder
"Ill formed type: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expr Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    RunError
UnexpectedOperation ->
      Builder
"When parsing script, an operation type was found in \
      \the storage or parameter field"
    REEmptyTransaction ImplicitAddress
addr ->
      Builder
"It's forbidden to send 0ꜩ to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" that has no code"
    RunError
ScriptOverflow ->
      Builder
"A contract failed due to the detection of an overflow"
    RunError
GasExhaustedOperation ->
      Builder
"Contract failed due to gas exhaustion"
    MutezAdditionOverflow [TezosInt64]
amounts ->
      Builder
"A contract failed due to mutez addition overflow when adding following values:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      [TezosInt64] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unwordsF [TezosInt64]
amounts Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    MutezSubtractionUnderflow [TezosInt64]
amounts ->
      Builder
"A contract failed due to mutez subtraction underflow when subtracting following values:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      [TezosInt64] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unwordsF [TezosInt64]
amounts Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    MutezMultiplicationOverflow TezosInt64
amount TezosInt64
multiplicator ->
      Builder
"A contract failed due to mutez multiplication overflow when multiplying" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      TezosInt64
amount TezosInt64 -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" by " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TezosInt64
multiplicator TezosInt64 -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    RunError
CantPayStorageFee ->
      Builder
"Balance is too low to pay storage fee"
    BalanceTooLow (Name "balance" -> ("balance" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "balance" (Name "balance")
Name "balance"
#balance -> Mutez
balance) (Name "required" -> ("required" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "required" (Name "required")
Name "required"
#required -> Mutez
required) ->
      Builder
"Balance is too low, \
      \current balance: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
balance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", but required: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
required Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    PreviouslyRevealedKey ImplicitAddress
addr ->
      Builder
"Key for " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" has already been revealed"
    NonExistingContract Address
addr ->
      Builder
"Contract is not registered: " 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
""
    InvalidB58Check Text
input ->
      Builder
"Failed to read a valid b58check_encoding data from \"" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
input Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\""
    UnregisteredDelegate ImplicitAddress
addr ->
      ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" is not registered as delegate"
    FailedUnDelegation ImplicitAddress
addr ->
      Builder
"Failed to withdraw delegation for: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    RunError
DelegateAlreadyActive ->
      Builder
"Delegate already active"
    IllTypedContract Expression
expr ->
      Builder
"Ill typed contract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expr Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    IllTypedData Expression
expected Expression
ill_typed ->
      Builder
"Ill typed data: Expected type " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
expected Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", ill typed expression: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expression
ill_typed Expression -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    BadStack BadStackInformation
info -> BadStackInformation -> Builder
forall p. Buildable p => p -> Builder
build BadStackInformation
info
    RunError
ForbiddenZeroAmountTicket -> Builder
"Forbidden zero amount ticket"

-- | Errors that are sent as part of an "Internal Server Error"
-- response (HTTP code 500).
--
-- We call them internal because of the HTTP code, but we shouldn't
-- treat them as internal. They can be easily triggered by making a
-- failing operation.
data InternalError
  = CounterInThePast
    -- ^ An operation assumed a contract counter in the past.
      ImplicitAddress -- ^ Address whose counter is invalid.
      ("expected" :! Word) -- ^ Expected counter.
      ("found" :! Word) -- ^ Found counter.
  | UnrevealedKey
    -- ^ One tried to apply a manager operation without revealing
    -- the manager public key.
      ImplicitAddress -- ^ Manager address.
  | Failure Text
    -- ^ Failure reported without specific id
  deriving stock Int -> InternalError -> ShowS
[InternalError] -> ShowS
InternalError -> String
(Int -> InternalError -> ShowS)
-> (InternalError -> String)
-> ([InternalError] -> ShowS)
-> Show InternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalError] -> ShowS
$cshowList :: [InternalError] -> ShowS
show :: InternalError -> String
$cshow :: InternalError -> String
showsPrec :: Int -> InternalError -> ShowS
$cshowsPrec :: Int -> InternalError -> ShowS
Show

instance Buildable InternalError where
  build :: InternalError -> Builder
build = \case
    CounterInThePast ImplicitAddress
addr (Name "expected" -> ("expected" :! Word) -> Word
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "expected" (Name "expected")
Name "expected"
#expected -> Word
expected) (Name "found" -> ("found" :! Word) -> Word
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "found" (Name "found")
Name "found"
#found -> Word
found) ->
      Builder
"Expected counter " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Word
expected Word -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" for " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"but got: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
      Word
found Word -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    UnrevealedKey ImplicitAddress
addr ->
      Builder
"One tried to apply a manager operation without revealing " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"the manager public key of " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ImplicitAddress -> Builder
forall p. Buildable p => p -> Builder
build ImplicitAddress
addr
    Failure Text
msg ->
      Builder
"Contract failed with the following message: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

instance FromJSON InternalError where
  parseJSON :: Value -> Parser InternalError
parseJSON = String
-> (Object -> Parser InternalError)
-> Value
-> Parser InternalError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"internal error" ((Object -> Parser InternalError) -> Value -> Parser InternalError)
-> (Object -> Parser InternalError)
-> Value
-> Parser InternalError
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser String
-> (String -> Parser InternalError) -> Parser InternalError
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      String
x | String
".counter_in_the_past" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          ImplicitAddress
-> ("expected" :! Word) -> ("found" :! Word) -> InternalError
CounterInThePast (ImplicitAddress
 -> ("expected" :! Word) -> ("found" :! Word) -> InternalError)
-> Parser ImplicitAddress
-> Parser
     (("expected" :! Word) -> ("found" :! Word) -> InternalError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ImplicitAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract" Parser (("expected" :! Word) -> ("found" :! Word) -> InternalError)
-> Parser ("expected" :! Word)
-> Parser (("found" :! Word) -> InternalError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            (IsLabel "expected" (Name "expected")
Name "expected"
#expected Name "expected" -> Parser Word -> Parser ("expected" :! Word)
forall (m :: * -> *) (name :: Symbol) a.
Functor m =>
Name name -> m a -> m (NamedF Identity a name)
<:!> Object -> Key -> Parser Word
parseCounter Object
o Key
"expected") Parser (("found" :! Word) -> InternalError)
-> Parser ("found" :! Word) -> Parser InternalError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            (IsLabel "found" (Name "found")
Name "found"
#found Name "found" -> Parser Word -> Parser ("found" :! Word)
forall (m :: * -> *) (name :: Symbol) a.
Functor m =>
Name name -> m a -> m (NamedF Identity a name)
<:!> Object -> Key -> Parser Word
parseCounter Object
o Key
"found")
      String
x | String
".unrevealed_key" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          ImplicitAddress -> InternalError
UnrevealedKey (ImplicitAddress -> InternalError)
-> Parser ImplicitAddress -> Parser InternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ImplicitAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract"
      String
"failure" -> Text -> InternalError
Failure (Text -> InternalError) -> Parser Text -> Parser InternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"msg"
      String
x -> String -> Parser InternalError
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unknown id: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x)
    where
      parseCounter :: Object -> Key -> Parser Word
      parseCounter :: Object -> Key -> Parser Word
parseCounter Object
o Key
fieldName = do
        TezosInt64
fieldValue <- Object
o Object -> Key -> Parser TezosInt64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
fieldName
        let mCounter :: Maybe Word
mCounter = TezosInt64 -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
fromIntegralMaybe TezosInt64
fieldValue
        Parser Word -> (Word -> Parser Word) -> Maybe Word -> Parser Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Word
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Word) -> String -> Parser Word
forall a b. (a -> b) -> a -> b
$ Text -> TezosInt64 -> String
mkErrorMsg (Key -> Text
Key.toText Key
fieldName) TezosInt64
fieldValue) Word -> Parser Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word
mCounter

      mkErrorMsg :: Text -> TezosInt64 -> String
      mkErrorMsg :: Text -> TezosInt64 -> String
mkErrorMsg Text
fieldName TezosInt64
fieldValue = Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unwords
        [Text
"Invalid", Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
dquotes Text
fieldName, Text
"counter:", Int64 -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Int64 -> Text) -> Int64 -> Text
forall a b. (a -> b) -> a -> b
$ TezosInt64 -> Int64
forall a. StringEncode a -> a
unStringEncode TezosInt64
fieldValue]

data OperationResult
  = OperationApplied AppliedResult
  | OperationFailed [RunError]

data AppliedResult = AppliedResult
  { AppliedResult -> TezosInt64
arConsumedMilliGas :: TezosInt64
  , AppliedResult -> TezosInt64
arStorageSize :: TezosInt64
  , AppliedResult -> TezosInt64
arPaidStorageDiff :: TezosInt64
  , AppliedResult -> [ContractAddress]
arOriginatedContracts :: [ContractAddress]
  , AppliedResult -> TezosInt64
arAllocatedDestinationContracts :: TezosInt64
  -- ^ We need to count number of destination contracts that are new
  -- to the chain in order to calculate proper storage_limit
  }
  deriving stock Int -> AppliedResult -> ShowS
[AppliedResult] -> ShowS
AppliedResult -> String
(Int -> AppliedResult -> ShowS)
-> (AppliedResult -> String)
-> ([AppliedResult] -> ShowS)
-> Show AppliedResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppliedResult] -> ShowS
$cshowList :: [AppliedResult] -> ShowS
show :: AppliedResult -> String
$cshow :: AppliedResult -> String
showsPrec :: Int -> AppliedResult -> ShowS
$cshowsPrec :: Int -> AppliedResult -> ShowS
Show

instance Semigroup AppliedResult where
  <> :: AppliedResult -> AppliedResult -> AppliedResult
(<>) AppliedResult
ar1 AppliedResult
ar2 = AppliedResult :: TezosInt64
-> TezosInt64
-> TezosInt64
-> [ContractAddress]
-> TezosInt64
-> AppliedResult
AppliedResult
    { arConsumedMilliGas :: TezosInt64
arConsumedMilliGas = AppliedResult -> TezosInt64
arConsumedMilliGas AppliedResult
ar1 TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ AppliedResult -> TezosInt64
arConsumedMilliGas AppliedResult
ar2
    , arStorageSize :: TezosInt64
arStorageSize = AppliedResult -> TezosInt64
arStorageSize AppliedResult
ar1 TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ AppliedResult -> TezosInt64
arStorageSize AppliedResult
ar2
    , arPaidStorageDiff :: TezosInt64
arPaidStorageDiff = AppliedResult -> TezosInt64
arPaidStorageDiff AppliedResult
ar1 TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ AppliedResult -> TezosInt64
arPaidStorageDiff AppliedResult
ar2
    , arOriginatedContracts :: [ContractAddress]
arOriginatedContracts = AppliedResult -> [ContractAddress]
arOriginatedContracts AppliedResult
ar1 [ContractAddress] -> [ContractAddress] -> [ContractAddress]
forall a. Semigroup a => a -> a -> a
<> AppliedResult -> [ContractAddress]
arOriginatedContracts AppliedResult
ar2
    , arAllocatedDestinationContracts :: TezosInt64
arAllocatedDestinationContracts =
      AppliedResult -> TezosInt64
arAllocatedDestinationContracts AppliedResult
ar1 TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ AppliedResult -> TezosInt64
arAllocatedDestinationContracts AppliedResult
ar2
    }

instance Monoid AppliedResult where
  mempty :: AppliedResult
mempty = TezosInt64
-> TezosInt64
-> TezosInt64
-> [ContractAddress]
-> TezosInt64
-> AppliedResult
AppliedResult TezosInt64
0 TezosInt64
0 TezosInt64
0 [] TezosInt64
0

instance FromJSON OperationResult where
  parseJSON :: Value -> Parser OperationResult
parseJSON = String
-> (Object -> Parser OperationResult)
-> Value
-> Parser OperationResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"operation_costs" ((Object -> Parser OperationResult)
 -> Value -> Parser OperationResult)
-> (Object -> Parser OperationResult)
-> Value
-> Parser OperationResult
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    String
status <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
    case String
status of
      String
"applied" -> AppliedResult -> OperationResult
OperationApplied (AppliedResult -> OperationResult)
-> Parser AppliedResult -> Parser OperationResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        TezosInt64
arConsumedMilliGas <- Object
o Object -> Key -> Parser TezosInt64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"consumed_milligas"
        TezosInt64
arStorageSize <- Object
o Object -> Key -> Parser (Maybe TezosInt64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"storage_size" Parser (Maybe TezosInt64) -> TezosInt64 -> Parser TezosInt64
forall a. Parser (Maybe a) -> a -> Parser a
.!= TezosInt64
0
        TezosInt64
arPaidStorageDiff <- Object
o Object -> Key -> Parser (Maybe TezosInt64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"paid_storage_size_diff" Parser (Maybe TezosInt64) -> TezosInt64 -> Parser TezosInt64
forall a. Parser (Maybe a) -> a -> Parser a
.!= TezosInt64
0
        [ContractAddress]
arOriginatedContracts <- Object
o Object -> Key -> Parser (Maybe [ContractAddress])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"originated_contracts" Parser (Maybe [ContractAddress])
-> [ContractAddress] -> Parser [ContractAddress]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
        Bool
allocatedFlag <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allocated_destination_contract" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        let arAllocatedDestinationContracts :: TezosInt64
arAllocatedDestinationContracts = if Bool
allocatedFlag then TezosInt64
1 else TezosInt64
0
        return AppliedResult :: TezosInt64
-> TezosInt64
-> TezosInt64
-> [ContractAddress]
-> TezosInt64
-> AppliedResult
AppliedResult{[ContractAddress]
TezosInt64
arAllocatedDestinationContracts :: TezosInt64
arOriginatedContracts :: [ContractAddress]
arPaidStorageDiff :: TezosInt64
arStorageSize :: TezosInt64
arConsumedMilliGas :: TezosInt64
arAllocatedDestinationContracts :: TezosInt64
arOriginatedContracts :: [ContractAddress]
arPaidStorageDiff :: TezosInt64
arStorageSize :: TezosInt64
arConsumedMilliGas :: TezosInt64
..}
      String
"failed" -> [RunError] -> OperationResult
OperationFailed ([RunError] -> OperationResult)
-> Parser [RunError] -> Parser OperationResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [RunError]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"errors"
      String
"backtracked" ->
        [RunError] -> OperationResult
OperationFailed ([RunError] -> OperationResult)
-> Parser [RunError] -> Parser OperationResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [RunError])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"errors" Parser (Maybe [RunError]) -> [RunError] -> Parser [RunError]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      String
"skipped" ->
        [RunError] -> OperationResult
OperationFailed ([RunError] -> OperationResult)
-> Parser [RunError] -> Parser OperationResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [RunError])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"errors" Parser (Maybe [RunError]) -> [RunError] -> Parser [RunError]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      String
_ -> String -> Parser OperationResult
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unexpected status " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
status)

data ParametersInternal = ParametersInternal
  { ParametersInternal -> Text
piEntrypoint :: Text
  , ParametersInternal -> Expression
piValue :: Expression
  }

-- | 'ParametersInternal' can be missing when default entrypoint is called with
-- Unit value. Usually it happens when destination is an implicit account.
-- In our structures 'ParametersInternal' is not optional because missing
-- case is equivalent to explicit calling of @default@ with @Unit@.
defaultParametersInternal :: ParametersInternal
defaultParametersInternal :: ParametersInternal
defaultParametersInternal = ParametersInternal :: Text -> Expression -> ParametersInternal
ParametersInternal
  { piEntrypoint :: Text
piEntrypoint = Text
"default"
  , piValue :: Expression
piValue = MichelinePrimAp RegularExp -> Expression
expressionPrim MichelinePrimAp :: forall (x :: ExpExtensionDescriptorKind).
MichelinePrimitive -> [Exp x] -> [Annotation] -> MichelinePrimAp x
MichelinePrimAp
    { mpaPrim :: MichelinePrimitive
mpaPrim = Text -> MichelinePrimitive
MichelinePrimitive Text
"Unit"
    , mpaArgs :: [Expression]
mpaArgs = []
    , mpaAnnots :: [Annotation]
mpaAnnots = []
    }
  }

-- | Data that is common for transaction and origination
-- operations.
data CommonOperationData = CommonOperationData
  { CommonOperationData -> ImplicitAddress
codSource :: ImplicitAddress
  , CommonOperationData -> TezosMutez
codFee :: TezosMutez
  , CommonOperationData -> TezosInt64
codCounter :: TezosInt64
  , CommonOperationData -> TezosInt64
codGasLimit :: TezosInt64
  , CommonOperationData -> TezosInt64
codStorageLimit :: TezosInt64
  }

-- | Create 'CommonOperationData' based on current blockchain protocol parameters
-- and sender info. This data is used for operation simulation.
--
-- @num_operations@ parameter can be used for smarter gas limit estimation. If
-- 'Nothing', the gas limit is set to 'ppHardGasLimitPerOperation', but that
-- puts a hard low limit on the number of operations that will fit into one
-- batch. If @num_operations@ is set, then gas limit is estimated as
--
-- \[
-- \mathrm{min}\left(\mathbf{hard\_gas\_limit\_per\_operation},
-- \left\lceil \frac{\mathbf{hard\_gas\_limit\_per\_block}}
-- {num\_operations}\right\rceil\right)
-- \]
--
-- This works well enough for the case of many small operations, but will break
-- when there is one big one and a lot of small ones. That said, specifying
-- @num_operations@ will work in all cases where not specifying it would, and
-- then some, so it's recommended to specify it whenever possible.
--
-- @num_operations@ is assumed to be greater than @0@, otherwise it'll be
-- silently ignored.
--
-- Fee isn't accounted during operation simulation, so it's safe to use zero amount.
-- Real operation fee is calculated later using @octez-client@.
mkCommonOperationData
  :: ProtocolParameters
  -> "sender" :! ImplicitAddress
  -> "counter" :! TezosInt64
  -> "num_operations" :? Int64
  -> CommonOperationData
mkCommonOperationData :: ProtocolParameters
-> ("sender" :! ImplicitAddress)
-> ("counter" :! TezosInt64)
-> ("num_operations" :? Int64)
-> CommonOperationData
mkCommonOperationData ProtocolParameters{Int
TezosInt64
TezosNat
TezosMutez
ppHardGasLimitPerBlock :: TezosInt64
ppCostPerByte :: TezosMutez
ppMinimalBlockDelay :: TezosNat
ppHardStorageLimitPerOperation :: TezosInt64
ppHardGasLimitPerOperation :: TezosInt64
ppOriginationSize :: Int
ppHardGasLimitPerBlock :: ProtocolParameters -> TezosInt64
ppCostPerByte :: ProtocolParameters -> TezosMutez
ppMinimalBlockDelay :: ProtocolParameters -> TezosNat
ppHardStorageLimitPerOperation :: ProtocolParameters -> TezosInt64
ppHardGasLimitPerOperation :: ProtocolParameters -> TezosInt64
ppOriginationSize :: ProtocolParameters -> Int
..} "sender" :! ImplicitAddress
source "counter" :! TezosInt64
counter "num_operations" :? Int64
mNumOp =
  CommonOperationData :: ImplicitAddress
-> TezosMutez
-> TezosInt64
-> TezosInt64
-> TezosInt64
-> CommonOperationData
CommonOperationData
    { codSource :: ImplicitAddress
codSource = Name "sender" -> ("sender" :! ImplicitAddress) -> ImplicitAddress
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "sender" (Name "sender")
Name "sender"
#sender "sender" :! ImplicitAddress
source
    , codFee :: TezosMutez
codFee = Mutez -> TezosMutez
TezosMutez Mutez
zeroMutez
    , codCounter :: TezosInt64
codCounter = Name "counter" -> ("counter" :! TezosInt64) -> TezosInt64
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "counter" (Name "counter")
Name "counter"
#counter "counter" :! TezosInt64
counter
    , codGasLimit :: TezosInt64
codGasLimit = TezosInt64
estGasLimitPerOperation
    , codStorageLimit :: TezosInt64
codStorageLimit = TezosInt64
ppHardStorageLimitPerOperation
    }
  where
    estGasLimitPerOperation :: TezosInt64
estGasLimitPerOperation
      | Just Int64
numOp <- Name "num_operations" -> ("num_operations" :? Int64) -> Maybe Int64
forall (name :: Symbol) (f :: * -> *) a.
Name name -> NamedF f a name -> f a
argF IsLabel "num_operations" (Name "num_operations")
Name "num_operations"
#num_operations "num_operations" :? Int64
mNumOp
      , Int64
numOp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
      = Int64 -> TezosInt64
forall a. a -> StringEncode a
StringEncode (Int64 -> TezosInt64) -> Int64 -> TezosInt64
forall a b. (a -> b) -> a -> b
$
          Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (TezosInt64 -> Int64
forall a. StringEncode a -> a
unStringEncode TezosInt64
ppHardGasLimitPerOperation) (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Ratio Int64 -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Int64 -> Int64) -> Ratio Int64 -> Int64
forall a b. (a -> b) -> a -> b
$
            TezosInt64 -> Int64
forall a. StringEncode a -> a
unStringEncode TezosInt64
ppHardGasLimitPerBlock Int64 -> Int64 -> Ratio Int64
forall a. Integral a => a -> a -> Ratio a
% Int64
numOp
      | Bool
otherwise = TezosInt64
ppHardGasLimitPerOperation

instance ToJSON CommonOperationData where
  toJSON :: CommonOperationData -> Value
toJSON CommonOperationData{ImplicitAddress
TezosInt64
TezosMutez
codStorageLimit :: TezosInt64
codGasLimit :: TezosInt64
codCounter :: TezosInt64
codFee :: TezosMutez
codSource :: ImplicitAddress
codStorageLimit :: CommonOperationData -> TezosInt64
codGasLimit :: CommonOperationData -> TezosInt64
codCounter :: CommonOperationData -> TezosInt64
codFee :: CommonOperationData -> TezosMutez
codSource :: CommonOperationData -> ImplicitAddress
..} = [Pair] -> Value
object
    [ Key
"source" Key -> ImplicitAddress -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ImplicitAddress
codSource
    , Key
"fee" Key -> TezosMutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TezosMutez
codFee
    , Key
"counter" Key -> TezosInt64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TezosInt64
codCounter
    , Key
"gas_limit" Key -> TezosInt64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TezosInt64
codGasLimit
    , Key
"storage_limit" Key -> TezosInt64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TezosInt64
codStorageLimit
    ]

instance FromJSON CommonOperationData where
  parseJSON :: Value -> Parser CommonOperationData
parseJSON = String
-> (Object -> Parser CommonOperationData)
-> Value
-> Parser CommonOperationData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"common operation data" ((Object -> Parser CommonOperationData)
 -> Value -> Parser CommonOperationData)
-> (Object -> Parser CommonOperationData)
-> Value
-> Parser CommonOperationData
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ImplicitAddress
codSource <- Object
o Object -> Key -> Parser ImplicitAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
    TezosMutez
codFee <- Object
o Object -> Key -> Parser TezosMutez
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fee"
    TezosInt64
codCounter <- Object
o Object -> Key -> Parser TezosInt64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"counter"
    TezosInt64
codGasLimit <- Object
o Object -> Key -> Parser TezosInt64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gas_limit"
    TezosInt64
codStorageLimit <- Object
o Object -> Key -> Parser TezosInt64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"storage_limit"
    pure CommonOperationData :: ImplicitAddress
-> TezosMutez
-> TezosInt64
-> TezosInt64
-> TezosInt64
-> CommonOperationData
CommonOperationData {ImplicitAddress
TezosInt64
TezosMutez
codStorageLimit :: TezosInt64
codGasLimit :: TezosInt64
codCounter :: TezosInt64
codFee :: TezosMutez
codSource :: ImplicitAddress
codStorageLimit :: TezosInt64
codGasLimit :: TezosInt64
codCounter :: TezosInt64
codFee :: TezosMutez
codSource :: ImplicitAddress
..}

-- | Some operation data accompanied with common data.
data WithCommonOperationData a = WithCommonOperationData
  { forall a. WithCommonOperationData a -> CommonOperationData
wcoCommon :: CommonOperationData
  , forall a. WithCommonOperationData a -> a
wcoCustom :: a
  }

instance ToJSONObject a => ToJSON (WithCommonOperationData a) where
  toJSON :: WithCommonOperationData a -> Value
toJSON (WithCommonOperationData CommonOperationData
common a
custom) =
    CommonOperationData -> Value
forall a. ToJSON a => a -> Value
toJSON CommonOperationData
common HasCallStack => Value -> Value -> Value
Value -> Value -> Value
`mergeObjects` a -> Value
forall a. ToJSON a => a -> Value
toJSON a
custom

instance FromJSON a => FromJSON (WithCommonOperationData a) where
  parseJSON :: Value -> Parser (WithCommonOperationData a)
parseJSON Value
v = CommonOperationData -> a -> WithCommonOperationData a
forall a. CommonOperationData -> a -> WithCommonOperationData a
WithCommonOperationData (CommonOperationData -> a -> WithCommonOperationData a)
-> Parser CommonOperationData
-> Parser (a -> WithCommonOperationData a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CommonOperationData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (a -> WithCommonOperationData a)
-> Parser a -> Parser (WithCommonOperationData a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | All the data needed to perform a transaction through
-- Tezos RPC interface.
-- For additional information, please refer to RPC documentation
-- http://tezos.gitlab.io/api/rpc.html
data TransactionOperation = TransactionOperation
  { TransactionOperation -> TezosMutez
toAmount :: TezosMutez
  , TransactionOperation -> Address
toDestination :: Address
  , TransactionOperation -> ParametersInternal
toParameters :: ParametersInternal
  }

data OriginationScript = OriginationScript
  { OriginationScript -> Expression
osCode :: Expression
  , OriginationScript -> Expression
osStorage :: Expression
  }

-- | All the data needed to perform contract origination
-- through Tezos RPC interface
data OriginationOperation = OriginationOperation
  { OriginationOperation -> TezosMutez
ooBalance :: TezosMutez
  , OriginationOperation -> Maybe KeyHash
ooDelegate :: Maybe KeyHash
  , OriginationOperation -> OriginationScript
ooScript :: OriginationScript
  }

-- | All the data needed to perform key revealing
-- through Tezos RPC interface
data RevealOperation = RevealOperation
  { RevealOperation -> PublicKey
roPublicKey :: PublicKey
  }

instance ToJSON RevealOperation where
  toJSON :: RevealOperation -> Value
toJSON RevealOperation{PublicKey
roPublicKey :: PublicKey
roPublicKey :: RevealOperation -> PublicKey
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"kind" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"reveal"
    , Key
"public_key" Key -> PublicKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PublicKey
roPublicKey
    ]
instance ToJSONObject RevealOperation

data DelegationOperation = DelegationOperation
  { DelegationOperation -> Maybe KeyHash
doDelegate :: Maybe KeyHash
    -- ^ 'Nothing' removes delegate, 'Just' sets it
  }

instance ToJSON DelegationOperation where
  toJSON :: DelegationOperation -> Value
toJSON DelegationOperation{Maybe KeyHash
doDelegate :: Maybe KeyHash
doDelegate :: DelegationOperation -> Maybe KeyHash
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"kind" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"delegation" ]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Maybe Pair -> [Pair]
forall a. Maybe a -> [a]
maybeToList ((Key
"delegate" Key -> KeyHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (KeyHash -> Pair) -> Maybe KeyHash -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe KeyHash
doDelegate)

instance ToJSONObject DelegationOperation

-- | @$operation@ in Tezos docs.
data BlockOperation = BlockOperation
  { BlockOperation -> Text
boHash :: Text
  , BlockOperation -> [OperationRespWithMeta]
boContents :: [OperationRespWithMeta]
  }

-- | Contents of an operation that can appear in RPC responses.
data OperationResp
  = TransactionOpResp (WithCommonOperationData TransactionOperation)
  -- ^ Operation with kind @transaction@.
  | OtherOpResp
  -- ^ Operation with kind that we don't support yet (but need to parse to something).

data OperationRespWithMeta = OperationRespWithMeta
  { OperationRespWithMeta -> OperationResp
orwmResponse :: OperationResp
  , OperationRespWithMeta -> Maybe OperationMetadata
orwmMetadata :: Maybe OperationMetadata
  }

newtype OperationMetadata = OperationMetadata { OperationMetadata -> Maybe OperationResult
unOperationMetadata :: Maybe OperationResult }

instance FromJSON OperationMetadata where
  parseJSON :: Value -> Parser OperationMetadata
parseJSON = String
-> (Object -> Parser OperationMetadata)
-> Value
-> Parser OperationMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"operationMetadata" ((Object -> Parser OperationMetadata)
 -> Value -> Parser OperationMetadata)
-> (Object -> Parser OperationMetadata)
-> Value
-> Parser OperationMetadata
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe OperationResult -> OperationMetadata
OperationMetadata (Maybe OperationResult -> OperationMetadata)
-> Parser (Maybe OperationResult) -> Parser OperationMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe OperationResult)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"operation_result"

data GetBigMap = GetBigMap
  { GetBigMap -> Expression
bmKey :: Expression
  , GetBigMap -> Expression
bmType :: Expression
  }

data GetBigMapResult
  = GetBigMapResult Expression
  | GetBigMapNotFound

-- | Data required for calling @run_code@ RPC endpoint.
data RunCode = RunCode
  { RunCode -> Expression
rcScript :: Expression
  , RunCode -> Expression
rcStorage :: Expression
  , RunCode -> Expression
rcInput :: Expression
  , RunCode -> TezosMutez
rcAmount :: TezosMutez
  , RunCode -> TezosMutez
rcBalance :: TezosMutez
  , RunCode -> Text
rcChainId :: Text
  , RunCode -> Maybe TezosNat
rcNow :: Maybe TezosNat
  , RunCode -> Maybe TezosNat
rcLevel :: Maybe TezosNat
  , RunCode -> Maybe ImplicitAddress
rcSource :: Maybe ImplicitAddress
  , RunCode -> Maybe ImplicitAddress
rcPayer :: Maybe ImplicitAddress
  }

-- | Result storage of @run_code@ RPC endpoint call.
--
-- Actual resulting JSON has more contents, but currently we're interested
-- only in resulting storage.
data RunCodeResult = RunCodeResult
  { RunCodeResult -> Expression
rcrStorage :: Expression
  }

newtype ScriptSize = ScriptSize { ScriptSize -> Natural
ssScriptSize :: Natural }

data CalcSize = CalcSize
  { CalcSize -> Expression
csProgram :: Expression
  , CalcSize -> Expression
csStorage :: Expression
  , CalcSize -> TezosInt64
csGas     :: TezosInt64
  , CalcSize -> Bool
csLegacy  :: Bool
  }

data MonitorHeadsStep a = MonitorHeadsStop a | MonitorHeadsContinue

deriveJSON morleyClientAesonOptions ''ParametersInternal

instance ToJSON TransactionOperation where
  toJSON :: TransactionOperation -> Value
toJSON TransactionOperation{Address
TezosMutez
ParametersInternal
toParameters :: ParametersInternal
toDestination :: Address
toAmount :: TezosMutez
toParameters :: TransactionOperation -> ParametersInternal
toDestination :: TransactionOperation -> Address
toAmount :: TransactionOperation -> TezosMutez
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"kind" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"transaction"
    , Key
"amount" Key -> TezosMutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TezosMutez
toAmount
    , Key
"destination" Key -> Address -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Address
toDestination
    , Key
"parameters" Key -> ParametersInternal -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParametersInternal
toParameters
    ]
instance ToJSONObject TransactionOperation

instance FromJSON TransactionOperation where
  parseJSON :: Value -> Parser TransactionOperation
parseJSON = String
-> (Object -> Parser TransactionOperation)
-> Value
-> Parser TransactionOperation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TransactionOperation" ((Object -> Parser TransactionOperation)
 -> Value -> Parser TransactionOperation)
-> (Object -> Parser TransactionOperation)
-> Value
-> Parser TransactionOperation
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    TezosMutez
toAmount <- Object
obj Object -> Key -> Parser TezosMutez
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount"
    Address
toDestination <- Object
obj Object -> Key -> Parser Address
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"destination"
    ParametersInternal
toParameters <- ParametersInternal
-> Maybe ParametersInternal -> ParametersInternal
forall a. a -> Maybe a -> a
fromMaybe ParametersInternal
defaultParametersInternal (Maybe ParametersInternal -> ParametersInternal)
-> Parser (Maybe ParametersInternal) -> Parser ParametersInternal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe ParametersInternal)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parameters"
    pure TransactionOperation :: TezosMutez -> Address -> ParametersInternal -> TransactionOperation
TransactionOperation {Address
TezosMutez
ParametersInternal
toParameters :: ParametersInternal
toDestination :: Address
toAmount :: TezosMutez
toParameters :: ParametersInternal
toDestination :: Address
toAmount :: TezosMutez
..}

instance FromJSON OperationResp where
  parseJSON :: Value -> Parser OperationResp
parseJSON = String
-> (Object -> Parser OperationResp)
-> Value
-> Parser OperationResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OperationResp" ((Object -> Parser OperationResp) -> Value -> Parser OperationResp)
-> (Object -> Parser OperationResp)
-> Value
-> Parser OperationResp
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Text
kind :: Text <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    case Text
kind of
      Text
"transaction" -> WithCommonOperationData TransactionOperation -> OperationResp
TransactionOpResp (WithCommonOperationData TransactionOperation -> OperationResp)
-> Parser (WithCommonOperationData TransactionOperation)
-> Parser OperationResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (WithCommonOperationData TransactionOperation)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj)
      Text
_ -> OperationResp -> Parser OperationResp
forall (f :: * -> *) a. Applicative f => a -> f a
pure OperationResp
OtherOpResp

instance FromJSON OperationRespWithMeta where
  parseJSON :: Value -> Parser OperationRespWithMeta
parseJSON = String
-> (Object -> Parser OperationRespWithMeta)
-> Value
-> Parser OperationRespWithMeta
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OperationRespWithMeta" ((Object -> Parser OperationRespWithMeta)
 -> Value -> Parser OperationRespWithMeta)
-> (Object -> Parser OperationRespWithMeta)
-> Value
-> Parser OperationRespWithMeta
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    OperationResp -> Maybe OperationMetadata -> OperationRespWithMeta
OperationRespWithMeta (OperationResp -> Maybe OperationMetadata -> OperationRespWithMeta)
-> Parser OperationResp
-> Parser (Maybe OperationMetadata -> OperationRespWithMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OperationResp
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj) Parser (Maybe OperationMetadata -> OperationRespWithMeta)
-> Parser (Maybe OperationMetadata) -> Parser OperationRespWithMeta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe OperationMetadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata"

deriveToJSON morleyClientAesonOptions ''OriginationScript

instance ToJSON OriginationOperation where
  toJSON :: OriginationOperation -> Value
toJSON OriginationOperation{Maybe KeyHash
TezosMutez
OriginationScript
ooScript :: OriginationScript
ooDelegate :: Maybe KeyHash
ooBalance :: TezosMutez
ooScript :: OriginationOperation -> OriginationScript
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooBalance :: OriginationOperation -> TezosMutez
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"kind" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"origination"
    , Key
"balance" Key -> TezosMutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TezosMutez
ooBalance
    , Key
"script" Key -> OriginationScript -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OriginationScript
ooScript
    ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Maybe Pair -> [Pair]
forall a. Maybe a -> [a]
maybeToList ((Key
"delegate" Key -> KeyHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (KeyHash -> Pair) -> Maybe KeyHash -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe KeyHash
ooDelegate)
instance ToJSONObject OriginationOperation

instance ToJSON ForgeOperation where
  toJSON :: ForgeOperation -> Value
toJSON ForgeOperation{NonEmpty OperationInput
BlockHash
foContents :: NonEmpty OperationInput
foBranch :: BlockHash
foContents :: ForgeOperation -> NonEmpty OperationInput
foBranch :: ForgeOperation -> BlockHash
..} = [Pair] -> Value
object
    [ Key
"branch" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BlockHash -> Text
unBlockHash BlockHash
foBranch
    , Key
"contents" Key -> NonEmpty OperationInput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty OperationInput
foContents
    ]

instance ToJSON RunOperationInternal where
  toJSON :: RunOperationInternal -> Value
toJSON RunOperationInternal{NonEmpty OperationInput
Signature
BlockHash
roiSignature :: Signature
roiContents :: NonEmpty OperationInput
roiBranch :: BlockHash
roiSignature :: RunOperationInternal -> Signature
roiContents :: RunOperationInternal -> NonEmpty OperationInput
roiBranch :: RunOperationInternal -> BlockHash
..} = [Pair] -> Value
object
    [ Key
"branch" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BlockHash -> Text
unBlockHash BlockHash
roiBranch
    , Key
"contents" Key -> NonEmpty OperationInput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty OperationInput
roiContents
    , Key
"signature" Key -> Signature -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Signature
roiSignature
    ]

instance ToJSON PreApplyOperation where
  toJSON :: PreApplyOperation -> Value
toJSON PreApplyOperation{NonEmpty OperationInput
Text
Signature
BlockHash
paoSignature :: Signature
paoContents :: NonEmpty OperationInput
paoBranch :: BlockHash
paoProtocol :: Text
paoSignature :: PreApplyOperation -> Signature
paoContents :: PreApplyOperation -> NonEmpty OperationInput
paoBranch :: PreApplyOperation -> BlockHash
paoProtocol :: PreApplyOperation -> Text
..} = [Pair] -> Value
object
    [ Key
"branch" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BlockHash -> Text
unBlockHash BlockHash
paoBranch
    , Key
"contents" Key -> NonEmpty OperationInput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty OperationInput
paoContents
    , Key
"protocol" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
paoProtocol
    , Key
"signature" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Signature -> Text
formatSignature Signature
paoSignature
    ]

deriveToJSON morleyClientAesonOptions ''RunOperation
deriveToJSON morleyClientAesonOptions ''GetBigMap
deriveToJSON morleyClientAesonOptions ''CalcSize
deriveToJSON morleyClientAesonOptions{omitNothingFields = True} ''RunCode
deriveFromJSON morleyClientAesonOptions ''BlockHeaderNoHash
deriveFromJSON morleyClientAesonOptions ''ScriptSize
deriveFromJSON morleyClientAesonOptions ''BlockConstants
deriveJSON morleyClientAesonOptions ''BlockHeader
deriveFromJSON morleyClientAesonOptions ''ProtocolParameters
deriveFromJSON morleyClientAesonOptions ''BlockOperation
deriveFromJSON morleyClientAesonOptions ''OriginationScript
deriveFromJSON morleyClientAesonOptions ''RunCodeResult

instance FromJSON GetBigMapResult where
  parseJSON :: Value -> Parser GetBigMapResult
parseJSON Value
v = GetBigMapResult
-> (Expression -> GetBigMapResult)
-> Maybe Expression
-> GetBigMapResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GetBigMapResult
GetBigMapNotFound Expression -> GetBigMapResult
GetBigMapResult (Maybe Expression -> GetBigMapResult)
-> Parser (Maybe Expression) -> Parser GetBigMapResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Maybe Expression)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

makePrisms ''RunError

wcoCommonDataL :: Lens' (WithCommonOperationData a) CommonOperationData
wcoCommonDataL :: forall a. Lens' (WithCommonOperationData a) CommonOperationData
wcoCommonDataL = \CommonOperationData -> f CommonOperationData
f (WithCommonOperationData CommonOperationData
com a
cust) ->
  (CommonOperationData -> a -> WithCommonOperationData a
forall a. CommonOperationData -> a -> WithCommonOperationData a
`WithCommonOperationData` a
cust) (CommonOperationData -> WithCommonOperationData a)
-> f CommonOperationData -> f (WithCommonOperationData a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommonOperationData -> f CommonOperationData
f CommonOperationData
com