module Tendermint.SDK.BaseApp.Errors
  ( AppError(..)
  , IsAppError(..)
  , queryAppError
  , txResultAppError
  , SDKError(..)
  , throwSDKError
  ) where

import           Control.Exception                    (Exception)
import           Control.Lens                         (Lens', lens)
import qualified Data.Aeson                           as A
import           Data.String.Conversions              (cs)
import           Data.Text                            (Text, intercalate)
import           Data.Word                            (Word32, Word64)
import           GHC.Generics                         (Generic)
import           Network.ABCI.Types.Messages.Common   (defaultABCIOptions)
import qualified Network.ABCI.Types.Messages.Response as Response
import           Polysemy
import           Polysemy.Error                       (Error, throw)
import           Tendermint.SDK.Types.Address         (Address)
import           Tendermint.SDK.Types.TxResult        (TxResult (..))

-- | This type represents a common error response for the query, checkTx,
-- | and deliver tx abci-messages.
data AppError = AppError
  { AppError -> Word32
appErrorCode      :: Word32
  , AppError -> Text
appErrorCodespace :: Text
  , AppError -> Text
appErrorMessage   :: Text
  } deriving (AppError -> AppError -> Bool
(AppError -> AppError -> Bool)
-> (AppError -> AppError -> Bool) -> Eq AppError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppError -> AppError -> Bool
$c/= :: AppError -> AppError -> Bool
== :: AppError -> AppError -> Bool
$c== :: AppError -> AppError -> Bool
Eq, Int -> AppError -> ShowS
[AppError] -> ShowS
AppError -> String
(Int -> AppError -> ShowS)
-> (AppError -> String) -> ([AppError] -> ShowS) -> Show AppError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppError] -> ShowS
$cshowList :: [AppError] -> ShowS
show :: AppError -> String
$cshow :: AppError -> String
showsPrec :: Int -> AppError -> ShowS
$cshowsPrec :: Int -> AppError -> ShowS
Show, (forall x. AppError -> Rep AppError x)
-> (forall x. Rep AppError x -> AppError) -> Generic AppError
forall x. Rep AppError x -> AppError
forall x. AppError -> Rep AppError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AppError x -> AppError
$cfrom :: forall x. AppError -> Rep AppError x
Generic)

instance Exception AppError

instance A.ToJSON AppError where
  toJSON :: AppError -> Value
toJSON = Options -> AppError -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (Options -> AppError -> Value) -> Options -> AppError -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "appError"

instance A.FromJSON AppError where
  parseJSON :: Value -> Parser AppError
parseJSON = Options -> Value -> Parser AppError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (Options -> Value -> Parser AppError)
-> Options -> Value -> Parser AppError
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "appError"

-- | Allows for custom application error types to be coerced into the
-- standard error resposne.
class IsAppError e where
  makeAppError :: e -> AppError

-- | This lens is used to set the 'AppError' data into the appropriate
-- | response fields for the query abci-message.
queryAppError :: Lens' Response.Query AppError
queryAppError :: (AppError -> f AppError) -> Query -> f Query
queryAppError = (Query -> AppError)
-> (Query -> AppError -> Query)
-> Lens Query Query AppError AppError
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Query -> AppError
g Query -> AppError -> Query
s
  where
    g :: Query -> AppError
g Response.Query{..} = AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = Word32
queryCode
      , appErrorCodespace :: Text
appErrorCodespace = Text
queryCodespace
      , appErrorMessage :: Text
appErrorMessage = Text
queryLog
      }
    s :: Query -> AppError -> Query
s query :: Query
query AppError{..} = Query
query
      { queryCode :: Word32
Response.queryCode = Word32
appErrorCode
      , queryCodespace :: Text
Response.queryCodespace  = Text
appErrorCodespace
      , queryLog :: Text
Response.queryLog = Text
appErrorMessage
      }

-- | This lens is used to set the 'AppError' data into the appropriate
-- | response fields for the checkTx/deliverTx abci-message.
txResultAppError :: Lens' TxResult AppError
txResultAppError :: (AppError -> f AppError) -> TxResult -> f TxResult
txResultAppError = (TxResult -> AppError)
-> (TxResult -> AppError -> TxResult)
-> Lens TxResult TxResult AppError AppError
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TxResult -> AppError
g TxResult -> AppError -> TxResult
s
  where
    g :: TxResult -> AppError
