{-# LANGUAGE TemplateHaskell #-}

module Network.ABCI.Types.Messages.Response where

import           Control.Lens                           (iso, (&), (.~), (^.),
                                                         (^..), (^?), _Just)
import           Control.Lens.Wrapped                   (Wrapped (..),
                                                         _Unwrapped')
import           Data.Aeson                             (FromJSON (..),
                                                         ToJSON (..),
                                                         genericParseJSON,
                                                         genericToJSON,
                                                         withObject, (.!=),
                                                         (.:), (.:?))
import           Data.ByteArray.Base64String            (Base64String)
import qualified Data.ByteArray.Base64String            as Base64
import           Data.ByteArray.HexString               (HexString)
import qualified Data.ByteArray.HexString               as Hex
import           Data.Default.Class                     (Default (..))
import           Data.Int                               (Int64)
import           Data.ProtoLens.Message                 (Message (defMessage))
import           Data.Text                              (Text)
import           Data.Word                              (Word32, Word64)
import           GHC.Generics                           (Generic)
import           Network.ABCI.Types.Messages.Common     (defaultABCIOptions,
                                                         makeABCILenses)
import           Network.ABCI.Types.Messages.FieldTypes (ConsensusParams, Event,
                                                         Proof, ValidatorUpdate,
                                                         WrappedVal (..))
import qualified Proto.Types                            as PT
import qualified Proto.Types_Fields                     as PT

--------------------------------------------------------------------------------
-- Echo
--------------------------------------------------------------------------------

data Echo = Echo
  { Echo -> Text
echoMessage :: Text
  -- ^ The input string
  } deriving (Echo -> Echo -> Bool
(Echo -> Echo -> Bool) -> (Echo -> Echo -> Bool) -> Eq Echo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Echo -> Echo -> Bool
$c/= :: Echo -> Echo -> Bool
== :: Echo -> Echo -> Bool
$c== :: Echo -> Echo -> Bool
Eq, Int -> Echo -> ShowS
[Echo] -> ShowS
Echo -> String
(Int -> Echo -> ShowS)
-> (Echo -> String) -> ([Echo] -> ShowS) -> Show Echo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Echo] -> ShowS
$cshowList :: [Echo] -> ShowS
show :: Echo -> String
$cshow :: Echo -> String
showsPrec :: Int -> Echo -> ShowS
$cshowsPrec :: Int -> Echo -> ShowS
Show, (forall x. Echo -> Rep Echo x)
-> (forall x. Rep Echo x -> Echo) -> Generic Echo
forall x. Rep Echo x -> Echo
forall x. Echo -> Rep Echo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Echo x -> Echo
$cfrom :: forall x. Echo -> Rep Echo x
Generic)

makeABCILenses ''Echo

instance ToJSON Echo where
  toJSON :: Echo -> Value
toJSON = Options -> Echo -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Echo -> Value) -> Options -> Echo -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "echo"
instance FromJSON Echo where
  parseJSON :: Value -> Parser Echo
parseJSON = Options -> Value -> Parser Echo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Echo)
-> Options -> Value -> Parser Echo
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "echo"


instance Wrapped Echo where
  type Unwrapped Echo = PT.ResponseEcho

  _Wrapped' :: p (Unwrapped Echo) (f (Unwrapped Echo)) -> p Echo (f Echo)
_Wrapped' = (Echo -> ResponseEcho)
-> (ResponseEcho -> Echo)
-> Iso Echo Echo ResponseEcho ResponseEcho
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Echo -> ResponseEcho
forall b. (Message b, HasField b "message" Text) => Echo -> b
t ResponseEcho -> Echo
forall s. HasField s "message" Text => s -> Echo
f
   where
    t :: Echo -> b
t Echo {..} = b
forall msg. Message msg => msg
defMessage b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "message" a) =>
LensLike' f s a
PT.message LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
echoMessage
    f :: s -> Echo
f message :: s
message = Echo :: Text -> Echo
Echo { echoMessage :: Text
echoMessage = 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 "message" a) =>
LensLike' f s a
PT.message }

instance Default Echo where
  def :: Echo
def = ResponseEcho
forall msg. Message msg => msg
defMessage ResponseEcho -> Getting Echo ResponseEcho Echo -> Echo
forall s a. s -> Getting a s a -> a
^. Getting Echo ResponseEcho Echo
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- Flush
--------------------------------------------------------------------------------

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

instance ToJSON Flush where
  toJSON :: Flush -> Value
toJSON = Options -> Flush -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Flush -> Value) -> Options -> Flush -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "flush"
instance FromJSON Flush where
  parseJSON :: Value -> Parser Flush
parseJSON = Options -> Value -> Parser Flush
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Flush)
-> Options -> Value -> Parser Flush
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "flush"

instance Wrapped Flush where
  type Unwrapped Flush = PT.ResponseFlush

  _Wrapped' :: p (Unwrapped Flush) (f (Unwrapped Flush)) -> p Flush (f Flush)
_Wrapped' = (Flush -> ResponseFlush)
-> (ResponseFlush -> Flush)
-> Iso Flush Flush ResponseFlush ResponseFlush
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Flush -> ResponseFlush
forall msg. Message msg => Flush -> msg
t ResponseFlush -> Flush
forall p. p -> Flush
f
   where
    t :: Flush -> msg
t Flush = msg
forall msg. Message msg => msg
defMessage
    f :: p -> Flush
f _ = Flush
Flush

instance Default Flush where
  def :: Flush
def = ResponseFlush
forall msg. Message msg => msg
defMessage ResponseFlush -> Getting Flush ResponseFlush Flush -> Flush
forall s a. s -> Getting a s a -> a
^. Getting Flush ResponseFlush Flush
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- Info
--------------------------------------------------------------------------------

data Info = Info
  { Info -> Text
infoData             :: Text
  -- ^ Some arbitrary information
  , Info -> Text
infoVersion          :: Text
  -- ^ The application software semantic version
  , Info -> WrappedVal Word64
infoAppVersion       :: WrappedVal Word64
  -- ^ The application protocol version
  , Info -> WrappedVal Int64
infoLastBlockHeight  :: WrappedVal Int64
  -- ^  Latest block for which the app has called Commit
  , Info -> HexString
infoLastBlockAppHash :: HexString
  -- ^  Latest result of Commit
  } deriving (Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c== :: Info -> Info -> Bool
Eq, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show, (forall x. Info -> Rep Info x)
-> (forall x. Rep Info x -> Info) -> Generic Info
forall x. Rep Info x -> Info
forall x. Info -> Rep Info x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Info x -> Info
$cfrom :: forall x. Info -> Rep Info x
Generic)


makeABCILenses ''Info

instance ToJSON Info where
  toJSON :: Info -> Value
toJSON = Options -> Info -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Info -> Value) -> Options -> Info -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "info"
instance FromJSON Info where
  parseJSON :: Value -> Parser Info
parseJSON = String -> (Object -> Parser Info) -> Value -> Parser Info
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Info" ((Object -> Parser Info) -> Value -> Parser Info)
-> (Object -> Parser Info) -> Value -> Parser Info
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> Text
-> Text
-> WrappedVal Word64
-> WrappedVal Int64
-> HexString
-> Info
Info
    (Text
 -> Text
 -> WrappedVal Word64
 -> WrappedVal Int64
 -> HexString
 -> Info)
-> Parser Text
-> Parser
     (Text
      -> WrappedVal Word64 -> WrappedVal Int64 -> HexString -> Info)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "data"
    Parser
  (Text
   -> WrappedVal Word64 -> WrappedVal Int64 -> HexString -> Info)
-> Parser Text
-> Parser
     (WrappedVal Word64 -> WrappedVal Int64 -> HexString -> Info)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "version"
    Parser (WrappedVal Word64 -> WrappedVal Int64 -> HexString -> Info)
-> Parser (WrappedVal Word64)
-> Parser (WrappedVal Int64 -> HexString -> Info)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (WrappedVal Word64)
forall a. FromJSON a => Object -> Text -> Parser a
.: "app_version"
    Parser (WrappedVal Int64 -> HexString -> Info)
-> Parser (WrappedVal Int64) -> Parser (HexString -> Info)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (WrappedVal Int64))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "last_block_height" Parser (Maybe (WrappedVal Int64))
-> WrappedVal Int64 -> Parser (WrappedVal Int64)
forall a. Parser (Maybe a) -> a -> Parser a
.!= 0
    Parser (HexString -> Info) -> Parser HexString -> Parser Info
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe HexString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "last_block_app_hash" Parser (Maybe HexString) -> HexString -> Parser HexString
forall a. Parser (Maybe a) -> a -> Parser a
.!= ""

instance Wrapped Info where
  type Unwrapped Info = PT.ResponseInfo

  _Wrapped' :: p (Unwrapped Info) (f (Unwrapped Info)) -> p Info (f Info)
_Wrapped' = (Info -> ResponseInfo)
-> (ResponseInfo -> Info)
-> Iso Info Info ResponseInfo ResponseInfo
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Info -> ResponseInfo
forall b a.
(Message b, HasField b "appVersion" Word64,
 HasField b "data'" Text, HasField b "lastBlockAppHash" a,
 HasField b "lastBlockHeight" Int64, HasField b "version" Text,
 ByteArray a) =>
