-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | 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 (..)
  , OperationResp (..)
  , OperationResult (..)
  , OriginationOperation (..)
  , OriginationScript (..)
  , ParametersInternal (..)
  , PreApplyOperation (..)
  , ProtocolParameters (..)
  , RunCode (..)
  , RunCodeResult (..)
  , RunMetadata (..)
  , RunOperation (..)
  , RunOperationInternal (..)
  , RunOperationResult (..)
  , TransactionOperation (..)
  , combineResults
  , mkCommonOperationData

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

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

  -- * Lenses
  , toCommonDataL
  , ooCommonDataL
  ) 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 qualified Data.Text as T
import Data.Time (UTCTime)
import Data.Vector (fromList)
import Fmt (Buildable(..), pretty, (+|), (|+))
import Servant.API (ToHttpApiData(..))

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

data ForgeOperation = ForgeOperation
  { foBranch :: Text
  , foContents :: NonEmpty (Either TransactionOperation OriginationOperation)
  }

contentsToJSON :: NonEmpty (Either TransactionOperation OriginationOperation) -> Value
contentsToJSON = Array . fromList . toList .
  map (\case
          Right transOp -> toJSON transOp
          Left origOp -> toJSON origOp
      )

instance ToJSON ForgeOperation where
  toJSON ForgeOperation{..} = object
    [ "branch" .= toString foBranch
    , ("contents", contentsToJSON foContents)
    ]

data RunOperationInternal = RunOperationInternal
  { roiBranch :: Text
  , roiContents :: NonEmpty (Either TransactionOperation OriginationOperation)
  , roiSignature :: Signature
  }

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

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

data PreApplyOperation = PreApplyOperation
  { paoProtocol :: Text
  , paoBranch :: Text
  , paoContents :: NonEmpty (Either TransactionOperation OriginationOperation)
  , paoSignature :: Signature
  }

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

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 (ToJSON, FromJSON)

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 = toMutez 100
    , 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.
  | 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 (Show, Eq)

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

instance Buildable BlockId where
  build = \case
    HeadId -> "head"
    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 == "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 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)
  | NonExistingContract Address
  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 | "non_existing_contract" `isSuffixOf` x ->
          NonExistingContract <$> o .: "contract"
      _ -> 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" +|
      mconcat (intersperse (" " :: Text) $ map show amounts) |+ ""
    MutezSubtractionUnderflow amounts ->
      "A contract failed due to mutez subtraction underflow when subtracting following values:\n" +|
      mconcat (intersperse (" " :: Text) $ map show 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 (N balance) (N required) ->
      "Balance is too low, \
      \current balance: " +| balance |+ ", but required: " +| required |+ ""
    NonExistingContract addr ->
      "Contract is not registered: " +| addr |+ ""

-- | 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 (N expected) (N 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 -> Text -> Parser Word
      parseCounter o fieldName = do
        fieldValue <- o .: fieldName
        let mCounter = fromIntegralMaybe fieldValue
        maybe (fail $ mkErrorMsg 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

combineResults :: OperationResult -> OperationResult -> OperationResult
combineResults
  (OperationApplied res1) (OperationApplied res2) =
  OperationApplied $ res1 <> res2
combineResults (OperationApplied _) (OperationFailed e) =
  OperationFailed e
combineResults (OperationFailed e) (OperationApplied _) =
  OperationFailed e
combineResults (OperationFailed e1) (OperationFailed e2) =
  OperationFailed $ e1 <> e2

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
  }

commonDataToValueList :: CommonOperationData -> [(Text, Value)]
commonDataToValueList CommonOperationData{..} =
  [ "source" .= codSource
  , "fee" .= codFee
  , "counter" .= codCounter
  , "gas_limit" .= codGasLimit
  , "storage_limit" .= codStorageLimit
  ]

parseCommonOperationData :: Object -> Parser CommonOperationData
parseCommonOperationData obj = do
  codSource <- obj .: "source"
  codFee <- obj .: "fee"
  codCounter <- obj .: "counter"
  codGasLimit <- obj .: "gas_limit"
  codStorageLimit <- obj .: "storage_limit"
  pure CommonOperationData {..}

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

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

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

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

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

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

-- | @$operation@ in Tezos docs.
data BlockOperation = BlockOperation
  { boHash :: Text
  , 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 = withObject "OperationResp" $ \obj -> do
    kind :: Text <- obj .: "kind"
    case kind of
      "transaction" -> TransactionOpResp <$> parseJSON (Object obj)
      _ -> pure OtherOpResp

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

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 v = maybe GetBigMapNotFound GetBigMapResult <$> parseJSON v

makePrisms ''RunError
makeLensesFor [("toCommonData", "toCommonDataL")] ''TransactionOperation
makeLensesFor [("ooCommonData", "ooCommonDataL")] ''OriginationOperation