-- 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 (..)
  , WithSource (..)
  , OperationContent (..)
  , OperationHash (..)
  , OperationInput
  , OperationResp (..)
  , OperationRespWithMeta (..)
  , OperationMetadata (..)
  , OperationResult (..)
  , OriginationOperation (..)
  , OriginationScript (..)
  , ParametersInternal (..)
  , PreApplyOperation (..)
  , ProtocolParameters (..)
  , RevealOperation (..)
  , RunCode (..)
  , RunCodeResult (..)
  , RunMetadata (..)
  , RunOperation (..)
  , RunOperationInternal (..)
  , RunOperationResult (..)
  , RPCInput
  , TransactionOperation (..)
  , TransferTicketOperation (..)
  , WithCommonOperationData (..)
  , EventOperation (..)
  , MonitorHeadsStep(..)
  , GetTicketBalance (..)
  , GetAllTicketBalancesResponse (..)
  , PackData(..)
  , PackDataResult(..)
  , 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,
  withText, (.!=), (.:), (.:?), (.=))
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(..), blockListF, blockMapF, enumerateF', fillSepF', nameF, reflowF, unlinesF, (++|),
  (|++))
import Servant.API (ToHttpApiData(..))

import Data.Aeson.Types (Parser)
import Morley.Client.RPC.Aeson
import Morley.Client.Types
import Morley.Micheline
  (Expression, MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosBigNum,
  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.MismatchError
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 TransferTicketInfo RPCInput = TransferTicketOperation
  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
$c== :: OperationHash -> OperationHash -> Bool
== :: OperationHash -> OperationHash -> Bool
$c/= :: OperationHash -> OperationHash -> Bool
/= :: 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
$cshowsPrec :: Int -> OperationHash -> ShowS
showsPrec :: Int -> OperationHash -> ShowS
$cshow :: OperationHash -> String
show :: OperationHash -> String
$cshowList :: [OperationHash] -> ShowS
showList :: [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
$cparseJSON :: Value -> Parser OperationHash
parseJSON :: Value -> Parser OperationHash
$cparseJSONList :: Value -> Parser [OperationHash]
parseJSONList :: Value -> Parser [OperationHash]
FromJSON, [OperationHash] -> Doc
OperationHash -> Doc
(OperationHash -> Doc)
-> ([OperationHash] -> Doc) -> Buildable OperationHash
forall a. (a -> Doc) -> ([a] -> Doc) -> Buildable a
$cbuild :: OperationHash -> Doc
build :: OperationHash -> Doc
$cbuildList :: [OperationHash] -> Doc
buildList :: [OperationHash] -> Doc
Buildable)

data OperationContent = OperationContent
  { OperationContent -> OperationResp WithSource
ocOperation :: OperationResp WithSource
  , OperationContent -> RunMetadata
ocMetadata :: RunMetadata
  }

instance FromJSON OperationContent where
  parseJSON :: Value -> Parser OperationContent
parseJSON Value
json = Value
json Value
-> (Value -> Parser OperationContent) -> Parser OperationContent
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser OperationContent)
-> Value
-> Parser OperationContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"operationCostContent" \Object
o ->
    OperationResp WithSource -> RunMetadata -> OperationContent