Info -> b
t ResponseInfo -> Info
forall ba s.
(ByteArrayAccess ba, HasField s "appVersion" Word64,
 HasField s "data'" Text, HasField s "lastBlockAppHash" ba,
 HasField s "lastBlockHeight" Int64, HasField s "version" Text) =>
s -> Info
f
   where
    t :: Info -> b
t Info {..} =
      b
forall msg. Message msg => msg
defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
PT.data' LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
infoData
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "version" a) =>
LensLike' f s a
PT.version LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
infoVersion
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "appVersion" a) =>
LensLike' f s a
PT.appVersion LensLike' Identity b Word64 -> Word64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Word64 -> Word64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Word64
infoAppVersion
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "lastBlockHeight" a) =>
LensLike' f s a
PT.lastBlockHeight LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
infoLastBlockHeight
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b a
forall (f :: * -> *) s a.
(Functor f, HasField s "lastBlockAppHash" a) =>
LensLike' f s a
PT.lastBlockAppHash LensLike' Identity b a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HexString -> a
forall ba. ByteArray ba => HexString -> ba
Hex.toBytes HexString
infoLastBlockAppHash
    f :: s -> Info
f message :: s
message = Info :: Text
-> Text
-> WrappedVal Word64
-> WrappedVal Int64
-> HexString
-> Info
Info
      { infoData :: Text
infoData             = 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 "data'" a) =>
LensLike' f s a
PT.data'
      , infoVersion :: Text
infoVersion          = 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 "version" a) =>
LensLike' f s a
PT.version
      , infoAppVersion :: WrappedVal Word64
infoAppVersion       = Word64 -> WrappedVal Word64
forall a. a -> WrappedVal a
WrappedVal  (Word64 -> WrappedVal Word64) -> Word64 -> WrappedVal Word64
forall a b. (a -> b) -> a -> b
$ 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 "appVersion" a) =>
LensLike' f s a
PT.appVersion
      , infoLastBlockHeight :: WrappedVal Int64
infoLastBlockHeight  = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal (Int64 -> WrappedVal Int64) -> Int64 -> WrappedVal Int64
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "lastBlockHeight" a) =>
LensLike' f s a
PT.lastBlockHeight
      , infoLastBlockAppHash :: HexString
infoLastBlockAppHash = ba -> HexString
forall ba. ByteArrayAccess ba => ba -> HexString
Hex.fromBytes (ba -> HexString) -> ba -> HexString
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting ba s ba -> ba
forall s a. s -> Getting a s a -> a
^. Getting ba s ba
forall (f :: * -> *) s a.
(Functor f, HasField s "lastBlockAppHash" a) =>
LensLike' f s a
PT.lastBlockAppHash
      }

instance Default Info where
  def :: Info
def = ResponseInfo
forall msg. Message msg => msg
defMessage ResponseInfo -> Getting Info ResponseInfo Info -> Info
forall s a. s -> Getting a s a -> a
^. Getting Info ResponseInfo Info
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- SetOption
--------------------------------------------------------------------------------

data SetOption = SetOption
  { SetOption -> Word32
setOptionCode :: Word32
  -- ^ Response code
  , SetOption -> Text
setOptionLog  :: Text
  -- ^ The output of the application's logger. May be non-deterministic.
  , SetOption -> Text
setOptionInfo :: Text
  -- ^ Additional information. May be non-deterministic.
  } deriving (SetOption -> SetOption -> Bool
(SetOption -> SetOption -> Bool)
-> (SetOption -> SetOption -> Bool) -> Eq SetOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetOption -> SetOption -> Bool
$c/= :: SetOption -> SetOption -> Bool
== :: SetOption -> SetOption -> Bool
$c== :: SetOption -> SetOption -> Bool
Eq, Int -> SetOption -> ShowS
[SetOption] -> ShowS
SetOption -> String
(Int -> SetOption -> ShowS)
-> (SetOption -> String)
-> ([SetOption] -> ShowS)
-> Show SetOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetOption] -> ShowS
$cshowList :: [SetOption] -> ShowS
show :: SetOption -> String
$cshow :: SetOption -> String
showsPrec :: Int -> SetOption -> ShowS
$cshowsPrec :: Int -> SetOption -> ShowS
Show, (forall x. SetOption -> Rep SetOption x)
-> (forall x. Rep SetOption x -> SetOption) -> Generic SetOption
forall x. Rep SetOption x -> SetOption
forall x. SetOption -> Rep SetOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetOption x -> SetOption
$cfrom :: forall x. SetOption -> Rep SetOption x
Generic)


makeABCILenses ''SetOption

instance ToJSON SetOption where
  toJSON :: SetOption -> Value
toJSON = Options -> SetOption -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> SetOption -> Value) -> Options -> SetOption -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "setOption"
instance FromJSON SetOption where
  parseJSON :: Value -> Parser SetOption
parseJSON = Options -> Value -> Parser SetOption
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser SetOption)
-> Options -> Value -> Parser SetOption
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "setOption"


instance Wrapped SetOption where
  type Unwrapped SetOption = PT.ResponseSetOption

  _Wrapped' :: p (Unwrapped SetOption) (f (Unwrapped SetOption))
-> p SetOption (f SetOption)
_Wrapped' = (SetOption -> ResponseSetOption)
-> (ResponseSetOption -> SetOption)
-> Iso SetOption SetOption ResponseSetOption ResponseSetOption
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso SetOption -> ResponseSetOption
forall b.
(Message b, HasField b "code" Word32, HasField b "info" Text,
 HasField b "log" Text) =>
SetOption -> b
t ResponseSetOption -> SetOption
forall s.
(HasField s "code" Word32, HasField s "info" Text,
 HasField s "log" Text) =>
s -> SetOption
f
   where
    t :: SetOption -> b
t SetOption {..} =
      b
forall msg. Message msg => msg
defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code LensLike' Identity b Word32 -> Word32 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
setOptionCode
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "log" a) =>
LensLike' f s a
PT.log LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
setOptionLog
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "info" a) =>
LensLike' f s a
PT.info LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
setOptionInfo
    f :: s -> SetOption
f message :: s
message = SetOption :: Word32 -> Text -> Text -> SetOption
SetOption { setOptionCode :: Word32
setOptionCode = s
message s -> Getting Word32 s Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 s Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code
                          , setOptionLog :: Text
setOptionLog  = 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 "log" a) =>
LensLike' f s a
PT.log
                          , setOptionInfo :: Text
setOptionInfo = 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 "info" a) =>
LensLike' f s a
PT.info
                          }

instance Default SetOption where
  def :: SetOption
def = ResponseSetOption
forall msg. Message msg => msg
defMessage ResponseSetOption
-> Getting SetOption ResponseSetOption SetOption -> SetOption
forall s a. s -> Getting a s a -> a
^. Getting SetOption ResponseSetOption SetOption
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- InitChain
--------------------------------------------------------------------------------

data InitChain = InitChain
  { InitChain -> Maybe ConsensusParams
initChainConsensusParams :: Maybe ConsensusParams
  -- ^ Initial consensus-critical parameters.
  , InitChain -> [ValidatorUpdate]
initChainValidators      :: [ValidatorUpdate]
  -- ^ Initial validator set (if non empty).
  } deriving (InitChain -> InitChain -> Bool
(InitChain -> InitChain -> Bool)
-> (InitChain -> InitChain -> Bool) -> Eq InitChain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitChain -> InitChain -> Bool
$c/= :: InitChain -> InitChain -> Bool
== :: InitChain -> InitChain -> Bool
$c== :: InitChain -> InitChain -> Bool
Eq, Int -> InitChain -> ShowS
[InitChain] -> ShowS
InitChain -> String
(Int -> InitChain -> ShowS)
-> (InitChain -> String)
-> ([InitChain] -> ShowS)
-> Show InitChain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitChain] -> ShowS
$cshowList :: [InitChain] -> ShowS
show :: InitChain -> String
$cshow :: InitChain -> String
showsPrec :: Int -> InitChain -> ShowS
$cshowsPrec :: Int -> InitChain -> ShowS
Show, (forall x. InitChain -> Rep InitChain x)
-> (forall x. Rep InitChain x -> InitChain) -> Generic InitChain
forall x. Rep InitChain x -> InitChain
forall x. InitChain -> Rep InitChain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitChain x -> InitChain
$cfrom :: forall x. InitChain -> Rep InitChain x
Generic)


makeABCILenses ''InitChain

instance ToJSON InitChain where
  toJSON :: InitChain -> Value
toJSON = Options -> InitChain -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> InitChain -> Value) -> Options -> InitChain -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "initChain"
instance FromJSON InitChain where
  parseJSON :: Value -> Parser InitChain
parseJSON = String -> (Object -> Parser InitChain) -> Value -> Parser InitChain
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "InitChain" ((Object -> Parser InitChain) -> Value -> Parser InitChain)
-> (Object -> Parser InitChain) -> Value -> Parser InitChain
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> Maybe ConsensusParams -> [ValidatorUpdate] -> InitChain
InitChain
    (Maybe ConsensusParams -> [ValidatorUpdate] -> InitChain)
-> Parser (Maybe ConsensusParams)
-> Parser ([ValidatorUpdate] -> InitChain)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe ConsensusParams)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "consensusParams"
    Parser ([ValidatorUpdate] -> InitChain)
