module Tendermint.SDK.Modules.Auth.Types
  ( module Tendermint.SDK.Modules.Auth.Types
  , Address(..)
  ) where

import           Control.Lens                 (Wrapped (..), from, iso, view,
                                               (&), (.~), (^.), (^..),
                                               _Unwrapped')
import           Data.Aeson                   as JSON
import           Data.Bifunctor               (bimap)
import qualified Data.ProtoLens               as P
import           Data.Proxy                   (Proxy (..))
import           Data.String                  (IsString (..))
import           Data.String.Conversions      (cs)
import           Data.Text                    (Text, pack)
import           Data.Word
import           GHC.Generics                 (Generic)
import           GHC.TypeLits                 (symbolVal)
import qualified Proto.Modules.Auth           as A
import qualified Proto.Modules.Auth_Fields    as A
import           Tendermint.SDK.BaseApp       (AppError (..), IsAppError (..))
import           Tendermint.SDK.Codec         (HasCodec (..),
                                               defaultSDKAesonOptions)
import           Tendermint.SDK.Types.Address (Address (..))
import           Web.HttpApiData              (FromHttpApiData (..),
                                               ToHttpApiData (..))

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

type AuthName = "auth"

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

data AuthError =
    AccountAlreadyExists Address
  | AccountNotFound Address

instance IsAppError AuthError where
  makeAppError :: AuthError -> AppError
makeAppError (AccountAlreadyExists addr :: Address
addr) =
    AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = 1
      , appErrorCodespace :: Text
appErrorCodespace = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Proxy AuthName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy AuthName -> String) -> Proxy AuthName -> String
forall a b. (a -> b) -> a -> b
$ Proxy AuthName
forall k (t :: k). Proxy t
Proxy @AuthName)
      , appErrorMessage :: Text
appErrorMessage = "Account already exists " 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) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
      }

  makeAppError (AccountNotFound addr :: Address
addr) =
    AppError :: Word32 -> Text -> Text -> AppError
AppError
      { appErrorCode :: Word32
appErrorCode = 2
      , appErrorCodespace :: Text
appErrorCodespace = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Proxy AuthName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy AuthName -> String) -> Proxy AuthName -> String
forall a b. (a -> b) -> a -> b
$ Proxy AuthName
forall k (t :: k). Proxy t
Proxy @AuthName)
      , appErrorMessage :: Text
appErrorMessage = "Account not found for address " 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) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
      }

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

newtype CoinId = CoinId { CoinId -> Text
unCoinId :: Text } deriving (CoinId -> CoinId -> Bool
(CoinId -> CoinId -> Bool)
-> (CoinId -> CoinId -> Bool) -> Eq CoinId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoinId -> CoinId -> Bool
$c/= :: CoinId -> CoinId -> Bool
== :: CoinId -> CoinId -> Bool
$c== :: CoinId -> CoinId -> Bool
Eq, Int -> CoinId -> ShowS
[CoinId] -> ShowS
CoinId -> String
(Int -> CoinId -> ShowS)
-> (CoinId -> String) -> ([CoinId] -> ShowS) -> Show CoinId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoinId] -> ShowS
$cshowList :: [CoinId] -> ShowS
show :: CoinId -> String
$cshow :: CoinId -> String
showsPrec :: Int -> CoinId -> ShowS
$cshowsPrec :: Int -> CoinId -> ShowS
Show, (forall x. CoinId -> Rep CoinId x)
-> (forall x. Rep CoinId x -> CoinId) -> Generic CoinId
forall x. Rep CoinId x -> CoinId
forall x. CoinId -> Rep CoinId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CoinId x -> CoinId
$cfrom :: forall x. CoinId -> Rep CoinId x
Generic)

instance Wrapped CoinId where
  type Unwrapped CoinId = A.CoinId

  _Wrapped' :: p (Unwrapped CoinId) (f (Unwrapped CoinId)) -> p CoinId (f CoinId)
_Wrapped' = (CoinId -> CoinId)
-> (CoinId -> CoinId) -> Iso CoinId CoinId CoinId CoinId
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso CoinId -> CoinId
forall b. (Message b, HasField b "id" Text) => CoinId -> b
t CoinId -> CoinId
forall s. HasField s "id" Text => s -> CoinId
f
   where
    t :: CoinId -> b
t CoinId {..} =
      b
forall msg. Message msg => msg
P.defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "id" a) =>
LensLike' f s a
A.id LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
unCoinId
    f :: s -> CoinId