g TxResult{..} = AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = Word32
_txResultCode
      , appErrorCodespace :: Text
appErrorCodespace = Text
_txResultCodespace
      , appErrorMessage :: Text
appErrorMessage = Text
_txResultLog
      }
    s :: TxResult -> AppError -> TxResult
s txResult :: TxResult
txResult AppError{..} = TxResult
txResult
      { _txResultCode :: Word32
_txResultCode = Word32
appErrorCode
      , _txResultCodespace :: Text
_txResultCodespace  = Text
appErrorCodespace
      , _txResultLog :: Text
_txResultLog = Text
appErrorMessage
      }

--------------------------------------------------------------------------------
-- Stock SDK Errors
--------------------------------------------------------------------------------

-- | These errors originate from the SDK itself. The "sdk" namespace is reserved
-- | for this error type and should not be used in modules or applications.
data SDKError =
    InternalError Text
  -- ^ Something went wrong and we have no idea what.
  | ParseError Text
  -- ^ Parsing errors for SDK specific types, e.g. 'RawTransaction' or 'Msg', etc.
  | UnmatchedRoute Text
  -- ^ The name of the route that failed to match.
  | OutOfGasException
  | MessageValidation [Text]
  | SignatureRecoveryError Text
  | NonceException Word64 Word64
  | StoreError Text
  | GrpcError Text
  | UnknownAccountError Address
  deriving (Int -> SDKError -> ShowS
[SDKError] -> ShowS
SDKError -> String
(Int -> SDKError -> ShowS)
-> (SDKError -> String) -> ([SDKError] -> ShowS) -> Show SDKError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SDKError] -> ShowS
$cshowList :: [SDKError] -> ShowS
show :: SDKError -> String
$cshow :: SDKError -> String
showsPrec :: Int -> SDKError -> ShowS
$cshowsPrec :: Int -> SDKError -> ShowS
Show)

-- | As of right now it's not expected that one can recover from an 'SDKError',
-- | so we are throwing them as 'AppError's directly.
throwSDKError
  :: Member (Error AppError) r
  => SDKError
  -> Sem r a
throwSDKError :: SDKError -> Sem r a
throwSDKError = AppError -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (AppError -> Sem r a)
-> (SDKError -> AppError) -> SDKError -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDKError -> AppError
forall e. IsAppError e => e -> AppError
makeAppError

instance IsAppError SDKError where
  makeAppError :: SDKError -> AppError
makeAppError (InternalError msg :: Text
msg) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 1
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Internal Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    }

  makeAppError (ParseError msg :: Text
msg) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 2
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = Text
msg
    }

  makeAppError (UnmatchedRoute route :: Text
route) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 3
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Route not recognized: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
route Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
    }

  makeAppError OutOfGasException = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 4
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Out of gas exception"
    }

  makeAppError (MessageValidation errors :: [Text]
errors) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 5
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Message failed validation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate "\n" [Text]
errors
    }

  makeAppError (SignatureRecoveryError msg :: Text
msg) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 6
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Signature Recovery Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    }

  makeAppError (NonceException expected :: Word64
expected found :: Word64
found) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 7
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Incorrect Transaction Nonce: Expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
expected) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
         " but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
found) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
    }

  makeAppError (StoreError msg :: Text
msg) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 8
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Store Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    }

  makeAppError (GrpcError msg :: Text
msg) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 9
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Grpc error: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    }

  makeAppError (UnknownAccountError addr :: Address
addr) = AppError :: Word32 -> Text -> Text -> AppError
AppError
    { appErrorCode :: Word32
appErrorCode = 10
    , appErrorCodespace :: Text
appErrorCodespace = "sdk"
    , appErrorMessage :: Text
appErrorMessage = "Unknown account at  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Address -> String) -> Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> String
forall a. Show a => a -> String
show (Address -> Text) -> Address -> Text
forall a b. (a -> b) -> a -> b
$ Address
addr)
    }