-> Parser [ValidatorUpdate] -> Parser InitChain
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [ValidatorUpdate])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "validators" Parser (Maybe [ValidatorUpdate])
-> [ValidatorUpdate] -> Parser [ValidatorUpdate]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []


instance Wrapped InitChain where
  type Unwrapped InitChain = PT.ResponseInitChain

  _Wrapped' :: p (Unwrapped InitChain) (f (Unwrapped InitChain))
-> p InitChain (f InitChain)
_Wrapped' = (InitChain -> ResponseInitChain)
-> (ResponseInitChain -> InitChain)
-> Iso InitChain InitChain ResponseInitChain ResponseInitChain
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso InitChain -> ResponseInitChain
forall b.
(Message b,
 HasField b "maybe'consensusParams" (Maybe ConsensusParams),
 HasField b "validators" [ValidatorUpdate]) =>
InitChain -> b
t ResponseInitChain -> InitChain
forall s (t :: * -> *).
(HasField s "maybe'consensusParams" (Maybe ConsensusParams),
 HasField s "validators" (t ValidatorUpdate), Traversable t) =>
s -> InitChain
f
   where
    t :: InitChain -> b
t InitChain {..} =
      b
forall msg. Message msg => msg
defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b (Maybe ConsensusParams)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'consensusParams" a) =>
LensLike' f s a
PT.maybe'consensusParams LensLike' Identity b (Maybe ConsensusParams)
-> Maybe ConsensusParams -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConsensusParams
initChainConsensusParams Maybe ConsensusParams
-> Getting
     (First ConsensusParams) (Maybe ConsensusParams) ConsensusParams
-> Maybe ConsensusParams
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> Maybe ConsensusParams
-> Const (First ConsensusParams) (Maybe ConsensusParams)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
 -> Maybe ConsensusParams
 -> Const (First ConsensusParams) (Maybe ConsensusParams))
-> ((ConsensusParams
     -> Const (First ConsensusParams) ConsensusParams)
    -> ConsensusParams
    -> Const (First ConsensusParams) ConsensusParams)
-> Getting
     (First ConsensusParams) (Maybe ConsensusParams) ConsensusParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> ConsensusParams -> Const (First ConsensusParams) ConsensusParams
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b [ValidatorUpdate]
forall (f :: * -> *) s a.
(Functor f, HasField s "validators" a) =>
LensLike' f s a
PT.validators LensLike' Identity b [ValidatorUpdate]
-> [ValidatorUpdate] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ValidatorUpdate]
initChainValidators [ValidatorUpdate]
-> Getting
     (Endo [ValidatorUpdate]) [ValidatorUpdate] ValidatorUpdate
-> [ValidatorUpdate]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> [ValidatorUpdate]
-> Const (Endo [ValidatorUpdate]) [ValidatorUpdate]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ValidatorUpdate
  -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
 -> [ValidatorUpdate]
 -> Const (Endo [ValidatorUpdate]) [ValidatorUpdate])
-> ((ValidatorUpdate
     -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
    -> ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> Getting
     (Endo [ValidatorUpdate]) [ValidatorUpdate] ValidatorUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) ValidatorUpdate
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
    f :: s -> InitChain
f message :: s
message = InitChain :: Maybe ConsensusParams -> [ValidatorUpdate] -> InitChain
InitChain
      { initChainConsensusParams :: Maybe ConsensusParams
initChainConsensusParams = s
message s
-> Getting (First ConsensusParams) s ConsensusParams
-> Maybe ConsensusParams
forall s a. s -> Getting (First a) s a -> Maybe a
^? LensLike' (Const (First ConsensusParams)) s (Maybe ConsensusParams)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'consensusParams" a) =>
LensLike' f s a
PT.maybe'consensusParams LensLike' (Const (First ConsensusParams)) s (Maybe ConsensusParams)
-> ((ConsensusParams
     -> Const (First ConsensusParams) ConsensusParams)
    -> Maybe ConsensusParams
    -> Const (First ConsensusParams) (Maybe ConsensusParams))
-> Getting (First ConsensusParams) s ConsensusParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> Maybe ConsensusParams
-> Const (First ConsensusParams) (Maybe ConsensusParams)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
 -> Maybe ConsensusParams
 -> Const (First ConsensusParams) (Maybe ConsensusParams))
-> ((ConsensusParams
     -> Const (First ConsensusParams) ConsensusParams)
    -> ConsensusParams
    -> Const (First ConsensusParams) ConsensusParams)
-> (ConsensusParams
    -> Const (First ConsensusParams) ConsensusParams)
-> Maybe ConsensusParams
-> Const (First ConsensusParams) (Maybe ConsensusParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> ConsensusParams -> Const (First ConsensusParams) ConsensusParams
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , initChainValidators :: [ValidatorUpdate]
initChainValidators = s
message s
-> Getting (Endo [ValidatorUpdate]) s ValidatorUpdate
-> [ValidatorUpdate]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. LensLike' (Const (Endo [ValidatorUpdate])) s (t ValidatorUpdate)
forall (f :: * -> *) s a.
(Functor f, HasField s "validators" a) =>
LensLike' f s a
PT.validators LensLike' (Const (Endo [ValidatorUpdate])) s (t ValidatorUpdate)
-> ((ValidatorUpdate
     -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
    -> t ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate))
-> Getting (Endo [ValidatorUpdate]) s ValidatorUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> t ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ValidatorUpdate
  -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
 -> t ValidatorUpdate
 -> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate))
-> ((ValidatorUpdate
     -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
    -> ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> (ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> t ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) ValidatorUpdate
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      }

instance Default InitChain where
  def :: InitChain
def = ResponseInitChain
forall msg. Message msg => msg
defMessage ResponseInitChain
-> Getting InitChain ResponseInitChain InitChain -> InitChain
forall s a. s -> Getting a s a -> a
^. Getting InitChain ResponseInitChain InitChain
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- Query
--------------------------------------------------------------------------------

data Query = Query
  { Query -> Word32
queryCode      :: Word32
  -- ^ Response code.
  , Query -> Text
queryLog       :: Text
  -- ^ The output of the application's logger. May be non-deterministic.
  , Query -> Text
queryInfo      :: Text
  -- ^ Additional information. May be non-deterministic.
  , Query -> WrappedVal Int64
queryIndex     :: WrappedVal Int64
  -- ^ The index of the key in the tree.
  , Query -> Base64String
queryKey       :: Base64String
  -- ^ The key of the matching data.
  , Query -> Base64String
queryValue     :: Base64String
  -- ^ The value of the matching data.
  , Query -> Maybe Proof
queryProof     :: Maybe Proof
  -- ^ Serialized proof for the value data, if requested, to be verified against
  -- the AppHash for the given Height.
  , Query -> WrappedVal Int64
queryHeight    :: WrappedVal Int64
  -- ^ The block height from which data was derived.
  , Query -> Text
queryCodespace :: Text
  -- ^ Namespace for the Code.
  } deriving (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c== :: Query -> Query -> Bool
Eq, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show, (forall x. Query -> Rep Query x)
-> (forall x. Rep Query x -> Query) -> Generic Query
forall x. Rep Query x -> Query
forall x. Query -> Rep Query x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Query x -> Query
$cfrom :: forall x. Query -> Rep Query x
Generic)


makeABCILenses ''Query

instance ToJSON Query where
  toJSON :: Query -> Value
toJSON = Options -> Query -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Query -> Value) -> Options -> Query -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "query"
instance FromJSON Query where
  parseJSON :: Value -> Parser Query
parseJSON = Options -> Value -> Parser Query
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Query)
-> Options -> Value -> Parser Query
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "query"


instance Wrapped Query where
  type Unwrapped Query = PT.ResponseQuery

  _Wrapped' :: p (Unwrapped Query) (f (Unwrapped Query)) -> p Query (f Query)
_Wrapped' = (Query -> ResponseQuery)
-> (ResponseQuery -> Query)
-> Iso Query Query ResponseQuery ResponseQuery
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Query -> ResponseQuery
forall b a a.
(Message b, ByteArray a, ByteArray a, HasField b "code" Word32,
 HasField b "codespace" Text, HasField b "height" Int64,
 HasField b "index" Int64, HasField b "info" Text,
 HasField b "key" a, HasField b "log" Text,
 HasField b "maybe'proof" (Maybe Proof), HasField b "value" a) =>
Query -> b
t ResponseQuery -> Query
forall ba ba s.
(ByteArrayAccess ba, ByteArrayAccess ba, HasField s "code" Word32,
 HasField s "codespace" Text, HasField s "height" Int64,
 HasField s "index" Int64, HasField s "info" Text,
 HasField s "key" ba, HasField s "log" Text,
 HasField s "maybe'proof" (Maybe Proof), HasField s "value" ba) =>
s -> Query
f
   where
    t :: Query -> b
t Query {..} =
      b
