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

-- | This module contains various types which are used in
-- tezos-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 (..)
  , ForgeOperation (..)
  , GetBigMap (..)
  , GetBigMapResult (..)
  , InternalOperation (..)
  , OperationContent (..)
  , OperationHash (..)
  , OperationInput (..)
  , OperationResp (..)
  , OperationResult (..)
  , OriginationOperation (..)
  , OriginationScript (..)
  , ParametersInternal (..)
  , PreApplyOperation (..)
  , ProtocolParameters (..)
  , RevealOperation (..)
  , RunCode (..)
  , RunCodeResult (..)
  , RunMetadata (..)
  , RunOperation (..)
  , RunOperationInternal (..)
  , RunOperationResult (..)
  , RPCInput
  , TransactionOperation (..)
  , combineResults
  , mkCommonOperationData

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

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

  -- * Lenses
  , oiCommonDataL
  ) where

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

import Data.Aeson.Types (Parser)
import Morley.Client.RPC.Aeson (morleyClientAesonOptions)
import Morley.Client.Types
import Morley.Micheline
  (Expression(..), MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64,
  TezosMutez(..), TezosNat)
import Morley.Tezos.Address (Address)
import Morley.Tezos.Core (Mutez, tz, zeroMutez)
import Morley.Tezos.Crypto (PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature)
import Morley.Util.CLI (HasCLReader(..), eitherReader)
import Morley.Util.Named (arg, pattern (:!), (:!), (<:!>))
import Morley.Util.Text (dquotes)

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

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

instance ToJSON (OperationInfo RPCInput) where
  toJSON :: OperationInfo RPCInput -> Value
toJSON = \case
    OpTransfer TransferInfo RPCInput
op -> TransactionOperation -> Value
forall a. ToJSON a => a -> Value
toJSON TransferInfo RPCInput
TransactionOperation
op
    OpOriginate OriginationInfo RPCInput
op -> OriginationOperation -> Value
forall a. ToJSON a => a -> Value
toJSON OriginationInfo RPCInput
OriginationOperation
op
    OpReveal RevealInfo RPCInput
op -> RevealOperation -> Value
forall a. ToJSON a => a -> Value
toJSON RevealInfo RPCInput
RevealOperation
op

data OperationInput = OperationInput
  { OperationInput -> CommonOperationData
oiCommonData :: CommonOperationData
  , OperationInput -> OperationInfo RPCInput
oiCustom :: OperationInfo RPCInput
  }

instance ToJSON OperationInput where
  toJSON :: OperationInput -> Value
toJSON OperationInput{OperationInfo RPCInput
CommonOperationData
oiCustom :: OperationInfo RPCInput
oiCommonData :: CommonOperationData
oiCustom :: OperationInput -> OperationInfo RPCInput
oiCommonData :: OperationInput -> CommonOperationData
..} =
    CommonOperationData -> Value
forall a. ToJSON a => a -> Value
toJSON CommonOperationData
oiCommonData HasCallStack => Value -> Value -> Value
Value -> Value -> Value
`mergeObjects` OperationInfo RPCInput -> Value
forall a. ToJSON a => a -> Value
toJSON OperationInfo RPCInput
oiCustom

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

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

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

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

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

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

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

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 -> Text -> Parser (NonEmpty OperationContent)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contents"

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

data OperationContent = OperationContent RunMetadata

instance FromJSON OperationContent where
  parseJSON :: Value -> Parser OperationContent
parseJSON = String
-> (Object -> Parser OperationContent)
-> Value
-> Parser OperationContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"operationCostContent" ((Object -> Parser OperationContent)
 -> Value -> Parser OperationContent)
-> (Object -> Parser OperationContent)
-> Value
-> Parser OperationContent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    RunMetadata -> OperationContent
OperationContent (RunMetadata -> OperationContent)
-> Parser RunMetadata -> Parser OperationContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RunMetadata
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser OperationResult
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"operation_result" Parser ([InternalOperation] -> RunMetadata)
-> Parser [InternalOperation] -> Parser RunMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Text -> Parser (Maybe [InternalOperation])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"internal_operation_results" Parser (Maybe [InternalOperation])
-> [InternalOperation] -> Parser [InternalOperation]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

newtype InternalOperation = InternalOperation
  { InternalOperation -> OperationResult
unInternalOperation :: OperationResult }

instance FromJSON InternalOperation where
  parseJSON :: Value -> Parser InternalOperation
parseJSON = String
-> (Object -> Parser InternalOperation)
-> Value
-> Parser InternalOperation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"internal_operation" ((Object -> Parser InternalOperation)
 -> Value -> Parser InternalOperation)
