-- 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 (..)
  , CalcSize(..)
  , ScriptSize(..)
  , GetBigMapResult (..)
  , InternalOperation (..)
  , OperationContent (..)
  , OperationHash (..)
  , OperationInput
  , OperationResp (..)
  , OperationRespWithMeta (..)
  , OperationMetadata (..)
  , OperationResult (..)
  , OriginationOperation (..)
  , OriginationScript (..)
  , ParametersInternal (..)
  , PreApplyOperation (..)
  , ProtocolParameters (..)
  , RevealOperation (..)
  , RunCode (..)
  , RunCodeResult (..)
  , RunMetadata (..)
  , RunOperation (..)
  , RunOperationInternal (..)
  , RunOperationResult (..)
  , RPCInput
  , TransactionOperation (..)
  , WithCommonOperationData (..)
  , MonitorHeadsStep(..)
  , mkCommonOperationData

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

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

  -- * Lenses
  , wcoCommonDataL
  ) where

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

import Data.Aeson.Types (Parser)
import Morley.Client.RPC.Aeson (morleyClientAesonOptions)
import Morley.Client.Types
import Morley.Micheline
  (Expression, MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64,
  TezosMutez(..), TezosNat, expressionPrim)
import Morley.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 (Object a) (Object b) = Object (a <> b)
mergeObjects (Object _) _ = error "Right part is not an Object"
mergeObjects _ _ = error "Left part is not an Object"

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

type OperationInput = WithCommonOperationData (OperationInfo RPCInput)

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

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

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

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

data RunOperationResult = RunOperationResult
  { rrOperationContents :: NonEmpty OperationContent
  }

instance FromJSON RunOperationResult where
  parseJSON = withObject "preApplyRes" $ \o ->
    RunOperationResult <$> o .: "contents"

newtype OperationHash = OperationHash
  { unOperationHash :: Text
  }
  deriving stock (Eq, Show)
  deriving newtype (FromJSON, Buildable)

data OperationContent = OperationContent RunMetadata

instance FromJSON OperationContent where
  parseJSON = withObject "operationCostContent" $ \o ->
    OperationContent <$> o .: "metadata"

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

instance FromJSON RunMetadata where
  parseJSON = withObject "metadata" $ \o ->
    RunMetadata <$> o .: "operation_result" <*>
    o .:? "internal_operation_results" .!= []

newtype InternalOperation = InternalOperation
  { unInternalOperation :: OperationResult }

instance FromJSON InternalOperation where
  parseJSON = withObject "internal_operation" $ \o ->
    InternalOperation <$> o .: "result"

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