forall msg. Message msg => msg
defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code LensLike' Identity b Word32 -> Word32 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
queryCode
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "log" a) =>
LensLike' f s a
PT.log LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
queryLog
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "info" a) =>
LensLike' f s a
PT.info LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
queryInfo
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "index" a) =>
LensLike' f s a
PT.index LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
queryIndex
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b a
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
PT.key LensLike' Identity b a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Base64String -> a
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
queryKey
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b a
forall (f :: * -> *) s a.
(Functor f, HasField s "value" a) =>
LensLike' f s a
PT.value LensLike' Identity b a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Base64String -> a
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
queryValue
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b (Maybe Proof)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'proof" a) =>
LensLike' f s a
PT.maybe'proof LensLike' Identity b (Maybe Proof) -> Maybe Proof -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Proof
queryProof Maybe Proof
-> Getting (First Proof) (Maybe Proof) Proof -> Maybe Proof
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Proof -> Const (First Proof) Proof)
-> Maybe Proof -> Const (First Proof) (Maybe Proof)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Proof -> Const (First Proof) Proof)
 -> Maybe Proof -> Const (First Proof) (Maybe Proof))
-> ((Proof -> Const (First Proof) Proof)
    -> Proof -> Const (First Proof) Proof)
-> Getting (First Proof) (Maybe Proof) Proof
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (Proof -> Const (First Proof) Proof)
-> Proof -> Const (First Proof) Proof
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "height" a) =>
LensLike' f s a
PT.height LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
queryHeight
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "codespace" a) =>
LensLike' f s a
PT.codespace LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
queryCodespace
    f :: s -> Query
f message :: s
message = Query :: Word32
-> Text
-> Text
-> WrappedVal Int64
-> Base64String
-> Base64String
-> Maybe Proof
-> WrappedVal Int64
-> Text
-> Query
Query
      { queryCode :: Word32
queryCode      = s
message s -> Getting Word32 s Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 s Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code
      , queryLog :: Text
queryLog       = 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 "log" a) =>
LensLike' f s a
PT.log
      , queryInfo :: Text
queryInfo      = 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 "info" a) =>
LensLike' f s a
PT.info
      , queryIndex :: WrappedVal Int64
queryIndex     = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal (Int64 -> WrappedVal Int64) -> Int64 -> WrappedVal Int64
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "index" a) =>
LensLike' f s a
PT.index
      , queryKey :: Base64String
queryKey       = ba -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
Base64.fromBytes (ba -> Base64String) -> ba -> Base64String
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting ba s ba -> ba
forall s a. s -> Getting a s a -> a
^. Getting ba s ba
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
PT.key
      , queryValue :: Base64String
queryValue     = ba -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
Base64.fromBytes (ba -> Base64String) -> ba -> Base64String
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting ba s ba -> ba
forall s a. s -> Getting a s a -> a
^. Getting ba s ba
forall (f :: * -> *) s a.
(Functor f, HasField s "value" a) =>
LensLike' f s a
PT.value
      , queryProof :: Maybe Proof
queryProof     = s
message s -> Getting (First Proof) s Proof -> Maybe Proof
forall s a. s -> Getting (First a) s a -> Maybe a
^? LensLike' (Const (First Proof)) s (Maybe Proof)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'proof" a) =>
LensLike' f s a
PT.maybe'proof LensLike' (Const (First Proof)) s (Maybe Proof)
-> ((Proof -> Const (First Proof) Proof)
    -> Maybe Proof -> Const (First Proof) (Maybe Proof))
-> Getting (First Proof) s Proof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proof -> Const (First Proof) Proof)
-> Maybe Proof -> Const (First Proof) (Maybe Proof)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Proof -> Const (First Proof) Proof)
 -> Maybe Proof -> Const (First Proof) (Maybe Proof))
-> ((Proof -> Const (First Proof) Proof)
    -> Proof -> Const (First Proof) Proof)
-> (Proof -> Const (First Proof) Proof)
-> Maybe Proof
-> Const (First Proof) (Maybe Proof)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proof -> Const (First Proof) Proof)
-> Proof -> Const (First Proof) Proof
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , queryHeight :: WrappedVal Int64
queryHeight    = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal (Int64 -> WrappedVal Int64) -> Int64 -> WrappedVal Int64
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "height" a) =>
LensLike' f s a
PT.height
      , queryCodespace :: Text
queryCodespace = 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 "codespace" a) =>
LensLike' f s a
PT.codespace
      }

instance Default Query where
  def :: Query
def = ResponseQuery
forall msg. Message msg => msg
defMessage ResponseQuery -> Getting Query ResponseQuery Query -> Query
forall s a. s -> Getting a s a -> a
^. Getting Query ResponseQuery Query
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- BeginBlock
--------------------------------------------------------------------------------

data BeginBlock = BeginBlock
  { BeginBlock -> [Event]
beginBlockEvents :: [Event]
  -- ^ Beginning block events
  } deriving (BeginBlock -> BeginBlock -> Bool
(BeginBlock -> BeginBlock -> Bool)
-> (BeginBlock -> BeginBlock -> Bool) -> Eq BeginBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeginBlock -> BeginBlock -> Bool
$c/= :: BeginBlock -> BeginBlock -> Bool
== :: BeginBlock -> BeginBlock -> Bool
$c== :: BeginBlock -> BeginBlock -> Bool
Eq, Int -> BeginBlock -> ShowS
[BeginBlock] -> ShowS
BeginBlock -> String
(Int -> BeginBlock -> ShowS)
-> (BeginBlock -> String)
-> ([BeginBlock] -> ShowS)
-> Show BeginBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeginBlock] -> ShowS
$cshowList :: [BeginBlock] -> ShowS
show :: BeginBlock -> String
$cshow :: BeginBlock -> String
showsPrec :: Int -> BeginBlock -> ShowS
$cshowsPrec :: Int -> BeginBlock -> ShowS
Show, (forall x. BeginBlock -> Rep BeginBlock x)
-> (forall x. Rep BeginBlock x -> BeginBlock) -> Generic BeginBlock
forall x. Rep BeginBlock x -> BeginBlock
forall x. BeginBlock -> Rep BeginBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeginBlock x -> BeginBlock
$cfrom :: forall x. BeginBlock -> Rep BeginBlock x
Generic)


makeABCILenses ''BeginBlock

instance ToJSON BeginBlock where
  toJSON :: BeginBlock -> Value
toJSON = Options -> BeginBlock -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BeginBlock -> Value) -> Options -> BeginBlock -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "beginBlock"
instance FromJSON BeginBlock where
  parseJSON :: Value -> Parser BeginBlock
parseJSON = String
-> (Object -> Parser BeginBlock) -> Value -> Parser BeginBlock
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "BeginBlock" ((Object -> Parser BeginBlock) -> Value -> Parser BeginBlock)
-> (Object -> Parser BeginBlock) -> Value -> Parser BeginBlock
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> [Event] -> BeginBlock
BeginBlock
   ([Event] -> BeginBlock) -> Parser [Event] -> Parser BeginBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe [Event])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "events" Parser (Maybe [Event]) -> [Event] -> Parser [Event]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []


instance Wrapped BeginBlock where
  type Unwrapped BeginBlock = PT.ResponseBeginBlock

  _Wrapped' :: p (Unwrapped BeginBlock) (f (Unwrapped BeginBlock))
-> p BeginBlock (f BeginBlock)
_Wrapped' = (BeginBlock -> ResponseBeginBlock)
-> (ResponseBeginBlock -> BeginBlock)
-> Iso BeginBlock BeginBlock ResponseBeginBlock ResponseBeginBlock
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso BeginBlock -> ResponseBeginBlock
forall b.
(Message b, HasField b "events" [Event]) =>
BeginBlock -> b
t ResponseBeginBlock -> BeginBlock
forall s (t :: * -> *).
(HasField s "events" (t Event), Traversable t) =>
s -> BeginBlock
f
   where
    t :: BeginBlock -> b
t BeginBlock {..} =
      b
forall msg. Message msg => msg
defMessage b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b [Event]
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' Identity b [Event] -> [Event] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Event]
beginBlockEvents [Event] -> Getting (Endo [Event]) [Event] Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Event -> Const (Endo [Event]) Event)
-> [Event] -> Const (Endo [Event]) [Event]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> [Event] -> Const (Endo [Event]) [Event])
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> Getting (Endo [Event]) [Event] Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
    f :: s -> BeginBlock
f message :: s
message = BeginBlock :: [Event] -> BeginBlock
BeginBlock
      { beginBlockEvents :: [Event]
beginBlockEvents = s
message s -> Getting (Endo [Event]) s Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. LensLike' (Const (Endo [Event])) s (t Event)
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' (Const (Endo [Event])) s (t Event)
-> ((Event -> Const (Endo [Event]) Event)
    -> t Event -> Const (Endo [Event]) (t Event))
-> Getting (Endo [Event]) s Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> t Event -> Const (Endo [Event]) (t Event)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> t Event -> Const (Endo [Event]) (t Event))
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> (Event -> Const (Endo [Event]) Event)
-> t Event
-> Const (Endo [Event]) (t Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      }

instance Default BeginBlock where
  def :: BeginBlock
def = ResponseBeginBlock
forall msg. Message msg => msg
defMessage ResponseBeginBlock
-> Getting BeginBlock ResponseBeginBlock BeginBlock -> BeginBlock
forall s a. s -> Getting a s a -> a
^. Getting BeginBlock ResponseBeginBlock BeginBlock
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- CheckTx
--------------------------------------------------------------------------------

