module Tendermint.SDK.Modules.Bank.Types
  ( module Tendermint.SDK.Modules.Bank.Types
  , Auth.Amount(..)
  , Auth.Coin(..)
  , Auth.CoinId(..)
  ) where

import           Data.Aeson                   as A
import           Data.Text                    (Text)
import           GHC.Generics                 (Generic)
import qualified Tendermint.SDK.BaseApp       as BaseApp
import           Tendermint.SDK.Codec         (defaultSDKAesonOptions)
import qualified Tendermint.SDK.Modules.Auth  as Auth
import           Tendermint.SDK.Types.Address (Address (..))

--------------------------------------------------------------------------------

type BankName = "bank"

--------------------------------------------------------------------------------
-- Exceptions
--------------------------------------------------------------------------------

data BankError =
    InsufficientFunds Text

instance BaseApp.IsAppError BankError where
  makeAppError :: BankError -> AppError
makeAppError (InsufficientFunds msg :: Text
msg) =
    AppError :: Word32 -> Text -> Text -> AppError
BaseApp.AppError
    { appErrorCode :: Word32
appErrorCode = 1
    , appErrorCodespace :: Text
appErrorCodespace = "bank"
    , appErrorMessage :: Text
appErrorMessage = Text
msg
    }

--------------------------------------------------------------------------------
-- Events
--------------------------------------------------------------------------------

data TransferEvent = TransferEvent
  { TransferEvent -> CoinId
transferEventCoinId :: Auth.CoinId
  , TransferEvent -> Amount
transferEventAmount :: Auth.Amount
  , TransferEvent -> Address
transferEventTo     :: Address
  , TransferEvent -> Address
transferEventFrom   :: Address
  } deriving (TransferEvent -> TransferEvent -> Bool
(TransferEvent -> TransferEvent -> Bool)
-> (TransferEvent -> TransferEvent -> Bool) -> Eq TransferEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransferEvent -> TransferEvent -> Bool
$c/= :: TransferEvent -> TransferEvent -> Bool
== :: TransferEvent -> TransferEvent -> Bool
$c== :: TransferEvent -> TransferEvent -> Bool
Eq, Int -> TransferEvent -> ShowS
[TransferEvent] -> ShowS
TransferEvent -> String
(Int -> TransferEvent -> ShowS)
-> (TransferEvent -> String)
-> ([TransferEvent] -> ShowS)
-> Show TransferEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferEvent] -> ShowS
$cshowList :: [TransferEvent] -> ShowS
show :: TransferEvent -> String
$cshow :: TransferEvent -> String
showsPrec :: Int -> TransferEvent -> ShowS
$cshowsPrec :: Int -> TransferEvent -> ShowS
Show, (forall x. TransferEvent -> Rep TransferEvent x)
-> (forall x. Rep TransferEvent x -> TransferEvent)
-> Generic TransferEvent
forall x. Rep TransferEvent x -> TransferEvent
forall x. TransferEvent -> Rep TransferEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransferEvent x -> TransferEvent
$cfrom :: forall x. TransferEvent -> Rep TransferEvent x
Generic)

transferEventAesonOptions :: A.Options
transferEventAesonOptions :: Options
transferEventAesonOptions = String -> Options
defaultSDKAesonOptions "transferEvent"

instance A.ToJSON TransferEvent where
  toJSON :: TransferEvent -> Value
toJSON = Options -> TransferEvent -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON Options
transferEventAesonOptions
instance A.FromJSON TransferEvent where
  parseJSON :: Value -> Parser TransferEvent
parseJSON = Options -> Value -> Parser TransferEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
transferEventAesonOptions
instance BaseApp.ToEvent TransferEvent
instance BaseApp.Select TransferEvent