f message :: s
message = CoinId :: Text -> CoinId
CoinId
      { unCoinId :: Text
unCoinId = s
message s -> Getting Text s Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text s Text
forall (f :: * -> *) s a.
(Functor f, HasField s "id" a) =>
LensLike' f s a
A.id
      }

instance HasCodec CoinId where
  encode :: CoinId -> ByteString
encode = CoinId -> ByteString
forall msg. Message msg => msg -> ByteString
P.encodeMessage (CoinId -> ByteString)
-> (CoinId -> CoinId) -> CoinId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CoinId CoinId CoinId -> CoinId -> CoinId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CoinId CoinId CoinId
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
  decode :: ByteString -> Either Text CoinId
decode = (String -> Text)
-> (CoinId -> CoinId) -> Either String CoinId -> Either Text CoinId
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Getting CoinId CoinId CoinId -> CoinId -> CoinId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting CoinId CoinId CoinId -> CoinId -> CoinId)
-> Getting CoinId CoinId CoinId -> CoinId -> CoinId
forall a b. (a -> b) -> a -> b
$ AnIso CoinId CoinId CoinId CoinId
-> Iso CoinId CoinId CoinId CoinId
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso CoinId CoinId CoinId CoinId
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (Either String CoinId -> Either Text CoinId)
-> (ByteString -> Either String CoinId)
-> ByteString
-> Either Text CoinId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String CoinId
forall msg. Message msg => ByteString -> Either String msg
P.decodeMessage

instance IsString CoinId where
  fromString :: String -> CoinId
fromString = Text -> CoinId
CoinId (Text -> CoinId) -> (String -> Text) -> String -> CoinId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
instance JSON.ToJSON CoinId where
  toJSON :: CoinId -> Value
toJSON = Options -> CoinId -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
JSON.genericToJSON Options
JSON.defaultOptions
instance JSON.FromJSON CoinId where
  parseJSON :: Value -> Parser CoinId
parseJSON = Options -> Value -> Parser CoinId
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
JSON.genericParseJSON Options
JSON.defaultOptions
instance ToHttpApiData CoinId where
  toQueryParam :: CoinId -> Text
toQueryParam = CoinId -> Text
unCoinId
instance FromHttpApiData CoinId where
  parseQueryParam :: Text -> Either Text CoinId
parseQueryParam = (Text -> CoinId) -> Either Text Text -> Either Text CoinId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> CoinId
CoinId (Either Text Text -> Either Text CoinId)
-> (Text -> Either Text Text) -> Text -> Either Text CoinId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam

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