data CheckTx = CheckTx
  { CheckTx -> Word32
checkTxCode      :: Word32
  -- ^ Response code
  , CheckTx -> Base64String
checkTxData      :: Base64String
  -- ^ Result bytes, if any.
  , CheckTx -> Text
checkTxLog       :: Text
  -- ^ The output of the application's logger.
  , CheckTx -> Text
checkTxInfo      :: Text
  -- ^ Additional information.
  , CheckTx -> WrappedVal Int64
checkTxGasWanted :: WrappedVal Int64
  -- ^ Amount of gas requested for transaction.
  , CheckTx -> WrappedVal Int64
checkTxGasUsed   :: WrappedVal Int64
  -- ^ Amount of gas consumed by transaction.
  , CheckTx -> [Event]
checkTxEvents    :: [Event]
  -- ^ Events
  , CheckTx -> Text
checkTxCodespace :: Text
  -- ^ Namespace for the Code.
  } deriving (CheckTx -> CheckTx -> Bool
(CheckTx -> CheckTx -> Bool)
-> (CheckTx -> CheckTx -> Bool) -> Eq CheckTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckTx -> CheckTx -> Bool
$c/= :: CheckTx -> CheckTx -> Bool
== :: CheckTx -> CheckTx -> Bool
$c== :: CheckTx -> CheckTx -> Bool
Eq, Int -> CheckTx -> ShowS
[CheckTx] -> ShowS
CheckTx -> String
(Int -> CheckTx -> ShowS)
-> (CheckTx -> String) -> ([CheckTx] -> ShowS) -> Show CheckTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckTx] -> ShowS
$cshowList :: [CheckTx] -> ShowS
show :: CheckTx -> String
$cshow :: CheckTx -> String
showsPrec :: Int -> CheckTx -> ShowS
$cshowsPrec :: Int -> CheckTx -> ShowS
Show, (forall x. CheckTx -> Rep CheckTx x)
-> (forall x. Rep CheckTx x -> CheckTx) -> Generic CheckTx
forall x. Rep CheckTx x -> CheckTx
forall x. CheckTx -> Rep CheckTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckTx x -> CheckTx
$cfrom :: forall x. CheckTx -> Rep CheckTx x
Generic)


makeABCILenses ''CheckTx

instance ToJSON CheckTx where
  toJSON :: CheckTx -> Value
toJSON = Options -> CheckTx -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> CheckTx -> Value) -> Options -> CheckTx -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "checkTx"
instance FromJSON CheckTx where
  parseJSON :: Value -> Parser CheckTx
parseJSON = String -> (Object -> Parser CheckTx) -> Value -> Parser CheckTx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "CheckTx" ((Object -> Parser CheckTx) -> Value -> Parser CheckTx)
-> (Object -> Parser CheckTx) -> Value -> Parser CheckTx
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> Word32
-> Base64String
-> Text
-> Text
-> WrappedVal Int64
-> WrappedVal Int64
-> [Event]
-> Text
-> CheckTx
CheckTx
    (Word32
 -> Base64String
 -> Text
 -> Text
 -> WrappedVal Int64
 -> WrappedVal Int64
 -> [Event]
 -> Text
 -> CheckTx)
-> Parser Word32
-> Parser
     (Base64String
      -> Text
      -> Text
      -> WrappedVal Int64
      -> WrappedVal Int64
      -> [Event]
      -> Text
      -> CheckTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "code"
    Parser
  (Base64String
   -> Text
   -> Text
   -> WrappedVal Int64
   -> WrappedVal Int64
   -> [Event]
   -> Text
   -> CheckTx)
-> Parser Base64String
-> Parser
     (Text
      -> Text
      -> WrappedVal Int64
      -> WrappedVal Int64
      -> [Event]
      -> Text
      -> CheckTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Base64String
forall a. FromJSON a => Object -> Text -> Parser a
.: "data"
    Parser
  (Text
   -> Text
   -> WrappedVal Int64
   -> WrappedVal Int64
   -> [Event]
   -> Text
   -> CheckTx)
-> Parser Text
-> Parser
     (Text
      -> WrappedVal Int64
      -> WrappedVal Int64
      -> [Event]
      -> Text
      -> CheckTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "log"
    Parser
  (Text
   -> WrappedVal Int64
   -> WrappedVal Int64
   -> [Event]
   -> Text
   -> CheckTx)
-> Parser Text
-> Parser
     (WrappedVal Int64
      -> WrappedVal Int64 -> [Event] -> Text -> CheckTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "info"
    Parser
  (WrappedVal Int64
   -> WrappedVal Int64 -> [Event] -> Text -> CheckTx)
-> Parser (WrappedVal Int64)
-> Parser (WrappedVal Int64 -> [Event] -> Text -> CheckTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (WrappedVal Int64)
forall a. FromJSON a => Object -> Text -> Parser a
.: "gasWanted"
    Parser (WrappedVal Int64 -> [Event] -> Text -> CheckTx)
-> Parser (WrappedVal Int64) -> Parser ([Event] -> Text -> CheckTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (WrappedVal Int64)
forall a. FromJSON a => Object -> Text -> Parser a
.: "gasUsed"
    Parser ([Event] -> Text -> CheckTx)
-> Parser [Event] -> Parser (Text -> CheckTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Event])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "events" Parser (Maybe [Event]) -> [Event] -> Parser [Event]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser (Text -> CheckTx) -> Parser Text -> Parser CheckTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "codespace"


instance Wrapped CheckTx where
  type Unwrapped CheckTx = PT.ResponseCheckTx

  _Wrapped' :: p (Unwrapped CheckTx) (f (Unwrapped CheckTx))
-> p CheckTx (f CheckTx)
_Wrapped' = (CheckTx -> ResponseCheckTx)
-> (ResponseCheckTx -> CheckTx)
-> Iso CheckTx CheckTx ResponseCheckTx ResponseCheckTx
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso CheckTx -> ResponseCheckTx
forall b a.
(Message b, ByteArray a, HasField b "code" Word32,
 HasField b "codespace" Text, HasField b "data'" a,
 HasField b "events" [Event], HasField b "gasUsed" Int64,
 HasField b "gasWanted" Int64, HasField b "info" Text,
 HasField b "log" Text) =>
CheckTx -> b
t ResponseCheckTx -> CheckTx
forall ba (t :: * -> *) s.
(ByteArrayAccess ba, Traversable t, HasField s "code" Word32,
 HasField s "codespace" Text, HasField s "data'" ba,
 HasField s "events" (t Event), HasField s "gasUsed" Int64,
 HasField s "gasWanted" Int64, HasField s "info" Text,
 HasField s "log" Text) =>
s -> CheckTx
f
   where
    t :: CheckTx -> b
t CheckTx {..} =
      b
forall msg. Message msg => msg
defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code LensLike' Identity b Word32 -> Word32 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
checkTxCode
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b a
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
PT.data' LensLike' Identity b a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Base64String -> a
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
checkTxData
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "log" a) =>
LensLike' f s a
PT.log LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
checkTxLog
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "info" a) =>
LensLike' f s a
PT.info LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
checkTxInfo
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasWanted" a) =>
LensLike' f s a
PT.gasWanted LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
checkTxGasWanted
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasUsed" a) =>
LensLike' f s a
PT.gasUsed LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
checkTxGasUsed
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b [Event]
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' Identity b [Event] -> [Event] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Event]
checkTxEvents [Event] -> Getting (Endo [Event]) [Event] Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Event -> Const (Endo [Event]) Event)
-> [Event] -> Const (Endo [Event]) [Event]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> [Event] -> Const (Endo [Event]) [Event])
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> Getting (Endo [Event]) [Event] Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "codespace" a) =>
LensLike' f s a
PT.codespace LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
checkTxCodespace
    f :: s -> CheckTx
f message :: s
message = CheckTx :: Word32
-> Base64String
-> Text
-> Text
-> WrappedVal Int64
-> WrappedVal Int64
-> [Event]
-> Text
-> CheckTx
CheckTx
      { checkTxCode :: Word32
checkTxCode      = s
message s -> Getting Word32 s Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 s Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code
      , checkTxData :: Base64String
checkTxData      = ba -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
Base64.fromBytes (ba -> Base64String) -> ba -> Base64String
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting ba s ba -> ba
forall s a. s -> Getting a s a -> a
^. Getting ba s ba
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
PT.data'
      , checkTxLog :: Text
checkTxLog       = 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 "log" a) =>
LensLike' f s a
PT.log
      , checkTxInfo :: Text
checkTxInfo      = 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 "info" a) =>
LensLike' f s a
PT.info
      , checkTxGasWanted :: WrappedVal Int64
checkTxGasWanted = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal (Int64 -> WrappedVal Int64) -> Int64 -> WrappedVal Int64
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasWanted" a) =>
LensLike' f s a
PT.gasWanted
      , checkTxGasUsed :: WrappedVal Int64
checkTxGasUsed   = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal (Int64 -> WrappedVal Int64) -> Int64 -> WrappedVal Int64
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasUsed" a) =>
LensLike' f s a
PT.gasUsed
      , checkTxEvents :: [Event]
checkTxEvents    = s
message s -> Getting (Endo [Event]) s Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. LensLike' (Const (Endo [Event])) s (t Event)
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' (Const (Endo [Event])) s (t Event)
-> ((Event -> Const (Endo [Event]) Event)
    -> t Event -> Const (Endo [Event]) (t Event))