OperationContent (OperationResp WithSource -> RunMetadata -> OperationContent)
-> Parser (OperationResp WithSource)
-> Parser (RunMetadata -> OperationContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (OperationResp WithSource)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json Parser (RunMetadata -> OperationContent)
-> Parser RunMetadata -> Parser OperationContent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => 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 a b. Parser (a -> b) -> Parser a -> Parser b
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 -> OperationResp WithSource
ioData :: OperationResp WithSource
  , 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 ->
    OperationResp WithSource -> OperationResult -> InternalOperation
InternalOperation (OperationResp WithSource -> OperationResult -> InternalOperation)
-> Parser (OperationResp WithSource)
-> Parser (OperationResult -> InternalOperation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (OperationResp WithSource)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json Parser (OperationResult -> InternalOperation)
-> Parser OperationResult -> Parser InternalOperation
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 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
$c== :: BlockHash -> BlockHash -> Bool
== :: BlockHash -> BlockHash -> Bool
$c/= :: BlockHash -> BlockHash -> Bool
/= :: 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
$ccompare :: BlockHash -> BlockHash -> Ordering
compare :: BlockHash -> BlockHash -> Ordering
$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
>= :: BlockHash -> BlockHash -> Bool
$cmax :: BlockHash -> BlockHash -> BlockHash
max :: BlockHash -> BlockHash -> BlockHash
$cmin :: BlockHash -> BlockHash -> BlockHash
min :: BlockHash -> BlockHash -> BlockHash
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
$cshowsPrec :: Int -> BlockHash -> ShowS
showsPrec :: Int -> BlockHash -> ShowS
$cshow :: BlockHash -> String
show :: BlockHash -> String
$cshowList :: [BlockHash] -> ShowS
showList :: [BlockHash] -> ShowS
Show, [BlockHash] -> Doc
BlockHash -> Doc
(BlockHash -> Doc) -> ([BlockHash] -> Doc) -> Buildable BlockHash
forall a. (a -> Doc) -> ([a] -> Doc) -> Buildable a
$cbuild :: BlockHash -> Doc
build :: BlockHash -> Doc
$cbuildList :: [BlockHash] -> Doc
buildList :: [BlockHash] -> Doc
Buildable, [BlockHash] -> Value
[BlockHash] -> Encoding
BlockHash -> Value
BlockHash -> Encoding
(BlockHash -> Value)
-> (BlockHash -> Encoding)
-> ([BlockHash] -> Value)
-> ([BlockHash] -> Encoding)
-> ToJSON BlockHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BlockHash -> Value
toJSON :: BlockHash -> Value
$ctoEncoding :: BlockHash -> Encoding
toEncoding :: BlockHash -> Encoding
$ctoJSONList :: [BlockHash] -> Value
toJSONList :: [BlockHash] -> Value
$ctoEncodingList :: [BlockHash] -> Encoding
toEncodingList :: [BlockHash] -> Encoding
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
$cparseJSON :: Value -> Parser BlockHash
parseJSON :: Value -> Parser BlockHash
$cparseJSONList :: Value -> Parser [BlockHash]
parseJSONList :: Value -> Parser [BlockHash]
FromJSON, BlockHash -> ByteString
BlockHash -> Text
BlockHash -> Builder
(BlockHash -> Text)
-> (BlockHash -> Builder)
-> (BlockHash -> ByteString)
-> (BlockHash -> Text)
-> ToHttpApiData BlockHash
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
$ctoUrlPiece :: BlockHash -> Text
toUrlPiece :: BlockHash -> Text
$ctoEncodedUrlPiece :: BlockHash -> Builder
toEncodedUrlPiece :: BlockHash -> Builder
$ctoHeader :: BlockHash -> ByteString
toHeader :: BlockHash -> ByteString
$ctoQueryParam :: BlockHash -> Text
toQueryParam :: 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
    { 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
$cshowsPrec :: Int -> BlockId -> ShowS
showsPrec :: Int -> BlockId -> ShowS
$cshow :: BlockId -> String
show :: BlockId -> String
$cshowList :: [BlockId] -> ShowS
showList :: [BlockId] -> ShowS
Show, BlockId -> BlockId -> Bool
(BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool) -> Eq BlockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockId -> BlockId -> Bool
== :: BlockId -> BlockId -> Bool
$c/= :: BlockId -> BlockId -> Bool
/= :: 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 -> Doc
build = \case
    BlockId
HeadId -> Doc
"head"
    BlockId
FinalHeadId -> Doc
"head~2"
    BlockId
GenesisId -> Doc
"genesis"
    LevelId Natural
x -> Doc
"block at level " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Natural -> Doc
forall a. Buildable a => a -> Doc
build Natural
x
    BlockHashId BlockHash
hash -> Doc
"block with hash " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Doc
forall a. Buildable a => a -> Doc
build BlockHash
hash
    AtDepthId Natural
depth -> Doc
"block at depth " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Natural -> Doc
forall a. Buildable a => a -> Doc
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
$c== :: BadStackInformation -> BadStackInformation -> Bool
== :: BadStackInformation -> BadStackInformation -> Bool
$c/= :: BadStackInformation -> BadStackInformation -> Bool
/= :: 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
$cshowsPrec :: Int -> BadStackInformation -> ShowS
showsPrec :: Int -> BadStackInformation -> ShowS
$cshow :: BadStackInformation -> String
show :: BadStackInformation -> String
$cshowList :: [BadStackInformation] -> ShowS
showList :: [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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 -> Doc
build (BadStackInformation Int
loc Int
stack_portion Text
prim Expression
stack_type) =
    Text
"Bad Stack in location" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Int
loc Int -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"stack portion" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Int
stack_portion Int -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++
    Text
"on primitive" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Text
prim Text -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"with (wrong) stack type" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Expression
stack_type Expression -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""

-- | 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
  | REEmptyImplicitContract ImplicitAddress
  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
$cshowsPrec :: Int -> RunError -> ShowS
showsPrec :: Int -> RunError -> ShowS
$cshow :: RunError -> String
show :: RunError -> String
$cshowList :: [RunError] -> ShowS
showList :: [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 {t} {m :: * -> *} {a}.
(Element t ~ (String, m a), MonadFail m, Container t) =>
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 a b. Parser (a -> b) -> Parser a -> Parser b
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
o Object -> 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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a. a -> Parser a
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 a. a -> Parser a
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 a. a -> Parser a
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 a. a -> Parser a
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a. a -> Parser a
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 (Name "balance"
#balance Name "balance" -> Mutez -> "balance" :! Mutez
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Mutez
balance) (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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
DelegateAlreadyActive
      , String
"empty_implicit_contract" String -> Parser RunError -> (String, Parser RunError)
forall {a} {b}. a -> b -> (a, b)
~> ImplicitAddress -> RunError
REEmptyImplicitContract (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
"implicit"
      , 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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a. a -> Parser a
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 a. 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 -> Doc
build = \case
    RuntimeError ContractAddress
addr -> Doc -> ContractAddress -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Runtime error for contract" ContractAddress
addr
    ScriptRejected Expression
expr -> Doc -> Expression -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Script rejected with:" Expression
expr
    BadContractParameter Address
addr -> Doc -> Address -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Bad contract parameter for" Address
addr
    InvalidConstant Expression
expectedType Expression
expr -> [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
      [ Doc -> Expression -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Invalid type" Expression
expectedType
      , Doc -> Expression -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"For" Expression
expr
      ]
    InvalidContract Address
addr -> Doc -> Address -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Invalid contract" Address
addr
    InconsistentTypes Expression
type1 Expression
type2 ->
      Doc -> MismatchError Expression -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Inconsistent types" (MismatchError Expression -> Doc)
-> MismatchError Expression -> Doc
forall a b. (a -> b) -> a -> b
$ Expression -> Expression -> MismatchError Expression
forall a. a -> a -> MismatchError a
MkMismatchError Expression
type1 Expression
type2
    InvalidPrimitive [Text]
expectedPrimitives Text
wrongPrimitive -> [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
      [ Doc -> Text -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Invalid primitive" Text
wrongPrimitive
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Expecting one of" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Text] -> Doc
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> t a -> Doc
fillSepF' Doc
"," [Text]
expectedPrimitives
      ]
    InvalidSyntacticConstantError Expression
expectedForm Expression
wrongExpression ->
      Doc -> MismatchError Expression -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Invalid syntatic constant error" (MismatchError Expression -> Doc)
-> MismatchError Expression -> Doc
forall a b. (a -> b) -> a -> b
$ MkMismatchError
        { meExpected :: Expression
meExpected = Expression
expectedForm, meActual :: Expression
meActual = Expression
wrongExpression }
    InvalidExpressionKind [Text]
expectedKinds Text
wrongKind ->
      Doc -> MismatchError Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Invalid expression kind" (MismatchError Doc -> Doc) -> MismatchError Doc -> Doc
forall a b. (a -> b) -> a -> b
$ MkMismatchError
        { meExpected :: Doc
meExpected = Doc -> [Text] -> Doc
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> t a -> Doc
fillSepF' Doc
"," [Text]
expectedKinds, meActual :: Doc
meActual = Text -> Doc
forall a. Buildable a => a -> Doc
build Text
wrongKind }
    InvalidContractNotation Text
notation -> Doc -> Text -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Invalid contract notation" Text
notation
    RunError
UnexpectedContract -> Text -> Doc
reflowF
      Text
"When parsing script, a contract type was found in \
      \the storage or parameter field."
    IllFormedType Expression
expr -> Doc -> Expression -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Ill formed type" Expression
expr
    RunError
UnexpectedOperation -> Text -> Doc
reflowF
      Text
"When parsing script, an operation type was found in \
      \the storage or parameter field"
    REEmptyTransaction ImplicitAddress
addr ->
      Text
"It's forbidden to send 0ꜩ to " Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| ImplicitAddress
addr ImplicitAddress -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
" that has no code"
    RunError
ScriptOverflow -> Text -> Doc
reflowF
      Text
"A contract failed due to the detection of an overflow"
    RunError
GasExhaustedOperation -> Text -> Doc
reflowF
      Text
"Contract failed due to gas exhaustion"
    MutezAdditionOverflow [TezosInt64]
amounts -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF
      (Text -> Doc
reflowF Text
"A contract failed due to mutez addition overflow when adding following values")
      (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [TezosInt64] -> Doc
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> t a -> Doc
fillSepF' Doc
"," [TezosInt64]
amounts
    MutezSubtractionUnderflow [TezosInt64]
amounts -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF
      (Text -> Doc
reflowF Text
"A contract failed due to mutez subtraction underflow when subtracting following values")
      (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [TezosInt64] -> Doc
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> t a -> Doc
fillSepF' Doc
"," [TezosInt64]
amounts
    MutezMultiplicationOverflow TezosInt64
amount TezosInt64
multiplicator ->
      Text
"A contract failed due to mutez multiplication overflow when multiplying" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++|
      TezosInt64
amount TezosInt64 -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"by" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| TezosInt64
multiplicator TezosInt64 -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""
    RunError
CantPayStorageFee -> Text -> Doc
reflowF
      Text
"Balance is too low to pay storage fee"
    BalanceTooLow (Name "balance" -> ("balance" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "balance"
#balance -> Mutez
balance) (Name "required" -> ("required" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "required"
#required -> Mutez
required) ->
      Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Balance is too low" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ forall k v f.
(Buildable k, Buildable v, IsList f, Item f ~ (k, v)) =>
f -> Doc
blockMapF @Text
        [ (Text
"current balance:", Mutez
balance)
        , (Text
"required balance:", Mutez
required)
        ]
    PreviouslyRevealedKey ImplicitAddress
addr -> Text
"Key for " Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| ImplicitAddress
addr ImplicitAddress -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
" has already been revealed"
    NonExistingContract Address
addr -> Doc -> Address -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Contract is not registered" Address
addr
    InvalidB58Check Text
input ->
      Text
"Failed to read a valid b58check_encoding data from" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
dquotes Text
input Text -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""
    UnregisteredDelegate ImplicitAddress
addr ->
      Text
"" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| ImplicitAddress
addr ImplicitAddress -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
" is not registered as delegate"
    FailedUnDelegation ImplicitAddress
addr ->
      Text
"Failed to withdraw delegation for" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| ImplicitAddress
addr ImplicitAddress -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""
    RunError
DelegateAlreadyActive -> Text -> Doc
reflowF Text
"Delegate already active"
    REEmptyImplicitContract ImplicitAddress
addr -> Doc -> ImplicitAddress -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Empty implicit contract" ImplicitAddress
addr
    IllTypedContract Expression
expr -> Doc -> Expression -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Ill typed contract" Expression
expr
    IllTypedData Expression
expected Expression
ill_typed ->
      Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Ill typed data" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ forall k v f.
(Buildable k, Buildable v, IsList f, Item f ~ (k, v)) =>
f -> Doc
blockMapF @Text
        [ (Text
"Expected type", Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
expected)
        , (Text
"Ill typed expression", Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
ill_typed)
        ]
    BadStack BadStackInformation
info -> BadStackInformation -> Doc
forall a. Buildable a => a -> Doc
build BadStackInformation
info
    RunError
ForbiddenZeroAmountTicket -> Doc
"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
$cshowsPrec :: Int -> InternalError -> ShowS
showsPrec :: Int -> InternalError -> ShowS
$cshow :: InternalError -> String
show :: InternalError -> String
$cshowList :: [InternalError] -> ShowS
showList :: [InternalError] -> ShowS
Show

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

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 a b. Parser a -> (a -> Parser b) -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            (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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            (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 a. String -> Parser a
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 a. String -> Parser a
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 a. a -> Parser a
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
$cshowsPrec :: Int -> AppliedResult -> ShowS
showsPrec :: Int -> AppliedResult -> ShowS
$cshow :: AppliedResult -> String
show :: AppliedResult -> String
$cshowList :: [AppliedResult] -> ShowS
showList :: [AppliedResult] -> ShowS
Show

instance Semigroup AppliedResult where
  <> :: AppliedResult -> AppliedResult -> AppliedResult
(<>) AppliedResult
ar1 AppliedResult
ar2 = 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{[ContractAddress]
TezosInt64
arConsumedMilliGas :: TezosInt64
arStorageSize :: TezosInt64
arPaidStorageDiff :: TezosInt64
arOriginatedContracts :: [ContractAddress]
arAllocatedDestinationContracts :: TezosInt64
arConsumedMilliGas :: TezosInt64
arStorageSize :: TezosInt64
arPaidStorageDiff :: TezosInt64
arOriginatedContracts :: [ContractAddress]
arAllocatedDestinationContracts :: 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 a. String -> Parser a
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
  } deriving stock ((forall x. ParametersInternal -> Rep ParametersInternal x)
-> (forall x. Rep ParametersInternal x -> ParametersInternal)
-> Generic ParametersInternal
forall x. Rep ParametersInternal x -> ParametersInternal
forall x. ParametersInternal -> Rep ParametersInternal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParametersInternal -> Rep ParametersInternal x
from :: forall x. ParametersInternal -> Rep ParametersInternal x
$cto :: forall x. Rep ParametersInternal x -> ParametersInternal
to :: forall x. Rep ParametersInternal x -> ParametersInternal
Generic, Int -> ParametersInternal -> ShowS
[ParametersInternal] -> ShowS
ParametersInternal -> String
(Int -> ParametersInternal -> ShowS)
-> (ParametersInternal -> String)
-> ([ParametersInternal] -> ShowS)
-> Show ParametersInternal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParametersInternal -> ShowS
showsPrec :: Int -> ParametersInternal -> ShowS
$cshow :: ParametersInternal -> String
show :: ParametersInternal -> String
$cshowList :: [ParametersInternal] -> ShowS
showList :: [ParametersInternal] -> ShowS
Show)
    deriving (Value -> Parser [ParametersInternal]
Value -> Parser ParametersInternal
(Value -> Parser ParametersInternal)
-> (Value -> Parser [ParametersInternal])
-> FromJSON ParametersInternal
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ParametersInternal
parseJSON :: Value -> Parser ParametersInternal
$cparseJSONList :: Value -> Parser [ParametersInternal]
parseJSONList :: Value -> Parser [ParametersInternal]
FromJSON, [ParametersInternal] -> Value
[ParametersInternal] -> Encoding
ParametersInternal -> Value
ParametersInternal -> Encoding
(ParametersInternal -> Value)
-> (ParametersInternal -> Encoding)
-> ([ParametersInternal] -> Value)
-> ([ParametersInternal] -> Encoding)
-> ToJSON ParametersInternal
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ParametersInternal -> Value
toJSON :: ParametersInternal -> Value
$ctoEncoding :: ParametersInternal -> Encoding
toEncoding :: ParametersInternal -> Encoding
$ctoJSONList :: [ParametersInternal] -> Value
toJSONList :: [ParametersInternal] -> Value
$ctoEncodingList :: [ParametersInternal] -> Encoding
toEncodingList :: [ParametersInternal] -> Encoding
ToJSON) via ClientJSON ParametersInternal

instance Buildable ParametersInternal where
  build :: ParametersInternal -> Doc
build ParametersInternal{Text
Expression
piEntrypoint :: ParametersInternal -> Text
piValue :: ParametersInternal -> Expression
piEntrypoint :: Text
piValue :: Expression
..} =
    Text
"entrypoint:" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| (Text -> Doc
forall a. Buildable a => a -> Doc
build Text
piEntrypoint Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
",") Doc -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"value:" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Expression
piValue Expression -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""

-- | '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
  { piEntrypoint :: Text
piEntrypoint = Text
"default"
  , piValue :: Expression
piValue = MichelinePrimAp RegularExp -> Expression
expressionPrim MichelinePrimAp
    { mpaPrim :: MichelinePrimitive
mpaPrim = MichelinePrimitive
Prim_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\lfloor \frac{\mathbf{hard\_gas\_limit\_per\_block}}
-- {num\_operations}\right\rfloor\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
ppOriginationSize :: ProtocolParameters -> Int
ppHardGasLimitPerOperation :: ProtocolParameters -> TezosInt64
ppHardStorageLimitPerOperation :: ProtocolParameters -> TezosInt64
ppMinimalBlockDelay :: ProtocolParameters -> TezosNat
ppCostPerByte :: ProtocolParameters -> TezosMutez
ppHardGasLimitPerBlock :: ProtocolParameters -> TezosInt64
ppOriginationSize :: Int
ppHardGasLimitPerOperation :: TezosInt64
ppHardStorageLimitPerOperation :: TezosInt64
ppMinimalBlockDelay :: TezosNat
ppCostPerByte :: TezosMutez
ppHardGasLimitPerBlock :: TezosInt64
..} "sender" :! ImplicitAddress
source "counter" :! TezosInt64
counter "num_operations" :? Int64
mNumOp =
  CommonOperationData
    { codSource :: ImplicitAddress
codSource = Name "sender" -> ("sender" :! ImplicitAddress) -> ImplicitAddress
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg 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 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 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 b. Integral b => Ratio Int64 -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (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
codSource :: CommonOperationData -> ImplicitAddress
codFee :: CommonOperationData -> TezosMutez
codCounter :: CommonOperationData -> TezosInt64
codGasLimit :: CommonOperationData -> TezosInt64
codStorageLimit :: CommonOperationData -> TezosInt64
codSource :: ImplicitAddress
codFee :: TezosMutez
codCounter :: TezosInt64
codGasLimit :: TezosInt64
codStorageLimit :: TezosInt64
..} = [Pair] -> Value
object
    [ Key
"source" Key -> ImplicitAddress -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ImplicitAddress
codSource
    , Key
"fee" Key -> TezosMutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TezosMutez
codFee
    , Key
"counter" Key -> TezosInt64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TezosInt64
codCounter
    , Key
"gas_limit" Key -> TezosInt64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TezosInt64
codGasLimit
    , Key
"storage_limit" Key -> TezosInt64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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
TezosInt64
TezosMutez
codSource :: ImplicitAddress
codFee :: TezosMutez
codCounter :: TezosInt64
codGasLimit :: TezosInt64
codStorageLimit :: TezosInt64
codSource :: ImplicitAddress
codFee :: TezosMutez
codCounter :: TezosInt64
codGasLimit :: TezosInt64
codStorageLimit :: TezosInt64
..}

-- | 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 a b. Parser (a -> b) -> Parser a -> Parser b
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

data WithSource a = WithSource
  { forall a. WithSource a -> Address
wsSource :: Address
  , forall a. WithSource a -> a
wsOtherData :: a
  } deriving stock (Int -> WithSource a -> ShowS
[WithSource a] -> ShowS
WithSource a -> String
(Int -> WithSource a -> ShowS)
-> (WithSource a -> String)
-> ([WithSource a] -> ShowS)
-> Show (WithSource a)
forall a. Show a => Int -> WithSource a -> ShowS
forall a. Show a => [WithSource a] -> ShowS
forall a. Show a => WithSource a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithSource a -> ShowS
showsPrec :: Int -> WithSource a -> ShowS
$cshow :: forall a. Show a => WithSource a -> String
show :: WithSource a -> String
$cshowList :: forall a. Show a => [WithSource a] -> ShowS
showList :: [WithSource a] -> ShowS
Show, (forall a b. (a -> b) -> WithSource a -> WithSource b)
-> (forall a b. a -> WithSource b -> WithSource a)
-> Functor WithSource
forall a b. a -> WithSource b -> WithSource a
forall a b. (a -> b) -> WithSource a -> WithSource b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithSource a -> WithSource b
fmap :: forall a b. (a -> b) -> WithSource a -> WithSource b
$c<$ :: forall a b. a -> WithSource b -> WithSource a
<$ :: forall a b. a -> WithSource b -> WithSource a
Functor)

instance FromJSON a => FromJSON (WithSource a) where
  parseJSON :: Value -> Parser (WithSource a)
parseJSON Value
v = Value
v Value -> (Value -> Parser (WithSource a)) -> Parser (WithSource a)
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser (WithSource a))
-> Value
-> Parser (WithSource a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WithSource" \Object
o ->
    Address -> a -> WithSource a
forall a. Address -> a -> WithSource a
WithSource (Address -> a -> WithSource a)
-> Parser Address -> Parser (a -> WithSource a)
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
"source") Parser (a -> WithSource a) -> Parser a -> Parser (WithSource a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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

instance Buildable a => Buildable (WithSource a) where
  build :: WithSource a -> Doc
build WithSource{a
Address
wsSource :: forall a. WithSource a -> Address
wsOtherData :: forall a. WithSource a -> a
wsSource :: Address
wsOtherData :: a
..} = Text
"" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| (a -> Doc
forall a. Buildable a => a -> Doc
build a
wsOtherData Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
",") Doc -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"and source" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Address
wsSource Address -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""

-- | 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
  } deriving stock Int -> TransactionOperation -> ShowS
[TransactionOperation] -> ShowS
TransactionOperation -> String
(Int -> TransactionOperation -> ShowS)
-> (TransactionOperation -> String)
-> ([TransactionOperation] -> ShowS)
-> Show TransactionOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransactionOperation -> ShowS
showsPrec :: Int -> TransactionOperation -> ShowS
$cshow :: TransactionOperation -> String
show :: TransactionOperation -> String
$cshowList :: [TransactionOperation] -> ShowS
showList :: [TransactionOperation] -> ShowS
Show

instance Buildable TransactionOperation where
  build :: TransactionOperation -> Doc
build TransactionOperation{Address
TezosMutez
ParametersInternal
toAmount :: TransactionOperation -> TezosMutez
toDestination :: TransactionOperation -> Address
toParameters :: TransactionOperation -> ParametersInternal
toAmount :: TezosMutez
toDestination :: Address
toParameters :: ParametersInternal
..} = Doc -> [(Text, Doc)] -> Doc
enumerateF' Doc
","
    [ (Text
"Transaction with amount:", Mutez -> Doc
forall a. Buildable a => a -> Doc
build (Mutez -> Doc) -> Mutez -> Doc
forall a b. (a -> b) -> a -> b
$ TezosMutez -> Mutez
unTezosMutez TezosMutez
toAmount)
    , (Text
"destination:", Address -> Doc
forall a. Buildable a => a -> Doc
build Address
toDestination)
    , (Text
"and parameter:", ParametersInternal -> Doc
forall a. Buildable a => a -> Doc
build ParametersInternal
toParameters)
    ]

data TransferTicketOperation = TransferTicketOperation
  { TransferTicketOperation -> Expression
ttoTicketContents :: Expression
  , TransferTicketOperation -> Expression
ttoTicketTy :: Expression
  , TransferTicketOperation -> Address
ttoTicketTicketer :: Address
  , TransferTicketOperation -> TezosNat
ttoTicketAmount :: TezosNat
  , TransferTicketOperation -> Address
ttoDestination :: Address
  , TransferTicketOperation -> Text
ttoEntrypoint :: Text
  } deriving stock (Int -> TransferTicketOperation -> ShowS
[TransferTicketOperation] -> ShowS
TransferTicketOperation -> String
(Int -> TransferTicketOperation -> ShowS)
-> (TransferTicketOperation -> String)
-> ([TransferTicketOperation] -> ShowS)
-> Show TransferTicketOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransferTicketOperation -> ShowS
showsPrec :: Int -> TransferTicketOperation -> ShowS
$cshow :: TransferTicketOperation -> String
show :: TransferTicketOperation -> String
$cshowList :: [TransferTicketOperation] -> ShowS
showList :: [TransferTicketOperation] -> ShowS
Show)

instance Buildable TransferTicketOperation where
  build :: TransferTicketOperation -> Doc
build TransferTicketOperation{Text
Address
Expression
TezosNat
ttoTicketContents :: TransferTicketOperation -> Expression
ttoTicketTy :: TransferTicketOperation -> Expression
ttoTicketTicketer :: TransferTicketOperation -> Address
ttoTicketAmount :: TransferTicketOperation -> TezosNat
ttoDestination :: TransferTicketOperation -> Address
ttoEntrypoint :: TransferTicketOperation -> Text
ttoTicketContents :: Expression
ttoTicketTy :: Expression
ttoTicketTicketer :: Address
ttoTicketAmount :: TezosNat
ttoDestination :: Address
ttoEntrypoint :: Text
..} =
    Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Transfer ticket with" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF
      [ Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Contents" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
ttoTicketContents
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Type" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
ttoTicketTy
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Ticketer" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Address -> Doc
forall a. Buildable a => a -> Doc
build Address
ttoTicketTicketer
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Amount" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ TezosNat -> Doc
forall a. Buildable a => a -> Doc
build TezosNat
ttoTicketAmount
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Destination" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Address -> Doc
forall a. Buildable a => a -> Doc
build Address
ttoDestination
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Entrypoint" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
forall a. Buildable a => a -> Doc
build Text
ttoEntrypoint
      ]

data OriginationScript = OriginationScript
  { OriginationScript -> Expression
osCode :: Expression
  , OriginationScript -> Expression
osStorage :: Expression
  } deriving stock ((forall x. OriginationScript -> Rep OriginationScript x)
-> (forall x. Rep OriginationScript x -> OriginationScript)
-> Generic OriginationScript
forall x. Rep OriginationScript x -> OriginationScript
forall x. OriginationScript -> Rep OriginationScript x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OriginationScript -> Rep OriginationScript x
from :: forall x. OriginationScript -> Rep OriginationScript x
$cto :: forall x. Rep OriginationScript x -> OriginationScript
to :: forall x. Rep OriginationScript x -> OriginationScript
Generic, Int -> OriginationScript -> ShowS
[OriginationScript] -> ShowS
OriginationScript -> String
(Int -> OriginationScript -> ShowS)
-> (OriginationScript -> String)
-> ([OriginationScript] -> ShowS)
-> Show OriginationScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OriginationScript -> ShowS
showsPrec :: Int -> OriginationScript -> ShowS
$cshow :: OriginationScript -> String
show :: OriginationScript -> String
$cshowList :: [OriginationScript] -> ShowS
showList :: [OriginationScript] -> ShowS
Show)
    deriving (Value -> Parser [OriginationScript]
Value -> Parser OriginationScript
(Value -> Parser OriginationScript)
-> (Value -> Parser [OriginationScript])
-> FromJSON OriginationScript
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OriginationScript
parseJSON :: Value -> Parser OriginationScript
$cparseJSONList :: Value -> Parser [OriginationScript]
parseJSONList :: Value -> Parser [OriginationScript]
FromJSON, [OriginationScript] -> Value
[OriginationScript] -> Encoding
OriginationScript -> Value
OriginationScript -> Encoding
(OriginationScript -> Value)
-> (OriginationScript -> Encoding)
-> ([OriginationScript] -> Value)
-> ([OriginationScript] -> Encoding)
-> ToJSON OriginationScript
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OriginationScript -> Value
toJSON :: OriginationScript -> Value
$ctoEncoding :: OriginationScript -> Encoding
toEncoding :: OriginationScript -> Encoding
$ctoJSONList :: [OriginationScript] -> Value
toJSONList :: [OriginationScript] -> Value
$ctoEncodingList :: [OriginationScript] -> Encoding
toEncodingList :: [OriginationScript] -> Encoding
ToJSON) via ClientJSON OriginationScript

-- | 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
  } deriving stock ((forall x. OriginationOperation -> Rep OriginationOperation x)
-> (forall x. Rep OriginationOperation x -> OriginationOperation)
-> Generic OriginationOperation
forall x. Rep OriginationOperation x -> OriginationOperation
forall x. OriginationOperation -> Rep OriginationOperation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OriginationOperation -> Rep OriginationOperation x
from :: forall x. OriginationOperation -> Rep OriginationOperation x
$cto :: forall x. Rep OriginationOperation x -> OriginationOperation
to :: forall x. Rep OriginationOperation x -> OriginationOperation
Generic, Int -> OriginationOperation -> ShowS
[OriginationOperation] -> ShowS
OriginationOperation -> String
(Int -> OriginationOperation -> ShowS)
-> (OriginationOperation -> String)
-> ([OriginationOperation] -> ShowS)
-> Show OriginationOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OriginationOperation -> ShowS
showsPrec :: Int -> OriginationOperation -> ShowS
$cshow :: OriginationOperation -> String
show :: OriginationOperation -> String
$cshowList :: [OriginationOperation] -> ShowS
showList :: [OriginationOperation] -> ShowS
Show)
    deriving (Value -> Parser [OriginationOperation]
Value -> Parser OriginationOperation
(Value -> Parser OriginationOperation)
-> (Value -> Parser [OriginationOperation])
-> FromJSON OriginationOperation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OriginationOperation
parseJSON :: Value -> Parser OriginationOperation
$cparseJSONList :: Value -> Parser [OriginationOperation]
parseJSONList :: Value -> Parser [OriginationOperation]
FromJSON) via ClientJSON OriginationOperation
    deriving anyclass ToJSON OriginationOperation
ToJSON OriginationOperation -> ToJSONObject OriginationOperation
forall a. ToJSON a -> ToJSONObject a
ToJSONObject

instance Buildable OriginationOperation where
  build :: OriginationOperation -> Doc
build OriginationOperation{Maybe KeyHash
TezosMutez
OriginationScript
ooBalance :: OriginationOperation -> TezosMutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooScript :: OriginationOperation -> OriginationScript
ooBalance :: TezosMutez
ooDelegate :: Maybe KeyHash
ooScript :: OriginationScript
..} =
    Text
"Origination operation with balance " Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| (Mutez -> Doc
forall a. Buildable a => a -> Doc
build (TezosMutez -> Mutez
unTezosMutez TezosMutez
ooBalance) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
",")
      Doc -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"delegate" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Maybe KeyHash
ooDelegate Maybe KeyHash -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""

instance ToJSON OriginationOperation where
  toJSON :: OriginationOperation -> Value
toJSON OriginationOperation{Maybe KeyHash
TezosMutez
OriginationScript
ooBalance :: OriginationOperation -> TezosMutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooScript :: OriginationOperation -> OriginationScript
ooBalance :: TezosMutez
ooDelegate :: Maybe KeyHash
ooScript :: OriginationScript
..} = [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
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"origination"
    , Key
"balance" Key -> TezosMutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TezosMutez
ooBalance
    , Key
"script" Key -> OriginationScript -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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
forall v. ToJSON v => Key -> v -> Pair
.=) (KeyHash -> Pair) -> Maybe KeyHash -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe KeyHash
ooDelegate)

-- | All the data needed to perform key revealing
-- through Tezos RPC interface
data RevealOperation = RevealOperation
  { RevealOperation -> PublicKey
roPublicKey :: PublicKey
  } deriving stock ((forall x. RevealOperation -> Rep RevealOperation x)
-> (forall x. Rep RevealOperation x -> RevealOperation)
-> Generic RevealOperation
forall x. Rep RevealOperation x -> RevealOperation
forall x. RevealOperation -> Rep RevealOperation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RevealOperation -> Rep RevealOperation x
from :: forall x. RevealOperation -> Rep RevealOperation x
$cto :: forall x. Rep RevealOperation x -> RevealOperation
to :: forall x. Rep RevealOperation x -> RevealOperation
Generic, Int -> RevealOperation -> ShowS
[RevealOperation] -> ShowS
RevealOperation -> String
(Int -> RevealOperation -> ShowS)
-> (RevealOperation -> String)
-> ([RevealOperation] -> ShowS)
-> Show RevealOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevealOperation -> ShowS
showsPrec :: Int -> RevealOperation -> ShowS
$cshow :: RevealOperation -> String
show :: RevealOperation -> String
$cshowList :: [RevealOperation] -> ShowS
showList :: [RevealOperation] -> ShowS
Show)
    deriving anyclass ToJSON RevealOperation
ToJSON RevealOperation -> ToJSONObject RevealOperation
forall a. ToJSON a -> ToJSONObject a
ToJSONObject
    deriving Value -> Parser [RevealOperation]
Value -> Parser RevealOperation
(Value -> Parser RevealOperation)
-> (Value -> Parser [RevealOperation]) -> FromJSON RevealOperation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RevealOperation
parseJSON :: Value -> Parser RevealOperation
$cparseJSONList :: Value -> Parser [RevealOperation]
parseJSONList :: Value -> Parser [RevealOperation]
FromJSON via ClientJSON RevealOperation

instance ToJSON RevealOperation where
  toJSON :: RevealOperation -> Value
toJSON RevealOperation{PublicKey
roPublicKey :: RevealOperation -> PublicKey
roPublicKey :: 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
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"reveal"
    , Key
"public_key" Key -> PublicKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PublicKey
roPublicKey
    ]

instance Buildable RevealOperation where
  build :: RevealOperation -> Doc
build (RevealOperation PublicKey
pk) = Text
"Reveal operation for public key" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| PublicKey
pk PublicKey -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""

data DelegationOperation = DelegationOperation
  { DelegationOperation -> Maybe KeyHash
doDelegate :: Maybe KeyHash
    -- ^ 'Nothing' removes delegate, 'Just' sets it
  } deriving stock ((forall x. DelegationOperation -> Rep DelegationOperation x)
-> (forall x. Rep DelegationOperation x -> DelegationOperation)
-> Generic DelegationOperation
forall x. Rep DelegationOperation x -> DelegationOperation
forall x. DelegationOperation -> Rep DelegationOperation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DelegationOperation -> Rep DelegationOperation x
from :: forall x. DelegationOperation -> Rep DelegationOperation x
$cto :: forall x. Rep DelegationOperation x -> DelegationOperation
to :: forall x. Rep DelegationOperation x -> DelegationOperation
Generic, Int -> DelegationOperation -> ShowS
[DelegationOperation] -> ShowS
DelegationOperation -> String
(Int -> DelegationOperation -> ShowS)
-> (DelegationOperation -> String)
-> ([DelegationOperation] -> ShowS)
-> Show DelegationOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DelegationOperation -> ShowS
showsPrec :: Int -> DelegationOperation -> ShowS
$cshow :: DelegationOperation -> String
show :: DelegationOperation -> String
$cshowList :: [DelegationOperation] -> ShowS
showList :: [DelegationOperation] -> ShowS
Show)
    deriving Value -> Parser [DelegationOperation]
Value -> Parser DelegationOperation
(Value -> Parser DelegationOperation)
-> (Value -> Parser [DelegationOperation])
-> FromJSON DelegationOperation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DelegationOperation
parseJSON :: Value -> Parser DelegationOperation
$cparseJSONList :: Value -> Parser [DelegationOperation]
parseJSONList :: Value -> Parser [DelegationOperation]
FromJSON via ClientJSON DelegationOperation
    deriving anyclass ToJSON DelegationOperation
ToJSON DelegationOperation -> ToJSONObject DelegationOperation
forall a. ToJSON a -> ToJSONObject a
ToJSONObject

instance ToJSON DelegationOperation where
  toJSON :: DelegationOperation -> Value
toJSON DelegationOperation{Maybe KeyHash
doDelegate :: DelegationOperation -> Maybe KeyHash
doDelegate :: 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
forall v. ToJSON v => Key -> v -> Pair
.= 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
forall v. ToJSON v => Key -> v -> Pair
.=) (KeyHash -> Pair) -> Maybe KeyHash -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe KeyHash
doDelegate)

instance Buildable DelegationOperation where
  build :: DelegationOperation -> Doc
build DelegationOperation{Maybe KeyHash
doDelegate :: DelegationOperation -> Maybe KeyHash
doDelegate :: Maybe KeyHash
..} = case Maybe KeyHash
doDelegate of
    Maybe KeyHash
Nothing -> Text -> Doc
reflowF Text
"Delegation operation removing delegate"
    Just KeyHash
kh -> Text
"Delegation operation setting delegate to" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| KeyHash
kh KeyHash -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""

data EventOperation = EventOperation
  { EventOperation -> Expression
eoType :: Expression
  , EventOperation -> Maybe MText
eoTag :: Maybe MText
  , EventOperation -> Maybe Expression
eoPayload :: Maybe Expression
  } deriving stock ((forall x. EventOperation -> Rep EventOperation x)
-> (forall x. Rep EventOperation x -> EventOperation)
-> Generic EventOperation
forall x. Rep EventOperation x -> EventOperation
forall x. EventOperation -> Rep EventOperation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EventOperation -> Rep EventOperation x
from :: forall x. EventOperation -> Rep EventOperation x
$cto :: forall x. Rep EventOperation x -> EventOperation
to :: forall x. Rep EventOperation x -> EventOperation
Generic, Int -> EventOperation -> ShowS
[EventOperation] -> ShowS
EventOperation -> String
(Int -> EventOperation -> ShowS)
-> (EventOperation -> String)
-> ([EventOperation] -> ShowS)
-> Show EventOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventOperation -> ShowS
showsPrec :: Int -> EventOperation -> ShowS
$cshow :: EventOperation -> String
show :: EventOperation -> String
$cshowList :: [EventOperation] -> ShowS
showList :: [EventOperation] -> ShowS
Show)
    deriving anyclass ToJSON EventOperation
ToJSON EventOperation -> ToJSONObject EventOperation
forall a. ToJSON a -> ToJSONObject a
ToJSONObject
    deriving ([EventOperation] -> Value
[EventOperation] -> Encoding
EventOperation -> Value
EventOperation -> Encoding
(EventOperation -> Value)
-> (EventOperation -> Encoding)
-> ([EventOperation] -> Value)
-> ([EventOperation] -> Encoding)
-> ToJSON EventOperation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EventOperation -> Value
toJSON :: EventOperation -> Value
$ctoEncoding :: EventOperation -> Encoding
toEncoding :: EventOperation -> Encoding
$ctoJSONList :: [EventOperation] -> Value
toJSONList :: [EventOperation] -> Value
$ctoEncodingList :: [EventOperation] -> Encoding
toEncodingList :: [EventOperation] -> Encoding
ToJSON, Value -> Parser [EventOperation]
Value -> Parser EventOperation
(Value -> Parser EventOperation)
-> (Value -> Parser [EventOperation]) -> FromJSON EventOperation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EventOperation
parseJSON :: Value -> Parser EventOperation
$cparseJSONList :: Value -> Parser [EventOperation]
parseJSONList :: Value -> Parser [EventOperation]
FromJSON) via ClientJSON EventOperation

instance Buildable EventOperation where
  build :: EventOperation -> Doc
build EventOperation{Maybe MText
Maybe Expression
Expression
eoType :: EventOperation -> Expression
eoTag :: EventOperation -> Maybe MText
eoPayload :: EventOperation -> Maybe Expression
eoType :: Expression
eoTag :: Maybe MText
eoPayload :: Maybe Expression
..} = Doc -> [(Text, Doc)] -> Doc
enumerateF' Doc
","
    [ (Text
"Contract event with tag:", Maybe MText -> Doc
forall a. Buildable a => a -> Doc
build Maybe MText
eoTag)
    , (Text
"type:", Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
eoType)
    , (Text
"and payload:", Maybe Expression -> Doc
forall a. Buildable a => a -> Doc
build Maybe Expression
eoPayload)
    ]

-- | @$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 f
  = TransactionOpResp (f TransactionOperation)
  -- ^ Operation with kind @transaction@.
  | TransferTicketOpResp (f TransferTicketOperation)
  -- ^ Operation with kind @transfer_ticket@.
  | OriginationOpResp (f OriginationOperation)
  -- ^ Operation with kind @origination@.
  | DelegationOpResp (f DelegationOperation)
  -- ^ Operation with kind @delegation@.
  | RevealOpResp (f RevealOperation)
  -- ^ Operation with kind @reveal@.
  | EventOpResp (f EventOperation)
  -- ^ Operation with kind @event@.
  | OtherOpResp Text
  -- ^ Response we don't handle yet.

deriving stock instance (forall a. Show a => Show (f a)) => Show (OperationResp f)

instance (forall a. Buildable a => Buildable (f a)) => Buildable (OperationResp f) where
  build :: OperationResp f -> Doc
build = \case
    TransactionOpResp f TransactionOperation
x -> f TransactionOperation -> Doc
forall a. Buildable a => a -> Doc
build f TransactionOperation
x
    TransferTicketOpResp f TransferTicketOperation
x -> f TransferTicketOperation -> Doc
forall a. Buildable a => a -> Doc
build f TransferTicketOperation
x
    OriginationOpResp f OriginationOperation
x -> f OriginationOperation -> Doc
forall a. Buildable a => a -> Doc
build f OriginationOperation
x
    DelegationOpResp f DelegationOperation
x -> f DelegationOperation -> Doc
forall a. Buildable a => a -> Doc
build f DelegationOperation
x
    RevealOpResp f RevealOperation
x -> f RevealOperation -> Doc
forall a. Buildable a => a -> Doc
build f RevealOperation
x
    EventOpResp f EventOperation
x -> f EventOperation -> Doc
forall a. Buildable a => a -> Doc
build f EventOperation
x
    OtherOpResp Text
x -> Doc
"Unsupported operation kind: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
forall a. Buildable a => a -> Doc
build Text
x

data OperationRespWithMeta = OperationRespWithMeta
  { OperationRespWithMeta -> OperationResp WithCommonOperationData
orwmResponse :: OperationResp WithCommonOperationData
  , 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
  }

data GetTicketBalance = GetTicketBalance
  { GetTicketBalance -> ContractAddress
gtbTicketer :: ContractAddress
  , GetTicketBalance -> Expression
gtbContentType :: Expression
  , GetTicketBalance -> Expression
gtbContent :: Expression
  }

data GetAllTicketBalancesResponse = GetAllTicketBalancesResponse
  { GetAllTicketBalancesResponse -> ContractAddress
gatbrTicketer :: ContractAddress
  , GetAllTicketBalancesResponse -> Expression
gatbrContentType :: Expression
  , GetAllTicketBalancesResponse -> Expression
gatbrContent :: Expression
  , GetAllTicketBalancesResponse -> TezosNat
gatbrAmount :: TezosNat
  }

-- | 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

instance ToJSON TransactionOperation where
  toJSON :: TransactionOperation -> Value
toJSON TransactionOperation{Address
TezosMutez
ParametersInternal
toAmount :: TransactionOperation -> TezosMutez
toDestination :: TransactionOperation -> Address
toParameters :: TransactionOperation -> ParametersInternal
toAmount :: TezosMutez
toDestination :: Address
toParameters :: ParametersInternal
..} = [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
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"transaction"
    , Key
"amount" Key -> TezosMutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TezosMutez
toAmount
    , Key
"destination" Key -> Address -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Address
toDestination
    , Key
"parameters" Key -> ParametersInternal -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ParametersInternal
toParameters
    ]
instance ToJSONObject TransactionOperation

instance ToJSON TransferTicketOperation where
  toJSON :: TransferTicketOperation -> Value
toJSON TransferTicketOperation{Text
Address
Expression
TezosNat
ttoTicketContents :: TransferTicketOperation -> Expression
ttoTicketTy :: TransferTicketOperation -> Expression
ttoTicketTicketer :: TransferTicketOperation -> Address
ttoTicketAmount :: TransferTicketOperation -> TezosNat
ttoDestination :: TransferTicketOperation -> Address
ttoEntrypoint :: TransferTicketOperation -> Text
ttoTicketContents :: Expression
ttoTicketTy :: Expression
ttoTicketTicketer :: Address
ttoTicketAmount :: TezosNat
ttoDestination :: Address
ttoEntrypoint :: Text
..} = [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
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"transfer_ticket"
    , Key
"ticket_contents" Key -> Expression -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Expression
ttoTicketContents
    , Key
"ticket_ty"       Key -> Expression -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Expression
ttoTicketTy
    , Key
"ticket_ticketer" Key -> Address -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Address
ttoTicketTicketer
    , Key
"ticket_amount"   Key -> TezosNat -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TezosNat
ttoTicketAmount
    , Key
"destination"     Key -> Address -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Address
ttoDestination
    , Key
"entrypoint"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
ttoEntrypoint
    ]
instance ToJSONObject TransferTicketOperation

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 {Address
TezosMutez
ParametersInternal
toAmount :: TezosMutez
toDestination :: Address
toParameters :: ParametersInternal
toAmount :: TezosMutez
toDestination :: Address
toParameters :: ParametersInternal
..}

instance (forall a. FromJSON a => FromJSON (f a)) => FromJSON (OperationResp f) where
  parseJSON :: Value -> Parser (OperationResp f)
parseJSON Value
json = Value
json Value
-> (Value -> Parser (OperationResp f)) -> Parser (OperationResp f)
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser (OperationResp f))
-> Value
-> Parser (OperationResp f)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OperationResp" \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" -> f TransactionOperation -> OperationResp f
forall (f :: * -> *). f TransactionOperation -> OperationResp f
TransactionOpResp (f TransactionOperation -> OperationResp f)
-> Parser (f TransactionOperation) -> Parser (OperationResp f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (f TransactionOperation)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json
      Text
"origination" -> f OriginationOperation -> OperationResp f
forall (f :: * -> *). f OriginationOperation -> OperationResp f
OriginationOpResp (f OriginationOperation -> OperationResp f)
-> Parser (f OriginationOperation) -> Parser (OperationResp f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (f OriginationOperation)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json
      Text
"delegation"  -> f DelegationOperation -> OperationResp f
forall (f :: * -> *). f DelegationOperation -> OperationResp f
DelegationOpResp (f DelegationOperation -> OperationResp f)
-> Parser (f DelegationOperation) -> Parser (OperationResp f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (f DelegationOperation)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json
      Text
"event"  -> f EventOperation -> OperationResp f
forall (f :: * -> *). f EventOperation -> OperationResp f
EventOpResp (f EventOperation -> OperationResp f)
-> Parser (f EventOperation) -> Parser (OperationResp f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (f EventOperation)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json
      Text
x -> OperationResp f -> Parser (OperationResp f)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationResp f -> Parser (OperationResp f))
-> OperationResp f -> Parser (OperationResp f)
forall a b. (a -> b) -> a -> b
$ Text -> OperationResp f
forall (f :: * -> *). Text -> OperationResp f
OtherOpResp Text
x

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 WithCommonOperationData
-> Maybe OperationMetadata -> OperationRespWithMeta
OperationRespWithMeta (OperationResp WithCommonOperationData
 -> Maybe OperationMetadata -> OperationRespWithMeta)
-> Parser (OperationResp WithCommonOperationData)
-> Parser (Maybe OperationMetadata -> OperationRespWithMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (OperationResp WithCommonOperationData)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj) Parser (Maybe OperationMetadata -> OperationRespWithMeta)
-> Parser (Maybe OperationMetadata) -> Parser OperationRespWithMeta
forall a b. Parser (a -> b) -> Parser a -> Parser b
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"

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

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

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

data PackData = PackData
  { PackData -> Expression
pdData :: Expression
  , PackData -> Expression
pdType :: Expression
  , PackData -> Maybe TezosBigNum
pdGas :: Maybe TezosBigNum
  }

instance Buildable PackData where
  build :: PackData -> Doc
build PackData{Maybe TezosBigNum
Expression
pdData :: PackData -> Expression
pdType :: PackData -> Expression
pdGas :: PackData -> Maybe TezosBigNum
pdData :: Expression
pdType :: Expression
pdGas :: Maybe TezosBigNum
..} = Doc -> [(Text, Doc)] -> Doc
enumerateF' Doc
"," ([(Text, Doc)] -> Doc) -> [(Text, Doc)] -> Doc
forall a b. (a -> b) -> a -> b
$
    [ (Text
"Pack data request with data:", Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
pdData)
    , (Text
"type:", Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
pdType)
    ] [(Text, Doc)] -> [(Text, Doc)] -> [(Text, Doc)]
forall a. Semigroup a => a -> a -> a
<> Maybe (Text, Doc) -> [(Text, Doc)]
forall a. Maybe a -> [a]
maybeToList ((Text
"gas:",) (Doc -> (Text, Doc))
-> (TezosBigNum -> Doc) -> TezosBigNum -> (Text, Doc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc
forall a. Buildable a => a -> Doc
build (Integer -> Doc) -> (TezosBigNum -> Integer) -> TezosBigNum -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TezosBigNum -> Integer
forall a. StringEncode a -> a
unStringEncode (TezosBigNum -> (Text, Doc))
-> Maybe TezosBigNum -> Maybe (Text, Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TezosBigNum
pdGas)

data PackDataResult = PackDataResult
  { PackDataResult -> Text
pdrPacked :: Text
  , PackDataResult -> PackDataResultGas
pdrGas :: PackDataResultGas
  }

newtype PackDataResultGas = PackDataResultGas (Maybe TezosBigNum)

instance FromJSON PackDataResultGas where
  parseJSON :: Value -> Parser PackDataResultGas
parseJSON Value
o = Value
o Value
-> (Value -> Parser PackDataResultGas) -> Parser PackDataResultGas
forall a b. a -> (a -> b) -> b
& String
-> (Text -> Parser PackDataResultGas)
-> Value
-> Parser PackDataResultGas
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PackDataResultGas" \case
    Text
"unaccounted" -> PackDataResultGas -> Parser PackDataResultGas
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackDataResultGas -> Parser PackDataResultGas)
-> PackDataResultGas -> Parser PackDataResultGas
forall a b. (a -> b) -> a -> b
$ Maybe TezosBigNum -> PackDataResultGas
PackDataResultGas Maybe TezosBigNum
forall a. Maybe a
Nothing
    Text
_ -> Maybe TezosBigNum -> PackDataResultGas
PackDataResultGas (Maybe TezosBigNum -> PackDataResultGas)
-> (TezosBigNum -> Maybe TezosBigNum)
-> TezosBigNum
-> PackDataResultGas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TezosBigNum -> Maybe TezosBigNum
forall a. a -> Maybe a
Just (TezosBigNum -> PackDataResultGas)
-> Parser TezosBigNum -> Parser PackDataResultGas
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TezosBigNum
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o

instance Buildable PackDataResultGas where
  build :: PackDataResultGas -> Doc
build (PackDataResultGas Maybe TezosBigNum
x) = Doc -> (TezosBigNum -> Doc) -> Maybe TezosBigNum -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"unaccounted" (Integer -> Doc
forall a. Buildable a => a -> Doc
build (Integer -> Doc) -> (TezosBigNum -> Integer) -> TezosBigNum -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TezosBigNum -> Integer
forall a. StringEncode a -> a
unStringEncode) Maybe TezosBigNum
x

instance Buildable PackDataResult where
  build :: PackDataResult -> Doc
build PackDataResult{Text
PackDataResultGas
pdrPacked :: PackDataResult -> Text
pdrGas :: PackDataResult -> PackDataResultGas
pdrPacked :: Text
pdrGas :: PackDataResultGas
..} = Doc -> [(Text, Doc)] -> Doc
enumerateF' Doc
","
    [ (Text
"Pack data response packed data:", Text -> Doc
forall a. Buildable a => a -> Doc
build Text
pdrPacked)
    , (Text
"gas:", PackDataResultGas -> Doc
forall a. Buildable a => a -> Doc
build PackDataResultGas
pdrGas)
    ]

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

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 (f :: * -> *).
Functor f =>
(CommonOperationData -> f CommonOperationData)
-> WithCommonOperationData a -> f (WithCommonOperationData a)
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