-> (Object -> Parser InternalOperation)
-> Value
-> Parser InternalOperation
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OperationResult -> InternalOperation
InternalOperation (OperationResult -> InternalOperation)
-> Parser OperationResult -> Parser InternalOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser OperationResult
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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] -> Encoding
[BlockHash] -> Value
BlockHash -> Encoding
BlockHash -> Value
(BlockHash -> Value)
-> (BlockHash -> Encoding)
-> ([BlockHash] -> Value)
-> ([BlockHash] -> Encoding)
-> ToJSON BlockHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BlockHash] -> Encoding
$ctoEncodingList :: [BlockHash] -> Encoding
toJSONList :: [BlockHash] -> Value
$ctoJSONList :: [BlockHash] -> Value
toEncoding :: BlockHash -> Encoding
$ctoEncoding :: BlockHash -> Encoding
toJSON :: BlockHash -> Value
$ctoJSON :: BlockHash -> Value
ToJSON, Value -> Parser [BlockHash]
Value -> Parser BlockHash
(Value -> Parser BlockHash)
-> (Value -> Parser [BlockHash]) -> FromJSON BlockHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BlockHash]
$cparseJSONList :: Value -> Parser [BlockHash]
parseJSON :: Value -> Parser BlockHash
$cparseJSON :: Value -> Parser BlockHash
FromJSON)

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

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

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

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

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

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

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

instance FromJSON RunError where
  parseJSON :: Value -> Parser RunError
parseJSON = String -> (Object -> Parser RunError) -> Value -> Parser RunError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"preapply error" ((Object -> Parser RunError) -> Value -> Parser RunError)
-> (Object -> Parser RunError) -> Value -> Parser RunError
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    String
id' <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    case String
id' of
      String