-> Getting (Endo [Event]) s Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> t Event -> Const (Endo [Event]) (t Event)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> t Event -> Const (Endo [Event]) (t Event))
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> (Event -> Const (Endo [Event]) Event)
-> t Event
-> Const (Endo [Event]) (t Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , checkTxCodespace :: Text
checkTxCodespace = 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 "codespace" a) =>
LensLike' f s a
PT.codespace
      }

instance Default CheckTx where
  def :: CheckTx
def = ResponseCheckTx
forall msg. Message msg => msg
defMessage ResponseCheckTx
-> Getting CheckTx ResponseCheckTx CheckTx -> CheckTx
forall s a. s -> Getting a s a -> a
^. Getting CheckTx ResponseCheckTx CheckTx
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- DeliverTx
--------------------------------------------------------------------------------

data DeliverTx = DeliverTx
  { DeliverTx -> Word32
deliverTxCode      :: Word32
  -- ^ Response code.
  , DeliverTx -> Base64String
deliverTxData      :: Base64String
  -- ^ Result bytes, if any.
  , DeliverTx -> Text
deliverTxLog       :: Text
  -- ^ The output of the application's logger. May be non-deterministic.
  , DeliverTx -> Text
deliverTxInfo      :: Text
  -- ^ Additional information.
  , DeliverTx -> WrappedVal Int64
deliverTxGasWanted :: WrappedVal Int64
  -- ^ Amount of gas requested for transaction.
  , DeliverTx -> WrappedVal Int64
deliverTxGasUsed   :: WrappedVal Int64
  -- ^ Amount of gas consumed by transaction.
  , DeliverTx -> [Event]
deliverTxEvents    :: [Event]
  -- ^ Events
  , DeliverTx -> Text
deliverTxCodespace :: Text
  -- ^ Namespace for the Code.
  } deriving (DeliverTx -> DeliverTx -> Bool
(DeliverTx -> DeliverTx -> Bool)
-> (DeliverTx -> DeliverTx -> Bool) -> Eq DeliverTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeliverTx -> DeliverTx -> Bool
$c/= :: DeliverTx -> DeliverTx -> Bool
== :: DeliverTx -> DeliverTx -> Bool
$c== :: DeliverTx -> DeliverTx -> Bool
Eq, Int -> DeliverTx -> ShowS
[DeliverTx] -> ShowS
DeliverTx -> String
(Int -> DeliverTx -> ShowS)
-> (DeliverTx -> String)
-> ([DeliverTx] -> ShowS)
-> Show DeliverTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeliverTx] -> ShowS
$cshowList :: [DeliverTx] -> ShowS
show :: DeliverTx -> String
$cshow :: DeliverTx -> String
showsPrec :: Int -> DeliverTx -> ShowS
$cshowsPrec :: Int -> DeliverTx -> ShowS
Show, (forall x. DeliverTx -> Rep DeliverTx x)
-> (forall x. Rep DeliverTx x -> DeliverTx) -> Generic DeliverTx
forall x. Rep DeliverTx x -> DeliverTx
forall x. DeliverTx -> Rep DeliverTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeliverTx x -> DeliverTx
$cfrom :: forall x. DeliverTx -> Rep DeliverTx x
Generic)


makeABCILenses ''DeliverTx

instance ToJSON DeliverTx where
  toJSON :: DeliverTx -> Value
toJSON = Options -> DeliverTx -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> DeliverTx -> Value) -> Options -> DeliverTx -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "deliverTx"
instance FromJSON DeliverTx where
  parseJSON :: Value -> Parser DeliverTx
parseJSON = String -> (Object -> Parser DeliverTx) -> Value -> Parser DeliverTx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "DeliverTx" ((Object -> Parser DeliverTx) -> Value -> Parser DeliverTx)
-> (Object -> Parser DeliverTx) -> Value -> Parser DeliverTx
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> Word32
-> Base64String
-> Text
-> Text
-> WrappedVal Int64
-> WrappedVal Int64
-> [Event]
-> Text
-> DeliverTx
DeliverTx
    (Word32
 -> Base64String
 -> Text
 -> Text
 -> WrappedVal Int64
 -> WrappedVal Int64
 -> [Event]
 -> Text
 -> DeliverTx)
-> Parser Word32
-> Parser
     (Base64String
      -> Text
      -> Text
      -> WrappedVal Int64
      -> WrappedVal Int64
      -> [Event]
      -> Text
      -> DeliverTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "code"
    Parser
  (Base64String
   -> Text
   -> Text
   -> WrappedVal Int64
   -> WrappedVal Int64
   -> [Event]
   -> Text
   -> DeliverTx)
-> Parser Base64String
-> Parser
     (Text
      -> Text
      -> WrappedVal Int64
      -> WrappedVal Int64
      -> [Event]
      -> Text
      -> DeliverTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Base64String
forall a. FromJSON a => Object -> Text -> Parser a
.: "data"
    Parser
  (Text
   -> Text
   -> WrappedVal Int64
   -> WrappedVal Int64
   -> [Event]
   -> Text
   -> DeliverTx)
-> Parser Text
-> Parser
     (Text
      -> WrappedVal Int64
      -> WrappedVal Int64
      -> [Event]
      -> Text
      -> DeliverTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "log"
    Parser
  (Text
   -> WrappedVal Int64
   -> WrappedVal Int64
   -> [Event]
   -> Text
   -> DeliverTx)
-> Parser Text
-> Parser
     (WrappedVal Int64
      -> WrappedVal Int64 -> [Event] -> Text -> DeliverTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "info"
    Parser
  (WrappedVal Int64
   -> WrappedVal Int64 -> [Event] -> Text -> DeliverTx)
-> Parser (WrappedVal Int64)
-> Parser (WrappedVal Int64 -> [Event] -> Text -> DeliverTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (WrappedVal Int64)
forall a. FromJSON a => Object -> Text -> Parser a
.: "gasWanted"
    Parser (WrappedVal Int64 -> [Event] -> Text -> DeliverTx)
-> Parser (WrappedVal Int64)
-> Parser ([Event] -> Text -> DeliverTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (WrappedVal Int64)
forall a. FromJSON a => Object -> Text -> Parser a
.: "gasUsed"
    Parser ([Event] -> Text -> DeliverTx)
-> Parser [Event] -> Parser (Text -> DeliverTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Event])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "events" Parser (Maybe [Event]) -> [Event] -> Parser [Event]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser (Text -> DeliverTx) -> Parser Text -> Parser DeliverTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "codespace"


instance Wrapped DeliverTx where
  type Unwrapped DeliverTx = PT.ResponseDeliverTx

  _Wrapped' :: p (Unwrapped DeliverTx) (f (Unwrapped DeliverTx))
-> p DeliverTx (f DeliverTx)
_Wrapped' = (DeliverTx -> ResponseDeliverTx)
-> (ResponseDeliverTx -> DeliverTx)
-> Iso DeliverTx DeliverTx ResponseDeliverTx ResponseDeliverTx
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso DeliverTx -> ResponseDeliverTx
forall b a.
(Message b, ByteArray a, HasField b "code" Word32,
 HasField b "codespace" Text, HasField b "data'" a,
 HasField b "events" [Event], HasField b "gasUsed" Int64,
 HasField b "gasWanted" Int64, HasField b "info" Text,
 HasField b "log" Text) =>
DeliverTx -> b
t ResponseDeliverTx -> DeliverTx
forall ba (t :: * -> *) s.
(ByteArrayAccess ba, Traversable t, HasField s "code" Word32,
 HasField s "codespace" Text, HasField s "data'" ba,
 HasField s "events" (t Event), HasField s "gasUsed" Int64,
 HasField s "gasWanted" Int64, HasField s "info" Text,
 HasField s "log" Text) =>
s -> DeliverTx
f
   where
    t :: DeliverTx -> b
t DeliverTx {..} =
      b
forall msg. Message msg => msg
defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code LensLike' Identity b Word32 -> Word32 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
deliverTxCode
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b a
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
PT.data' LensLike' Identity b a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Base64String -> a
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
deliverTxData
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "log" a) =>
LensLike' f s a
PT.log LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
deliverTxLog
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "info" a) =>
LensLike' f s a
PT.info LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
deliverTxInfo
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasWanted" a) =>
LensLike' f s a
PT.gasWanted LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
deliverTxGasWanted
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasUsed" a) =>
LensLike' f s a
PT.gasUsed LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
deliverTxGasUsed
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b [Event]
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' Identity b [Event] -> [Event] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Event]
deliverTxEvents [Event] -> Getting (Endo [Event]) [Event] Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Event -> Const (Endo [Event]) Event)
-> [Event] -> Const (Endo [Event]) [Event]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> [Event] -> Const (Endo [Event]) [Event])
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> Getting (Endo [Event]) [Event] Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "codespace" a) =>
LensLike' f s a
PT.codespace LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
deliverTxCodespace
    f :: s -> DeliverTx
