Error.hs

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

-- | Various errors that can happen in the RPC part of @morley-client@.
module Morley.Client.RPC.Error
  ( ClientRpcError (..)
  , RunCodeErrors (..)
  , UnexpectedErrors (..)
  , IncorrectRpcResponse (..)
  , WaitForOperationError (..)
  ) where

import Fmt (Buildable(..), blockListF, pretty, (+|), (|+))

import Morley.Micheline (Expression)
import Morley.Tezos.Address

import Morley.Client.RPC.Types

----------------------------------------------------------------------------
-- Caused by invalid user action
----------------------------------------------------------------------------

-- | Errors that can happen in the RPC part when a user tries to make
-- failing actions.
data ClientRpcError
  -- | Smart contract execution has failed.
  = ContractFailed
      ContractAddress -- ^ Smart contract address.
      Expression -- ^ Value the contract has failed with.

  | BadParameter
    -- ^ Parameter passed to a contract does not match its type.
      Address -- ^ Smart or implicit contract address.
      Expression -- ^ Value passed as parameter.
  | EmptyTransaction
    -- ^ Transfer of 0 to an implicit account.
      ImplicitAddress -- ^ Receiver address.
  | ShiftOverflow
    -- ^ A smart contract execution failed due to a shift overflow.
    ContractAddress
    -- ^ Smart contract address.
  | GasExhaustion
    -- ^ A smart contract execution failed due gas exhaustion.
    ContractAddress
    -- ^ Smart contract address.
  | KeyAlreadyRevealed
    -- ^ A key has already been revealed.
    ImplicitAddress
    -- ^ The address corresponding to the key.
  | ClientInternalError
    -- ^ An error that RPC considers internal occurred. These errors
    -- are considered internal by mistake, they are actually quite
    -- realistic and normally indicate bad user action. Currently we
    -- put 'InternalError' here as is, because it's easy for a user of
    -- @morley-client@ to work with this type. In #284 we will
    -- consider more errors and maybe some of them will need to be
    -- mapped into something more user-friendly, then we will
    -- reconsider this approach.
    InternalError
  deriving stock Show

instance Buildable ClientRpcError where
  build = \case
    ContractFailed addr expr ->
      "The execution of the smart contract " +| addr |+
      " failed with " +| expr |+ ""
    BadParameter addr expr ->
      "Parameter " +| expr |+ " does not match the type of " +| addr |+ "."
    EmptyTransaction addr -> build (REEmptyTransaction addr)
    ShiftOverflow addr -> addr |+ " failed due to shift overflow"
    GasExhaustion addr -> addr |+ " failed due to gas exhaustion"
    KeyAlreadyRevealed addr -> "Key for " +| addr |+ " has already been revealed"
    ClientInternalError err -> build err

instance Exception ClientRpcError where
  displayException = pretty

-- | Errors that can happen during @run_code@ endpoint call.
-- These errors returned along with 500 code, so we have to handle
-- them a bit differently in comparison to other run errors that are
-- returned as a part of successful JSON response.
data RunCodeErrors = RunCodeErrors [RunError]
  deriving stock Show

instance Buildable RunCodeErrors where
  build (RunCodeErrors errs) = "'run_code' failed with the following errors: " +|
      blockListF errs |+ ""

instance Exception RunCodeErrors where
  displayException = pretty

----------------------------------------------------------------------------
-- Caused by unexpected node behavior or incorrect assumption in our code
----------------------------------------------------------------------------

-- | Errors that we don't expect to happen, but they can be reported
-- by the server.
data UnexpectedErrors
  = UnexpectedRunErrors [RunError]
  | UnexpectedInternalErrors [InternalError]
  deriving stock (Show)

instance Buildable UnexpectedErrors where
  build = \case
    UnexpectedRunErrors errs ->
      "Preapply failed due to the following errors:\n" +|
      mconcat (map ((<> "\n\n") . build) errs) |+ ""
    UnexpectedInternalErrors errs ->
      "RPC failed with unexpected internal errors:\n" +|
      mconcat (map ((<> "\n\n") . build) errs) |+ ""

instance Exception UnexpectedErrors where
  displayException = pretty

-- | Errors that we can throw when we get a response from a node that
-- doesn't match our expectations. It means that either the node we
-- are talking to misbehaves or our code is incorrect.
data IncorrectRpcResponse
  = RpcUnexpectedSize Int Int
  | RpcOriginatedNoContracts
  | RpcNoOperationsRun
  | RpcOriginatedMoreContracts [ContractAddress]
  deriving stock Show

instance Buildable IncorrectRpcResponse where
  build = \case
    RpcUnexpectedSize expected got ->
      "An RPC call returned a list that has " +| got |+
      " items, but we expected to get " +| expected |+ " results"
    RpcOriginatedMoreContracts addresses ->
      "Operation expected to originate one contract, but will more:\n" +|
      mconcat (map ((<> "\n") . build) addresses) |+ ""
    RpcOriginatedNoContracts ->
      "Operation expected to originate a contract, but produced nothing"
    RpcNoOperationsRun ->
      "No operations was run"

instance Exception IncorrectRpcResponse where
  displayException = pretty

data WaitForOperationError
  = WaitForOperationBlockout Word
  | WaitForOperationStreamingError Text
  deriving stock Show

instance Buildable WaitForOperationError where
  build = \case
    WaitForOperationBlockout n -> "Operation not included after " +| n |+ " blocks"
    WaitForOperationStreamingError s ->
      "Streaming error received waiting for operation: " +| s |+ ""

instance Exception WaitForOperationError where
  displayException = pretty