newtype Amount = Amount { Amount -> Word64
unAmount :: Word64 }
  deriving (Amount -> Amount -> Bool
(Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool) -> Eq Amount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Amount -> Amount -> Bool
$c/= :: Amount -> Amount -> Bool
== :: Amount -> Amount -> Bool
$c== :: Amount -> Amount -> Bool
Eq, Int -> Amount -> ShowS
[Amount] -> ShowS
Amount -> String
(Int -> Amount -> ShowS)
-> (Amount -> String) -> ([Amount] -> ShowS) -> Show Amount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Amount] -> ShowS
$cshowList :: [Amount] -> ShowS
show :: Amount -> String
$cshow :: Amount -> String
showsPrec :: Int -> Amount -> ShowS
$cshowsPrec :: Int -> Amount -> ShowS
Show, Integer -> Amount
Amount -> Amount
Amount -> Amount -> Amount
(Amount -> Amount -> Amount)
-> (Amount -> Amount -> Amount)
-> (Amount -> Amount -> Amount)
-> (Amount -> Amount)
-> (Amount -> Amount)
-> (Amount -> Amount)
-> (Integer -> Amount)
-> Num Amount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Amount
$cfromInteger :: Integer -> Amount
signum :: Amount -> Amount
$csignum :: Amount -> Amount
abs :: Amount -> Amount
$cabs :: Amount -> Amount
negate :: Amount -> Amount
$cnegate :: Amount -> Amount
* :: Amount -> Amount -> Amount
$c* :: Amount -> Amount -> Amount
- :: Amount -> Amount -> Amount
$c- :: Amount -> Amount -> Amount
+ :: Amount -> Amount -> Amount
$c+ :: Amount -> Amount -> Amount
Num, (forall x. Amount -> Rep Amount x)
-> (forall x. Rep Amount x -> Amount) -> Generic Amount
forall x. Rep Amount x -> Amount
forall x. Amount -> Rep Amount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Amount x -> Amount
$cfrom :: forall x. Amount -> Rep Amount x
Generic, Eq Amount
Eq Amount =>
(Amount -> Amount -> Ordering)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Amount)
-> (Amount -> Amount -> Amount)
-> Ord Amount
Amount -> Amount -> Bool
Amount -> Amount -> Ordering
Amount -> Amount -> Amount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Amount -> Amount -> Amount
$cmin :: Amount -> Amount -> Amount
max :: Amount -> Amount -> Amount
$cmax :: Amount -> Amount -> Amount
>= :: Amount -> Amount -> Bool
$c>= :: Amount -> Amount -> Bool
> :: Amount -> Amount -> Bool
$c> :: Amount -> Amount -> Bool
<= :: Amount -> Amount -> Bool
$c<= :: Amount -> Amount -> Bool
< :: Amount -> Amount -> Bool
$c< :: Amount -> Amount -> Bool
compare :: Amount -> Amount -> Ordering
$ccompare :: Amount -> Amount -> Ordering
$cp1Ord :: Eq Amount
Ord, [Amount] -> Encoding
[Amount] -> Value
Amount -> Encoding
Amount -> Value
(Amount -> Value)
-> (Amount -> Encoding)
-> ([Amount] -> Value)
-> ([Amount] -> Encoding)
-> ToJSON Amount
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Amount] -> Encoding
$ctoEncodingList :: [Amount] -> Encoding
toJSONList :: [Amount] -> Value
$ctoJSONList :: [Amount] -> Value
toEncoding :: Amount -> Encoding
$ctoEncoding :: Amount -> Encoding
toJSON :: Amount -> Value
$ctoJSON :: Amount -> Value
JSON.ToJSON, Value -> Parser [Amount]
Value -> Parser Amount
(Value -> Parser Amount)
-> (Value -> Parser [Amount]) -> FromJSON Amount
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Amount]
$cparseJSONList :: Value -> Parser [Amount]
parseJSON :: Value -> Parser Amount
$cparseJSON :: Value -> Parser Amount
JSON.FromJSON)

instance Wrapped Amount where
  type Unwrapped Amount = A.Amount

  _Wrapped' :: p (Unwrapped Amount) (f (Unwrapped Amount)) -> p Amount (f Amount)
_Wrapped' = (Amount -> Amount)
-> (Amount -> Amount) -> Iso Amount Amount Amount Amount
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Amount -> Amount
forall b. (Message b, HasField b "amount" Word64) => Amount -> b
t Amount -> Amount
forall s. HasField s "amount" Word64 => s -> Amount
f
   where
    t :: Amount -> b
t Amount {..} =
      b
forall msg. Message msg => msg
P.defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "amount" a) =>
LensLike' f s a
A.amount LensLike' Identity b Word64 -> Word64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
unAmount
    f :: s -> Amount
f message :: s
message = Amount :: Word64 -> Amount
Amount
      { unAmount :: Word64
unAmount = s
message s -> Getting Word64 s Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 s Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "amount" a) =>
LensLike' f s a
A.amount
      }

instance HasCodec Amount where
  encode :: Amount -> ByteString
encode = Amount -> ByteString
forall msg. Message msg => msg -> ByteString
P.encodeMessage (Amount -> ByteString)
-> (Amount -> Amount) -> Amount -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Amount Amount Amount -> Amount -> Amount
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Amount Amount Amount
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
  decode :: ByteString -> Either Text Amount
decode = (String -> Text)
-> (Amount -> Amount) -> Either String Amount -> Either Text Amount
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Getting Amount Amount Amount -> Amount -> Amount
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Amount Amount Amount -> Amount -> Amount)
-> Getting Amount Amount Amount -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ AnIso Amount Amount Amount Amount
-> Iso Amount Amount Amount Amount
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Amount Amount Amount Amount
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (Either String Amount -> Either Text Amount)
-> (ByteString -> Either String Amount)
-> ByteString
-> Either Text Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Amount
forall msg. Message msg => ByteString -> Either String msg
P.decodeMessage

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