f responseDeliverTx :: s
responseDeliverTx = DeliverTx :: Word32
-> Base64String
-> Text
-> Text
-> WrappedVal Int64
-> WrappedVal Int64
-> [Event]
-> Text
-> DeliverTx
DeliverTx
      { deliverTxCode :: Word32
deliverTxCode      = s
responseDeliverTx s -> Getting Word32 s Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 s Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "code" a) =>
LensLike' f s a
PT.code
      , deliverTxData :: Base64String
deliverTxData      = ba -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
Base64.fromBytes (ba -> Base64String) -> ba -> Base64String
forall a b. (a -> b) -> a -> b
$ s
responseDeliverTx s -> Getting ba s ba -> ba
forall s a. s -> Getting a s a -> a
^. Getting ba s ba
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
PT.data'
      , deliverTxLog :: Text
deliverTxLog       = s
responseDeliverTx 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 "log" a) =>
LensLike' f s a
PT.log
      , deliverTxInfo :: Text
deliverTxInfo      = s
responseDeliverTx 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 "info" a) =>
LensLike' f s a
PT.info
      , deliverTxGasWanted :: WrappedVal Int64
deliverTxGasWanted = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal (Int64 -> WrappedVal Int64) -> Int64 -> WrappedVal Int64
forall a b. (a -> b) -> a -> b
$ s
responseDeliverTx s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasWanted" a) =>
LensLike' f s a
PT.gasWanted
      , deliverTxGasUsed :: WrappedVal Int64
deliverTxGasUsed   = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal (Int64 -> WrappedVal Int64) -> Int64 -> WrappedVal Int64
forall a b. (a -> b) -> a -> b
$ s
responseDeliverTx s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gasUsed" a) =>
LensLike' f s a
PT.gasUsed
      , deliverTxEvents :: [Event]
deliverTxEvents    = s
responseDeliverTx s -> Getting (Endo [Event]) s Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. LensLike' (Const (Endo [Event])) s (t Event)
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' (Const (Endo [Event])) s (t Event)
-> ((Event -> Const (Endo [Event]) Event)
    -> t Event -> Const (Endo [Event]) (t Event))
-> Getting (Endo [Event]) s Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> t Event -> Const (Endo [Event]) (t Event)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> t Event -> Const (Endo [Event]) (t Event))
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> (Event -> Const (Endo [Event]) Event)
-> t Event
-> Const (Endo [Event]) (t Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , deliverTxCodespace :: Text
deliverTxCodespace = s
responseDeliverTx 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 "codespace" a) =>
LensLike' f s a
PT.codespace
      }

instance Default DeliverTx where
  def :: DeliverTx
def = ResponseDeliverTx
forall msg. Message msg => msg
defMessage ResponseDeliverTx
-> Getting DeliverTx ResponseDeliverTx DeliverTx -> DeliverTx
forall s a. s -> Getting a s a -> a
^. Getting DeliverTx ResponseDeliverTx DeliverTx
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- EndBlock
--------------------------------------------------------------------------------

data EndBlock = EndBlock
  { EndBlock -> [ValidatorUpdate]
endBlockValidatorUpdates      :: [ValidatorUpdate]
  -- ^ Changes to validator set (set voting power to 0 to remove).
  , EndBlock -> Maybe ConsensusParams
endBlockConsensusParamUpdates :: Maybe ConsensusParams
  -- ^ Changes to consensus-critical time, size, and other parameters.
  , EndBlock -> [Event]
endBlockEvents                :: [Event]
  -- ^ Events
  } deriving (EndBlock -> EndBlock -> Bool
(EndBlock -> EndBlock -> Bool)
-> (EndBlock -> EndBlock -> Bool) -> Eq EndBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndBlock -> EndBlock -> Bool
$c/= :: EndBlock -> EndBlock -> Bool
== :: EndBlock -> EndBlock -> Bool
$c== :: EndBlock -> EndBlock -> Bool
Eq, Int -> EndBlock -> ShowS
[EndBlock] -> ShowS
EndBlock -> String
(Int -> EndBlock -> ShowS)
-> (EndBlock -> String) -> ([EndBlock] -> ShowS) -> Show EndBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndBlock] -> ShowS
$cshowList :: [EndBlock] -> ShowS
show :: EndBlock -> String
$cshow :: EndBlock -> String
showsPrec :: Int -> EndBlock -> ShowS
$cshowsPrec :: Int -> EndBlock -> ShowS
Show, (forall x. EndBlock -> Rep EndBlock x)
-> (forall x. Rep EndBlock x -> EndBlock) -> Generic EndBlock
forall x. Rep EndBlock x -> EndBlock
forall x. EndBlock -> Rep EndBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EndBlock x -> EndBlock
$cfrom :: forall x. EndBlock -> Rep EndBlock x
Generic)

makeABCILenses ''EndBlock

instance ToJSON EndBlock where
  toJSON :: EndBlock -> Value
toJSON = Options -> EndBlock -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> EndBlock -> Value) -> Options -> EndBlock -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "endBlock"
instance FromJSON EndBlock where
  parseJSON :: Value -> Parser EndBlock
parseJSON = String -> (Object -> Parser EndBlock) -> Value -> Parser EndBlock
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "EndBlock" ((Object -> Parser EndBlock) -> Value -> Parser EndBlock)
-> (Object -> Parser EndBlock) -> Value -> Parser EndBlock
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> [ValidatorUpdate] -> Maybe ConsensusParams -> [Event] -> EndBlock
EndBlock
    ([ValidatorUpdate] -> Maybe ConsensusParams -> [Event] -> EndBlock)
-> Parser [ValidatorUpdate]
-> Parser (Maybe ConsensusParams -> [Event] -> EndBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe [ValidatorUpdate])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "validatorUpdates" Parser (Maybe [ValidatorUpdate])
-> [ValidatorUpdate] -> Parser [ValidatorUpdate]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser (Maybe ConsensusParams -> [Event] -> EndBlock)
-> Parser (Maybe ConsensusParams) -> Parser ([Event] -> EndBlock)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe ConsensusParams)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "consensusParams"
    Parser ([Event] -> EndBlock) -> Parser [Event] -> Parser EndBlock
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Event])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "events" Parser (Maybe [Event]) -> [Event] -> Parser [Event]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []


instance Wrapped EndBlock where
  type Unwrapped EndBlock = PT.ResponseEndBlock

  _Wrapped' :: p (Unwrapped EndBlock) (f (Unwrapped EndBlock))
-> p EndBlock (f EndBlock)
_Wrapped' = (EndBlock -> ResponseEndBlock)
-> (ResponseEndBlock -> EndBlock)
-> Iso EndBlock EndBlock ResponseEndBlock ResponseEndBlock
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso EndBlock -> ResponseEndBlock
forall b.
(Message b, HasField b "events" [Event],
 HasField b "maybe'consensusParamUpdates" (Maybe ConsensusParams),
 HasField b "validatorUpdates" [ValidatorUpdate]) =>
EndBlock -> b
t ResponseEndBlock -> EndBlock
forall s (t :: * -> *) (t :: * -> *).
(HasField s "events" (t Event),
 HasField s "maybe'consensusParamUpdates" (Maybe ConsensusParams),
 HasField s "validatorUpdates" (t ValidatorUpdate), Traversable t,
 Traversable t) =>
s -> EndBlock
f
   where
    t :: EndBlock -> b
t EndBlock {..} =
      b
forall msg. Message msg => msg
defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b [ValidatorUpdate]
forall (f :: * -> *) s a.
(Functor f, HasField s "validatorUpdates" a) =>
LensLike' f s a
PT.validatorUpdates LensLike' Identity b [ValidatorUpdate]
-> [ValidatorUpdate] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ValidatorUpdate]
endBlockValidatorUpdates [ValidatorUpdate]
-> Getting
     (Endo [ValidatorUpdate]) [ValidatorUpdate] ValidatorUpdate
-> [ValidatorUpdate]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> [ValidatorUpdate]
-> Const (Endo [ValidatorUpdate]) [ValidatorUpdate]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ValidatorUpdate
  -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
 -> [ValidatorUpdate]
 -> Const (Endo [ValidatorUpdate]) [ValidatorUpdate])
-> ((ValidatorUpdate
     -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
    -> ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> Getting
     (Endo [ValidatorUpdate]) [ValidatorUpdate] ValidatorUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) ValidatorUpdate
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b (Maybe ConsensusParams)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'consensusParamUpdates" a) =>
LensLike' f s a
PT.maybe'consensusParamUpdates LensLike' Identity b (Maybe ConsensusParams)
-> Maybe ConsensusParams -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConsensusParams
endBlockConsensusParamUpdates Maybe ConsensusParams
-> Getting
     (First ConsensusParams) (Maybe ConsensusParams) ConsensusParams
-> Maybe ConsensusParams
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> Maybe ConsensusParams
-> Const (First ConsensusParams) (Maybe ConsensusParams)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
 -> Maybe ConsensusParams
 -> Const (First ConsensusParams) (Maybe ConsensusParams))
-> ((ConsensusParams
     -> Const (First ConsensusParams) ConsensusParams)
    -> ConsensusParams
    -> Const (First ConsensusParams) ConsensusParams)
-> Getting
     (First ConsensusParams) (Maybe ConsensusParams) ConsensusParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> ConsensusParams -> Const (First ConsensusParams) ConsensusParams
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b [Event]
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' Identity b [Event] -> [Event] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Event]
endBlockEvents [Event] -> Getting (Endo [Event]) [Event] Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Event -> Const (Endo [Event]) Event)
-> [Event] -> Const (Endo [Event]) [Event]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> [Event] -> Const (Endo [Event]) [Event])
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> Getting (Endo [Event]) [Event] Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
    f :: s -> EndBlock