x | String
"runtime_error" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Address -> RunError
RuntimeError (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Address
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contract_handle"
      String
x | String
"script_rejected" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Expression -> RunError
ScriptRejected (Expression -> RunError) -> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"with"
      String
x | String
"bad_contract_parameter" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Address -> RunError
BadContractParameter (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Address
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contract"
      String
x | String
"invalid_constant" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          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 -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expected_type" Parser (Expression -> RunError)
-> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"wrong_expression"
      String
x | String
"invalid_contract" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Address -> RunError
InvalidContract (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
oObject -> Text -> Parser Address
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contract"
      String
x | String
"inconsistent_types" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          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 -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"first_type" Parser (Expression -> RunError)
-> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"other_type"
      String
x | String
"invalid_primitive" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          [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 -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expected_primitive_names" Parser (Text -> RunError) -> Parser Text -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"wrong_primitive_name"
      String
x | String
"invalidSyntacticConstantError" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          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 -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expectedForm" Parser (Expression -> RunError)
-> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"wrongExpression"
      String
x | String
"invalid_expression_kind" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          [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 -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expected_kinds" Parser (Text -> RunError) -> Parser Text -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"wrong_kind"
      String
x | String
"invalid_contract_notation" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Text -> RunError
InvalidContractNotation (Text -> RunError) -> Parser Text -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"notation"
      String
x | String
"unexpected_contract" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
UnexpectedContract
      String
x | String
"ill_formed_type" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Expression -> RunError
IllFormedType (Expression -> RunError) -> Parser Expression -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Expression
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ill_formed_expression"
      String
x | String
"unexpected_operation" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
UnexpectedOperation
      String
x | String
"empty_transaction" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Address -> RunError
REEmptyTransaction (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Address
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contract"
      String
x | String
"script_overflow" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
ScriptOverflow
      String
x | String
"gas_exhausted.operation" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
GasExhaustedOperation
      String
x | String
"tez.addition_overflow" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          [TezosInt64] -> RunError
MutezAdditionOverflow ([TezosInt64] -> RunError)
-> Parser [TezosInt64] -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [TezosInt64]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"amounts"
      String
x | String
"tez.subtraction_underflow" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          [TezosInt64] -> RunError
MutezSubtractionUnderflow ([TezosInt64] -> RunError)
-> Parser [TezosInt64] -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [TezosInt64]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"amounts"
      String
x | String
"tez.multiplication_overflow" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          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 -> Text -> Parser TezosInt64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"amount" Parser (TezosInt64 -> RunError)
-> Parser TezosInt64 -> Parser RunError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser TezosInt64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"multiplicator"
      String
x | String
"cannot_pay_storage_fee" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          RunError -> Parser RunError
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunError
CantPayStorageFee
      String
x | String
"balance_too_low" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x -> 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 -> Text -> Parser TezosMutez
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser TezosMutez
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"amount"
          return $ ("balance" :! Mutez) -> ("required" :! Mutez) -> RunError
BalanceTooLow (IsLabel "balance" (Name "balance")
Name "balance"
#balance Name "balance" -> Mutez -> "balance" :! Mutez
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Mutez
balance) (IsLabel "required" (Name "required")
Name "required"
#required Name "required" -> Mutez -> "required" :! Mutez
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Mutez
amount)
      String
x | String
"previously_revealed_key" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Address -> RunError
PreviouslyRevealedKey (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Address
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contract"
      String
x | String
"non_existing_contract" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x ->
          Address -> RunError
NonExistingContract (Address -> RunError) -> Parser Address -> Parser RunError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Address
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contract"
      String
_ -> String -> Parser RunError
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unknown id: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
id')

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

-- | 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.
      Address -- ^ 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.
      Address -- ^ Manager address.
  | Failure Text
    -- ^ Failure reported without specific id
  deriving stock Int -> InternalError -> ShowS
[InternalError] -> ShowS
InternalError -> String
(Int -> InternalError -> ShowS)
-> (InternalError -> String)
-> ([InternalError] -> ShowS)
-> Show InternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalError] -> ShowS
$cshowList :: [InternalError] -> ShowS
show :: InternalError -> String
$cshow :: InternalError -> String
showsPrec :: Int -> InternalError -> ShowS
$cshowsPrec :: Int -> InternalError -> ShowS
Show

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

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

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

data OperationResult
  = OperationApplied AppliedResult
  | OperationFailed [RunError]

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

instance Semigroup AppliedResult where
  <> :: AppliedResult -> AppliedResult -> AppliedResult
(<>) AppliedResult
ar1 AppliedResult
ar2 = AppliedResult :: TezosInt64
-> TezosInt64
-> TezosInt64
-> [Address]
-> TezosInt64
-> AppliedResult
AppliedResult
    { arConsumedGas :: TezosInt64
arConsumedGas = AppliedResult -> TezosInt64
arConsumedGas AppliedResult
ar1 TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ AppliedResult -> TezosInt64
arConsumedGas 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 :: [Address]
arOriginatedContracts = AppliedResult -> [Address]
arOriginatedContracts AppliedResult
ar1 [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
<> AppliedResult -> [Address]
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
-> [Address]
-> TezosInt64
-> AppliedResult
AppliedResult TezosInt64
0 TezosInt64
0 TezosInt64
0 [] TezosInt64
0

combineResults :: OperationResult -> OperationResult -> OperationResult
combineResults :: OperationResult -> OperationResult -> OperationResult
combineResults
  (OperationApplied AppliedResult
res1) (OperationApplied AppliedResult
res2) =
  AppliedResult -> OperationResult
OperationApplied (AppliedResult -> OperationResult)
-> AppliedResult -> OperationResult
forall a b. (a -> b) -> a -> b
$ AppliedResult
res1 AppliedResult -> AppliedResult -> AppliedResult
forall a. Semigroup a => a -> a -> a
<> AppliedResult
res2
combineResults (OperationApplied AppliedResult
_) (OperationFailed [RunError]
e) =
  [RunError] -> OperationResult
OperationFailed [RunError]
e
combineResults (OperationFailed [RunError]
e) (OperationApplied AppliedResult
_) =
  [RunError] -> OperationResult
OperationFailed [RunError]
e
combineResults (OperationFailed [RunError]
e1) (OperationFailed [RunError]
e2) =
  [RunError] -> OperationResult
OperationFailed ([RunError] -> OperationResult) -> [RunError] -> OperationResult
forall a b. (a -> b) -> a -> b
$ [RunError]
e1 [RunError] -> [RunError] -> [RunError]
forall a. Semigroup a => a -> a -> a
<> [RunError]
e2

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 -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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
arConsumedGas <- Object
o Object -> Text -> Parser TezosInt64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"consumed_gas"
        TezosInt64
arStorageSize <- Object
o Object -> Text -> Parser (Maybe TezosInt64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"storage_size" Parser (Maybe TezosInt64) -> TezosInt64 -> Parser TezosInt64
forall a. Parser (Maybe a) -> a -> Parser a
.!= TezosInt64
0
        TezosInt64
arPaidStorageDiff <- Object
o Object -> Text -> Parser (Maybe TezosInt64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"paid_storage_size_diff" Parser (Maybe TezosInt64) -> TezosInt64 -> Parser TezosInt64
forall a. Parser (Maybe a) -> a -> Parser a
.!= TezosInt64
0
        [Address]
arOriginatedContracts <- Object
o Object -> Text -> Parser (Maybe [Address])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"originated_contracts" Parser (Maybe [Address]) -> [Address] -> Parser [Address]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
        Bool
allocatedFlag <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"allocated_destination_contract" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        let arAllocatedDestinationContracts :: TezosInt64
arAllocatedDestinationContracts = if Bool
allocatedFlag then TezosInt64
1 else TezosInt64
0
        return AppliedResult :: TezosInt64
-> TezosInt64
-> TezosInt64
-> [Address]
-> TezosInt64
-> AppliedResult
AppliedResult{[Address]
TezosInt64
arAllocatedDestinationContracts :: TezosInt64
arOriginatedContracts :: [Address]
arPaidStorageDiff :: TezosInt64
arStorageSize :: TezosInt64
arConsumedGas :: TezosInt64
arAllocatedDestinationContracts :: TezosInt64
arOriginatedContracts :: [Address]
arPaidStorageDiff :: TezosInt64
arStorageSize :: TezosInt64
arConsumedGas :: 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 -> Text -> Parser [RunError]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser (Maybe [RunError])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe [RunError])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"errors" Parser (Maybe [RunError]) -> [RunError] -> Parser [RunError]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      String
_ -> String -> Parser OperationResult
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unexpected status " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
status)

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

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

-- | Data that is common for transaction and origination
-- operations.
data CommonOperationData = CommonOperationData
  { CommonOperationData -> Address
codSource :: Address
  , 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.
--
-- Fee isn't accounted during operation simulation, so it's safe to use zero amount.
-- Real operation fee is calculated later using 'tezos-client'.
mkCommonOperationData
  :: Address -> TezosInt64 -> ProtocolParameters
  -> CommonOperationData
mkCommonOperationData :: Address -> TezosInt64 -> ProtocolParameters -> CommonOperationData
mkCommonOperationData Address
source TezosInt64
counter ProtocolParameters{Int
TezosInt64
TezosNat
TezosMutez
ppCostPerByte :: TezosMutez
ppMinimalBlockDelay :: TezosNat
ppHardStorageLimitPerOperation :: TezosInt64
ppHardGasLimitPerOperation :: TezosInt64
ppOriginationSize :: Int
ppCostPerByte :: ProtocolParameters -> TezosMutez
ppMinimalBlockDelay :: ProtocolParameters -> TezosNat
ppHardStorageLimitPerOperation :: ProtocolParameters -> TezosInt64
ppHardGasLimitPerOperation :: ProtocolParameters -> TezosInt64
ppOriginationSize :: ProtocolParameters -> Int
..} = CommonOperationData :: Address
-> TezosMutez
-> TezosInt64
-> TezosInt64
-> TezosInt64
-> CommonOperationData
CommonOperationData
  { codSource :: Address
codSource = Address
source
  , codFee :: TezosMutez
codFee = Mutez -> TezosMutez
TezosMutez Mutez
zeroMutez
  , codCounter :: TezosInt64
codCounter = TezosInt64
counter
  , codGasLimit :: TezosInt64
codGasLimit = TezosInt64
ppHardGasLimitPerOperation
  , codStorageLimit :: TezosInt64
codStorageLimit = TezosInt64
ppHardStorageLimitPerOperation
  }

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

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

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

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

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 -> Text -> Parser TezosMutez
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"amount"
    Address
toDestination <- Object
obj Object -> Text -> Parser Address
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser (Maybe ParametersInternal)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"parameters"
    pure TransactionOperation :: TezosMutez -> Address -> ParametersInternal -> TransactionOperation
TransactionOperation {TezosMutez
Address
ParametersInternal
toParameters :: ParametersInternal
toDestination :: Address
toAmount :: TezosMutez
toParameters :: ParametersInternal
toDestination :: Address
toAmount :: TezosMutez
..}

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

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

instance ToJSON OriginationOperation where
  toJSON :: OriginationOperation -> Value
toJSON OriginationOperation{TezosMutez
OriginationScript
ooScript :: OriginationScript
ooBalance :: TezosMutez
ooScript :: OriginationOperation -> OriginationScript
ooBalance :: OriginationOperation -> TezosMutez
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Text
"kind" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"origination"
    , Text
"balance" Text -> TezosMutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TezosMutez
ooBalance
    , Text
"script" Text -> OriginationScript -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OriginationScript
ooScript
    ]

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

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

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

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

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

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 Address
rcSource :: Maybe Address
  , RunCode -> Maybe Address
rcPayer :: Maybe Address
  }

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

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

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

makePrisms ''RunError
makeLensesFor [("oiCommonData", "oiCommonDataL")] ''OperationInput