data BlockHeaderNoHash = BlockHeaderNoHash
  { bhnhTimestamp :: UTCTime
  , bhnhLevel :: Int64
  , 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
  { bhTimestamp :: UTCTime
  , bhLevel :: Int64
  , bhPredecessor :: BlockHash
  , bhHash :: BlockHash
  }

newtype BlockHash = BlockHash { unBlockHash :: Text }
  deriving newtype (Eq, Ord, Show, Buildable, ToJSON, FromJSON, ToHttpApiData)

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

-- | At the moment of writing, Tezos always uses these constants.
instance Default FeeConstants where
  def = FeeConstants
    { fcBase = [tz|100u|]
    , fcMutezPerGas = 0.1
    , fcMutezPerOpByte = 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 (Show, Eq)

instance ToHttpApiData BlockId where
  toUrlPiece = \case
    HeadId -> "head"
    FinalHeadId -> "head~2"
    GenesisId -> "genesis"
    LevelId x -> toUrlPiece x
    BlockHashId hash -> toUrlPiece hash
    AtDepthId depth -> "head~" <> toUrlPiece depth

instance Buildable BlockId where
  build = \case
    HeadId -> "head"
    FinalHeadId -> "head~2"
    GenesisId -> "genesis"
    LevelId x -> "block at level " <> build x
    BlockHashId hash -> "block with hash " <> build hash
    AtDepthId depth -> "block at depth " <> build depth

-- | Parse 'BlockId' in its textual representation in the same format as
-- submitted via RPC.
parseBlockId :: Text -> Maybe BlockId
parseBlockId t
  | t == "head" = Just HeadId
  | t == "head~2" = Just FinalHeadId
  | t == "genesis" = Just GenesisId
  | Right lvl <- readEither t = Just (LevelId lvl)
  | Just depthTxt <- "head~" `T.stripPrefix` t
  , Right depth <- readEither depthTxt = Just (AtDepthId depth)
  | Right _ <- decodeBase58CheckWithPrefix blockPrefix t = Just (BlockHashId (BlockHash t))
  | otherwise = 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 = "\001\052"

instance HasCLReader BlockId where
  getReader = eitherReader parseBlockId'
    where
      parseBlockId' :: String -> Either String BlockId
      parseBlockId' =
        maybeToRight ("failed to parse block ID, try passing block's hash, level or 'head'") .
        parseBlockId . toText
  getMetavar = "BLOCK_ID"

-- | Protocol-wide constants.
--
-- There are more constants, but currently, we are using only these
-- in our code.
data ProtocolParameters = ProtocolParameters
  { ppOriginationSize :: Int
  -- ^ Byte size cost for originating new contract.
  , ppHardGasLimitPerOperation :: TezosInt64
  -- ^ Gas limit for a single operation.
  , ppHardStorageLimitPerOperation :: TezosInt64
  -- ^ Storage limit for a single operation.
  , ppMinimalBlockDelay :: TezosNat
  -- ^ Minimal delay between two blocks, this constant is new in V010.
  , 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
  | InvalidB58Check Text
  deriving stock Show

instance FromJSON RunError where
  parseJSON = withObject "preapply error" $ \o -> do
    id' <- o .: "id"
    case id' of
      x | "runtime_error" `isSuffixOf` x ->
          RuntimeError <$> o .: "contract_handle"
      x | "script_rejected" `isSuffixOf` x ->
          ScriptRejected <$> o .: "with"
      x | "bad_contract_parameter" `isSuffixOf` x ->
          BadContractParameter <$> o .: "contract"
      x | "invalid_constant" `isSuffixOf` x ->
          InvalidConstant <$> o .: "expected_type" <*> o .: "wrong_expression"
      x | "invalid_contract" `isSuffixOf` x ->
          InvalidContract <$> o.: "contract"
      x | "inconsistent_types" `isSuffixOf` x ->
          InconsistentTypes <$> o .: "first_type" <*> o .: "other_type"
      x | "invalid_primitive" `isSuffixOf` x ->
          InvalidPrimitive <$> o .: "expected_primitive_names" <*> o .: "wrong_primitive_name"
      x | "invalidSyntacticConstantError" `isSuffixOf` x ->
          InvalidSyntacticConstantError <$> o .: "expectedForm" <*> o .: "wrongExpression"
      x | "invalid_expression_kind" `isSuffixOf` x ->
          InvalidExpressionKind <$> o .: "expected_kinds" <*> o .: "wrong_kind"
      x | "invalid_contract_notation" `isSuffixOf` x ->
          InvalidContractNotation <$> o .: "notation"
      x | "unexpected_contract" `isSuffixOf` x ->
          pure UnexpectedContract
      x | "ill_formed_type" `isSuffixOf` x ->
          IllFormedType <$> o .: "ill_formed_expression"
      x | "unexpected_operation" `isSuffixOf` x ->
          pure UnexpectedOperation
      x | "empty_transaction" `isSuffixOf` x ->
          REEmptyTransaction <$> o .: "contract"
      x | "script_overflow" `isSuffixOf` x ->
          pure ScriptOverflow
      x | "gas_exhausted.operation" `isSuffixOf` x ->
          pure GasExhaustedOperation
      x | "tez.addition_overflow" `isSuffixOf` x ->
          MutezAdditionOverflow <$> o .: "amounts"
      x | "tez.subtraction_underflow" `isSuffixOf` x ->
          MutezSubtractionUnderflow <$> o .: "amounts"
      x | "tez.multiplication_overflow" `isSuffixOf` x ->
          MutezMultiplicationOverflow <$> o .: "amount" <*> o .: "multiplicator"
      x | "cannot_pay_storage_fee" `isSuffixOf` x ->
          pure CantPayStorageFee
      x | "balance_too_low" `isSuffixOf` x -> do
          balance <- unTezosMutez <$> o .: "balance"
          amount  <- unTezosMutez <$> o .: "amount"
          return $ BalanceTooLow (#balance :! balance) (#required :! amount)
      x | "previously_revealed_key" `isSuffixOf` x ->
          PreviouslyRevealedKey <$> o .: "contract"
      x | "non_existing_contract" `isSuffixOf` x ->
          NonExistingContract <$> o .: "contract"
      x | "invalid_b58check" `isSuffixOf` x ->
          InvalidB58Check <$> o .: "input"
      _ -> fail ("unknown id: " <> id')

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

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

instance Buildable InternalError where
  build = \case
    CounterInThePast addr (arg #expected -> expected) (arg #found -> found) ->
      "Expected counter " +| expected |+ " for " +| addr |+ "but got: " +|
      found |+ ""
    UnrevealedKey addr ->
      "One tried to apply a manager operation without revealing " <>
      "the manager public key of " <> build addr
    Failure msg ->
      "Contract failed with the following message: " +| msg |+ ""

instance FromJSON InternalError where
  parseJSON = withObject "internal error" $ \o ->
    o .: "id" >>= \case
      x | "counter_in_the_past" `isSuffixOf` x ->
          CounterInThePast <$> o .: "contract" <*>
            (#expected <:!> parseCounter o "expected") <*>
            (#found <:!> parseCounter o "found")
      x | "unrevealed_key" `isSuffixOf` x ->
          UnrevealedKey <$> o .: "contract"
      "failure" -> Failure <$> o .: "msg"
      x -> fail ("unknown id: " <> x)
    where
      parseCounter :: Object -> Key -> Parser Word
      parseCounter o fieldName = do
        fieldValue <- o .: fieldName
        let mCounter = fromIntegralMaybe fieldValue
        maybe (fail $ mkErrorMsg (Key.toText fieldName) fieldValue) pure mCounter

      mkErrorMsg :: Text -> TezosInt64 -> String
      mkErrorMsg fieldName fieldValue = toString $ unwords
        ["Invalid", dquotes fieldName, "counter:", show $ unStringEncode fieldValue]

data OperationResult
  = OperationApplied AppliedResult
  | OperationFailed [RunError]

data AppliedResult = AppliedResult
  { arConsumedGas :: TezosInt64
  , arStorageSize :: TezosInt64
  , arPaidStorageDiff :: TezosInt64
  , arOriginatedContracts :: [Address]
  , 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 Show

instance Semigroup AppliedResult where
  (<>) ar1 ar2 = AppliedResult
    { arConsumedGas = arConsumedGas ar1 + arConsumedGas ar2
    , arStorageSize = arStorageSize ar1 + arStorageSize ar2
    , arPaidStorageDiff = arPaidStorageDiff ar1 + arPaidStorageDiff ar2
    , arOriginatedContracts = arOriginatedContracts ar1 <> arOriginatedContracts ar2
    , arAllocatedDestinationContracts =
      arAllocatedDestinationContracts ar1 + arAllocatedDestinationContracts ar2
    }

instance Monoid AppliedResult where
  mempty = AppliedResult 0 0 0 [] 0

instance FromJSON OperationResult where
  parseJSON = withObject "operation_costs" $ \o -> do
    status <- o .: "status"
    case status of
      "applied" -> OperationApplied <$> do
        arConsumedGas <- o .: "consumed_gas"
        arStorageSize <- o .:? "storage_size" .!= 0
        arPaidStorageDiff <- o .:? "paid_storage_size_diff" .!= 0
        arOriginatedContracts <- o .:? "originated_contracts" .!= []
        allocatedFlag <- o .:? "allocated_destination_contract" .!= False
        let arAllocatedDestinationContracts = if allocatedFlag then 1 else 0
        return AppliedResult{..}
      "failed" -> OperationFailed <$> o .: "errors"
      "backtracked" ->
        OperationFailed <$> o .:? "errors" .!= []
      "skipped" ->
        OperationFailed <$> o .:? "errors" .!= []
      _ -> fail ("unexpected status " ++ status)

data ParametersInternal = ParametersInternal
  { piEntrypoint :: Text
  , 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
  { piEntrypoint = "default"
  , piValue = expressionPrim MichelinePrimAp
    { mpaPrim = MichelinePrimitive "Unit"
    , mpaArgs = []
    , mpaAnnots = []
    }
  }

-- | Data that is common for transaction and origination
-- operations.
data CommonOperationData = CommonOperationData
  { codSource :: Address
  , codFee :: TezosMutez
  , codCounter :: TezosInt64
  , codGasLimit :: 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 source counter ProtocolParameters{..} = CommonOperationData
  { codSource = source
  , codFee = TezosMutez zeroMutez
  , codCounter = counter
  , codGasLimit = ppHardGasLimitPerOperation
  , codStorageLimit = ppHardStorageLimitPerOperation
  }

instance ToJSON CommonOperationData where
  toJSON CommonOperationData{..} = object
    [ "source" .= codSource
    , "fee" .= codFee
    , "counter" .= codCounter
    , "gas_limit" .= codGasLimit
    , "storage_limit" .= codStorageLimit
    ]

instance FromJSON CommonOperationData where
  parseJSON = withObject "common operation data" $ \o -> do
    codSource <- o .: "source"
    codFee <- o .: "fee"
    codCounter <- o .: "counter"
    codGasLimit <- o .: "gas_limit"
    codStorageLimit <- o .: "storage_limit"
    pure CommonOperationData {..}

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

instance ToJSONObject a => ToJSON (WithCommonOperationData a) where
  toJSON (WithCommonOperationData common custom) =
    toJSON common `mergeObjects` toJSON custom

instance FromJSON a => FromJSON (WithCommonOperationData a) where
  parseJSON v = WithCommonOperationData <$> parseJSON v <*> parseJSON v

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

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

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

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

instance ToJSON RevealOperation where
  toJSON RevealOperation{..} = object $
    [ "kind" .= String "reveal"
    , "public_key" .= roPublicKey
    ]
instance ToJSONObject RevealOperation

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

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

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

newtype OperationMetadata = OperationMetadata { unOperationMetadata :: Maybe OperationResult }

instance FromJSON OperationMetadata where
  parseJSON = withObject "operationMetadata" $ \o ->
    OperationMetadata <$> o .:? "operation_result"

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

data GetBigMapResult
  = GetBigMapResult Expression
  | GetBigMapNotFound

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

newtype ScriptSize = ScriptSize { ssScriptSize :: Natural }

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

data MonitorHeadsStep a = MonitorHeadsStop a | MonitorHeadsContinue

deriveJSON morleyClientAesonOptions ''ParametersInternal

instance ToJSON TransactionOperation where
  toJSON TransactionOperation{..} = object $
    [ "kind" .= String "transaction"
    , "amount" .= toAmount
    , "destination" .= toDestination
    , "parameters" .= toParameters
    ]
instance ToJSONObject TransactionOperation

instance FromJSON TransactionOperation where
  parseJSON = withObject "TransactionOperation" $ \obj -> do
    toAmount <- obj .: "amount"
    toDestination <- obj .: "destination"
    toParameters <- fromMaybe defaultParametersInternal <$> obj .:? "parameters"
    pure TransactionOperation {..}

instance FromJSON OperationResp where
  parseJSON = withObject "OperationResp" $ \obj -> do
    kind :: Text <- obj .: "kind"
    case kind of
      "transaction" -> TransactionOpResp <$> parseJSON (Object obj)
      _ -> pure OtherOpResp

instance FromJSON OperationRespWithMeta where
  parseJSON = withObject "OperationRespWithMeta" $ \obj -> do
    OperationRespWithMeta <$> parseJSON (Object obj) <*> obj .:? "metadata"

deriveToJSON morleyClientAesonOptions ''OriginationScript

instance ToJSON OriginationOperation where
  toJSON OriginationOperation{..} = object $
    [ "kind" .= String "origination"
    , "balance" .= ooBalance
    , "script" .= ooScript
    ]
instance ToJSONObject OriginationOperation

instance ToJSON ForgeOperation where
  toJSON ForgeOperation{..} = object
    [ "branch" .= unBlockHash foBranch
    , "contents" .= foContents
    ]

instance ToJSON RunOperationInternal where
  toJSON RunOperationInternal{..} = object
    [ "branch" .= unBlockHash roiBranch
    , "contents" .= roiContents
    , "signature" .= roiSignature
    ]

instance ToJSON PreApplyOperation where
  toJSON PreApplyOperation{..} = object
    [ "branch" .= unBlockHash paoBranch
    , "contents" .= paoContents
    , "protocol" .= paoProtocol
    , "signature" .= formatSignature paoSignature
    ]

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

instance FromJSON GetBigMapResult where
  parseJSON v = maybe GetBigMapNotFound GetBigMapResult <$> parseJSON v

makePrisms ''RunError

wcoCommonDataL :: Lens' (WithCommonOperationData a) CommonOperationData
wcoCommonDataL = \f (WithCommonOperationData com cust) ->
  (`WithCommonOperationData` cust) <$> f com