f message :: s
message = EndBlock :: [ValidatorUpdate] -> Maybe ConsensusParams -> [Event] -> EndBlock
EndBlock
      { endBlockValidatorUpdates :: [ValidatorUpdate]
endBlockValidatorUpdates = s
message s
-> Getting (Endo [ValidatorUpdate]) s ValidatorUpdate
-> [ValidatorUpdate]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. LensLike' (Const (Endo [ValidatorUpdate])) s (t ValidatorUpdate)
forall (f :: * -> *) s a.
(Functor f, HasField s "validatorUpdates" a) =>
LensLike' f s a
PT.validatorUpdates LensLike' (Const (Endo [ValidatorUpdate])) s (t ValidatorUpdate)
-> ((ValidatorUpdate
     -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
    -> t ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate))
-> Getting (Endo [ValidatorUpdate]) s ValidatorUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> t ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ValidatorUpdate
  -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
 -> t ValidatorUpdate
 -> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate))
-> ((ValidatorUpdate
     -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
    -> ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> (ValidatorUpdate
    -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> t ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) (t ValidatorUpdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorUpdate -> Const (Endo [ValidatorUpdate]) ValidatorUpdate)
-> ValidatorUpdate
-> Const (Endo [ValidatorUpdate]) ValidatorUpdate
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , endBlockConsensusParamUpdates :: Maybe ConsensusParams
endBlockConsensusParamUpdates = s
message s
-> Getting (First ConsensusParams) s ConsensusParams
-> Maybe ConsensusParams
forall s a. s -> Getting (First a) s a -> Maybe a
^? LensLike' (Const (First ConsensusParams)) s (Maybe ConsensusParams)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'consensusParamUpdates" a) =>
LensLike' f s a
PT.maybe'consensusParamUpdates LensLike' (Const (First ConsensusParams)) s (Maybe ConsensusParams)
-> ((ConsensusParams
     -> Const (First ConsensusParams) ConsensusParams)
    -> Maybe ConsensusParams
    -> Const (First ConsensusParams) (Maybe ConsensusParams))
-> Getting (First ConsensusParams) s ConsensusParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> Maybe ConsensusParams
-> Const (First ConsensusParams) (Maybe ConsensusParams)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
 -> Maybe ConsensusParams
 -> Const (First ConsensusParams) (Maybe ConsensusParams))
-> ((ConsensusParams
     -> Const (First ConsensusParams) ConsensusParams)
    -> ConsensusParams
    -> Const (First ConsensusParams) ConsensusParams)
-> (ConsensusParams
    -> Const (First ConsensusParams) ConsensusParams)
-> Maybe ConsensusParams
-> Const (First ConsensusParams) (Maybe ConsensusParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsensusParams -> Const (First ConsensusParams) ConsensusParams)
-> ConsensusParams -> Const (First ConsensusParams) ConsensusParams
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , endBlockEvents :: [Event]
endBlockEvents = s
message s -> Getting (Endo [Event]) s Event -> [Event]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. LensLike' (Const (Endo [Event])) s (t Event)
forall (f :: * -> *) s a.
(Functor f, HasField s "events" a) =>
LensLike' f s a
PT.events LensLike' (Const (Endo [Event])) s (t Event)
-> ((Event -> Const (Endo [Event]) Event)
    -> t Event -> Const (Endo [Event]) (t Event))
-> Getting (Endo [Event]) s Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> t Event -> Const (Endo [Event]) (t Event)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Event -> Const (Endo [Event]) Event)
 -> t Event -> Const (Endo [Event]) (t Event))
-> ((Event -> Const (Endo [Event]) Event)
    -> Event -> Const (Endo [Event]) Event)
-> (Event -> Const (Endo [Event]) Event)
-> t Event
-> Const (Endo [Event]) (t Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Const (Endo [Event]) Event)
-> Event -> Const (Endo [Event]) Event
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      }

instance Default EndBlock where
  def :: EndBlock
def = ResponseEndBlock
forall msg. Message msg => msg
defMessage ResponseEndBlock
-> Getting EndBlock ResponseEndBlock EndBlock -> EndBlock
forall s a. s -> Getting a s a -> a
^. Getting EndBlock ResponseEndBlock EndBlock
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- Commit
--------------------------------------------------------------------------------

data Commit = Commit
  { Commit -> Base64String
commitData :: Base64String
  -- ^ The Merkle root hash of the application state
  } deriving (Commit -> Commit -> Bool
(Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool) -> Eq Commit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commit -> Commit -> Bool
$c/= :: Commit -> Commit -> Bool
== :: Commit -> Commit -> Bool
$c== :: Commit -> Commit -> Bool
Eq, Int -> Commit -> ShowS
[Commit] -> ShowS
Commit -> String
(Int -> Commit -> ShowS)
-> (Commit -> String) -> ([Commit] -> ShowS) -> Show Commit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Commit] -> ShowS
$cshowList :: [Commit] -> ShowS
show :: Commit -> String
$cshow :: Commit -> String
showsPrec :: Int -> Commit -> ShowS
$cshowsPrec :: Int -> Commit -> ShowS
Show, (forall x. Commit -> Rep Commit x)
-> (forall x. Rep Commit x -> Commit) -> Generic Commit
forall x. Rep Commit x -> Commit
forall x. Commit -> Rep Commit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Commit x -> Commit
$cfrom :: forall x. Commit -> Rep Commit x
Generic)

makeABCILenses ''Commit

instance ToJSON Commit where
  toJSON :: Commit -> Value
toJSON = Options -> Commit -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Commit -> Value) -> Options -> Commit -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "commit"
instance FromJSON Commit where
  parseJSON :: Value -> Parser Commit
parseJSON = Options -> Value -> Parser Commit
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Commit)
-> Options -> Value -> Parser Commit
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "commit"

instance Wrapped Commit where
  type Unwrapped Commit = PT.ResponseCommit

  _Wrapped' :: p (Unwrapped Commit) (f (Unwrapped Commit)) -> p Commit (f Commit)
_Wrapped' = (Commit -> ResponseCommit)
-> (ResponseCommit -> Commit)
-> Iso Commit Commit ResponseCommit ResponseCommit
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Commit -> ResponseCommit
forall b a.
(Message b, HasField b "data'" a, ByteArray a) =>
Commit -> b
t ResponseCommit -> Commit
forall ba s.
(ByteArrayAccess ba, HasField s "data'" ba) =>
s -> Commit
f
   where
    t :: Commit -> b
t Commit {..} = b
forall msg. Message msg => msg
defMessage b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b a
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
PT.data' LensLike' Identity b a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Base64String -> a
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
commitData
    f :: s -> Commit
f message :: s
message = Commit :: Base64String -> Commit
Commit { commitData :: Base64String
commitData = ba -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
Base64.fromBytes (ba -> Base64String) -> ba -> Base64String
forall a b. (a -> b) -> a -> b
$ s
message s -> Getting ba s ba -> ba
forall s a. s -> Getting a s a -> a
^. Getting ba s ba
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
PT.data' }

instance Default Commit where
  def :: Commit
def = ResponseCommit
forall msg. Message msg => msg
defMessage ResponseCommit -> Getting Commit ResponseCommit Commit -> Commit
forall s a. s -> Getting a s a -> a
^. Getting Commit ResponseCommit Commit
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

--------------------------------------------------------------------------------
-- Exception
--------------------------------------------------------------------------------

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


makeABCILenses ''Exception

instance ToJSON Exception where
  toJSON :: Exception -> Value
toJSON = Options -> Exception -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Exception -> Value) -> Options -> Exception -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "exception"
instance FromJSON Exception where
  parseJSON :: Value -> Parser Exception
parseJSON = Options -> Value -> Parser Exception
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Exception)
-> Options -> Value -> Parser Exception
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultABCIOptions "exception"

instance Default Exception where
  def :: Exception
def = ResponseException
forall msg. Message msg => msg
defMessage ResponseException
-> Getting Exception ResponseException Exception -> Exception
forall s a. s -> Getting a s a -> a
^. Getting Exception ResponseException Exception
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'

instance Wrapped Exception where
  type Unwrapped Exception = PT.ResponseException

  _Wrapped' :: p (Unwrapped Exception) (f (Unwrapped Exception))
-> p Exception (f Exception)
_Wrapped' = (Exception -> ResponseException)
-> (ResponseException -> Exception)
-> Iso Exception Exception ResponseException ResponseException
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Exception -> ResponseException
forall b. (Message b, HasField b "error" Text) => Exception -> b
t ResponseException -> Exception
forall s. HasField s "error" Text => s -> Exception
f
   where
    t :: Exception -> b
t Exception {..} = b
forall msg. Message msg => msg
defMessage b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "error" a) =>
LensLike' f s a
PT.error LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
exceptionError
    f :: s -> Exception
f responseException :: s
responseException =
      Exception :: Text -> Exception
Exception { exceptionError :: Text
exceptionError = s
responseException 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 "error" a) =>
LensLike' f s a
PT.error }