data Coin = Coin
  { Coin -> CoinId
coinId     :: CoinId
  , Coin -> Amount
coinAmount :: Amount
  } deriving (Coin -> Coin -> Bool
(Coin -> Coin -> Bool) -> (Coin -> Coin -> Bool) -> Eq Coin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coin -> Coin -> Bool
$c/= :: Coin -> Coin -> Bool
== :: Coin -> Coin -> Bool
$c== :: Coin -> Coin -> Bool
Eq, Int -> Coin -> ShowS
[Coin] -> ShowS
Coin -> String
(Int -> Coin -> ShowS)
-> (Coin -> String) -> ([Coin] -> ShowS) -> Show Coin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coin] -> ShowS
$cshowList :: [Coin] -> ShowS
show :: Coin -> String
$cshow :: Coin -> String
showsPrec :: Int -> Coin -> ShowS
$cshowsPrec :: Int -> Coin -> ShowS
Show, (forall x. Coin -> Rep Coin x)
-> (forall x. Rep Coin x -> Coin) -> Generic Coin
forall x. Rep Coin x -> Coin
forall x. Coin -> Rep Coin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Coin x -> Coin
$cfrom :: forall x. Coin -> Rep Coin x
Generic)

instance Wrapped Coin where
  type Unwrapped Coin = A.Coin

  _Wrapped' :: p (Unwrapped Coin) (f (Unwrapped Coin)) -> p Coin (f Coin)
_Wrapped' = (Coin -> Coin) -> (Coin -> Coin) -> Iso Coin Coin Coin Coin
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Coin -> Coin
forall b.
(Message b, HasField b "amount" Amount, HasField b "id" CoinId) =>
Coin -> b
t Coin -> Coin
forall s.
(HasField s "amount" Amount, HasField s "id" CoinId) =>
s -> Coin
f
   where
    t :: Coin -> b
t Coin {..} =
      b
forall msg. Message msg => msg
P.defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b CoinId
forall (f :: * -> *) s a.
(Functor f, HasField s "id" a) =>
LensLike' f s a
A.id LensLike' Identity b CoinId -> CoinId -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CoinId
coinId CoinId -> Getting CoinId CoinId CoinId -> CoinId
forall s a. s -> Getting a s a -> a
^. Getting CoinId CoinId CoinId
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Amount
forall (f :: * -> *) s a.
(Functor f, HasField s "amount" a) =>
LensLike' f s a
A.amount LensLike' Identity b Amount -> Amount -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Amount
coinAmount Amount -> Getting Amount Amount Amount -> Amount
forall s a. s -> Getting a s a -> a
^. Getting Amount Amount Amount
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
    f :: s -> Coin
f message :: s
message = Coin :: CoinId -> Amount -> Coin
Coin
      { coinId :: CoinId
coinId = s
message s -> Getting CoinId s CoinId -> CoinId
forall s a. s -> Getting a s a -> a
^. LensLike' (Const CoinId) s CoinId
forall (f :: * -> *) s a.
(Functor f, HasField s "id" a) =>
LensLike' f s a
A.id LensLike' (Const CoinId) s CoinId
-> Getting CoinId CoinId CoinId -> Getting CoinId s CoinId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CoinId CoinId CoinId
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , coinAmount :: Amount
coinAmount = s
message s -> Getting Amount s Amount -> Amount
forall s a. s -> Getting a s a -> a
^. LensLike' (Const Amount) s Amount
forall (f :: * -> *) s a.
(Functor f, HasField s "amount" a) =>
LensLike' f s a
A.amount LensLike' (Const Amount) s Amount
-> Getting Amount Amount Amount -> Getting Amount s Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Amount Amount Amount
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      }

instance HasCodec Coin where
  encode :: Coin -> ByteString
encode = Coin -> ByteString
forall msg. Message msg => msg -> ByteString
P.encodeMessage (Coin -> ByteString) -> (Coin -> Coin) -> Coin -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Coin Coin Coin -> Coin -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Coin Coin Coin
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
  decode :: ByteString -> Either Text Coin
decode = (String -> Text)
-> (Coin -> Coin) -> Either String Coin -> Either Text Coin
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Getting Coin Coin Coin -> Coin -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Coin Coin Coin -> Coin -> Coin)
-> Getting Coin Coin Coin -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$ AnIso Coin Coin Coin Coin -> Iso Coin Coin Coin Coin
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Coin Coin Coin Coin
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (Either String Coin -> Either Text Coin)
-> (ByteString -> Either String Coin)
-> ByteString
-> Either Text Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Coin
forall msg. Message msg => ByteString -> Either String msg
P.decodeMessage

coinAesonOptions :: JSON.Options
coinAesonOptions :: Options
coinAesonOptions = String -> Options
defaultSDKAesonOptions "coin"

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

data Account = Account
  { Account -> [Coin]
accountCoins :: [Coin]
  , Account -> Word64
accountNonce :: Word64
  } deriving (Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
(Int -> Account -> ShowS)
-> (Account -> String) -> ([Account] -> ShowS) -> Show Account
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show, (forall x. Account -> Rep Account x)
-> (forall x. Rep Account x -> Account) -> Generic Account
forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
Generic)

instance Wrapped Account where
  type Unwrapped Account = A.Account

  _Wrapped' :: p (Unwrapped Account) (f (Unwrapped Account))
-> p Account (f Account)
_Wrapped' = (Account -> Account)
-> (Account -> Account) -> Iso Account Account Account Account
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Account -> Account
forall b.
(Message b, HasField b "coins" [Coin],
 HasField b "nonce" Word64) =>
Account -> b
t Account -> Account
forall (t :: * -> *) s.
(Traversable t, HasField s "coins" (t Coin),
 HasField s "nonce" Word64) =>
s -> Account
f
   where
    t :: Account -> b
t Account {..} =
      b
forall msg. Message msg => msg
P.defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b [Coin]
forall (f :: * -> *) s a.
(Functor f, HasField s "coins" a) =>
LensLike' f s a
A.coins LensLike' Identity b [Coin] -> [Coin] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Coin]
accountCoins [Coin] -> Getting (Endo [Coin]) [Coin] Coin -> [Coin]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Coin -> Const (Endo [Coin]) Coin)
-> [Coin] -> Const (Endo [Coin]) [Coin]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Coin -> Const (Endo [Coin]) Coin)
 -> [Coin] -> Const (Endo [Coin]) [Coin])
-> ((Coin -> Const (Endo [Coin]) Coin)
    -> Coin -> Const (Endo [Coin]) Coin)
-> Getting (Endo [Coin]) [Coin] Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const (Endo [Coin]) Coin)
-> Coin -> Const (Endo [Coin]) Coin
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "nonce" a) =>
LensLike' f s a
A.nonce LensLike' Identity b Word64 -> Word64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
accountNonce
    f :: s -> Account
f message :: s
message = Account :: [Coin] -> Word64 -> Account
Account
      { accountCoins :: [Coin]
accountCoins = s
message s -> Getting (Endo [Coin]) s Coin -> [Coin]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. LensLike' (Const (Endo [Coin])) s (t Coin)
forall (f :: * -> *) s a.
(Functor f, HasField s "coins" a) =>
LensLike' f s a
A.coinsLensLike' (Const (Endo [Coin])) s (t Coin)
-> ((Coin -> Const (Endo [Coin]) Coin)
    -> t Coin -> Const (Endo [Coin]) (t Coin))
-> Getting (Endo [Coin]) s Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const (Endo [Coin]) Coin)
-> t Coin -> Const (Endo [Coin]) (t Coin)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Coin -> Const (Endo [Coin]) Coin)
 -> t Coin -> Const (Endo [Coin]) (t Coin))
-> ((Coin -> Const (Endo [Coin]) Coin)
    -> Coin -> Const (Endo [Coin]) Coin)
-> (Coin -> Const (Endo [Coin]) Coin)
-> t Coin
-> Const (Endo [Coin]) (t Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const (Endo [Coin]) Coin)
-> Coin -> Const (Endo [Coin]) Coin
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , accountNonce :: Word64
accountNonce = s
message s -> Getting Word64 s Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 s Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "nonce" a) =>
LensLike' f s a
A.nonce
      }

instance HasCodec Account where
  encode :: Account -> ByteString
encode = Account -> ByteString
forall msg. Message msg => msg -> ByteString
P.encodeMessage (Account -> ByteString)
-> (Account -> Account) -> Account -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Account Account Account -> Account -> Account
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Account Account Account
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
  decode :: ByteString -> Either Text Account
decode = (String -> Text)
-> (Account -> Account)
-> Either String Account
-> Either Text Account
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Getting Account Account Account -> Account -> Account
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Account Account Account -> Account -> Account)
-> Getting Account Account Account -> Account -> Account
forall a b. (a -> b) -> a -> b
$ AnIso Account Account Account Account
-> Iso Account Account Account Account
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Account Account Account Account
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (Either String Account -> Either Text Account)
-> (ByteString -> Either String Account)
-> ByteString
-> Either Text Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Account
forall msg. Message msg => ByteString -> Either String msg
P.decodeMessage