{- This file was auto-generated from btc_lsp/data/high_level.proto by the proto-lens-protoc program. -}
{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, BangPatterns, TypeApplications, OverloadedStrings, DerivingStrategies, DeriveGeneric#-}
{-# OPTIONS_GHC -Wno-unused-imports#-}
{-# OPTIONS_GHC -Wno-duplicate-exports#-}
{-# OPTIONS_GHC -Wno-dodgy-exports#-}
module Proto.BtcLsp.Data.HighLevel (
        Ctx(), FeeMoney(), FeeRate(), FieldIndex(), FundLnHodlInvoice(),
        FundLnInvoice(), FundMoney(), FundOnChainAddress(), InputFailure(),
        InputFailureKind(..), InputFailureKind(),
        InputFailureKind'UnrecognizedValue, InternalFailure(),
        InternalFailure'Either(..), _InternalFailure'Redacted,
        _InternalFailure'GrpcServer, _InternalFailure'Math, LnHost(),
        LnPeer(), LnPort(), LnPubKey(), LocalBalance(), Nonce(),
        Privacy(..), Privacy(), Privacy'UnrecognizedValue, RefundMoney(),
        RefundOnChainAddress(), RemoteBalance()
    ) where
import qualified Data.ProtoLens.Runtime.Control.DeepSeq as Control.DeepSeq
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Prism as Data.ProtoLens.Prism
import qualified Text.PrettyPrint.GenericPretty.Instance
import qualified GHC.Generics
import qualified Text.PrettyPrint.GenericPretty
import qualified Data.ProtoLens.Runtime.Prelude as Prelude
import qualified Data.ProtoLens.Runtime.Data.Int as Data.Int
import qualified Data.ProtoLens.Runtime.Data.Monoid as Data.Monoid
import qualified Data.ProtoLens.Runtime.Data.Word as Data.Word
import qualified Data.ProtoLens.Runtime.Data.ProtoLens as Data.ProtoLens
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes as Data.ProtoLens.Encoding.Bytes
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing as Data.ProtoLens.Encoding.Growing
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe as Data.ProtoLens.Encoding.Parser.Unsafe
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire as Data.ProtoLens.Encoding.Wire
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Field as Data.ProtoLens.Field
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum as Data.ProtoLens.Message.Enum
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types as Data.ProtoLens.Service.Types
import qualified Data.ProtoLens.Runtime.Lens.Family2 as Lens.Family2
import qualified Data.ProtoLens.Runtime.Lens.Family2.Unchecked as Lens.Family2.Unchecked
import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text
import qualified Data.ProtoLens.Runtime.Data.Map as Data.Map
import qualified Data.ProtoLens.Runtime.Data.ByteString as Data.ByteString
import qualified Data.ProtoLens.Runtime.Data.ByteString.Char8 as Data.ByteString.Char8
import qualified Data.ProtoLens.Runtime.Data.Text.Encoding as Data.Text.Encoding
import qualified Data.ProtoLens.Runtime.Data.Vector as Data.Vector
import qualified Data.ProtoLens.Runtime.Data.Vector.Generic as Data.Vector.Generic
import qualified Data.ProtoLens.Runtime.Data.Vector.Unboxed as Data.Vector.Unboxed
import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read
import qualified Proto.BtcLsp.Data.LowLevel
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.nonce' @:: Lens' Ctx Nonce@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'nonce' @:: Lens' Ctx (Prelude.Maybe Nonce)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.lnPubKey' @:: Lens' Ctx LnPubKey@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'lnPubKey' @:: Lens' Ctx (Prelude.Maybe LnPubKey)@ -}
data Ctx
  = Ctx'_constructor {Ctx -> Maybe Nonce
_Ctx'nonce :: !(Prelude.Maybe Nonce),
                      Ctx -> Maybe LnPubKey
_Ctx'lnPubKey :: !(Prelude.Maybe LnPubKey),
                      Ctx -> FieldSet
_Ctx'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (Ctx -> Ctx -> Bool
(Ctx -> Ctx -> Bool) -> (Ctx -> Ctx -> Bool) -> Eq Ctx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ctx -> Ctx -> Bool
$c/= :: Ctx -> Ctx -> Bool
== :: Ctx -> Ctx -> Bool
$c== :: Ctx -> Ctx -> Bool
Prelude.Eq, Eq Ctx
Eq Ctx
-> (Ctx -> Ctx -> Ordering)
-> (Ctx -> Ctx -> Bool)
-> (Ctx -> Ctx -> Bool)
-> (Ctx -> Ctx -> Bool)
-> (Ctx -> Ctx -> Bool)
-> (Ctx -> Ctx -> Ctx)
-> (Ctx -> Ctx -> Ctx)
-> Ord Ctx
Ctx -> Ctx -> Bool
Ctx -> Ctx -> Ordering
Ctx -> Ctx -> Ctx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ctx -> Ctx -> Ctx
$cmin :: Ctx -> Ctx -> Ctx
max :: Ctx -> Ctx -> Ctx
$cmax :: Ctx -> Ctx -> Ctx
>= :: Ctx -> Ctx -> Bool
$c>= :: Ctx -> Ctx -> Bool
> :: Ctx -> Ctx -> Bool
$c> :: Ctx -> Ctx -> Bool
<= :: Ctx -> Ctx -> Bool
$c<= :: Ctx -> Ctx -> Bool
< :: Ctx -> Ctx -> Bool
$c< :: Ctx -> Ctx -> Bool
compare :: Ctx -> Ctx -> Ordering
$ccompare :: Ctx -> Ctx -> Ordering
Prelude.Ord, (forall x. Ctx -> Rep Ctx x)
-> (forall x. Rep Ctx x -> Ctx) -> Generic Ctx
forall x. Rep Ctx x -> Ctx
forall x. Ctx -> Rep Ctx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ctx x -> Ctx
$cfrom :: forall x. Ctx -> Rep Ctx x
GHC.Generics.Generic)
instance Prelude.Show Ctx where
  showsPrec :: Int -> Ctx -> ShowS
showsPrec Int
_ Ctx
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (Ctx -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort Ctx
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out Ctx
instance Data.ProtoLens.Field.HasField Ctx "nonce" Nonce where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "nonce" -> (Nonce -> f Nonce) -> Ctx -> f Ctx
fieldOf Proxy# "nonce"
_
    = ((Maybe Nonce -> f (Maybe Nonce)) -> Ctx -> f Ctx)
-> ((Nonce -> f Nonce) -> Maybe Nonce -> f (Maybe Nonce))
-> (Nonce -> f Nonce)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((Ctx -> Maybe Nonce)
-> (Ctx -> Maybe Nonce -> Ctx)
-> Lens Ctx Ctx (Maybe Nonce) (Maybe Nonce)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Ctx -> Maybe Nonce
_Ctx'nonce (\ Ctx
x__ Maybe Nonce
y__ -> Ctx
x__ {_Ctx'nonce :: Maybe Nonce
_Ctx'nonce = Maybe Nonce
y__}))
        (Nonce -> Lens' (Maybe Nonce) Nonce
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Nonce
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField Ctx "maybe'nonce" (Prelude.Maybe Nonce) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'nonce"
-> (Maybe Nonce -> f (Maybe Nonce)) -> Ctx -> f Ctx
fieldOf Proxy# "maybe'nonce"
_
    = ((Maybe Nonce -> f (Maybe Nonce)) -> Ctx -> f Ctx)
-> ((Maybe Nonce -> f (Maybe Nonce))
    -> Maybe Nonce -> f (Maybe Nonce))
-> (Maybe Nonce -> f (Maybe Nonce))
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((Ctx -> Maybe Nonce)
-> (Ctx -> Maybe Nonce -> Ctx)
-> Lens Ctx Ctx (Maybe Nonce) (Maybe Nonce)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Ctx -> Maybe Nonce
_Ctx'nonce (\ Ctx
x__ Maybe Nonce
y__ -> Ctx
x__ {_Ctx'nonce :: Maybe Nonce
_Ctx'nonce = Maybe Nonce
y__}))
        (Maybe Nonce -> f (Maybe Nonce)) -> Maybe Nonce -> f (Maybe Nonce)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField Ctx "lnPubKey" LnPubKey where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "lnPubKey" -> (LnPubKey -> f LnPubKey) -> Ctx -> f Ctx
fieldOf Proxy# "lnPubKey"
_
    = ((Maybe LnPubKey -> f (Maybe LnPubKey)) -> Ctx -> f Ctx)
-> ((LnPubKey -> f LnPubKey)
    -> Maybe LnPubKey -> f (Maybe LnPubKey))
-> (LnPubKey -> f LnPubKey)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((Ctx -> Maybe LnPubKey)
-> (Ctx -> Maybe LnPubKey -> Ctx)
-> Lens Ctx Ctx (Maybe LnPubKey) (Maybe LnPubKey)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Ctx -> Maybe LnPubKey
_Ctx'lnPubKey (\ Ctx
x__ Maybe LnPubKey
y__ -> Ctx
x__ {_Ctx'lnPubKey :: Maybe LnPubKey
_Ctx'lnPubKey = Maybe LnPubKey
y__}))
        (LnPubKey -> Lens' (Maybe LnPubKey) LnPubKey
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens LnPubKey
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField Ctx "maybe'lnPubKey" (Prelude.Maybe LnPubKey) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'lnPubKey"
-> (Maybe LnPubKey -> f (Maybe LnPubKey)) -> Ctx -> f Ctx
fieldOf Proxy# "maybe'lnPubKey"
_
    = ((Maybe LnPubKey -> f (Maybe LnPubKey)) -> Ctx -> f Ctx)
-> ((Maybe LnPubKey -> f (Maybe LnPubKey))
    -> Maybe LnPubKey -> f (Maybe LnPubKey))
-> (Maybe LnPubKey -> f (Maybe LnPubKey))
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((Ctx -> Maybe LnPubKey)
-> (Ctx -> Maybe LnPubKey -> Ctx)
-> Lens Ctx Ctx (Maybe LnPubKey) (Maybe LnPubKey)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Ctx -> Maybe LnPubKey
_Ctx'lnPubKey (\ Ctx
x__ Maybe LnPubKey
y__ -> Ctx
x__ {_Ctx'lnPubKey :: Maybe LnPubKey
_Ctx'lnPubKey = Maybe LnPubKey
y__}))
        (Maybe LnPubKey -> f (Maybe LnPubKey))
-> Maybe LnPubKey -> f (Maybe LnPubKey)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message Ctx where
  messageName :: Proxy Ctx -> Text
messageName Proxy Ctx
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.Ctx"
  packedMessageDescriptor :: Proxy Ctx -> ByteString
packedMessageDescriptor Proxy Ctx
_
    = ByteString
"\n\
      \\ETXCtx\DC22\n\
      \\ENQnonce\CAN\SOH \SOH(\v2\FS.BtcLsp.Data.HighLevel.NonceR\ENQnonce\DC2=\n\
      \\n\
      \ln_pub_key\CAN\STX \SOH(\v2\US.BtcLsp.Data.HighLevel.LnPubKeyR\blnPubKey"
  packedFileDescriptor :: Proxy Ctx -> ByteString
packedFileDescriptor Proxy Ctx
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor Ctx)
fieldsByTag
    = let
        nonce__field_descriptor :: FieldDescriptor Ctx
nonce__field_descriptor
          = String
-> FieldTypeDescriptor Nonce
-> FieldAccessor Ctx Nonce
-> FieldDescriptor Ctx
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"nonce"
              (MessageOrGroup -> FieldTypeDescriptor Nonce
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Nonce)
              (Lens Ctx Ctx (Maybe Nonce) (Maybe Nonce) -> FieldAccessor Ctx Nonce
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nonce")) ::
              Data.ProtoLens.FieldDescriptor Ctx
        lnPubKey__field_descriptor :: FieldDescriptor Ctx
lnPubKey__field_descriptor
          = String
-> FieldTypeDescriptor LnPubKey
-> FieldAccessor Ctx LnPubKey
-> FieldDescriptor Ctx
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"ln_pub_key"
              (MessageOrGroup -> FieldTypeDescriptor LnPubKey
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor LnPubKey)
              (Lens Ctx Ctx (Maybe LnPubKey) (Maybe LnPubKey)
-> FieldAccessor Ctx LnPubKey
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lnPubKey")) ::
              Data.ProtoLens.FieldDescriptor Ctx
      in
        [(Tag, FieldDescriptor Ctx)] -> Map Tag (FieldDescriptor Ctx)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor Ctx
nonce__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor Ctx
lnPubKey__field_descriptor)]
  unknownFields :: Lens' Ctx FieldSet
unknownFields
    = (Ctx -> FieldSet) -> (Ctx -> FieldSet -> Ctx) -> Lens' Ctx FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        Ctx -> FieldSet
_Ctx'_unknownFields (\ Ctx
x__ FieldSet
y__ -> Ctx
x__ {_Ctx'_unknownFields :: FieldSet
_Ctx'_unknownFields = FieldSet
y__})
  defMessage :: Ctx
defMessage
    = Ctx'_constructor :: Maybe Nonce -> Maybe LnPubKey -> FieldSet -> Ctx
Ctx'_constructor
        {_Ctx'nonce :: Maybe Nonce
_Ctx'nonce = Maybe Nonce
forall a. Maybe a
Prelude.Nothing, _Ctx'lnPubKey :: Maybe LnPubKey
_Ctx'lnPubKey = Maybe LnPubKey
forall a. Maybe a
Prelude.Nothing,
         _Ctx'_unknownFields :: FieldSet
_Ctx'_unknownFields = []}
  parseMessage :: Parser Ctx
parseMessage
    = let
        loop :: Ctx -> Data.ProtoLens.Encoding.Bytes.Parser Ctx
        loop :: Ctx -> Parser Ctx
loop Ctx
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      Ctx -> Parser Ctx
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter Ctx Ctx FieldSet FieldSet
-> (FieldSet -> FieldSet) -> Ctx -> Ctx
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter Ctx Ctx FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) Ctx
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Nonce
y <- Parser Nonce -> String -> Parser Nonce
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser Nonce -> Parser Nonce
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser Nonce
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"nonce"
                                Ctx -> Parser Ctx
loop (Setter Ctx Ctx Nonce Nonce -> Nonce -> Ctx -> Ctx
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nonce") Nonce
y Ctx
x)
                        Word64
18
                          -> do LnPubKey
y <- Parser LnPubKey -> String -> Parser LnPubKey
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser LnPubKey -> Parser LnPubKey
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser LnPubKey
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"ln_pub_key"
                                Ctx -> Parser Ctx
loop
                                  (Setter Ctx Ctx LnPubKey LnPubKey -> LnPubKey -> Ctx -> Ctx
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lnPubKey") LnPubKey
y Ctx
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                Ctx -> Parser Ctx
loop
                                  (Setter Ctx Ctx FieldSet FieldSet
-> (FieldSet -> FieldSet) -> Ctx -> Ctx
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter Ctx Ctx FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) Ctx
x)
      in
        Parser Ctx -> String -> Parser Ctx
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Ctx -> Parser Ctx
loop Ctx
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"Ctx"
  buildMessage :: Ctx -> Builder
buildMessage
    = \ Ctx
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike (Maybe Nonce) Ctx Ctx (Maybe Nonce) (Maybe Nonce)
-> Ctx -> Maybe Nonce
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nonce") Ctx
_x
              of
                Maybe Nonce
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Nonce
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (Nonce -> ByteString) -> Nonce -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Nonce -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage Nonce
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike (Maybe LnPubKey) Ctx Ctx (Maybe LnPubKey) (Maybe LnPubKey)
-> Ctx -> Maybe LnPubKey
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lnPubKey") Ctx
_x
                 of
                   Maybe LnPubKey
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just LnPubKey
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((ByteString -> Builder)
-> (LnPubKey -> ByteString) -> LnPubKey -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             (\ ByteString
bs
                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                        (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                     (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                             LnPubKey -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage LnPubKey
_v))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet Ctx Ctx FieldSet FieldSet -> Ctx -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet Ctx Ctx FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields Ctx
_x)))
instance Control.DeepSeq.NFData Ctx where
  rnf :: Ctx -> ()
rnf
    = \ Ctx
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (Ctx -> FieldSet
_Ctx'_unknownFields Ctx
x__)
             (Maybe Nonce -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (Ctx -> Maybe Nonce
_Ctx'nonce Ctx
x__) (Maybe LnPubKey -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (Ctx -> Maybe LnPubKey
_Ctx'lnPubKey Ctx
x__) ()))
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' FeeMoney Proto.BtcLsp.Data.LowLevel.Msat@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' FeeMoney (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat)@ -}
data FeeMoney
  = FeeMoney'_constructor {FeeMoney -> Maybe Msat
_FeeMoney'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat),
                           FeeMoney -> FieldSet
_FeeMoney'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (FeeMoney -> FeeMoney -> Bool
(FeeMoney -> FeeMoney -> Bool)
-> (FeeMoney -> FeeMoney -> Bool) -> Eq FeeMoney
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeeMoney -> FeeMoney -> Bool
$c/= :: FeeMoney -> FeeMoney -> Bool
== :: FeeMoney -> FeeMoney -> Bool
$c== :: FeeMoney -> FeeMoney -> Bool
Prelude.Eq, Eq FeeMoney
Eq FeeMoney
-> (FeeMoney -> FeeMoney -> Ordering)
-> (FeeMoney -> FeeMoney -> Bool)
-> (FeeMoney -> FeeMoney -> Bool)
-> (FeeMoney -> FeeMoney -> Bool)
-> (FeeMoney -> FeeMoney -> Bool)
-> (FeeMoney -> FeeMoney -> FeeMoney)
-> (FeeMoney -> FeeMoney -> FeeMoney)
-> Ord FeeMoney
FeeMoney -> FeeMoney -> Bool
FeeMoney -> FeeMoney -> Ordering
FeeMoney -> FeeMoney -> FeeMoney
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FeeMoney -> FeeMoney -> FeeMoney
$cmin :: FeeMoney -> FeeMoney -> FeeMoney
max :: FeeMoney -> FeeMoney -> FeeMoney
$cmax :: FeeMoney -> FeeMoney -> FeeMoney
>= :: FeeMoney -> FeeMoney -> Bool
$c>= :: FeeMoney -> FeeMoney -> Bool
> :: FeeMoney -> FeeMoney -> Bool
$c> :: FeeMoney -> FeeMoney -> Bool
<= :: FeeMoney -> FeeMoney -> Bool
$c<= :: FeeMoney -> FeeMoney -> Bool
< :: FeeMoney -> FeeMoney -> Bool
$c< :: FeeMoney -> FeeMoney -> Bool
compare :: FeeMoney -> FeeMoney -> Ordering
$ccompare :: FeeMoney -> FeeMoney -> Ordering
Prelude.Ord, (forall x. FeeMoney -> Rep FeeMoney x)
-> (forall x. Rep FeeMoney x -> FeeMoney) -> Generic FeeMoney
forall x. Rep FeeMoney x -> FeeMoney
forall x. FeeMoney -> Rep FeeMoney x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FeeMoney x -> FeeMoney
$cfrom :: forall x. FeeMoney -> Rep FeeMoney x
GHC.Generics.Generic)
instance Prelude.Show FeeMoney where
  showsPrec :: Int -> FeeMoney -> ShowS
showsPrec Int
_ FeeMoney
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (FeeMoney -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort FeeMoney
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out FeeMoney
instance Data.ProtoLens.Field.HasField FeeMoney "val" Proto.BtcLsp.Data.LowLevel.Msat where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Msat -> f Msat) -> FeeMoney -> f FeeMoney
fieldOf Proxy# "val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> FeeMoney -> f FeeMoney)
-> ((Msat -> f Msat) -> Maybe Msat -> f (Maybe Msat))
-> (Msat -> f Msat)
-> FeeMoney
-> f FeeMoney
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FeeMoney -> Maybe Msat)
-> (FeeMoney -> Maybe Msat -> FeeMoney)
-> Lens FeeMoney FeeMoney (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FeeMoney -> Maybe Msat
_FeeMoney'val (\ FeeMoney
x__ Maybe Msat
y__ -> FeeMoney
x__ {_FeeMoney'val :: Maybe Msat
_FeeMoney'val = Maybe Msat
y__}))
        (Msat -> Lens' (Maybe Msat) Msat
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Msat
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField FeeMoney "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe Msat -> f (Maybe Msat)) -> FeeMoney -> f FeeMoney
fieldOf Proxy# "maybe'val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> FeeMoney -> f FeeMoney)
-> ((Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat))
-> (Maybe Msat -> f (Maybe Msat))
-> FeeMoney
-> f FeeMoney
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FeeMoney -> Maybe Msat)
-> (FeeMoney -> Maybe Msat -> FeeMoney)
-> Lens FeeMoney FeeMoney (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FeeMoney -> Maybe Msat
_FeeMoney'val (\ FeeMoney
x__ Maybe Msat
y__ -> FeeMoney
x__ {_FeeMoney'val :: Maybe Msat
_FeeMoney'val = Maybe Msat
y__}))
        (Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message FeeMoney where
  messageName :: Proxy FeeMoney -> Text
messageName Proxy FeeMoney
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.FeeMoney"
  packedMessageDescriptor :: Proxy FeeMoney -> ByteString
packedMessageDescriptor Proxy FeeMoney
_
    = ByteString
"\n\
      \\bFeeMoney\DC2,\n\
      \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval"
  packedFileDescriptor :: Proxy FeeMoney -> ByteString
packedFileDescriptor Proxy FeeMoney
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor FeeMoney)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor FeeMoney
val__field_descriptor
          = String
-> FieldTypeDescriptor Msat
-> FieldAccessor FeeMoney Msat
-> FieldDescriptor FeeMoney
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor Msat
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.Msat)
              (Lens FeeMoney FeeMoney (Maybe Msat) (Maybe Msat)
-> FieldAccessor FeeMoney Msat
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor FeeMoney
      in
        [(Tag, FieldDescriptor FeeMoney)]
-> Map Tag (FieldDescriptor FeeMoney)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor FeeMoney
val__field_descriptor)]
  unknownFields :: Lens' FeeMoney FieldSet
unknownFields
    = (FeeMoney -> FieldSet)
-> (FeeMoney -> FieldSet -> FeeMoney) -> Lens' FeeMoney FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        FeeMoney -> FieldSet
_FeeMoney'_unknownFields
        (\ FeeMoney
x__ FieldSet
y__ -> FeeMoney
x__ {_FeeMoney'_unknownFields :: FieldSet
_FeeMoney'_unknownFields = FieldSet
y__})
  defMessage :: FeeMoney
defMessage
    = FeeMoney'_constructor :: Maybe Msat -> FieldSet -> FeeMoney
FeeMoney'_constructor
        {_FeeMoney'val :: Maybe Msat
_FeeMoney'val = Maybe Msat
forall a. Maybe a
Prelude.Nothing, _FeeMoney'_unknownFields :: FieldSet
_FeeMoney'_unknownFields = []}
  parseMessage :: Parser FeeMoney
parseMessage
    = let
        loop :: FeeMoney -> Data.ProtoLens.Encoding.Bytes.Parser FeeMoney
        loop :: FeeMoney -> Parser FeeMoney
loop FeeMoney
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      FeeMoney -> Parser FeeMoney
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter FeeMoney FeeMoney FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FeeMoney -> FeeMoney
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter FeeMoney FeeMoney FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) FeeMoney
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Msat
y <- Parser Msat -> String -> Parser Msat
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser Msat -> Parser Msat
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser Msat
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                FeeMoney -> Parser FeeMoney
loop (Setter FeeMoney FeeMoney Msat Msat -> Msat -> FeeMoney -> FeeMoney
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Msat
y FeeMoney
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                FeeMoney -> Parser FeeMoney
loop
                                  (Setter FeeMoney FeeMoney FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FeeMoney -> FeeMoney
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter FeeMoney FeeMoney FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) FeeMoney
x)
      in
        Parser FeeMoney -> String -> Parser FeeMoney
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do FeeMoney -> Parser FeeMoney
loop FeeMoney
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"FeeMoney"
  buildMessage :: FeeMoney -> Builder
buildMessage
    = \ FeeMoney
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike (Maybe Msat) FeeMoney FeeMoney (Maybe Msat) (Maybe Msat)
-> FeeMoney -> Maybe Msat
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") FeeMoney
_x
              of
                Maybe Msat
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Msat
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder) -> (Msat -> ByteString) -> Msat -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Msat -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage Msat
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet FeeMoney FeeMoney FieldSet FieldSet
-> FeeMoney -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet FeeMoney FeeMoney FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields FeeMoney
_x))
instance Control.DeepSeq.NFData FeeMoney where
  rnf :: FeeMoney -> ()
rnf
    = \ FeeMoney
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (FeeMoney -> FieldSet
_FeeMoney'_unknownFields FeeMoney
x__)
             (Maybe Msat -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (FeeMoney -> Maybe Msat
_FeeMoney'val FeeMoney
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' FeeRate Proto.BtcLsp.Data.LowLevel.Urational@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' FeeRate (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Urational)@ -}
data FeeRate
  = FeeRate'_constructor {FeeRate -> Maybe Urational
_FeeRate'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Urational),
                          FeeRate -> FieldSet
_FeeRate'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (FeeRate -> FeeRate -> Bool
(FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool) -> Eq FeeRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeeRate -> FeeRate -> Bool
$c/= :: FeeRate -> FeeRate -> Bool
== :: FeeRate -> FeeRate -> Bool
$c== :: FeeRate -> FeeRate -> Bool
Prelude.Eq, Eq FeeRate
Eq FeeRate
-> (FeeRate -> FeeRate -> Ordering)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> FeeRate)
-> (FeeRate -> FeeRate -> FeeRate)
-> Ord FeeRate
FeeRate -> FeeRate -> Bool
FeeRate -> FeeRate -> Ordering
FeeRate -> FeeRate -> FeeRate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FeeRate -> FeeRate -> FeeRate
$cmin :: FeeRate -> FeeRate -> FeeRate
max :: FeeRate -> FeeRate -> FeeRate
$cmax :: FeeRate -> FeeRate -> FeeRate
>= :: FeeRate -> FeeRate -> Bool
$c>= :: FeeRate -> FeeRate -> Bool
> :: FeeRate -> FeeRate -> Bool
$c> :: FeeRate -> FeeRate -> Bool
<= :: FeeRate -> FeeRate -> Bool
$c<= :: FeeRate -> FeeRate -> Bool
< :: FeeRate -> FeeRate -> Bool
$c< :: FeeRate -> FeeRate -> Bool
compare :: FeeRate -> FeeRate -> Ordering
$ccompare :: FeeRate -> FeeRate -> Ordering
Prelude.Ord, (forall x. FeeRate -> Rep FeeRate x)
-> (forall x. Rep FeeRate x -> FeeRate) -> Generic FeeRate
forall x. Rep FeeRate x -> FeeRate
forall x. FeeRate -> Rep FeeRate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FeeRate x -> FeeRate
$cfrom :: forall x. FeeRate -> Rep FeeRate x
GHC.Generics.Generic)
instance Prelude.Show FeeRate where
  showsPrec :: Int -> FeeRate -> ShowS
showsPrec Int
_ FeeRate
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (FeeRate -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort FeeRate
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out FeeRate
instance Data.ProtoLens.Field.HasField FeeRate "val" Proto.BtcLsp.Data.LowLevel.Urational where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Urational -> f Urational) -> FeeRate -> f FeeRate
fieldOf Proxy# "val"
_
    = ((Maybe Urational -> f (Maybe Urational)) -> FeeRate -> f FeeRate)
-> ((Urational -> f Urational)
    -> Maybe Urational -> f (Maybe Urational))
-> (Urational -> f Urational)
-> FeeRate
-> f FeeRate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FeeRate -> Maybe Urational)
-> (FeeRate -> Maybe Urational -> FeeRate)
-> Lens FeeRate FeeRate (Maybe Urational) (Maybe Urational)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FeeRate -> Maybe Urational
_FeeRate'val (\ FeeRate
x__ Maybe Urational
y__ -> FeeRate
x__ {_FeeRate'val :: Maybe Urational
_FeeRate'val = Maybe Urational
y__}))
        (Urational -> Lens' (Maybe Urational) Urational
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Urational
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField FeeRate "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Urational) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe Urational -> f (Maybe Urational)) -> FeeRate -> f FeeRate
fieldOf Proxy# "maybe'val"
_
    = ((Maybe Urational -> f (Maybe Urational)) -> FeeRate -> f FeeRate)
-> ((Maybe Urational -> f (Maybe Urational))
    -> Maybe Urational -> f (Maybe Urational))
-> (Maybe Urational -> f (Maybe Urational))
-> FeeRate
-> f FeeRate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FeeRate -> Maybe Urational)
-> (FeeRate -> Maybe Urational -> FeeRate)
-> Lens FeeRate FeeRate (Maybe Urational) (Maybe Urational)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FeeRate -> Maybe Urational
_FeeRate'val (\ FeeRate
x__ Maybe Urational
y__ -> FeeRate
x__ {_FeeRate'val :: Maybe Urational
_FeeRate'val = Maybe Urational
y__}))
        (Maybe Urational -> f (Maybe Urational))
-> Maybe Urational -> f (Maybe Urational)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message FeeRate where
  messageName :: Proxy FeeRate -> Text
messageName Proxy FeeRate
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.FeeRate"
  packedMessageDescriptor :: Proxy FeeRate -> ByteString
packedMessageDescriptor Proxy FeeRate
_
    = ByteString
"\n\
      \\aFeeRate\DC21\n\
      \\ETXval\CAN\SOH \SOH(\v2\US.BtcLsp.Data.LowLevel.UrationalR\ETXval"
  packedFileDescriptor :: Proxy FeeRate -> ByteString
packedFileDescriptor Proxy FeeRate
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor FeeRate)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor FeeRate
val__field_descriptor
          = String
-> FieldTypeDescriptor Urational
-> FieldAccessor FeeRate Urational
-> FieldDescriptor FeeRate
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor Urational
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.Urational)
              (Lens FeeRate FeeRate (Maybe Urational) (Maybe Urational)
-> FieldAccessor FeeRate Urational
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor FeeRate
      in
        [(Tag, FieldDescriptor FeeRate)]
-> Map Tag (FieldDescriptor FeeRate)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor FeeRate
val__field_descriptor)]
  unknownFields :: Lens' FeeRate FieldSet
unknownFields
    = (FeeRate -> FieldSet)
-> (FeeRate -> FieldSet -> FeeRate) -> Lens' FeeRate FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        FeeRate -> FieldSet
_FeeRate'_unknownFields
        (\ FeeRate
x__ FieldSet
y__ -> FeeRate
x__ {_FeeRate'_unknownFields :: FieldSet
_FeeRate'_unknownFields = FieldSet
y__})
  defMessage :: FeeRate
defMessage
    = FeeRate'_constructor :: Maybe Urational -> FieldSet -> FeeRate
FeeRate'_constructor
        {_FeeRate'val :: Maybe Urational
_FeeRate'val = Maybe Urational
forall a. Maybe a
Prelude.Nothing, _FeeRate'_unknownFields :: FieldSet
_FeeRate'_unknownFields = []}
  parseMessage :: Parser FeeRate
parseMessage
    = let
        loop :: FeeRate -> Data.ProtoLens.Encoding.Bytes.Parser FeeRate
        loop :: FeeRate -> Parser FeeRate
loop FeeRate
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      FeeRate -> Parser FeeRate
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter FeeRate FeeRate FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FeeRate -> FeeRate
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter FeeRate FeeRate FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) FeeRate
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Urational
y <- Parser Urational -> String -> Parser Urational
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser Urational -> Parser Urational
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser Urational
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                FeeRate -> Parser FeeRate
loop (Setter FeeRate FeeRate Urational Urational
-> Urational -> FeeRate -> FeeRate
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Urational
y FeeRate
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                FeeRate -> Parser FeeRate
loop
                                  (Setter FeeRate FeeRate FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FeeRate -> FeeRate
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter FeeRate FeeRate FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) FeeRate
x)
      in
        Parser FeeRate -> String -> Parser FeeRate
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do FeeRate -> Parser FeeRate
loop FeeRate
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"FeeRate"
  buildMessage :: FeeRate -> Builder
buildMessage
    = \ FeeRate
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Urational)
  FeeRate
  FeeRate
  (Maybe Urational)
  (Maybe Urational)
-> FeeRate -> Maybe Urational
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") FeeRate
_x
              of
                Maybe Urational
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Urational
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (Urational -> ByteString) -> Urational -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Urational -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage Urational
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet FeeRate FeeRate FieldSet FieldSet
-> FeeRate -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet FeeRate FeeRate FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields FeeRate
_x))
instance Control.DeepSeq.NFData FeeRate where
  rnf :: FeeRate -> ()
rnf
    = \ FeeRate
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (FeeRate -> FieldSet
_FeeRate'_unknownFields FeeRate
x__)
             (Maybe Urational -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (FeeRate -> Maybe Urational
_FeeRate'val FeeRate
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' FieldIndex Data.Word.Word32@ -}
data FieldIndex
  = FieldIndex'_constructor {FieldIndex -> Word32
_FieldIndex'val :: !Data.Word.Word32,
                             FieldIndex -> FieldSet
_FieldIndex'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (FieldIndex -> FieldIndex -> Bool
(FieldIndex -> FieldIndex -> Bool)
-> (FieldIndex -> FieldIndex -> Bool) -> Eq FieldIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldIndex -> FieldIndex -> Bool
$c/= :: FieldIndex -> FieldIndex -> Bool
== :: FieldIndex -> FieldIndex -> Bool
$c== :: FieldIndex -> FieldIndex -> Bool
Prelude.Eq, Eq FieldIndex
Eq FieldIndex
-> (FieldIndex -> FieldIndex -> Ordering)
-> (FieldIndex -> FieldIndex -> Bool)
-> (FieldIndex -> FieldIndex -> Bool)
-> (FieldIndex -> FieldIndex -> Bool)
-> (FieldIndex -> FieldIndex -> Bool)
-> (FieldIndex -> FieldIndex -> FieldIndex)
-> (FieldIndex -> FieldIndex -> FieldIndex)
-> Ord FieldIndex
FieldIndex -> FieldIndex -> Bool
FieldIndex -> FieldIndex -> Ordering
FieldIndex -> FieldIndex -> FieldIndex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldIndex -> FieldIndex -> FieldIndex
$cmin :: FieldIndex -> FieldIndex -> FieldIndex
max :: FieldIndex -> FieldIndex -> FieldIndex
$cmax :: FieldIndex -> FieldIndex -> FieldIndex
>= :: FieldIndex -> FieldIndex -> Bool
$c>= :: FieldIndex -> FieldIndex -> Bool
> :: FieldIndex -> FieldIndex -> Bool
$c> :: FieldIndex -> FieldIndex -> Bool
<= :: FieldIndex -> FieldIndex -> Bool
$c<= :: FieldIndex -> FieldIndex -> Bool
< :: FieldIndex -> FieldIndex -> Bool
$c< :: FieldIndex -> FieldIndex -> Bool
compare :: FieldIndex -> FieldIndex -> Ordering
$ccompare :: FieldIndex -> FieldIndex -> Ordering
Prelude.Ord, (forall x. FieldIndex -> Rep FieldIndex x)
-> (forall x. Rep FieldIndex x -> FieldIndex) -> Generic FieldIndex
forall x. Rep FieldIndex x -> FieldIndex
forall x. FieldIndex -> Rep FieldIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldIndex x -> FieldIndex
$cfrom :: forall x. FieldIndex -> Rep FieldIndex x
GHC.Generics.Generic)
instance Prelude.Show FieldIndex where
  showsPrec :: Int -> FieldIndex -> ShowS
showsPrec Int
_ FieldIndex
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (FieldIndex -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort FieldIndex
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out FieldIndex
instance Data.ProtoLens.Field.HasField FieldIndex "val" Data.Word.Word32 where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Word32 -> f Word32) -> FieldIndex -> f FieldIndex
fieldOf Proxy# "val"
_
    = ((Word32 -> f Word32) -> FieldIndex -> f FieldIndex)
-> ((Word32 -> f Word32) -> Word32 -> f Word32)
-> (Word32 -> f Word32)
-> FieldIndex
-> f FieldIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FieldIndex -> Word32)
-> (FieldIndex -> Word32 -> FieldIndex)
-> Lens FieldIndex FieldIndex Word32 Word32
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FieldIndex -> Word32
_FieldIndex'val (\ FieldIndex
x__ Word32
y__ -> FieldIndex
x__ {_FieldIndex'val :: Word32
_FieldIndex'val = Word32
y__}))
        (Word32 -> f Word32) -> Word32 -> f Word32
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message FieldIndex where
  messageName :: Proxy FieldIndex -> Text
messageName Proxy FieldIndex
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.FieldIndex"
  packedMessageDescriptor :: Proxy FieldIndex -> ByteString
packedMessageDescriptor Proxy FieldIndex
_
    = ByteString
"\n\
      \\n\
      \FieldIndex\DC2\DLE\n\
      \\ETXval\CAN\SOH \SOH(\rR\ETXval"
  packedFileDescriptor :: Proxy FieldIndex -> ByteString
packedFileDescriptor Proxy FieldIndex
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor FieldIndex)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor FieldIndex
val__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor FieldIndex Word32
-> FieldDescriptor FieldIndex
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (WireDefault Word32
-> Lens FieldIndex FieldIndex Word32 Word32
-> FieldAccessor FieldIndex Word32
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Word32
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val")) ::
              Data.ProtoLens.FieldDescriptor FieldIndex
      in
        [(Tag, FieldDescriptor FieldIndex)]
-> Map Tag (FieldDescriptor FieldIndex)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor FieldIndex
val__field_descriptor)]
  unknownFields :: Lens' FieldIndex FieldSet
unknownFields
    = (FieldIndex -> FieldSet)
-> (FieldIndex -> FieldSet -> FieldIndex)
-> Lens' FieldIndex FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        FieldIndex -> FieldSet
_FieldIndex'_unknownFields
        (\ FieldIndex
x__ FieldSet
y__ -> FieldIndex
x__ {_FieldIndex'_unknownFields :: FieldSet
_FieldIndex'_unknownFields = FieldSet
y__})
  defMessage :: FieldIndex
defMessage
    = FieldIndex'_constructor :: Word32 -> FieldSet -> FieldIndex
FieldIndex'_constructor
        {_FieldIndex'val :: Word32
_FieldIndex'val = Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _FieldIndex'_unknownFields :: FieldSet
_FieldIndex'_unknownFields = []}
  parseMessage :: Parser FieldIndex
parseMessage
    = let
        loop ::
          FieldIndex -> Data.ProtoLens.Encoding.Bytes.Parser FieldIndex
        loop :: FieldIndex -> Parser FieldIndex
loop FieldIndex
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      FieldIndex -> Parser FieldIndex
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter FieldIndex FieldIndex FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FieldIndex -> FieldIndex
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter FieldIndex FieldIndex FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) FieldIndex
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Word32
y <- Parser Word32 -> String -> Parser Word32
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Word32) -> Parser Word64 -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                          Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt)
                                       String
"val"
                                FieldIndex -> Parser FieldIndex
loop (Setter FieldIndex FieldIndex Word32 Word32
-> Word32 -> FieldIndex -> FieldIndex
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Word32
y FieldIndex
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                FieldIndex -> Parser FieldIndex
loop
                                  (Setter FieldIndex FieldIndex FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FieldIndex -> FieldIndex
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter FieldIndex FieldIndex FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) FieldIndex
x)
      in
        Parser FieldIndex -> String -> Parser FieldIndex
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do FieldIndex -> Parser FieldIndex
loop FieldIndex
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"FieldIndex"
  buildMessage :: FieldIndex -> Builder
buildMessage
    = \ FieldIndex
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: Word32
_v = FoldLike Word32 FieldIndex FieldIndex Word32 Word32
-> FieldIndex -> Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") FieldIndex
_x
              in
                if Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Word32
_v Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                      ((Word64 -> Builder) -> (Word32 -> Word64) -> Word32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word32
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet FieldIndex FieldIndex FieldSet FieldSet
-> FieldIndex -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet FieldIndex FieldIndex FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields FieldIndex
_x))
instance Control.DeepSeq.NFData FieldIndex where
  rnf :: FieldIndex -> ()
rnf
    = \ FieldIndex
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (FieldIndex -> FieldSet
_FieldIndex'_unknownFields FieldIndex
x__)
             (Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (FieldIndex -> Word32
_FieldIndex'val FieldIndex
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' FundLnHodlInvoice Proto.BtcLsp.Data.LowLevel.LnHodlInvoice@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' FundLnHodlInvoice (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.LnHodlInvoice)@ -}
data FundLnHodlInvoice
  = FundLnHodlInvoice'_constructor {FundLnHodlInvoice -> Maybe LnHodlInvoice
_FundLnHodlInvoice'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.LnHodlInvoice),
                                    FundLnHodlInvoice -> FieldSet
_FundLnHodlInvoice'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
(FundLnHodlInvoice -> FundLnHodlInvoice -> Bool)
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> Bool)
-> Eq FundLnHodlInvoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
$c/= :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
== :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
$c== :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
Prelude.Eq, Eq FundLnHodlInvoice
Eq FundLnHodlInvoice
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> Ordering)
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> Bool)
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> Bool)
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> Bool)
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> Bool)
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice)
-> (FundLnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice)
-> Ord FundLnHodlInvoice
FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
FundLnHodlInvoice -> FundLnHodlInvoice -> Ordering
FundLnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FundLnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice
$cmin :: FundLnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice
max :: FundLnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice
$cmax :: FundLnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice
>= :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
$c>= :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
> :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
$c> :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
<= :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
$c<= :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
< :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
$c< :: FundLnHodlInvoice -> FundLnHodlInvoice -> Bool
compare :: FundLnHodlInvoice -> FundLnHodlInvoice -> Ordering
$ccompare :: FundLnHodlInvoice -> FundLnHodlInvoice -> Ordering
Prelude.Ord, (forall x. FundLnHodlInvoice -> Rep FundLnHodlInvoice x)
-> (forall x. Rep FundLnHodlInvoice x -> FundLnHodlInvoice)
-> Generic FundLnHodlInvoice
forall x. Rep FundLnHodlInvoice x -> FundLnHodlInvoice
forall x. FundLnHodlInvoice -> Rep FundLnHodlInvoice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FundLnHodlInvoice x -> FundLnHodlInvoice
$cfrom :: forall x. FundLnHodlInvoice -> Rep FundLnHodlInvoice x
GHC.Generics.Generic)
instance Prelude.Show FundLnHodlInvoice where
  showsPrec :: Int -> FundLnHodlInvoice -> ShowS
showsPrec Int
_ FundLnHodlInvoice
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (FundLnHodlInvoice -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort FundLnHodlInvoice
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out FundLnHodlInvoice
instance Data.ProtoLens.Field.HasField FundLnHodlInvoice "val" Proto.BtcLsp.Data.LowLevel.LnHodlInvoice where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val"
-> (LnHodlInvoice -> f LnHodlInvoice)
-> FundLnHodlInvoice
-> f FundLnHodlInvoice
fieldOf Proxy# "val"
_
    = ((Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
 -> FundLnHodlInvoice -> f FundLnHodlInvoice)
-> ((LnHodlInvoice -> f LnHodlInvoice)
    -> Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
-> (LnHodlInvoice -> f LnHodlInvoice)
-> FundLnHodlInvoice
-> f FundLnHodlInvoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundLnHodlInvoice -> Maybe LnHodlInvoice)
-> (FundLnHodlInvoice -> Maybe LnHodlInvoice -> FundLnHodlInvoice)
-> Lens
     FundLnHodlInvoice
     FundLnHodlInvoice
     (Maybe LnHodlInvoice)
     (Maybe LnHodlInvoice)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundLnHodlInvoice -> Maybe LnHodlInvoice
_FundLnHodlInvoice'val
           (\ FundLnHodlInvoice
x__ Maybe LnHodlInvoice
y__ -> FundLnHodlInvoice
x__ {_FundLnHodlInvoice'val :: Maybe LnHodlInvoice
_FundLnHodlInvoice'val = Maybe LnHodlInvoice
y__}))
        (LnHodlInvoice -> Lens' (Maybe LnHodlInvoice) LnHodlInvoice
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens LnHodlInvoice
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField FundLnHodlInvoice "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.LnHodlInvoice) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
-> FundLnHodlInvoice
-> f FundLnHodlInvoice
fieldOf Proxy# "maybe'val"
_
    = ((Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
 -> FundLnHodlInvoice -> f FundLnHodlInvoice)
-> ((Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
    -> Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
-> (Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
-> FundLnHodlInvoice
-> f FundLnHodlInvoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundLnHodlInvoice -> Maybe LnHodlInvoice)
-> (FundLnHodlInvoice -> Maybe LnHodlInvoice -> FundLnHodlInvoice)
-> Lens
     FundLnHodlInvoice
     FundLnHodlInvoice
     (Maybe LnHodlInvoice)
     (Maybe LnHodlInvoice)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundLnHodlInvoice -> Maybe LnHodlInvoice
_FundLnHodlInvoice'val
           (\ FundLnHodlInvoice
x__ Maybe LnHodlInvoice
y__ -> FundLnHodlInvoice
x__ {_FundLnHodlInvoice'val :: Maybe LnHodlInvoice
_FundLnHodlInvoice'val = Maybe LnHodlInvoice
y__}))
        (Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice))
-> Maybe LnHodlInvoice -> f (Maybe LnHodlInvoice)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message FundLnHodlInvoice where
  messageName :: Proxy FundLnHodlInvoice -> Text
messageName Proxy FundLnHodlInvoice
_
    = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.FundLnHodlInvoice"
  packedMessageDescriptor :: Proxy FundLnHodlInvoice -> ByteString
packedMessageDescriptor Proxy FundLnHodlInvoice
_
    = ByteString
"\n\
      \\DC1FundLnHodlInvoice\DC25\n\
      \\ETXval\CAN\SOH \SOH(\v2#.BtcLsp.Data.LowLevel.LnHodlInvoiceR\ETXval"
  packedFileDescriptor :: Proxy FundLnHodlInvoice -> ByteString
packedFileDescriptor Proxy FundLnHodlInvoice
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor FundLnHodlInvoice)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor FundLnHodlInvoice
val__field_descriptor
          = String
-> FieldTypeDescriptor LnHodlInvoice
-> FieldAccessor FundLnHodlInvoice LnHodlInvoice
-> FieldDescriptor FundLnHodlInvoice
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor LnHodlInvoice
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.LnHodlInvoice)
              (Lens
  FundLnHodlInvoice
  FundLnHodlInvoice
  (Maybe LnHodlInvoice)
  (Maybe LnHodlInvoice)
-> FieldAccessor FundLnHodlInvoice LnHodlInvoice
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor FundLnHodlInvoice
      in
        [(Tag, FieldDescriptor FundLnHodlInvoice)]
-> Map Tag (FieldDescriptor FundLnHodlInvoice)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor FundLnHodlInvoice
val__field_descriptor)]
  unknownFields :: Lens' FundLnHodlInvoice FieldSet
unknownFields
    = (FundLnHodlInvoice -> FieldSet)
-> (FundLnHodlInvoice -> FieldSet -> FundLnHodlInvoice)
-> Lens' FundLnHodlInvoice FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        FundLnHodlInvoice -> FieldSet
_FundLnHodlInvoice'_unknownFields
        (\ FundLnHodlInvoice
x__ FieldSet
y__ -> FundLnHodlInvoice
x__ {_FundLnHodlInvoice'_unknownFields :: FieldSet
_FundLnHodlInvoice'_unknownFields = FieldSet
y__})
  defMessage :: FundLnHodlInvoice
defMessage
    = FundLnHodlInvoice'_constructor :: Maybe LnHodlInvoice -> FieldSet -> FundLnHodlInvoice
FundLnHodlInvoice'_constructor
        {_FundLnHodlInvoice'val :: Maybe LnHodlInvoice
_FundLnHodlInvoice'val = Maybe LnHodlInvoice
forall a. Maybe a
Prelude.Nothing,
         _FundLnHodlInvoice'_unknownFields :: FieldSet
_FundLnHodlInvoice'_unknownFields = []}
  parseMessage :: Parser FundLnHodlInvoice
parseMessage
    = let
        loop ::
          FundLnHodlInvoice
          -> Data.ProtoLens.Encoding.Bytes.Parser FundLnHodlInvoice
        loop :: FundLnHodlInvoice -> Parser FundLnHodlInvoice
loop FundLnHodlInvoice
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      FundLnHodlInvoice -> Parser FundLnHodlInvoice
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter FundLnHodlInvoice FundLnHodlInvoice FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FundLnHodlInvoice -> FundLnHodlInvoice
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter FundLnHodlInvoice FundLnHodlInvoice FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) FundLnHodlInvoice
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do LnHodlInvoice
y <- Parser LnHodlInvoice -> String -> Parser LnHodlInvoice
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser LnHodlInvoice -> Parser LnHodlInvoice
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser LnHodlInvoice
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                FundLnHodlInvoice -> Parser FundLnHodlInvoice
loop (Setter
  FundLnHodlInvoice FundLnHodlInvoice LnHodlInvoice LnHodlInvoice
-> LnHodlInvoice -> FundLnHodlInvoice -> FundLnHodlInvoice
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") LnHodlInvoice
y FundLnHodlInvoice
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                FundLnHodlInvoice -> Parser FundLnHodlInvoice
loop
                                  (Setter FundLnHodlInvoice FundLnHodlInvoice FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FundLnHodlInvoice -> FundLnHodlInvoice
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter FundLnHodlInvoice FundLnHodlInvoice FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) FundLnHodlInvoice
x)
      in
        Parser FundLnHodlInvoice -> String -> Parser FundLnHodlInvoice
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do FundLnHodlInvoice -> Parser FundLnHodlInvoice
loop FundLnHodlInvoice
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"FundLnHodlInvoice"
  buildMessage :: FundLnHodlInvoice -> Builder
buildMessage
    = \ FundLnHodlInvoice
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe LnHodlInvoice)
  FundLnHodlInvoice
  FundLnHodlInvoice
  (Maybe LnHodlInvoice)
  (Maybe LnHodlInvoice)
-> FundLnHodlInvoice -> Maybe LnHodlInvoice
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") FundLnHodlInvoice
_x
              of
                Maybe LnHodlInvoice
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just LnHodlInvoice
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (LnHodlInvoice -> ByteString) -> LnHodlInvoice -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          LnHodlInvoice -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage LnHodlInvoice
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet FundLnHodlInvoice FundLnHodlInvoice FieldSet FieldSet
-> FundLnHodlInvoice -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet FundLnHodlInvoice FundLnHodlInvoice FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields FundLnHodlInvoice
_x))
instance Control.DeepSeq.NFData FundLnHodlInvoice where
  rnf :: FundLnHodlInvoice -> ()
rnf
    = \ FundLnHodlInvoice
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (FundLnHodlInvoice -> FieldSet
_FundLnHodlInvoice'_unknownFields FundLnHodlInvoice
x__)
             (Maybe LnHodlInvoice -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (FundLnHodlInvoice -> Maybe LnHodlInvoice
_FundLnHodlInvoice'val FundLnHodlInvoice
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' FundLnInvoice Proto.BtcLsp.Data.LowLevel.LnInvoice@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' FundLnInvoice (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.LnInvoice)@ -}
data FundLnInvoice
  = FundLnInvoice'_constructor {FundLnInvoice -> Maybe LnInvoice
_FundLnInvoice'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.LnInvoice),
                                FundLnInvoice -> FieldSet
_FundLnInvoice'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (FundLnInvoice -> FundLnInvoice -> Bool
(FundLnInvoice -> FundLnInvoice -> Bool)
-> (FundLnInvoice -> FundLnInvoice -> Bool) -> Eq FundLnInvoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FundLnInvoice -> FundLnInvoice -> Bool
$c/= :: FundLnInvoice -> FundLnInvoice -> Bool
== :: FundLnInvoice -> FundLnInvoice -> Bool
$c== :: FundLnInvoice -> FundLnInvoice -> Bool
Prelude.Eq, Eq FundLnInvoice
Eq FundLnInvoice
-> (FundLnInvoice -> FundLnInvoice -> Ordering)
-> (FundLnInvoice -> FundLnInvoice -> Bool)
-> (FundLnInvoice -> FundLnInvoice -> Bool)
-> (FundLnInvoice -> FundLnInvoice -> Bool)
-> (FundLnInvoice -> FundLnInvoice -> Bool)
-> (FundLnInvoice -> FundLnInvoice -> FundLnInvoice)
-> (FundLnInvoice -> FundLnInvoice -> FundLnInvoice)
-> Ord FundLnInvoice
FundLnInvoice -> FundLnInvoice -> Bool
FundLnInvoice -> FundLnInvoice -> Ordering
FundLnInvoice -> FundLnInvoice -> FundLnInvoice
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FundLnInvoice -> FundLnInvoice -> FundLnInvoice
$cmin :: FundLnInvoice -> FundLnInvoice -> FundLnInvoice
max :: FundLnInvoice -> FundLnInvoice -> FundLnInvoice
$cmax :: FundLnInvoice -> FundLnInvoice -> FundLnInvoice
>= :: FundLnInvoice -> FundLnInvoice -> Bool
$c>= :: FundLnInvoice -> FundLnInvoice -> Bool
> :: FundLnInvoice -> FundLnInvoice -> Bool
$c> :: FundLnInvoice -> FundLnInvoice -> Bool
<= :: FundLnInvoice -> FundLnInvoice -> Bool
$c<= :: FundLnInvoice -> FundLnInvoice -> Bool
< :: FundLnInvoice -> FundLnInvoice -> Bool
$c< :: FundLnInvoice -> FundLnInvoice -> Bool
compare :: FundLnInvoice -> FundLnInvoice -> Ordering
$ccompare :: FundLnInvoice -> FundLnInvoice -> Ordering
Prelude.Ord, (forall x. FundLnInvoice -> Rep FundLnInvoice x)
-> (forall x. Rep FundLnInvoice x -> FundLnInvoice)
-> Generic FundLnInvoice
forall x. Rep FundLnInvoice x -> FundLnInvoice
forall x. FundLnInvoice -> Rep FundLnInvoice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FundLnInvoice x -> FundLnInvoice
$cfrom :: forall x. FundLnInvoice -> Rep FundLnInvoice x
GHC.Generics.Generic)
instance Prelude.Show FundLnInvoice where
  showsPrec :: Int -> FundLnInvoice -> ShowS
showsPrec Int
_ FundLnInvoice
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (FundLnInvoice -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort FundLnInvoice
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out FundLnInvoice
instance Data.ProtoLens.Field.HasField FundLnInvoice "val" Proto.BtcLsp.Data.LowLevel.LnInvoice where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val"
-> (LnInvoice -> f LnInvoice) -> FundLnInvoice -> f FundLnInvoice
fieldOf Proxy# "val"
_
    = ((Maybe LnInvoice -> f (Maybe LnInvoice))
 -> FundLnInvoice -> f FundLnInvoice)
-> ((LnInvoice -> f LnInvoice)
    -> Maybe LnInvoice -> f (Maybe LnInvoice))
-> (LnInvoice -> f LnInvoice)
-> FundLnInvoice
-> f FundLnInvoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundLnInvoice -> Maybe LnInvoice)
-> (FundLnInvoice -> Maybe LnInvoice -> FundLnInvoice)
-> Lens
     FundLnInvoice FundLnInvoice (Maybe LnInvoice) (Maybe LnInvoice)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundLnInvoice -> Maybe LnInvoice
_FundLnInvoice'val (\ FundLnInvoice
x__ Maybe LnInvoice
y__ -> FundLnInvoice
x__ {_FundLnInvoice'val :: Maybe LnInvoice
_FundLnInvoice'val = Maybe LnInvoice
y__}))
        (LnInvoice -> Lens' (Maybe LnInvoice) LnInvoice
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens LnInvoice
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField FundLnInvoice "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.LnInvoice) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe LnInvoice -> f (Maybe LnInvoice))
-> FundLnInvoice
-> f FundLnInvoice
fieldOf Proxy# "maybe'val"
_
    = ((Maybe LnInvoice -> f (Maybe LnInvoice))
 -> FundLnInvoice -> f FundLnInvoice)
-> ((Maybe LnInvoice -> f (Maybe LnInvoice))
    -> Maybe LnInvoice -> f (Maybe LnInvoice))
-> (Maybe LnInvoice -> f (Maybe LnInvoice))
-> FundLnInvoice
-> f FundLnInvoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundLnInvoice -> Maybe LnInvoice)
-> (FundLnInvoice -> Maybe LnInvoice -> FundLnInvoice)
-> Lens
     FundLnInvoice FundLnInvoice (Maybe LnInvoice) (Maybe LnInvoice)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundLnInvoice -> Maybe LnInvoice
_FundLnInvoice'val (\ FundLnInvoice
x__ Maybe LnInvoice
y__ -> FundLnInvoice
x__ {_FundLnInvoice'val :: Maybe LnInvoice
_FundLnInvoice'val = Maybe LnInvoice
y__}))
        (Maybe LnInvoice -> f (Maybe LnInvoice))
-> Maybe LnInvoice -> f (Maybe LnInvoice)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message FundLnInvoice where
  messageName :: Proxy FundLnInvoice -> Text
messageName Proxy FundLnInvoice
_
    = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.FundLnInvoice"
  packedMessageDescriptor :: Proxy FundLnInvoice -> ByteString
packedMessageDescriptor Proxy FundLnInvoice
_
    = ByteString
"\n\
      \\rFundLnInvoice\DC21\n\
      \\ETXval\CAN\SOH \SOH(\v2\US.BtcLsp.Data.LowLevel.LnInvoiceR\ETXval"
  packedFileDescriptor :: Proxy FundLnInvoice -> ByteString
packedFileDescriptor Proxy FundLnInvoice
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor FundLnInvoice)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor FundLnInvoice
val__field_descriptor
          = String
-> FieldTypeDescriptor LnInvoice
-> FieldAccessor FundLnInvoice LnInvoice
-> FieldDescriptor FundLnInvoice
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor LnInvoice
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.LnInvoice)
              (Lens
  FundLnInvoice FundLnInvoice (Maybe LnInvoice) (Maybe LnInvoice)
-> FieldAccessor FundLnInvoice LnInvoice
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor FundLnInvoice
      in
        [(Tag, FieldDescriptor FundLnInvoice)]
-> Map Tag (FieldDescriptor FundLnInvoice)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor FundLnInvoice
val__field_descriptor)]
  unknownFields :: Lens' FundLnInvoice FieldSet
unknownFields
    = (FundLnInvoice -> FieldSet)
-> (FundLnInvoice -> FieldSet -> FundLnInvoice)
-> Lens' FundLnInvoice FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        FundLnInvoice -> FieldSet
_FundLnInvoice'_unknownFields
        (\ FundLnInvoice
x__ FieldSet
y__ -> FundLnInvoice
x__ {_FundLnInvoice'_unknownFields :: FieldSet
_FundLnInvoice'_unknownFields = FieldSet
y__})
  defMessage :: FundLnInvoice
defMessage
    = FundLnInvoice'_constructor :: Maybe LnInvoice -> FieldSet -> FundLnInvoice
FundLnInvoice'_constructor
        {_FundLnInvoice'val :: Maybe LnInvoice
_FundLnInvoice'val = Maybe LnInvoice
forall a. Maybe a
Prelude.Nothing,
         _FundLnInvoice'_unknownFields :: FieldSet
_FundLnInvoice'_unknownFields = []}
  parseMessage :: Parser FundLnInvoice
parseMessage
    = let
        loop ::
          FundLnInvoice -> Data.ProtoLens.Encoding.Bytes.Parser FundLnInvoice
        loop :: FundLnInvoice -> Parser FundLnInvoice
loop FundLnInvoice
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      FundLnInvoice -> Parser FundLnInvoice
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter FundLnInvoice FundLnInvoice FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FundLnInvoice -> FundLnInvoice
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter FundLnInvoice FundLnInvoice FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) FundLnInvoice
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do LnInvoice
y <- Parser LnInvoice -> String -> Parser LnInvoice
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser LnInvoice -> Parser LnInvoice
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser LnInvoice
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                FundLnInvoice -> Parser FundLnInvoice
loop (Setter FundLnInvoice FundLnInvoice LnInvoice LnInvoice
-> LnInvoice -> FundLnInvoice -> FundLnInvoice
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") LnInvoice
y FundLnInvoice
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                FundLnInvoice -> Parser FundLnInvoice
loop
                                  (Setter FundLnInvoice FundLnInvoice FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FundLnInvoice -> FundLnInvoice
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter FundLnInvoice FundLnInvoice FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) FundLnInvoice
x)
      in
        Parser FundLnInvoice -> String -> Parser FundLnInvoice
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do FundLnInvoice -> Parser FundLnInvoice
loop FundLnInvoice
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"FundLnInvoice"
  buildMessage :: FundLnInvoice -> Builder
buildMessage
    = \ FundLnInvoice
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe LnInvoice)
  FundLnInvoice
  FundLnInvoice
  (Maybe LnInvoice)
  (Maybe LnInvoice)
-> FundLnInvoice -> Maybe LnInvoice
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") FundLnInvoice
_x
              of
                Maybe LnInvoice
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just LnInvoice
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (LnInvoice -> ByteString) -> LnInvoice -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          LnInvoice -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage LnInvoice
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet FundLnInvoice FundLnInvoice FieldSet FieldSet
-> FundLnInvoice -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet FundLnInvoice FundLnInvoice FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields FundLnInvoice
_x))
instance Control.DeepSeq.NFData FundLnInvoice where
  rnf :: FundLnInvoice -> ()
rnf
    = \ FundLnInvoice
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (FundLnInvoice -> FieldSet
_FundLnInvoice'_unknownFields FundLnInvoice
x__)
             (Maybe LnInvoice -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (FundLnInvoice -> Maybe LnInvoice
_FundLnInvoice'val FundLnInvoice
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' FundMoney Proto.BtcLsp.Data.LowLevel.Msat@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' FundMoney (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat)@ -}
data FundMoney
  = FundMoney'_constructor {FundMoney -> Maybe Msat
_FundMoney'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat),
                            FundMoney -> FieldSet
_FundMoney'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (FundMoney -> FundMoney -> Bool
(FundMoney -> FundMoney -> Bool)
-> (FundMoney -> FundMoney -> Bool) -> Eq FundMoney
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FundMoney -> FundMoney -> Bool
$c/= :: FundMoney -> FundMoney -> Bool
== :: FundMoney -> FundMoney -> Bool
$c== :: FundMoney -> FundMoney -> Bool
Prelude.Eq, Eq FundMoney
Eq FundMoney
-> (FundMoney -> FundMoney -> Ordering)
-> (FundMoney -> FundMoney -> Bool)
-> (FundMoney -> FundMoney -> Bool)
-> (FundMoney -> FundMoney -> Bool)
-> (FundMoney -> FundMoney -> Bool)
-> (FundMoney -> FundMoney -> FundMoney)
-> (FundMoney -> FundMoney -> FundMoney)
-> Ord FundMoney
FundMoney -> FundMoney -> Bool
FundMoney -> FundMoney -> Ordering
FundMoney -> FundMoney -> FundMoney
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FundMoney -> FundMoney -> FundMoney
$cmin :: FundMoney -> FundMoney -> FundMoney
max :: FundMoney -> FundMoney -> FundMoney
$cmax :: FundMoney -> FundMoney -> FundMoney
>= :: FundMoney -> FundMoney -> Bool
$c>= :: FundMoney -> FundMoney -> Bool
> :: FundMoney -> FundMoney -> Bool
$c> :: FundMoney -> FundMoney -> Bool
<= :: FundMoney -> FundMoney -> Bool
$c<= :: FundMoney -> FundMoney -> Bool
< :: FundMoney -> FundMoney -> Bool
$c< :: FundMoney -> FundMoney -> Bool
compare :: FundMoney -> FundMoney -> Ordering
$ccompare :: FundMoney -> FundMoney -> Ordering
Prelude.Ord, (forall x. FundMoney -> Rep FundMoney x)
-> (forall x. Rep FundMoney x -> FundMoney) -> Generic FundMoney
forall x. Rep FundMoney x -> FundMoney
forall x. FundMoney -> Rep FundMoney x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FundMoney x -> FundMoney
$cfrom :: forall x. FundMoney -> Rep FundMoney x
GHC.Generics.Generic)
instance Prelude.Show FundMoney where
  showsPrec :: Int -> FundMoney -> ShowS
showsPrec Int
_ FundMoney
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (FundMoney -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort FundMoney
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out FundMoney
instance Data.ProtoLens.Field.HasField FundMoney "val" Proto.BtcLsp.Data.LowLevel.Msat where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Msat -> f Msat) -> FundMoney -> f FundMoney
fieldOf Proxy# "val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> FundMoney -> f FundMoney)
-> ((Msat -> f Msat) -> Maybe Msat -> f (Maybe Msat))
-> (Msat -> f Msat)
-> FundMoney
-> f FundMoney
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundMoney -> Maybe Msat)
-> (FundMoney -> Maybe Msat -> FundMoney)
-> Lens FundMoney FundMoney (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundMoney -> Maybe Msat
_FundMoney'val (\ FundMoney
x__ Maybe Msat
y__ -> FundMoney
x__ {_FundMoney'val :: Maybe Msat
_FundMoney'val = Maybe Msat
y__}))
        (Msat -> Lens' (Maybe Msat) Msat
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Msat
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField FundMoney "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe Msat -> f (Maybe Msat)) -> FundMoney -> f FundMoney
fieldOf Proxy# "maybe'val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> FundMoney -> f FundMoney)
-> ((Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat))
-> (Maybe Msat -> f (Maybe Msat))
-> FundMoney
-> f FundMoney
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundMoney -> Maybe Msat)
-> (FundMoney -> Maybe Msat -> FundMoney)
-> Lens FundMoney FundMoney (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundMoney -> Maybe Msat
_FundMoney'val (\ FundMoney
x__ Maybe Msat
y__ -> FundMoney
x__ {_FundMoney'val :: Maybe Msat
_FundMoney'val = Maybe Msat
y__}))
        (Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message FundMoney where
  messageName :: Proxy FundMoney -> Text
messageName Proxy FundMoney
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.FundMoney"
  packedMessageDescriptor :: Proxy FundMoney -> ByteString
packedMessageDescriptor Proxy FundMoney
_
    = ByteString
"\n\
      \\tFundMoney\DC2,\n\
      \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval"
  packedFileDescriptor :: Proxy FundMoney -> ByteString
packedFileDescriptor Proxy FundMoney
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor FundMoney)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor FundMoney
val__field_descriptor
          = String
-> FieldTypeDescriptor Msat
-> FieldAccessor FundMoney Msat
-> FieldDescriptor FundMoney
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor Msat
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.Msat)
              (Lens FundMoney FundMoney (Maybe Msat) (Maybe Msat)
-> FieldAccessor FundMoney Msat
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor FundMoney
      in
        [(Tag, FieldDescriptor FundMoney)]
-> Map Tag (FieldDescriptor FundMoney)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor FundMoney
val__field_descriptor)]
  unknownFields :: Lens' FundMoney FieldSet
unknownFields
    = (FundMoney -> FieldSet)
-> (FundMoney -> FieldSet -> FundMoney) -> Lens' FundMoney FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        FundMoney -> FieldSet
_FundMoney'_unknownFields
        (\ FundMoney
x__ FieldSet
y__ -> FundMoney
x__ {_FundMoney'_unknownFields :: FieldSet
_FundMoney'_unknownFields = FieldSet
y__})
  defMessage :: FundMoney
defMessage
    = FundMoney'_constructor :: Maybe Msat -> FieldSet -> FundMoney
FundMoney'_constructor
        {_FundMoney'val :: Maybe Msat
_FundMoney'val = Maybe Msat
forall a. Maybe a
Prelude.Nothing, _FundMoney'_unknownFields :: FieldSet
_FundMoney'_unknownFields = []}
  parseMessage :: Parser FundMoney
parseMessage
    = let
        loop :: FundMoney -> Data.ProtoLens.Encoding.Bytes.Parser FundMoney
        loop :: FundMoney -> Parser FundMoney
loop FundMoney
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      FundMoney -> Parser FundMoney
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter FundMoney FundMoney FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FundMoney -> FundMoney
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter FundMoney FundMoney FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) FundMoney
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Msat
y <- Parser Msat -> String -> Parser Msat
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser Msat -> Parser Msat
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser Msat
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                FundMoney -> Parser FundMoney
loop (Setter FundMoney FundMoney Msat Msat
-> Msat -> FundMoney -> FundMoney
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Msat
y FundMoney
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                FundMoney -> Parser FundMoney
loop
                                  (Setter FundMoney FundMoney FieldSet FieldSet
-> (FieldSet -> FieldSet) -> FundMoney -> FundMoney
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter FundMoney FundMoney FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) FundMoney
x)
      in
        Parser FundMoney -> String -> Parser FundMoney
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do FundMoney -> Parser FundMoney
loop FundMoney
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"FundMoney"
  buildMessage :: FundMoney -> Builder
buildMessage
    = \ FundMoney
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike (Maybe Msat) FundMoney FundMoney (Maybe Msat) (Maybe Msat)
-> FundMoney -> Maybe Msat
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") FundMoney
_x
              of
                Maybe Msat
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Msat
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder) -> (Msat -> ByteString) -> Msat -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Msat -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage Msat
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet FundMoney FundMoney FieldSet FieldSet
-> FundMoney -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet FundMoney FundMoney FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields FundMoney
_x))
instance Control.DeepSeq.NFData FundMoney where
  rnf :: FundMoney -> ()
rnf
    = \ FundMoney
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (FundMoney -> FieldSet
_FundMoney'_unknownFields FundMoney
x__)
             (Maybe Msat -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (FundMoney -> Maybe Msat
_FundMoney'val FundMoney
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' FundOnChainAddress Proto.BtcLsp.Data.LowLevel.OnChainAddress@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' FundOnChainAddress (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.OnChainAddress)@ -}
data FundOnChainAddress
  = FundOnChainAddress'_constructor {FundOnChainAddress -> Maybe OnChainAddress
_FundOnChainAddress'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.OnChainAddress),
                                     FundOnChainAddress -> FieldSet
_FundOnChainAddress'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (FundOnChainAddress -> FundOnChainAddress -> Bool
(FundOnChainAddress -> FundOnChainAddress -> Bool)
-> (FundOnChainAddress -> FundOnChainAddress -> Bool)
-> Eq FundOnChainAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FundOnChainAddress -> FundOnChainAddress -> Bool
$c/= :: FundOnChainAddress -> FundOnChainAddress -> Bool
== :: FundOnChainAddress -> FundOnChainAddress -> Bool
$c== :: FundOnChainAddress -> FundOnChainAddress -> Bool
Prelude.Eq, Eq FundOnChainAddress
Eq FundOnChainAddress
-> (FundOnChainAddress -> FundOnChainAddress -> Ordering)
-> (FundOnChainAddress -> FundOnChainAddress -> Bool)
-> (FundOnChainAddress -> FundOnChainAddress -> Bool)
-> (FundOnChainAddress -> FundOnChainAddress -> Bool)
-> (FundOnChainAddress -> FundOnChainAddress -> Bool)
-> (FundOnChainAddress -> FundOnChainAddress -> FundOnChainAddress)
-> (FundOnChainAddress -> FundOnChainAddress -> FundOnChainAddress)
-> Ord FundOnChainAddress
FundOnChainAddress -> FundOnChainAddress -> Bool
FundOnChainAddress -> FundOnChainAddress -> Ordering
FundOnChainAddress -> FundOnChainAddress -> FundOnChainAddress
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FundOnChainAddress -> FundOnChainAddress -> FundOnChainAddress
$cmin :: FundOnChainAddress -> FundOnChainAddress -> FundOnChainAddress
max :: FundOnChainAddress -> FundOnChainAddress -> FundOnChainAddress
$cmax :: FundOnChainAddress -> FundOnChainAddress -> FundOnChainAddress
>= :: FundOnChainAddress -> FundOnChainAddress -> Bool
$c>= :: FundOnChainAddress -> FundOnChainAddress -> Bool
> :: FundOnChainAddress -> FundOnChainAddress -> Bool
$c> :: FundOnChainAddress -> FundOnChainAddress -> Bool
<= :: FundOnChainAddress -> FundOnChainAddress -> Bool
$c<= :: FundOnChainAddress -> FundOnChainAddress -> Bool
< :: FundOnChainAddress -> FundOnChainAddress -> Bool
$c< :: FundOnChainAddress -> FundOnChainAddress -> Bool
compare :: FundOnChainAddress -> FundOnChainAddress -> Ordering
$ccompare :: FundOnChainAddress -> FundOnChainAddress -> Ordering
Prelude.Ord, (forall x. FundOnChainAddress -> Rep FundOnChainAddress x)
-> (forall x. Rep FundOnChainAddress x -> FundOnChainAddress)
-> Generic FundOnChainAddress
forall x. Rep FundOnChainAddress x -> FundOnChainAddress
forall x. FundOnChainAddress -> Rep FundOnChainAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FundOnChainAddress x -> FundOnChainAddress
$cfrom :: forall x. FundOnChainAddress -> Rep FundOnChainAddress x
GHC.Generics.Generic)
instance Prelude.Show FundOnChainAddress where
  showsPrec :: Int -> FundOnChainAddress -> ShowS
showsPrec Int
_ FundOnChainAddress
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (FundOnChainAddress -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort FundOnChainAddress
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out FundOnChainAddress
instance Data.ProtoLens.Field.HasField FundOnChainAddress "val" Proto.BtcLsp.Data.LowLevel.OnChainAddress where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val"
-> (OnChainAddress -> f OnChainAddress)
-> FundOnChainAddress
-> f FundOnChainAddress
fieldOf Proxy# "val"
_
    = ((Maybe OnChainAddress -> f (Maybe OnChainAddress))
 -> FundOnChainAddress -> f FundOnChainAddress)
-> ((OnChainAddress -> f OnChainAddress)
    -> Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> (OnChainAddress -> f OnChainAddress)
-> FundOnChainAddress
-> f FundOnChainAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundOnChainAddress -> Maybe OnChainAddress)
-> (FundOnChainAddress
    -> Maybe OnChainAddress -> FundOnChainAddress)
-> Lens
     FundOnChainAddress
     FundOnChainAddress
     (Maybe OnChainAddress)
     (Maybe OnChainAddress)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundOnChainAddress -> Maybe OnChainAddress
_FundOnChainAddress'val
           (\ FundOnChainAddress
x__ Maybe OnChainAddress
y__ -> FundOnChainAddress
x__ {_FundOnChainAddress'val :: Maybe OnChainAddress
_FundOnChainAddress'val = Maybe OnChainAddress
y__}))
        (OnChainAddress -> Lens' (Maybe OnChainAddress) OnChainAddress
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens OnChainAddress
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField FundOnChainAddress "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.OnChainAddress) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> FundOnChainAddress
-> f FundOnChainAddress
fieldOf Proxy# "maybe'val"
_
    = ((Maybe OnChainAddress -> f (Maybe OnChainAddress))
 -> FundOnChainAddress -> f FundOnChainAddress)
-> ((Maybe OnChainAddress -> f (Maybe OnChainAddress))
    -> Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> (Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> FundOnChainAddress
-> f FundOnChainAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((FundOnChainAddress -> Maybe OnChainAddress)
-> (FundOnChainAddress
    -> Maybe OnChainAddress -> FundOnChainAddress)
-> Lens
     FundOnChainAddress
     FundOnChainAddress
     (Maybe OnChainAddress)
     (Maybe OnChainAddress)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           FundOnChainAddress -> Maybe OnChainAddress
_FundOnChainAddress'val
           (\ FundOnChainAddress
x__ Maybe OnChainAddress
y__ -> FundOnChainAddress
x__ {_FundOnChainAddress'val :: Maybe OnChainAddress
_FundOnChainAddress'val = Maybe OnChainAddress
y__}))
        (Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> Maybe OnChainAddress -> f (Maybe OnChainAddress)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message FundOnChainAddress where
  messageName :: Proxy FundOnChainAddress -> Text
messageName Proxy FundOnChainAddress
_
    = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.FundOnChainAddress"
  packedMessageDescriptor :: Proxy FundOnChainAddress -> ByteString
packedMessageDescriptor Proxy FundOnChainAddress
_
    = ByteString
"\n\
      \\DC2FundOnChainAddress\DC26\n\
      \\ETXval\CAN\SOH \SOH(\v2$.BtcLsp.Data.LowLevel.OnChainAddressR\ETXval"
  packedFileDescriptor :: Proxy FundOnChainAddress -> ByteString
packedFileDescriptor Proxy FundOnChainAddress
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor FundOnChainAddress)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor FundOnChainAddress
val__field_descriptor
          = String
-> FieldTypeDescriptor OnChainAddress
-> FieldAccessor FundOnChainAddress OnChainAddress
-> FieldDescriptor FundOnChainAddress
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor OnChainAddress
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.OnChainAddress)
              (Lens
  FundOnChainAddress
  FundOnChainAddress
  (Maybe OnChainAddress)
  (Maybe OnChainAddress)
-> FieldAccessor FundOnChainAddress OnChainAddress
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor FundOnChainAddress
      in
        [(Tag, FieldDescriptor FundOnChainAddress)]
-> Map Tag (FieldDescriptor FundOnChainAddress)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor FundOnChainAddress
val__field_descriptor)]
  unknownFields :: Lens' FundOnChainAddress FieldSet
unknownFields
    = (FundOnChainAddress -> FieldSet)
-> (FundOnChainAddress -> FieldSet -> FundOnChainAddress)
-> Lens' FundOnChainAddress FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        FundOnChainAddress -> FieldSet
_FundOnChainAddress'_unknownFields
        (\ FundOnChainAddress
x__ FieldSet
y__ -> FundOnChainAddress
x__ {_FundOnChainAddress'_unknownFields :: FieldSet
_FundOnChainAddress'_unknownFields = FieldSet
y__})
  defMessage :: FundOnChainAddress
defMessage
    = FundOnChainAddress'_constructor :: Maybe OnChainAddress -> FieldSet -> FundOnChainAddress
FundOnChainAddress'_constructor
        {_FundOnChainAddress'val :: Maybe OnChainAddress
_FundOnChainAddress'val = Maybe OnChainAddress
forall a. Maybe a
Prelude.Nothing,
         _FundOnChainAddress'_unknownFields :: FieldSet
_FundOnChainAddress'_unknownFields = []}
  parseMessage :: Parser FundOnChainAddress
parseMessage
    = let
        loop ::
          FundOnChainAddress
          -> Data.ProtoLens.Encoding.Bytes.Parser FundOnChainAddress
        loop :: FundOnChainAddress -> Parser FundOnChainAddress
loop FundOnChainAddress
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      FundOnChainAddress -> Parser FundOnChainAddress
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter FundOnChainAddress FundOnChainAddress FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> FundOnChainAddress
-> FundOnChainAddress
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter FundOnChainAddress FundOnChainAddress FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) FundOnChainAddress
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do OnChainAddress
y <- Parser OnChainAddress -> String -> Parser OnChainAddress
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser OnChainAddress -> Parser OnChainAddress
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser OnChainAddress
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                FundOnChainAddress -> Parser FundOnChainAddress
loop (Setter
  FundOnChainAddress FundOnChainAddress OnChainAddress OnChainAddress
-> OnChainAddress -> FundOnChainAddress -> FundOnChainAddress
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") OnChainAddress
y FundOnChainAddress
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                FundOnChainAddress -> Parser FundOnChainAddress
loop
                                  (Setter FundOnChainAddress FundOnChainAddress FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> FundOnChainAddress
-> FundOnChainAddress
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter FundOnChainAddress FundOnChainAddress FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) FundOnChainAddress
x)
      in
        Parser FundOnChainAddress -> String -> Parser FundOnChainAddress
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do FundOnChainAddress -> Parser FundOnChainAddress
loop FundOnChainAddress
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"FundOnChainAddress"
  buildMessage :: FundOnChainAddress -> Builder
buildMessage
    = \ FundOnChainAddress
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe OnChainAddress)
  FundOnChainAddress
  FundOnChainAddress
  (Maybe OnChainAddress)
  (Maybe OnChainAddress)
-> FundOnChainAddress -> Maybe OnChainAddress
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") FundOnChainAddress
_x
              of
                Maybe OnChainAddress
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just OnChainAddress
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (OnChainAddress -> ByteString) -> OnChainAddress -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          OnChainAddress -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage OnChainAddress
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet FundOnChainAddress FundOnChainAddress FieldSet FieldSet
-> FundOnChainAddress -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet FundOnChainAddress FundOnChainAddress FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields FundOnChainAddress
_x))
instance Control.DeepSeq.NFData FundOnChainAddress where
  rnf :: FundOnChainAddress -> ()
rnf
    = \ FundOnChainAddress
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (FundOnChainAddress -> FieldSet
_FundOnChainAddress'_unknownFields FundOnChainAddress
x__)
             (Maybe OnChainAddress -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (FundOnChainAddress -> Maybe OnChainAddress
_FundOnChainAddress'val FundOnChainAddress
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.fieldLocation' @:: Lens' InputFailure [FieldIndex]@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.vec'fieldLocation' @:: Lens' InputFailure (Data.Vector.Vector FieldIndex)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.kind' @:: Lens' InputFailure InputFailureKind@ -}
data InputFailure
  = InputFailure'_constructor {InputFailure -> Vector FieldIndex
_InputFailure'fieldLocation :: !(Data.Vector.Vector FieldIndex),
                               InputFailure -> InputFailureKind
_InputFailure'kind :: !InputFailureKind,
                               InputFailure -> FieldSet
_InputFailure'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (InputFailure -> InputFailure -> Bool
(InputFailure -> InputFailure -> Bool)
-> (InputFailure -> InputFailure -> Bool) -> Eq InputFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputFailure -> InputFailure -> Bool
$c/= :: InputFailure -> InputFailure -> Bool
== :: InputFailure -> InputFailure -> Bool
$c== :: InputFailure -> InputFailure -> Bool
Prelude.Eq, Eq InputFailure
Eq InputFailure
-> (InputFailure -> InputFailure -> Ordering)
-> (InputFailure -> InputFailure -> Bool)
-> (InputFailure -> InputFailure -> Bool)
-> (InputFailure -> InputFailure -> Bool)
-> (InputFailure -> InputFailure -> Bool)
-> (InputFailure -> InputFailure -> InputFailure)
-> (InputFailure -> InputFailure -> InputFailure)
-> Ord InputFailure
InputFailure -> InputFailure -> Bool
InputFailure -> InputFailure -> Ordering
InputFailure -> InputFailure -> InputFailure
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InputFailure -> InputFailure -> InputFailure
$cmin :: InputFailure -> InputFailure -> InputFailure
max :: InputFailure -> InputFailure -> InputFailure
$cmax :: InputFailure -> InputFailure -> InputFailure
>= :: InputFailure -> InputFailure -> Bool
$c>= :: InputFailure -> InputFailure -> Bool
> :: InputFailure -> InputFailure -> Bool
$c> :: InputFailure -> InputFailure -> Bool
<= :: InputFailure -> InputFailure -> Bool
$c<= :: InputFailure -> InputFailure -> Bool
< :: InputFailure -> InputFailure -> Bool
$c< :: InputFailure -> InputFailure -> Bool
compare :: InputFailure -> InputFailure -> Ordering
$ccompare :: InputFailure -> InputFailure -> Ordering
Prelude.Ord, (forall x. InputFailure -> Rep InputFailure x)
-> (forall x. Rep InputFailure x -> InputFailure)
-> Generic InputFailure
forall x. Rep InputFailure x -> InputFailure
forall x. InputFailure -> Rep InputFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputFailure x -> InputFailure
$cfrom :: forall x. InputFailure -> Rep InputFailure x
GHC.Generics.Generic)
instance Prelude.Show InputFailure where
  showsPrec :: Int -> InputFailure -> ShowS
showsPrec Int
_ InputFailure
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (InputFailure -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort InputFailure
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out InputFailure
instance Data.ProtoLens.Field.HasField InputFailure "fieldLocation" [FieldIndex] where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "fieldLocation"
-> ([FieldIndex] -> f [FieldIndex])
-> InputFailure
-> f InputFailure
fieldOf Proxy# "fieldLocation"
_
    = ((Vector FieldIndex -> f (Vector FieldIndex))
 -> InputFailure -> f InputFailure)
-> (([FieldIndex] -> f [FieldIndex])
    -> Vector FieldIndex -> f (Vector FieldIndex))
-> ([FieldIndex] -> f [FieldIndex])
-> InputFailure
-> f InputFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InputFailure -> Vector FieldIndex)
-> (InputFailure -> Vector FieldIndex -> InputFailure)
-> Lens
     InputFailure InputFailure (Vector FieldIndex) (Vector FieldIndex)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InputFailure -> Vector FieldIndex
_InputFailure'fieldLocation
           (\ InputFailure
x__ Vector FieldIndex
y__ -> InputFailure
x__ {_InputFailure'fieldLocation :: Vector FieldIndex
_InputFailure'fieldLocation = Vector FieldIndex
y__}))
        ((Vector FieldIndex -> [FieldIndex])
-> (Vector FieldIndex -> [FieldIndex] -> Vector FieldIndex)
-> Lens
     (Vector FieldIndex) (Vector FieldIndex) [FieldIndex] [FieldIndex]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector FieldIndex -> [FieldIndex]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector FieldIndex
_ [FieldIndex]
y__ -> [FieldIndex] -> Vector FieldIndex
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [FieldIndex]
y__))
instance Data.ProtoLens.Field.HasField InputFailure "vec'fieldLocation" (Data.Vector.Vector FieldIndex) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "vec'fieldLocation"
-> (Vector FieldIndex -> f (Vector FieldIndex))
-> InputFailure
-> f InputFailure
fieldOf Proxy# "vec'fieldLocation"
_
    = ((Vector FieldIndex -> f (Vector FieldIndex))
 -> InputFailure -> f InputFailure)
-> ((Vector FieldIndex -> f (Vector FieldIndex))
    -> Vector FieldIndex -> f (Vector FieldIndex))
-> (Vector FieldIndex -> f (Vector FieldIndex))
-> InputFailure
-> f InputFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InputFailure -> Vector FieldIndex)
-> (InputFailure -> Vector FieldIndex -> InputFailure)
-> Lens
     InputFailure InputFailure (Vector FieldIndex) (Vector FieldIndex)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InputFailure -> Vector FieldIndex
_InputFailure'fieldLocation
           (\ InputFailure
x__ Vector FieldIndex
y__ -> InputFailure
x__ {_InputFailure'fieldLocation :: Vector FieldIndex
_InputFailure'fieldLocation = Vector FieldIndex
y__}))
        (Vector FieldIndex -> f (Vector FieldIndex))
-> Vector FieldIndex -> f (Vector FieldIndex)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField InputFailure "kind" InputFailureKind where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "kind"
-> (InputFailureKind -> f InputFailureKind)
-> InputFailure
-> f InputFailure
fieldOf Proxy# "kind"
_
    = ((InputFailureKind -> f InputFailureKind)
 -> InputFailure -> f InputFailure)
-> ((InputFailureKind -> f InputFailureKind)
    -> InputFailureKind -> f InputFailureKind)
-> (InputFailureKind -> f InputFailureKind)
-> InputFailure
-> f InputFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InputFailure -> InputFailureKind)
-> (InputFailure -> InputFailureKind -> InputFailure)
-> Lens InputFailure InputFailure InputFailureKind InputFailureKind
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InputFailure -> InputFailureKind
_InputFailure'kind (\ InputFailure
x__ InputFailureKind
y__ -> InputFailure
x__ {_InputFailure'kind :: InputFailureKind
_InputFailure'kind = InputFailureKind
y__}))
        (InputFailureKind -> f InputFailureKind)
-> InputFailureKind -> f InputFailureKind
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message InputFailure where
  messageName :: Proxy InputFailure -> Text
messageName Proxy InputFailure
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.InputFailure"
  packedMessageDescriptor :: Proxy InputFailure -> ByteString
packedMessageDescriptor Proxy InputFailure
_
    = ByteString
"\n\
      \\fInputFailure\DC2H\n\
      \\SOfield_location\CAN\SOH \ETX(\v2!.BtcLsp.Data.HighLevel.FieldIndexR\rfieldLocation\DC2;\n\
      \\EOTkind\CAN\STX \SOH(\SO2'.BtcLsp.Data.HighLevel.InputFailureKindR\EOTkind"
  packedFileDescriptor :: Proxy InputFailure -> ByteString
packedFileDescriptor Proxy InputFailure
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor InputFailure)
fieldsByTag
    = let
        fieldLocation__field_descriptor :: FieldDescriptor InputFailure
fieldLocation__field_descriptor
          = String
-> FieldTypeDescriptor FieldIndex
-> FieldAccessor InputFailure FieldIndex
-> FieldDescriptor InputFailure
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"field_location"
              (MessageOrGroup -> FieldTypeDescriptor FieldIndex
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor FieldIndex)
              (Packing
-> Lens' InputFailure [FieldIndex]
-> FieldAccessor InputFailure FieldIndex
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"fieldLocation")) ::
              Data.ProtoLens.FieldDescriptor InputFailure
        kind__field_descriptor :: FieldDescriptor InputFailure
kind__field_descriptor
          = String
-> FieldTypeDescriptor InputFailureKind
-> FieldAccessor InputFailure InputFailureKind
-> FieldDescriptor InputFailure
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"kind"
              (ScalarField InputFailureKind
-> FieldTypeDescriptor InputFailureKind
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField InputFailureKind
forall t. MessageEnum t => ScalarField t
Data.ProtoLens.EnumField ::
                 Data.ProtoLens.FieldTypeDescriptor InputFailureKind)
              (WireDefault InputFailureKind
-> Lens InputFailure InputFailure InputFailureKind InputFailureKind
-> FieldAccessor InputFailure InputFailureKind
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault InputFailureKind
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"kind")) ::
              Data.ProtoLens.FieldDescriptor InputFailure
      in
        [(Tag, FieldDescriptor InputFailure)]
-> Map Tag (FieldDescriptor InputFailure)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor InputFailure
fieldLocation__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor InputFailure
kind__field_descriptor)]
  unknownFields :: Lens' InputFailure FieldSet
unknownFields
    = (InputFailure -> FieldSet)
-> (InputFailure -> FieldSet -> InputFailure)
-> Lens' InputFailure FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        InputFailure -> FieldSet
_InputFailure'_unknownFields
        (\ InputFailure
x__ FieldSet
y__ -> InputFailure
x__ {_InputFailure'_unknownFields :: FieldSet
_InputFailure'_unknownFields = FieldSet
y__})
  defMessage :: InputFailure
defMessage
    = InputFailure'_constructor :: Vector FieldIndex -> InputFailureKind -> FieldSet -> InputFailure
InputFailure'_constructor
        {_InputFailure'fieldLocation :: Vector FieldIndex
_InputFailure'fieldLocation = Vector FieldIndex
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _InputFailure'kind :: InputFailureKind
_InputFailure'kind = InputFailureKind
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _InputFailure'_unknownFields :: FieldSet
_InputFailure'_unknownFields = []}
  parseMessage :: Parser InputFailure
parseMessage
    = let
        loop ::
          InputFailure
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld FieldIndex
             -> Data.ProtoLens.Encoding.Bytes.Parser InputFailure
        loop :: InputFailure
-> Growing Vector RealWorld FieldIndex -> Parser InputFailure
loop InputFailure
x Growing Vector RealWorld FieldIndex
mutable'fieldLocation
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector FieldIndex
frozen'fieldLocation <- IO (Vector FieldIndex) -> Parser (Vector FieldIndex)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                                (Growing Vector (PrimState IO) FieldIndex -> IO (Vector FieldIndex)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Growing v (PrimState m) a -> m (v a)
Data.ProtoLens.Encoding.Growing.unsafeFreeze
                                                   Growing Vector RealWorld FieldIndex
Growing Vector (PrimState IO) FieldIndex
mutable'fieldLocation)
                      (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      InputFailure -> Parser InputFailure
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter InputFailure InputFailure FieldSet FieldSet
-> (FieldSet -> FieldSet) -> InputFailure -> InputFailure
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter InputFailure InputFailure FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  InputFailure InputFailure (Vector FieldIndex) (Vector FieldIndex)
-> Vector FieldIndex -> InputFailure -> InputFailure
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'fieldLocation")
                              Vector FieldIndex
frozen'fieldLocation InputFailure
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !FieldIndex
y <- Parser FieldIndex -> String -> Parser FieldIndex
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser FieldIndex -> Parser FieldIndex
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                              (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                              Parser FieldIndex
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"field_location"
                                Growing Vector RealWorld FieldIndex
v <- IO (Growing Vector RealWorld FieldIndex)
-> Parser (Growing Vector RealWorld FieldIndex)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) FieldIndex
-> FieldIndex -> IO (Growing Vector (PrimState IO) FieldIndex)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Growing v (PrimState m) a -> a -> m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.append
                                          Growing Vector RealWorld FieldIndex
Growing Vector (PrimState IO) FieldIndex
mutable'fieldLocation FieldIndex
y)
                                InputFailure
-> Growing Vector RealWorld FieldIndex -> Parser InputFailure
loop InputFailure
x Growing Vector RealWorld FieldIndex
v
                        Word64
16
                          -> do InputFailureKind
y <- Parser InputFailureKind -> String -> Parser InputFailureKind
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Int -> InputFailureKind) -> Parser Int -> Parser InputFailureKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Int -> InputFailureKind
forall a. Enum a => Int -> a
Prelude.toEnum
                                          ((Word64 -> Int) -> Parser Word64 -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"kind"
                                InputFailure
-> Growing Vector RealWorld FieldIndex -> Parser InputFailure
loop
                                  (Setter InputFailure InputFailure InputFailureKind InputFailureKind
-> InputFailureKind -> InputFailure -> InputFailure
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"kind") InputFailureKind
y InputFailure
x)
                                  Growing Vector RealWorld FieldIndex
mutable'fieldLocation
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                InputFailure
-> Growing Vector RealWorld FieldIndex -> Parser InputFailure
loop
                                  (Setter InputFailure InputFailure FieldSet FieldSet
-> (FieldSet -> FieldSet) -> InputFailure -> InputFailure
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter InputFailure InputFailure FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) InputFailure
x)
                                  Growing Vector RealWorld FieldIndex
mutable'fieldLocation
      in
        Parser InputFailure -> String -> Parser InputFailure
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld FieldIndex
mutable'fieldLocation <- IO (Growing Vector RealWorld FieldIndex)
-> Parser (Growing Vector RealWorld FieldIndex)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                         IO (Growing Vector RealWorld FieldIndex)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              InputFailure
-> Growing Vector RealWorld FieldIndex -> Parser InputFailure
loop InputFailure
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld FieldIndex
mutable'fieldLocation)
          String
"InputFailure"
  buildMessage :: InputFailure -> Builder
buildMessage
    = \ InputFailure
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((FieldIndex -> Builder) -> Vector FieldIndex -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ FieldIndex
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (FieldIndex -> ByteString) -> FieldIndex -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                           (\ ByteString
bs
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                      (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                   (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                           FieldIndex -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage FieldIndex
_v))
                (FoldLike
  (Vector FieldIndex)
  InputFailure
  InputFailure
  (Vector FieldIndex)
  (Vector FieldIndex)
-> InputFailure -> Vector FieldIndex
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                   (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'fieldLocation") InputFailure
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (let _v :: InputFailureKind
_v = FoldLike
  InputFailureKind
  InputFailure
  InputFailure
  InputFailureKind
  InputFailureKind
-> InputFailure -> InputFailureKind
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"kind") InputFailure
_x
                 in
                   if InputFailureKind -> InputFailureKind -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) InputFailureKind
_v InputFailureKind
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                       Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   else
                       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                         ((Int -> Builder)
-> (InputFailureKind -> Int) -> InputFailureKind -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                            ((Word64 -> Builder) -> (Int -> Word64) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                               Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                            InputFailureKind -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum InputFailureKind
_v))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet InputFailure InputFailure FieldSet FieldSet
-> InputFailure -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet InputFailure InputFailure FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields InputFailure
_x)))
instance Control.DeepSeq.NFData InputFailure where
  rnf :: InputFailure -> ()
rnf
    = \ InputFailure
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (InputFailure -> FieldSet
_InputFailure'_unknownFields InputFailure
x__)
             (Vector FieldIndex -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (InputFailure -> Vector FieldIndex
_InputFailure'fieldLocation InputFailure
x__)
                (InputFailureKind -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (InputFailure -> InputFailureKind
_InputFailure'kind InputFailure
x__) ()))
newtype InputFailureKind'UnrecognizedValue
  = InputFailureKind'UnrecognizedValue Data.Int.Int32
  deriving stock (InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
(InputFailureKind'UnrecognizedValue
 -> InputFailureKind'UnrecognizedValue -> Bool)
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue -> Bool)
-> Eq InputFailureKind'UnrecognizedValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
$c/= :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
== :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
$c== :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
Prelude.Eq,
                  Eq InputFailureKind'UnrecognizedValue
Eq InputFailureKind'UnrecognizedValue
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue -> Ordering)
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue -> Bool)
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue -> Bool)
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue -> Bool)
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue -> Bool)
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue)
-> (InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue
    -> InputFailureKind'UnrecognizedValue)
-> Ord InputFailureKind'UnrecognizedValue
InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Ordering
InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
$cmin :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
max :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
$cmax :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue
>= :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
$c>= :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
> :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
$c> :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
<= :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
$c<= :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
< :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
$c< :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Bool
compare :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Ordering
$ccompare :: InputFailureKind'UnrecognizedValue
-> InputFailureKind'UnrecognizedValue -> Ordering
Prelude.Ord,
                  Int -> InputFailureKind'UnrecognizedValue -> ShowS
[InputFailureKind'UnrecognizedValue] -> ShowS
InputFailureKind'UnrecognizedValue -> String
(Int -> InputFailureKind'UnrecognizedValue -> ShowS)
-> (InputFailureKind'UnrecognizedValue -> String)
-> ([InputFailureKind'UnrecognizedValue] -> ShowS)
-> Show InputFailureKind'UnrecognizedValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputFailureKind'UnrecognizedValue] -> ShowS
$cshowList :: [InputFailureKind'UnrecognizedValue] -> ShowS
show :: InputFailureKind'UnrecognizedValue -> String
$cshow :: InputFailureKind'UnrecognizedValue -> String
showsPrec :: Int -> InputFailureKind'UnrecognizedValue -> ShowS
$cshowsPrec :: Int -> InputFailureKind'UnrecognizedValue -> ShowS
Prelude.Show,
                  (forall x.
 InputFailureKind'UnrecognizedValue
 -> Rep InputFailureKind'UnrecognizedValue x)
-> (forall x.
    Rep InputFailureKind'UnrecognizedValue x
    -> InputFailureKind'UnrecognizedValue)
-> Generic InputFailureKind'UnrecognizedValue
forall x.
Rep InputFailureKind'UnrecognizedValue x
-> InputFailureKind'UnrecognizedValue
forall x.
InputFailureKind'UnrecognizedValue
-> Rep InputFailureKind'UnrecognizedValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InputFailureKind'UnrecognizedValue x
-> InputFailureKind'UnrecognizedValue
$cfrom :: forall x.
InputFailureKind'UnrecognizedValue
-> Rep InputFailureKind'UnrecognizedValue x
GHC.Generics.Generic)
instance Text.PrettyPrint.GenericPretty.Out InputFailureKind'UnrecognizedValue
data InputFailureKind
  = REQUIRED |
    NOT_FOUND |
    PARSING_FAILED |
    VERIFICATION_FAILED |
    InputFailureKind'Unrecognized !InputFailureKind'UnrecognizedValue
  deriving stock (Int -> InputFailureKind -> ShowS
[InputFailureKind] -> ShowS
InputFailureKind -> String
(Int -> InputFailureKind -> ShowS)
-> (InputFailureKind -> String)
-> ([InputFailureKind] -> ShowS)
-> Show InputFailureKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputFailureKind] -> ShowS
$cshowList :: [InputFailureKind] -> ShowS
show :: InputFailureKind -> String
$cshow :: InputFailureKind -> String
showsPrec :: Int -> InputFailureKind -> ShowS
$cshowsPrec :: Int -> InputFailureKind -> ShowS
Prelude.Show,
                  InputFailureKind -> InputFailureKind -> Bool
(InputFailureKind -> InputFailureKind -> Bool)
-> (InputFailureKind -> InputFailureKind -> Bool)
-> Eq InputFailureKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputFailureKind -> InputFailureKind -> Bool
$c/= :: InputFailureKind -> InputFailureKind -> Bool
== :: InputFailureKind -> InputFailureKind -> Bool
$c== :: InputFailureKind -> InputFailureKind -> Bool
Prelude.Eq,
                  Eq InputFailureKind
Eq InputFailureKind
-> (InputFailureKind -> InputFailureKind -> Ordering)
-> (InputFailureKind -> InputFailureKind -> Bool)
-> (InputFailureKind -> InputFailureKind -> Bool)
-> (InputFailureKind -> InputFailureKind -> Bool)
-> (InputFailureKind -> InputFailureKind -> Bool)
-> (InputFailureKind -> InputFailureKind -> InputFailureKind)
-> (InputFailureKind -> InputFailureKind -> InputFailureKind)
-> Ord InputFailureKind
InputFailureKind -> InputFailureKind -> Bool
InputFailureKind -> InputFailureKind -> Ordering
InputFailureKind -> InputFailureKind -> InputFailureKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InputFailureKind -> InputFailureKind -> InputFailureKind
$cmin :: InputFailureKind -> InputFailureKind -> InputFailureKind
max :: InputFailureKind -> InputFailureKind -> InputFailureKind
$cmax :: InputFailureKind -> InputFailureKind -> InputFailureKind
>= :: InputFailureKind -> InputFailureKind -> Bool
$c>= :: InputFailureKind -> InputFailureKind -> Bool
> :: InputFailureKind -> InputFailureKind -> Bool
$c> :: InputFailureKind -> InputFailureKind -> Bool
<= :: InputFailureKind -> InputFailureKind -> Bool
$c<= :: InputFailureKind -> InputFailureKind -> Bool
< :: InputFailureKind -> InputFailureKind -> Bool
$c< :: InputFailureKind -> InputFailureKind -> Bool
compare :: InputFailureKind -> InputFailureKind -> Ordering
$ccompare :: InputFailureKind -> InputFailureKind -> Ordering
Prelude.Ord,
                  (forall x. InputFailureKind -> Rep InputFailureKind x)
-> (forall x. Rep InputFailureKind x -> InputFailureKind)
-> Generic InputFailureKind
forall x. Rep InputFailureKind x -> InputFailureKind
forall x. InputFailureKind -> Rep InputFailureKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputFailureKind x -> InputFailureKind
$cfrom :: forall x. InputFailureKind -> Rep InputFailureKind x
GHC.Generics.Generic)
instance Data.ProtoLens.MessageEnum InputFailureKind where
  maybeToEnum :: Int -> Maybe InputFailureKind
maybeToEnum Int
0 = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
REQUIRED
  maybeToEnum Int
1 = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
NOT_FOUND
  maybeToEnum Int
2 = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
PARSING_FAILED
  maybeToEnum Int
3 = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
VERIFICATION_FAILED
  maybeToEnum Int
k
    = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just
        (InputFailureKind'UnrecognizedValue -> InputFailureKind
InputFailureKind'Unrecognized
           (Int32 -> InputFailureKind'UnrecognizedValue
InputFailureKind'UnrecognizedValue (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
k)))
  showEnum :: InputFailureKind -> String
showEnum InputFailureKind
REQUIRED = String
"REQUIRED"
  showEnum InputFailureKind
NOT_FOUND = String
"NOT_FOUND"
  showEnum InputFailureKind
PARSING_FAILED = String
"PARSING_FAILED"
  showEnum InputFailureKind
VERIFICATION_FAILED = String
"VERIFICATION_FAILED"
  showEnum
    (InputFailureKind'Unrecognized (InputFailureKind'UnrecognizedValue Int32
k))
    = Int32 -> String
forall a. Show a => a -> String
Prelude.show Int32
k
  readEnum :: String -> Maybe InputFailureKind
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"REQUIRED" = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
REQUIRED
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"NOT_FOUND" = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
NOT_FOUND
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"PARSING_FAILED" = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
PARSING_FAILED
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"VERIFICATION_FAILED"
    = InputFailureKind -> Maybe InputFailureKind
forall a. a -> Maybe a
Prelude.Just InputFailureKind
VERIFICATION_FAILED
    | Bool
Prelude.otherwise
    = Maybe Int
-> (Int -> Maybe InputFailureKind) -> Maybe InputFailureKind
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(Prelude.>>=) (String -> Maybe Int
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
k) Int -> Maybe InputFailureKind
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded InputFailureKind where
  minBound :: InputFailureKind
minBound = InputFailureKind
REQUIRED
  maxBound :: InputFailureKind
maxBound = InputFailureKind
VERIFICATION_FAILED
instance Prelude.Enum InputFailureKind where
  toEnum :: Int -> InputFailureKind
toEnum Int
k__
    = InputFailureKind
-> (InputFailureKind -> InputFailureKind)
-> Maybe InputFailureKind
-> InputFailureKind
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> InputFailureKind
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum InputFailureKind: "
              (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        InputFailureKind -> InputFailureKind
forall a. a -> a
Prelude.id (Int -> Maybe InputFailureKind
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: InputFailureKind -> Int
fromEnum InputFailureKind
REQUIRED = Int
0
  fromEnum InputFailureKind
NOT_FOUND = Int
1
  fromEnum InputFailureKind
PARSING_FAILED = Int
2
  fromEnum InputFailureKind
VERIFICATION_FAILED = Int
3
  fromEnum
    (InputFailureKind'Unrecognized (InputFailureKind'UnrecognizedValue Int32
k))
    = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int32
k
  succ :: InputFailureKind -> InputFailureKind
succ InputFailureKind
VERIFICATION_FAILED
    = String -> InputFailureKind
forall a. HasCallStack => String -> a
Prelude.error
        String
"InputFailureKind.succ: bad argument VERIFICATION_FAILED. This value would be out of bounds."
  succ InputFailureKind
REQUIRED = InputFailureKind
NOT_FOUND
  succ InputFailureKind
NOT_FOUND = InputFailureKind
PARSING_FAILED
  succ InputFailureKind
PARSING_FAILED = InputFailureKind
VERIFICATION_FAILED
  succ (InputFailureKind'Unrecognized InputFailureKind'UnrecognizedValue
_)
    = String -> InputFailureKind
forall a. HasCallStack => String -> a
Prelude.error
        String
"InputFailureKind.succ: bad argument: unrecognized value"
  pred :: InputFailureKind -> InputFailureKind
pred InputFailureKind
REQUIRED
    = String -> InputFailureKind
forall a. HasCallStack => String -> a
Prelude.error
        String
"InputFailureKind.pred: bad argument REQUIRED. This value would be out of bounds."
  pred InputFailureKind
NOT_FOUND = InputFailureKind
REQUIRED
  pred InputFailureKind
PARSING_FAILED = InputFailureKind
NOT_FOUND
  pred InputFailureKind
VERIFICATION_FAILED = InputFailureKind
PARSING_FAILED
  pred (InputFailureKind'Unrecognized InputFailureKind'UnrecognizedValue
_)
    = String -> InputFailureKind
forall a. HasCallStack => String -> a
Prelude.error
        String
"InputFailureKind.pred: bad argument: unrecognized value"
  enumFrom :: InputFailureKind -> [InputFailureKind]
enumFrom = InputFailureKind -> [InputFailureKind]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: InputFailureKind -> InputFailureKind -> [InputFailureKind]
enumFromTo = InputFailureKind -> InputFailureKind -> [InputFailureKind]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: InputFailureKind -> InputFailureKind -> [InputFailureKind]
enumFromThen = InputFailureKind -> InputFailureKind -> [InputFailureKind]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: InputFailureKind
-> InputFailureKind -> InputFailureKind -> [InputFailureKind]
enumFromThenTo = InputFailureKind
-> InputFailureKind -> InputFailureKind -> [InputFailureKind]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault InputFailureKind where
  fieldDefault :: InputFailureKind
fieldDefault = InputFailureKind
REQUIRED
instance Control.DeepSeq.NFData InputFailureKind where
  rnf :: InputFailureKind -> ()
rnf InputFailureKind
x__ = InputFailureKind -> () -> ()
Prelude.seq InputFailureKind
x__ ()
instance Text.PrettyPrint.GenericPretty.Out InputFailureKind
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'either' @:: Lens' InternalFailure (Prelude.Maybe InternalFailure'Either)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'redacted' @:: Lens' InternalFailure (Prelude.Maybe Prelude.Bool)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.redacted' @:: Lens' InternalFailure Prelude.Bool@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'grpcServer' @:: Lens' InternalFailure (Prelude.Maybe Data.Text.Text)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.grpcServer' @:: Lens' InternalFailure Data.Text.Text@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'math' @:: Lens' InternalFailure (Prelude.Maybe Data.Text.Text)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.math' @:: Lens' InternalFailure Data.Text.Text@ -}
data InternalFailure
  = InternalFailure'_constructor {InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either :: !(Prelude.Maybe InternalFailure'Either),
                                  InternalFailure -> FieldSet
_InternalFailure'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (InternalFailure -> InternalFailure -> Bool
(InternalFailure -> InternalFailure -> Bool)
-> (InternalFailure -> InternalFailure -> Bool)
-> Eq InternalFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalFailure -> InternalFailure -> Bool
$c/= :: InternalFailure -> InternalFailure -> Bool
== :: InternalFailure -> InternalFailure -> Bool
$c== :: InternalFailure -> InternalFailure -> Bool
Prelude.Eq, Eq InternalFailure
Eq InternalFailure
-> (InternalFailure -> InternalFailure -> Ordering)
-> (InternalFailure -> InternalFailure -> Bool)
-> (InternalFailure -> InternalFailure -> Bool)
-> (InternalFailure -> InternalFailure -> Bool)
-> (InternalFailure -> InternalFailure -> Bool)
-> (InternalFailure -> InternalFailure -> InternalFailure)
-> (InternalFailure -> InternalFailure -> InternalFailure)
-> Ord InternalFailure
InternalFailure -> InternalFailure -> Bool
InternalFailure -> InternalFailure -> Ordering
InternalFailure -> InternalFailure -> InternalFailure
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InternalFailure -> InternalFailure -> InternalFailure
$cmin :: InternalFailure -> InternalFailure -> InternalFailure
max :: InternalFailure -> InternalFailure -> InternalFailure
$cmax :: InternalFailure -> InternalFailure -> InternalFailure
>= :: InternalFailure -> InternalFailure -> Bool
$c>= :: InternalFailure -> InternalFailure -> Bool
> :: InternalFailure -> InternalFailure -> Bool
$c> :: InternalFailure -> InternalFailure -> Bool
<= :: InternalFailure -> InternalFailure -> Bool
$c<= :: InternalFailure -> InternalFailure -> Bool
< :: InternalFailure -> InternalFailure -> Bool
$c< :: InternalFailure -> InternalFailure -> Bool
compare :: InternalFailure -> InternalFailure -> Ordering
$ccompare :: InternalFailure -> InternalFailure -> Ordering
Prelude.Ord, (forall x. InternalFailure -> Rep InternalFailure x)
-> (forall x. Rep InternalFailure x -> InternalFailure)
-> Generic InternalFailure
forall x. Rep InternalFailure x -> InternalFailure
forall x. InternalFailure -> Rep InternalFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InternalFailure x -> InternalFailure
$cfrom :: forall x. InternalFailure -> Rep InternalFailure x
GHC.Generics.Generic)
instance Prelude.Show InternalFailure where
  showsPrec :: Int -> InternalFailure -> ShowS
showsPrec Int
_ InternalFailure
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (InternalFailure -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort InternalFailure
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out InternalFailure
data InternalFailure'Either
  = InternalFailure'Redacted !Prelude.Bool |
    InternalFailure'GrpcServer !Data.Text.Text |
    InternalFailure'Math !Data.Text.Text
  deriving stock (Int -> InternalFailure'Either -> ShowS
[InternalFailure'Either] -> ShowS
InternalFailure'Either -> String
(Int -> InternalFailure'Either -> ShowS)
-> (InternalFailure'Either -> String)
-> ([InternalFailure'Either] -> ShowS)
-> Show InternalFailure'Either
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalFailure'Either] -> ShowS
$cshowList :: [InternalFailure'Either] -> ShowS
show :: InternalFailure'Either -> String
$cshow :: InternalFailure'Either -> String
showsPrec :: Int -> InternalFailure'Either -> ShowS
$cshowsPrec :: Int -> InternalFailure'Either -> ShowS
Prelude.Show,
                  InternalFailure'Either -> InternalFailure'Either -> Bool
(InternalFailure'Either -> InternalFailure'Either -> Bool)
-> (InternalFailure'Either -> InternalFailure'Either -> Bool)
-> Eq InternalFailure'Either
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalFailure'Either -> InternalFailure'Either -> Bool
$c/= :: InternalFailure'Either -> InternalFailure'Either -> Bool
== :: InternalFailure'Either -> InternalFailure'Either -> Bool
$c== :: InternalFailure'Either -> InternalFailure'Either -> Bool
Prelude.Eq,
                  Eq InternalFailure'Either
Eq InternalFailure'Either
-> (InternalFailure'Either -> InternalFailure'Either -> Ordering)
-> (InternalFailure'Either -> InternalFailure'Either -> Bool)
-> (InternalFailure'Either -> InternalFailure'Either -> Bool)
-> (InternalFailure'Either -> InternalFailure'Either -> Bool)
-> (InternalFailure'Either -> InternalFailure'Either -> Bool)
-> (InternalFailure'Either
    -> InternalFailure'Either -> InternalFailure'Either)
-> (InternalFailure'Either
    -> InternalFailure'Either -> InternalFailure'Either)
-> Ord InternalFailure'Either
InternalFailure'Either -> InternalFailure'Either -> Bool
InternalFailure'Either -> InternalFailure'Either -> Ordering
InternalFailure'Either
-> InternalFailure'Either -> InternalFailure'Either
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InternalFailure'Either
-> InternalFailure'Either -> InternalFailure'Either
$cmin :: InternalFailure'Either
-> InternalFailure'Either -> InternalFailure'Either
max :: InternalFailure'Either
-> InternalFailure'Either -> InternalFailure'Either
$cmax :: InternalFailure'Either
-> InternalFailure'Either -> InternalFailure'Either
>= :: InternalFailure'Either -> InternalFailure'Either -> Bool
$c>= :: InternalFailure'Either -> InternalFailure'Either -> Bool
> :: InternalFailure'Either -> InternalFailure'Either -> Bool
$c> :: InternalFailure'Either -> InternalFailure'Either -> Bool
<= :: InternalFailure'Either -> InternalFailure'Either -> Bool
$c<= :: InternalFailure'Either -> InternalFailure'Either -> Bool
< :: InternalFailure'Either -> InternalFailure'Either -> Bool
$c< :: InternalFailure'Either -> InternalFailure'Either -> Bool
compare :: InternalFailure'Either -> InternalFailure'Either -> Ordering
$ccompare :: InternalFailure'Either -> InternalFailure'Either -> Ordering
Prelude.Ord,
                  (forall x. InternalFailure'Either -> Rep InternalFailure'Either x)
-> (forall x.
    Rep InternalFailure'Either x -> InternalFailure'Either)
-> Generic InternalFailure'Either
forall x. Rep InternalFailure'Either x -> InternalFailure'Either
forall x. InternalFailure'Either -> Rep InternalFailure'Either x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InternalFailure'Either x -> InternalFailure'Either
$cfrom :: forall x. InternalFailure'Either -> Rep InternalFailure'Either x
GHC.Generics.Generic)
instance Text.PrettyPrint.GenericPretty.Out InternalFailure'Either
instance Data.ProtoLens.Field.HasField InternalFailure "maybe'either" (Prelude.Maybe InternalFailure'Either) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'either"
-> (Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> InternalFailure
-> f InternalFailure
fieldOf Proxy# "maybe'either"
_
    = ((Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
 -> InternalFailure -> f InternalFailure)
-> ((Maybe InternalFailure'Either
     -> f (Maybe InternalFailure'Either))
    -> Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> (Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> InternalFailure
-> f InternalFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InternalFailure -> Maybe InternalFailure'Either)
-> (InternalFailure
    -> Maybe InternalFailure'Either -> InternalFailure)
-> Lens
     InternalFailure
     InternalFailure
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either
           (\ InternalFailure
x__ Maybe InternalFailure'Either
y__ -> InternalFailure
x__ {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
y__}))
        (Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
-> Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField InternalFailure "maybe'redacted" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'redacted"
-> (Maybe Bool -> f (Maybe Bool))
-> InternalFailure
-> f InternalFailure
fieldOf Proxy# "maybe'redacted"
_
    = ((Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
 -> InternalFailure -> f InternalFailure)
-> ((Maybe Bool -> f (Maybe Bool))
    -> Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> (Maybe Bool -> f (Maybe Bool))
-> InternalFailure
-> f InternalFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InternalFailure -> Maybe InternalFailure'Either)
-> (InternalFailure
    -> Maybe InternalFailure'Either -> InternalFailure)
-> Lens
     InternalFailure
     InternalFailure
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either
           (\ InternalFailure
x__ Maybe InternalFailure'Either
y__ -> InternalFailure
x__ {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
y__}))
        ((Maybe InternalFailure'Either -> Maybe Bool)
-> (Maybe InternalFailure'Either
    -> Maybe Bool -> Maybe InternalFailure'Either)
-> Lens
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
     (Maybe Bool)
     (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe InternalFailure'Either
x__
              -> case Maybe InternalFailure'Either
x__ of
                   (Prelude.Just (InternalFailure'Redacted Bool
x__val))
                     -> Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude.Just Bool
x__val
                   Maybe InternalFailure'Either
_otherwise -> Maybe Bool
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe InternalFailure'Either
_ Maybe Bool
y__ -> (Bool -> InternalFailure'Either)
-> Maybe Bool -> Maybe InternalFailure'Either
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Bool -> InternalFailure'Either
InternalFailure'Redacted Maybe Bool
y__))
instance Data.ProtoLens.Field.HasField InternalFailure "redacted" Prelude.Bool where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "redacted"
-> (Bool -> f Bool) -> InternalFailure -> f InternalFailure
fieldOf Proxy# "redacted"
_
    = ((Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
 -> InternalFailure -> f InternalFailure)
-> ((Bool -> f Bool)
    -> Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> (Bool -> f Bool)
-> InternalFailure
-> f InternalFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InternalFailure -> Maybe InternalFailure'Either)
-> (InternalFailure
    -> Maybe InternalFailure'Either -> InternalFailure)
-> Lens
     InternalFailure
     InternalFailure
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either
           (\ InternalFailure
x__ Maybe InternalFailure'Either
y__ -> InternalFailure
x__ {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
y__}))
        (((Maybe Bool -> f (Maybe Bool))
 -> Maybe InternalFailure'Either
 -> f (Maybe InternalFailure'Either))
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> Maybe InternalFailure'Either
-> f (Maybe InternalFailure'Either)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe InternalFailure'Either -> Maybe Bool)
-> (Maybe InternalFailure'Either
    -> Maybe Bool -> Maybe InternalFailure'Either)
-> Lens
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
     (Maybe Bool)
     (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe InternalFailure'Either
x__
                 -> case Maybe InternalFailure'Either
x__ of
                      (Prelude.Just (InternalFailure'Redacted Bool
x__val))
                        -> Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude.Just Bool
x__val
                      Maybe InternalFailure'Either
_otherwise -> Maybe Bool
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe InternalFailure'Either
_ Maybe Bool
y__ -> (Bool -> InternalFailure'Either)
-> Maybe Bool -> Maybe InternalFailure'Either
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Bool -> InternalFailure'Either
InternalFailure'Redacted Maybe Bool
y__))
           (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Field.HasField InternalFailure "maybe'grpcServer" (Prelude.Maybe Data.Text.Text) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'grpcServer"
-> (Maybe Text -> f (Maybe Text))
-> InternalFailure
-> f InternalFailure
fieldOf Proxy# "maybe'grpcServer"
_
    = ((Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
 -> InternalFailure -> f InternalFailure)
-> ((Maybe Text -> f (Maybe Text))
    -> Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> (Maybe Text -> f (Maybe Text))
-> InternalFailure
-> f InternalFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InternalFailure -> Maybe InternalFailure'Either)
-> (InternalFailure
    -> Maybe InternalFailure'Either -> InternalFailure)
-> Lens
     InternalFailure
     InternalFailure
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either
           (\ InternalFailure
x__ Maybe InternalFailure'Either
y__ -> InternalFailure
x__ {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
y__}))
        ((Maybe InternalFailure'Either -> Maybe Text)
-> (Maybe InternalFailure'Either
    -> Maybe Text -> Maybe InternalFailure'Either)
-> Lens
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
     (Maybe Text)
     (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe InternalFailure'Either
x__
              -> case Maybe InternalFailure'Either
x__ of
                   (Prelude.Just (InternalFailure'GrpcServer Text
x__val))
                     -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
x__val
                   Maybe InternalFailure'Either
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe InternalFailure'Either
_ Maybe Text
y__ -> (Text -> InternalFailure'Either)
-> Maybe Text -> Maybe InternalFailure'Either
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Text -> InternalFailure'Either
InternalFailure'GrpcServer Maybe Text
y__))
instance Data.ProtoLens.Field.HasField InternalFailure "grpcServer" Data.Text.Text where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "grpcServer"
-> (Text -> f Text) -> InternalFailure -> f InternalFailure
fieldOf Proxy# "grpcServer"
_
    = ((Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
 -> InternalFailure -> f InternalFailure)
-> ((Text -> f Text)
    -> Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> (Text -> f Text)
-> InternalFailure
-> f InternalFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InternalFailure -> Maybe InternalFailure'Either)
-> (InternalFailure
    -> Maybe InternalFailure'Either -> InternalFailure)
-> Lens
     InternalFailure
     InternalFailure
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either
           (\ InternalFailure
x__ Maybe InternalFailure'Either
y__ -> InternalFailure
x__ {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
y__}))
        (((Maybe Text -> f (Maybe Text))
 -> Maybe InternalFailure'Either
 -> f (Maybe InternalFailure'Either))
-> ((Text -> f Text) -> Maybe Text -> f (Maybe Text))
-> (Text -> f Text)
-> Maybe InternalFailure'Either
-> f (Maybe InternalFailure'Either)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe InternalFailure'Either -> Maybe Text)
-> (Maybe InternalFailure'Either
    -> Maybe Text -> Maybe InternalFailure'Either)
-> Lens
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
     (Maybe Text)
     (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe InternalFailure'Either
x__
                 -> case Maybe InternalFailure'Either
x__ of
                      (Prelude.Just (InternalFailure'GrpcServer Text
x__val))
                        -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
x__val
                      Maybe InternalFailure'Either
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe InternalFailure'Either
_ Maybe Text
y__ -> (Text -> InternalFailure'Either)
-> Maybe Text -> Maybe InternalFailure'Either
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Text -> InternalFailure'Either
InternalFailure'GrpcServer Maybe Text
y__))
           (Text -> Lens' (Maybe Text) Text
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Field.HasField InternalFailure "maybe'math" (Prelude.Maybe Data.Text.Text) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'math"
-> (Maybe Text -> f (Maybe Text))
-> InternalFailure
-> f InternalFailure
fieldOf Proxy# "maybe'math"
_
    = ((Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
 -> InternalFailure -> f InternalFailure)
-> ((Maybe Text -> f (Maybe Text))
    -> Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> (Maybe Text -> f (Maybe Text))
-> InternalFailure
-> f InternalFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InternalFailure -> Maybe InternalFailure'Either)
-> (InternalFailure
    -> Maybe InternalFailure'Either -> InternalFailure)
-> Lens
     InternalFailure
     InternalFailure
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either
           (\ InternalFailure
x__ Maybe InternalFailure'Either
y__ -> InternalFailure
x__ {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
y__}))
        ((Maybe InternalFailure'Either -> Maybe Text)
-> (Maybe InternalFailure'Either
    -> Maybe Text -> Maybe InternalFailure'Either)
-> Lens
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
     (Maybe Text)
     (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe InternalFailure'Either
x__
              -> case Maybe InternalFailure'Either
x__ of
                   (Prelude.Just (InternalFailure'Math Text
x__val)) -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
x__val
                   Maybe InternalFailure'Either
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe InternalFailure'Either
_ Maybe Text
y__ -> (Text -> InternalFailure'Either)
-> Maybe Text -> Maybe InternalFailure'Either
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Text -> InternalFailure'Either
InternalFailure'Math Maybe Text
y__))
instance Data.ProtoLens.Field.HasField InternalFailure "math" Data.Text.Text where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "math"
-> (Text -> f Text) -> InternalFailure -> f InternalFailure
fieldOf Proxy# "math"
_
    = ((Maybe InternalFailure'Either -> f (Maybe InternalFailure'Either))
 -> InternalFailure -> f InternalFailure)
-> ((Text -> f Text)
    -> Maybe InternalFailure'Either
    -> f (Maybe InternalFailure'Either))
-> (Text -> f Text)
-> InternalFailure
-> f InternalFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InternalFailure -> Maybe InternalFailure'Either)
-> (InternalFailure
    -> Maybe InternalFailure'Either -> InternalFailure)
-> Lens
     InternalFailure
     InternalFailure
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either
           (\ InternalFailure
x__ Maybe InternalFailure'Either
y__ -> InternalFailure
x__ {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
y__}))
        (((Maybe Text -> f (Maybe Text))
 -> Maybe InternalFailure'Either
 -> f (Maybe InternalFailure'Either))
-> ((Text -> f Text) -> Maybe Text -> f (Maybe Text))
-> (Text -> f Text)
-> Maybe InternalFailure'Either
-> f (Maybe InternalFailure'Either)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe InternalFailure'Either -> Maybe Text)
-> (Maybe InternalFailure'Either
    -> Maybe Text -> Maybe InternalFailure'Either)
-> Lens
     (Maybe InternalFailure'Either)
     (Maybe InternalFailure'Either)
     (Maybe Text)
     (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe InternalFailure'Either
x__
                 -> case Maybe InternalFailure'Either
x__ of
                      (Prelude.Just (InternalFailure'Math Text
x__val)) -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
x__val
                      Maybe InternalFailure'Either
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe InternalFailure'Either
_ Maybe Text
y__ -> (Text -> InternalFailure'Either)
-> Maybe Text -> Maybe InternalFailure'Either
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Text -> InternalFailure'Either
InternalFailure'Math Maybe Text
y__))
           (Text -> Lens' (Maybe Text) Text
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Message InternalFailure where
  messageName :: Proxy InternalFailure -> Text
messageName Proxy InternalFailure
_
    = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.InternalFailure"
  packedMessageDescriptor :: Proxy InternalFailure -> ByteString
packedMessageDescriptor Proxy InternalFailure
_
    = ByteString
"\n\
      \\SIInternalFailure\DC2\FS\n\
      \\bredacted\CAN\SOH \SOH(\bH\NULR\bredacted\DC2!\n\
      \\vgrpc_server\CAN\STX \SOH(\tH\NULR\n\
      \grpcServer\DC2\DC4\n\
      \\EOTmath\CAN\ETX \SOH(\tH\NULR\EOTmathB\b\n\
      \\ACKeither"
  packedFileDescriptor :: Proxy InternalFailure -> ByteString
packedFileDescriptor Proxy InternalFailure
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor InternalFailure)
fieldsByTag
    = let
        redacted__field_descriptor :: FieldDescriptor InternalFailure
redacted__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor InternalFailure Bool
-> FieldDescriptor InternalFailure
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"redacted"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens' InternalFailure (Maybe Bool)
-> FieldAccessor InternalFailure Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'redacted")) ::
              Data.ProtoLens.FieldDescriptor InternalFailure
        grpcServer__field_descriptor :: FieldDescriptor InternalFailure
grpcServer__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor InternalFailure Text
-> FieldDescriptor InternalFailure
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"grpc_server"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (Lens' InternalFailure (Maybe Text)
-> FieldAccessor InternalFailure Text
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'grpcServer")) ::
              Data.ProtoLens.FieldDescriptor InternalFailure
        math__field_descriptor :: FieldDescriptor InternalFailure
math__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor InternalFailure Text
-> FieldDescriptor InternalFailure
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"math"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (Lens' InternalFailure (Maybe Text)
-> FieldAccessor InternalFailure Text
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'math")) ::
              Data.ProtoLens.FieldDescriptor InternalFailure
      in
        [(Tag, FieldDescriptor InternalFailure)]
-> Map Tag (FieldDescriptor InternalFailure)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor InternalFailure
redacted__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor InternalFailure
grpcServer__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor InternalFailure
math__field_descriptor)]
  unknownFields :: Lens' InternalFailure FieldSet
unknownFields
    = (InternalFailure -> FieldSet)
-> (InternalFailure -> FieldSet -> InternalFailure)
-> Lens' InternalFailure FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        InternalFailure -> FieldSet
_InternalFailure'_unknownFields
        (\ InternalFailure
x__ FieldSet
y__ -> InternalFailure
x__ {_InternalFailure'_unknownFields :: FieldSet
_InternalFailure'_unknownFields = FieldSet
y__})
  defMessage :: InternalFailure
defMessage
    = InternalFailure'_constructor :: Maybe InternalFailure'Either -> FieldSet -> InternalFailure
InternalFailure'_constructor
        {_InternalFailure'either :: Maybe InternalFailure'Either
_InternalFailure'either = Maybe InternalFailure'Either
forall a. Maybe a
Prelude.Nothing,
         _InternalFailure'_unknownFields :: FieldSet
_InternalFailure'_unknownFields = []}
  parseMessage :: Parser InternalFailure
parseMessage
    = let
        loop ::
          InternalFailure
          -> Data.ProtoLens.Encoding.Bytes.Parser InternalFailure
        loop :: InternalFailure -> Parser InternalFailure
loop InternalFailure
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      InternalFailure -> Parser InternalFailure
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter InternalFailure InternalFailure FieldSet FieldSet
-> (FieldSet -> FieldSet) -> InternalFailure -> InternalFailure
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter InternalFailure InternalFailure FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) InternalFailure
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Bool
y <- Parser Bool -> String -> Parser Bool
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Bool) -> Parser Word64 -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude./=) Word64
0) Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt)
                                       String
"redacted"
                                InternalFailure -> Parser InternalFailure
loop
                                  (Setter InternalFailure InternalFailure Bool Bool
-> Bool -> InternalFailure -> InternalFailure
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"redacted") Bool
y InternalFailure
x)
                        Word64
18
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"grpc_server"
                                InternalFailure -> Parser InternalFailure
loop
                                  (Setter InternalFailure InternalFailure Text Text
-> Text -> InternalFailure -> InternalFailure
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"grpcServer") Text
y InternalFailure
x)
                        Word64
26
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"math"
                                InternalFailure -> Parser InternalFailure
loop (Setter InternalFailure InternalFailure Text Text
-> Text -> InternalFailure -> InternalFailure
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"math") Text
y InternalFailure
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                InternalFailure -> Parser InternalFailure
loop
                                  (Setter InternalFailure InternalFailure FieldSet FieldSet
-> (FieldSet -> FieldSet) -> InternalFailure -> InternalFailure
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter InternalFailure InternalFailure FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) InternalFailure
x)
      in
        Parser InternalFailure -> String -> Parser InternalFailure
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do InternalFailure -> Parser InternalFailure
loop InternalFailure
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"InternalFailure"
  buildMessage :: InternalFailure -> Builder
buildMessage
    = \ InternalFailure
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe InternalFailure'Either)
  InternalFailure
  InternalFailure
  (Maybe InternalFailure'Either)
  (Maybe InternalFailure'Either)
-> InternalFailure -> Maybe InternalFailure'Either
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'either") InternalFailure
_x
              of
                Maybe InternalFailure'Either
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just (InternalFailure'Redacted Bool
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                       ((Word64 -> Builder) -> (Bool -> Word64) -> Bool -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt (\ Bool
b -> if Bool
b then Word64
1 else Word64
0)
                          Bool
v)
                (Prelude.Just (InternalFailure'GrpcServer Text
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                       ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
v)
                (Prelude.Just (InternalFailure'Math Text
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                       ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet InternalFailure InternalFailure FieldSet FieldSet
-> InternalFailure -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet InternalFailure InternalFailure FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields InternalFailure
_x))
instance Control.DeepSeq.NFData InternalFailure where
  rnf :: InternalFailure -> ()
rnf
    = \ InternalFailure
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (InternalFailure -> FieldSet
_InternalFailure'_unknownFields InternalFailure
x__)
             (Maybe InternalFailure'Either -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (InternalFailure -> Maybe InternalFailure'Either
_InternalFailure'either InternalFailure
x__) ())
instance Control.DeepSeq.NFData InternalFailure'Either where
  rnf :: InternalFailure'Either -> ()
rnf (InternalFailure'Redacted Bool
x__) = Bool -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf Bool
x__
  rnf (InternalFailure'GrpcServer Text
x__) = Text -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf Text
x__
  rnf (InternalFailure'Math Text
x__) = Text -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf Text
x__
_InternalFailure'Redacted ::
  Data.ProtoLens.Prism.Prism' InternalFailure'Either Prelude.Bool
_InternalFailure'Redacted :: Prism' InternalFailure'Either Bool
_InternalFailure'Redacted
  = (Bool -> InternalFailure'Either)
-> (InternalFailure'Either -> Maybe Bool)
-> Prism' InternalFailure'Either Bool
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      Bool -> InternalFailure'Either
InternalFailure'Redacted
      (\ InternalFailure'Either
p__
         -> case InternalFailure'Either
p__ of
              (InternalFailure'Redacted Bool
p__val) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude.Just Bool
p__val
              InternalFailure'Either
_otherwise -> Maybe Bool
forall a. Maybe a
Prelude.Nothing)
_InternalFailure'GrpcServer ::
  Data.ProtoLens.Prism.Prism' InternalFailure'Either Data.Text.Text
_InternalFailure'GrpcServer :: Prism' InternalFailure'Either Text
_InternalFailure'GrpcServer
  = (Text -> InternalFailure'Either)
-> (InternalFailure'Either -> Maybe Text)
-> Prism' InternalFailure'Either Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      Text -> InternalFailure'Either
InternalFailure'GrpcServer
      (\ InternalFailure'Either
p__
         -> case InternalFailure'Either
p__ of
              (InternalFailure'GrpcServer Text
p__val) -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
p__val
              InternalFailure'Either
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
_InternalFailure'Math ::
  Data.ProtoLens.Prism.Prism' InternalFailure'Either Data.Text.Text
_InternalFailure'Math :: Prism' InternalFailure'Either Text
_InternalFailure'Math
  = (Text -> InternalFailure'Either)
-> (InternalFailure'Either -> Maybe Text)
-> Prism' InternalFailure'Either Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      Text -> InternalFailure'Either
InternalFailure'Math
      (\ InternalFailure'Either
p__
         -> case InternalFailure'Either
p__ of
              (InternalFailure'Math Text
p__val) -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
p__val
              InternalFailure'Either
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' LnHost Data.Text.Text@ -}
data LnHost
  = LnHost'_constructor {LnHost -> Text
_LnHost'val :: !Data.Text.Text,
                         LnHost -> FieldSet
_LnHost'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (LnHost -> LnHost -> Bool
(LnHost -> LnHost -> Bool)
-> (LnHost -> LnHost -> Bool) -> Eq LnHost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LnHost -> LnHost -> Bool
$c/= :: LnHost -> LnHost -> Bool
== :: LnHost -> LnHost -> Bool
$c== :: LnHost -> LnHost -> Bool
Prelude.Eq, Eq LnHost
Eq LnHost
-> (LnHost -> LnHost -> Ordering)
-> (LnHost -> LnHost -> Bool)
-> (LnHost -> LnHost -> Bool)
-> (LnHost -> LnHost -> Bool)
-> (LnHost -> LnHost -> Bool)
-> (LnHost -> LnHost -> LnHost)
-> (LnHost -> LnHost -> LnHost)
-> Ord LnHost
LnHost -> LnHost -> Bool
LnHost -> LnHost -> Ordering
LnHost -> LnHost -> LnHost
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LnHost -> LnHost -> LnHost
$cmin :: LnHost -> LnHost -> LnHost
max :: LnHost -> LnHost -> LnHost
$cmax :: LnHost -> LnHost -> LnHost
>= :: LnHost -> LnHost -> Bool
$c>= :: LnHost -> LnHost -> Bool
> :: LnHost -> LnHost -> Bool
$c> :: LnHost -> LnHost -> Bool
<= :: LnHost -> LnHost -> Bool
$c<= :: LnHost -> LnHost -> Bool
< :: LnHost -> LnHost -> Bool
$c< :: LnHost -> LnHost -> Bool
compare :: LnHost -> LnHost -> Ordering
$ccompare :: LnHost -> LnHost -> Ordering
Prelude.Ord, (forall x. LnHost -> Rep LnHost x)
-> (forall x. Rep LnHost x -> LnHost) -> Generic LnHost
forall x. Rep LnHost x -> LnHost
forall x. LnHost -> Rep LnHost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LnHost x -> LnHost
$cfrom :: forall x. LnHost -> Rep LnHost x
GHC.Generics.Generic)
instance Prelude.Show LnHost where
  showsPrec :: Int -> LnHost -> ShowS
showsPrec Int
_ LnHost
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (LnHost -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort LnHost
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out LnHost
instance Data.ProtoLens.Field.HasField LnHost "val" Data.Text.Text where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Text -> f Text) -> LnHost -> f LnHost
fieldOf Proxy# "val"
_
    = ((Text -> f Text) -> LnHost -> f LnHost)
-> ((Text -> f Text) -> Text -> f Text)
-> (Text -> f Text)
-> LnHost
-> f LnHost
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnHost -> Text)
-> (LnHost -> Text -> LnHost) -> Lens LnHost LnHost Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnHost -> Text
_LnHost'val (\ LnHost
x__ Text
y__ -> LnHost
x__ {_LnHost'val :: Text
_LnHost'val = Text
y__}))
        (Text -> f Text) -> Text -> f Text
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message LnHost where
  messageName :: Proxy LnHost -> Text
messageName Proxy LnHost
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.LnHost"
  packedMessageDescriptor :: Proxy LnHost -> ByteString
packedMessageDescriptor Proxy LnHost
_
    = ByteString
"\n\
      \\ACKLnHost\DC2\DLE\n\
      \\ETXval\CAN\SOH \SOH(\tR\ETXval"
  packedFileDescriptor :: Proxy LnHost -> ByteString
packedFileDescriptor Proxy LnHost
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor LnHost)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor LnHost
val__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor LnHost Text
-> FieldDescriptor LnHost
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (WireDefault Text
-> Lens LnHost LnHost Text Text -> FieldAccessor LnHost Text
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Text
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val")) ::
              Data.ProtoLens.FieldDescriptor LnHost
      in
        [(Tag, FieldDescriptor LnHost)] -> Map Tag (FieldDescriptor LnHost)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor LnHost
val__field_descriptor)]
  unknownFields :: Lens' LnHost FieldSet
unknownFields
    = (LnHost -> FieldSet)
-> (LnHost -> FieldSet -> LnHost) -> Lens' LnHost FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        LnHost -> FieldSet
_LnHost'_unknownFields
        (\ LnHost
x__ FieldSet
y__ -> LnHost
x__ {_LnHost'_unknownFields :: FieldSet
_LnHost'_unknownFields = FieldSet
y__})
  defMessage :: LnHost
defMessage
    = LnHost'_constructor :: Text -> FieldSet -> LnHost
LnHost'_constructor
        {_LnHost'val :: Text
_LnHost'val = Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _LnHost'_unknownFields :: FieldSet
_LnHost'_unknownFields = []}
  parseMessage :: Parser LnHost
parseMessage
    = let
        loop :: LnHost -> Data.ProtoLens.Encoding.Bytes.Parser LnHost
        loop :: LnHost -> Parser LnHost
loop LnHost
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      LnHost -> Parser LnHost
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter LnHost LnHost FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnHost -> LnHost
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter LnHost LnHost FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) LnHost
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"val"
                                LnHost -> Parser LnHost
loop (Setter LnHost LnHost Text Text -> Text -> LnHost -> LnHost
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Text
y LnHost
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                LnHost -> Parser LnHost
loop
                                  (Setter LnHost LnHost FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnHost -> LnHost
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter LnHost LnHost FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) LnHost
x)
      in
        Parser LnHost -> String -> Parser LnHost
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do LnHost -> Parser LnHost
loop LnHost
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"LnHost"
  buildMessage :: LnHost -> Builder
buildMessage
    = \ LnHost
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: Text
_v = FoldLike Text LnHost LnHost Text Text -> LnHost -> Text
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") LnHost
_x
              in
                if Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Text
_v Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                      ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         (\ ByteString
bs
                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                    (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                 (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                         Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet LnHost LnHost FieldSet FieldSet
-> LnHost -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet LnHost LnHost FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields LnHost
_x))
instance Control.DeepSeq.NFData LnHost where
  rnf :: LnHost -> ()
rnf
    = \ LnHost
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (LnHost -> FieldSet
_LnHost'_unknownFields LnHost
x__)
             (Text -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (LnHost -> Text
_LnHost'val LnHost
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.pubKey' @:: Lens' LnPeer LnPubKey@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'pubKey' @:: Lens' LnPeer (Prelude.Maybe LnPubKey)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.host' @:: Lens' LnPeer LnHost@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'host' @:: Lens' LnPeer (Prelude.Maybe LnHost)@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.port' @:: Lens' LnPeer LnPort@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'port' @:: Lens' LnPeer (Prelude.Maybe LnPort)@ -}
data LnPeer
  = LnPeer'_constructor {LnPeer -> Maybe LnPubKey
_LnPeer'pubKey :: !(Prelude.Maybe LnPubKey),
                         LnPeer -> Maybe LnHost
_LnPeer'host :: !(Prelude.Maybe LnHost),
                         LnPeer -> Maybe LnPort
_LnPeer'port :: !(Prelude.Maybe LnPort),
                         LnPeer -> FieldSet
_LnPeer'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (LnPeer -> LnPeer -> Bool
(LnPeer -> LnPeer -> Bool)
-> (LnPeer -> LnPeer -> Bool) -> Eq LnPeer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LnPeer -> LnPeer -> Bool
$c/= :: LnPeer -> LnPeer -> Bool
== :: LnPeer -> LnPeer -> Bool
$c== :: LnPeer -> LnPeer -> Bool
Prelude.Eq, Eq LnPeer
Eq LnPeer
-> (LnPeer -> LnPeer -> Ordering)
-> (LnPeer -> LnPeer -> Bool)
-> (LnPeer -> LnPeer -> Bool)
-> (LnPeer -> LnPeer -> Bool)
-> (LnPeer -> LnPeer -> Bool)
-> (LnPeer -> LnPeer -> LnPeer)
-> (LnPeer -> LnPeer -> LnPeer)
-> Ord LnPeer
LnPeer -> LnPeer -> Bool
LnPeer -> LnPeer -> Ordering
LnPeer -> LnPeer -> LnPeer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LnPeer -> LnPeer -> LnPeer
$cmin :: LnPeer -> LnPeer -> LnPeer
max :: LnPeer -> LnPeer -> LnPeer
$cmax :: LnPeer -> LnPeer -> LnPeer
>= :: LnPeer -> LnPeer -> Bool
$c>= :: LnPeer -> LnPeer -> Bool
> :: LnPeer -> LnPeer -> Bool
$c> :: LnPeer -> LnPeer -> Bool
<= :: LnPeer -> LnPeer -> Bool
$c<= :: LnPeer -> LnPeer -> Bool
< :: LnPeer -> LnPeer -> Bool
$c< :: LnPeer -> LnPeer -> Bool
compare :: LnPeer -> LnPeer -> Ordering
$ccompare :: LnPeer -> LnPeer -> Ordering
Prelude.Ord, (forall x. LnPeer -> Rep LnPeer x)
-> (forall x. Rep LnPeer x -> LnPeer) -> Generic LnPeer
forall x. Rep LnPeer x -> LnPeer
forall x. LnPeer -> Rep LnPeer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LnPeer x -> LnPeer
$cfrom :: forall x. LnPeer -> Rep LnPeer x
GHC.Generics.Generic)
instance Prelude.Show LnPeer where
  showsPrec :: Int -> LnPeer -> ShowS
showsPrec Int
_ LnPeer
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (LnPeer -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort LnPeer
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out LnPeer
instance Data.ProtoLens.Field.HasField LnPeer "pubKey" LnPubKey where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "pubKey" -> (LnPubKey -> f LnPubKey) -> LnPeer -> f LnPeer
fieldOf Proxy# "pubKey"
_
    = ((Maybe LnPubKey -> f (Maybe LnPubKey)) -> LnPeer -> f LnPeer)
-> ((LnPubKey -> f LnPubKey)
    -> Maybe LnPubKey -> f (Maybe LnPubKey))
-> (LnPubKey -> f LnPubKey)
-> LnPeer
-> f LnPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPeer -> Maybe LnPubKey)
-> (LnPeer -> Maybe LnPubKey -> LnPeer)
-> Lens LnPeer LnPeer (Maybe LnPubKey) (Maybe LnPubKey)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPeer -> Maybe LnPubKey
_LnPeer'pubKey (\ LnPeer
x__ Maybe LnPubKey
y__ -> LnPeer
x__ {_LnPeer'pubKey :: Maybe LnPubKey
_LnPeer'pubKey = Maybe LnPubKey
y__}))
        (LnPubKey -> Lens' (Maybe LnPubKey) LnPubKey
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens LnPubKey
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField LnPeer "maybe'pubKey" (Prelude.Maybe LnPubKey) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'pubKey"
-> (Maybe LnPubKey -> f (Maybe LnPubKey)) -> LnPeer -> f LnPeer
fieldOf Proxy# "maybe'pubKey"
_
    = ((Maybe LnPubKey -> f (Maybe LnPubKey)) -> LnPeer -> f LnPeer)
-> ((Maybe LnPubKey -> f (Maybe LnPubKey))
    -> Maybe LnPubKey -> f (Maybe LnPubKey))
-> (Maybe LnPubKey -> f (Maybe LnPubKey))
-> LnPeer
-> f LnPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPeer -> Maybe LnPubKey)
-> (LnPeer -> Maybe LnPubKey -> LnPeer)
-> Lens LnPeer LnPeer (Maybe LnPubKey) (Maybe LnPubKey)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPeer -> Maybe LnPubKey
_LnPeer'pubKey (\ LnPeer
x__ Maybe LnPubKey
y__ -> LnPeer
x__ {_LnPeer'pubKey :: Maybe LnPubKey
_LnPeer'pubKey = Maybe LnPubKey
y__}))
        (Maybe LnPubKey -> f (Maybe LnPubKey))
-> Maybe LnPubKey -> f (Maybe LnPubKey)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField LnPeer "host" LnHost where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "host" -> (LnHost -> f LnHost) -> LnPeer -> f LnPeer
fieldOf Proxy# "host"
_
    = ((Maybe LnHost -> f (Maybe LnHost)) -> LnPeer -> f LnPeer)
-> ((LnHost -> f LnHost) -> Maybe LnHost -> f (Maybe LnHost))
-> (LnHost -> f LnHost)
-> LnPeer
-> f LnPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPeer -> Maybe LnHost)
-> (LnPeer -> Maybe LnHost -> LnPeer)
-> Lens LnPeer LnPeer (Maybe LnHost) (Maybe LnHost)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPeer -> Maybe LnHost
_LnPeer'host (\ LnPeer
x__ Maybe LnHost
y__ -> LnPeer
x__ {_LnPeer'host :: Maybe LnHost
_LnPeer'host = Maybe LnHost
y__}))
        (LnHost -> Lens' (Maybe LnHost) LnHost
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens LnHost
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField LnPeer "maybe'host" (Prelude.Maybe LnHost) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'host"
-> (Maybe LnHost -> f (Maybe LnHost)) -> LnPeer -> f LnPeer
fieldOf Proxy# "maybe'host"
_
    = ((Maybe LnHost -> f (Maybe LnHost)) -> LnPeer -> f LnPeer)
-> ((Maybe LnHost -> f (Maybe LnHost))
    -> Maybe LnHost -> f (Maybe LnHost))
-> (Maybe LnHost -> f (Maybe LnHost))
-> LnPeer
-> f LnPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPeer -> Maybe LnHost)
-> (LnPeer -> Maybe LnHost -> LnPeer)
-> Lens LnPeer LnPeer (Maybe LnHost) (Maybe LnHost)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPeer -> Maybe LnHost
_LnPeer'host (\ LnPeer
x__ Maybe LnHost
y__ -> LnPeer
x__ {_LnPeer'host :: Maybe LnHost
_LnPeer'host = Maybe LnHost
y__}))
        (Maybe LnHost -> f (Maybe LnHost))
-> Maybe LnHost -> f (Maybe LnHost)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField LnPeer "port" LnPort where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "port" -> (LnPort -> f LnPort) -> LnPeer -> f LnPeer
fieldOf Proxy# "port"
_
    = ((Maybe LnPort -> f (Maybe LnPort)) -> LnPeer -> f LnPeer)
-> ((LnPort -> f LnPort) -> Maybe LnPort -> f (Maybe LnPort))
-> (LnPort -> f LnPort)
-> LnPeer
-> f LnPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPeer -> Maybe LnPort)
-> (LnPeer -> Maybe LnPort -> LnPeer)
-> Lens LnPeer LnPeer (Maybe LnPort) (Maybe LnPort)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPeer -> Maybe LnPort
_LnPeer'port (\ LnPeer
x__ Maybe LnPort
y__ -> LnPeer
x__ {_LnPeer'port :: Maybe LnPort
_LnPeer'port = Maybe LnPort
y__}))
        (LnPort -> Lens' (Maybe LnPort) LnPort
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens LnPort
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField LnPeer "maybe'port" (Prelude.Maybe LnPort) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'port"
-> (Maybe LnPort -> f (Maybe LnPort)) -> LnPeer -> f LnPeer
fieldOf Proxy# "maybe'port"
_
    = ((Maybe LnPort -> f (Maybe LnPort)) -> LnPeer -> f LnPeer)
-> ((Maybe LnPort -> f (Maybe LnPort))
    -> Maybe LnPort -> f (Maybe LnPort))
-> (Maybe LnPort -> f (Maybe LnPort))
-> LnPeer
-> f LnPeer
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPeer -> Maybe LnPort)
-> (LnPeer -> Maybe LnPort -> LnPeer)
-> Lens LnPeer LnPeer (Maybe LnPort) (Maybe LnPort)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPeer -> Maybe LnPort
_LnPeer'port (\ LnPeer
x__ Maybe LnPort
y__ -> LnPeer
x__ {_LnPeer'port :: Maybe LnPort
_LnPeer'port = Maybe LnPort
y__}))
        (Maybe LnPort -> f (Maybe LnPort))
-> Maybe LnPort -> f (Maybe LnPort)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message LnPeer where
  messageName :: Proxy LnPeer -> Text
messageName Proxy LnPeer
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.LnPeer"
  packedMessageDescriptor :: Proxy LnPeer -> ByteString
packedMessageDescriptor Proxy LnPeer
_
    = ByteString
"\n\
      \\ACKLnPeer\DC28\n\
      \\apub_key\CAN\SOH \SOH(\v2\US.BtcLsp.Data.HighLevel.LnPubKeyR\ACKpubKey\DC21\n\
      \\EOThost\CAN\STX \SOH(\v2\GS.BtcLsp.Data.HighLevel.LnHostR\EOThost\DC21\n\
      \\EOTport\CAN\ETX \SOH(\v2\GS.BtcLsp.Data.HighLevel.LnPortR\EOTport"
  packedFileDescriptor :: Proxy LnPeer -> ByteString
packedFileDescriptor Proxy LnPeer
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor LnPeer)
fieldsByTag
    = let
        pubKey__field_descriptor :: FieldDescriptor LnPeer
pubKey__field_descriptor
          = String
-> FieldTypeDescriptor LnPubKey
-> FieldAccessor LnPeer LnPubKey
-> FieldDescriptor LnPeer
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pub_key"
              (MessageOrGroup -> FieldTypeDescriptor LnPubKey
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor LnPubKey)
              (Lens LnPeer LnPeer (Maybe LnPubKey) (Maybe LnPubKey)
-> FieldAccessor LnPeer LnPubKey
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pubKey")) ::
              Data.ProtoLens.FieldDescriptor LnPeer
        host__field_descriptor :: FieldDescriptor LnPeer
host__field_descriptor
          = String
-> FieldTypeDescriptor LnHost
-> FieldAccessor LnPeer LnHost
-> FieldDescriptor LnPeer
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"host"
              (MessageOrGroup -> FieldTypeDescriptor LnHost
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor LnHost)
              (Lens LnPeer LnPeer (Maybe LnHost) (Maybe LnHost)
-> FieldAccessor LnPeer LnHost
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'host")) ::
              Data.ProtoLens.FieldDescriptor LnPeer
        port__field_descriptor :: FieldDescriptor LnPeer
port__field_descriptor
          = String
-> FieldTypeDescriptor LnPort
-> FieldAccessor LnPeer LnPort
-> FieldDescriptor LnPeer
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"port"
              (MessageOrGroup -> FieldTypeDescriptor LnPort
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor LnPort)
              (Lens LnPeer LnPeer (Maybe LnPort) (Maybe LnPort)
-> FieldAccessor LnPeer LnPort
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'port")) ::
              Data.ProtoLens.FieldDescriptor LnPeer
      in
        [(Tag, FieldDescriptor LnPeer)] -> Map Tag (FieldDescriptor LnPeer)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor LnPeer
pubKey__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor LnPeer
host__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor LnPeer
port__field_descriptor)]
  unknownFields :: Lens' LnPeer FieldSet
unknownFields
    = (LnPeer -> FieldSet)
-> (LnPeer -> FieldSet -> LnPeer) -> Lens' LnPeer FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        LnPeer -> FieldSet
_LnPeer'_unknownFields
        (\ LnPeer
x__ FieldSet
y__ -> LnPeer
x__ {_LnPeer'_unknownFields :: FieldSet
_LnPeer'_unknownFields = FieldSet
y__})
  defMessage :: LnPeer
defMessage
    = LnPeer'_constructor :: Maybe LnPubKey
-> Maybe LnHost -> Maybe LnPort -> FieldSet -> LnPeer
LnPeer'_constructor
        {_LnPeer'pubKey :: Maybe LnPubKey
_LnPeer'pubKey = Maybe LnPubKey
forall a. Maybe a
Prelude.Nothing, _LnPeer'host :: Maybe LnHost
_LnPeer'host = Maybe LnHost
forall a. Maybe a
Prelude.Nothing,
         _LnPeer'port :: Maybe LnPort
_LnPeer'port = Maybe LnPort
forall a. Maybe a
Prelude.Nothing, _LnPeer'_unknownFields :: FieldSet
_LnPeer'_unknownFields = []}
  parseMessage :: Parser LnPeer
parseMessage
    = let
        loop :: LnPeer -> Data.ProtoLens.Encoding.Bytes.Parser LnPeer
        loop :: LnPeer -> Parser LnPeer
loop LnPeer
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      LnPeer -> Parser LnPeer
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter LnPeer LnPeer FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnPeer -> LnPeer
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter LnPeer LnPeer FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) LnPeer
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do LnPubKey
y <- Parser LnPubKey -> String -> Parser LnPubKey
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser LnPubKey -> Parser LnPubKey
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser LnPubKey
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"pub_key"
                                LnPeer -> Parser LnPeer
loop (Setter LnPeer LnPeer LnPubKey LnPubKey
-> LnPubKey -> LnPeer -> LnPeer
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pubKey") LnPubKey
y LnPeer
x)
                        Word64
18
                          -> do LnHost
y <- Parser LnHost -> String -> Parser LnHost
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser LnHost -> Parser LnHost
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser LnHost
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"host"
                                LnPeer -> Parser LnPeer
loop (Setter LnPeer LnPeer LnHost LnHost -> LnHost -> LnPeer -> LnPeer
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"host") LnHost
y LnPeer
x)
                        Word64
26
                          -> do LnPort
y <- Parser LnPort -> String -> Parser LnPort
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser LnPort -> Parser LnPort
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser LnPort
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"port"
                                LnPeer -> Parser LnPeer
loop (Setter LnPeer LnPeer LnPort LnPort -> LnPort -> LnPeer -> LnPeer
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"port") LnPort
y LnPeer
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                LnPeer -> Parser LnPeer
loop
                                  (Setter LnPeer LnPeer FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnPeer -> LnPeer
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter LnPeer LnPeer FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) LnPeer
x)
      in
        Parser LnPeer -> String -> Parser LnPeer
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do LnPeer -> Parser LnPeer
loop LnPeer
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"LnPeer"
  buildMessage :: LnPeer -> Builder
buildMessage
    = \ LnPeer
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe LnPubKey) LnPeer LnPeer (Maybe LnPubKey) (Maybe LnPubKey)
-> LnPeer -> Maybe LnPubKey
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pubKey") LnPeer
_x
              of
                Maybe LnPubKey
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just LnPubKey
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (LnPubKey -> ByteString) -> LnPubKey -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          LnPubKey -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage LnPubKey
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike (Maybe LnHost) LnPeer LnPeer (Maybe LnHost) (Maybe LnHost)
-> LnPeer -> Maybe LnHost
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'host") LnPeer
_x
                 of
                   Maybe LnHost
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just LnHost
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((ByteString -> Builder)
-> (LnHost -> ByteString) -> LnHost -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             (\ ByteString
bs
                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                        (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                     (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                             LnHost -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage LnHost
_v))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike (Maybe LnPort) LnPeer LnPeer (Maybe LnPort) (Maybe LnPort)
-> LnPeer -> Maybe LnPort
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'port") LnPeer
_x
                    of
                      Maybe LnPort
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just LnPort
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((ByteString -> Builder)
-> (LnPort -> ByteString) -> LnPort -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                (\ ByteString
bs
                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                           (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                        (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                                LnPort -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage LnPort
_v))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike FieldSet LnPeer LnPeer FieldSet FieldSet
-> LnPeer -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet LnPeer LnPeer FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields LnPeer
_x))))
instance Control.DeepSeq.NFData LnPeer where
  rnf :: LnPeer -> ()
rnf
    = \ LnPeer
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (LnPeer -> FieldSet
_LnPeer'_unknownFields LnPeer
x__)
             (Maybe LnPubKey -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (LnPeer -> Maybe LnPubKey
_LnPeer'pubKey LnPeer
x__)
                (Maybe LnHost -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (LnPeer -> Maybe LnHost
_LnPeer'host LnPeer
x__)
                   (Maybe LnPort -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (LnPeer -> Maybe LnPort
_LnPeer'port LnPeer
x__) ())))
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' LnPort Data.Word.Word32@ -}
data LnPort
  = LnPort'_constructor {LnPort -> Word32
_LnPort'val :: !Data.Word.Word32,
                         LnPort -> FieldSet
_LnPort'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (LnPort -> LnPort -> Bool
(LnPort -> LnPort -> Bool)
-> (LnPort -> LnPort -> Bool) -> Eq LnPort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LnPort -> LnPort -> Bool
$c/= :: LnPort -> LnPort -> Bool
== :: LnPort -> LnPort -> Bool
$c== :: LnPort -> LnPort -> Bool
Prelude.Eq, Eq LnPort
Eq LnPort
-> (LnPort -> LnPort -> Ordering)
-> (LnPort -> LnPort -> Bool)
-> (LnPort -> LnPort -> Bool)
-> (LnPort -> LnPort -> Bool)
-> (LnPort -> LnPort -> Bool)
-> (LnPort -> LnPort -> LnPort)
-> (LnPort -> LnPort -> LnPort)
-> Ord LnPort
LnPort -> LnPort -> Bool
LnPort -> LnPort -> Ordering
LnPort -> LnPort -> LnPort
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LnPort -> LnPort -> LnPort
$cmin :: LnPort -> LnPort -> LnPort
max :: LnPort -> LnPort -> LnPort
$cmax :: LnPort -> LnPort -> LnPort
>= :: LnPort -> LnPort -> Bool
$c>= :: LnPort -> LnPort -> Bool
> :: LnPort -> LnPort -> Bool
$c> :: LnPort -> LnPort -> Bool
<= :: LnPort -> LnPort -> Bool
$c<= :: LnPort -> LnPort -> Bool
< :: LnPort -> LnPort -> Bool
$c< :: LnPort -> LnPort -> Bool
compare :: LnPort -> LnPort -> Ordering
$ccompare :: LnPort -> LnPort -> Ordering
Prelude.Ord, (forall x. LnPort -> Rep LnPort x)
-> (forall x. Rep LnPort x -> LnPort) -> Generic LnPort
forall x. Rep LnPort x -> LnPort
forall x. LnPort -> Rep LnPort x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LnPort x -> LnPort
$cfrom :: forall x. LnPort -> Rep LnPort x
GHC.Generics.Generic)
instance Prelude.Show LnPort where
  showsPrec :: Int -> LnPort -> ShowS
showsPrec Int
_ LnPort
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (LnPort -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort LnPort
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out LnPort
instance Data.ProtoLens.Field.HasField LnPort "val" Data.Word.Word32 where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Word32 -> f Word32) -> LnPort -> f LnPort
fieldOf Proxy# "val"
_
    = ((Word32 -> f Word32) -> LnPort -> f LnPort)
-> ((Word32 -> f Word32) -> Word32 -> f Word32)
-> (Word32 -> f Word32)
-> LnPort
-> f LnPort
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPort -> Word32)
-> (LnPort -> Word32 -> LnPort) -> Lens LnPort LnPort Word32 Word32
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPort -> Word32
_LnPort'val (\ LnPort
x__ Word32
y__ -> LnPort
x__ {_LnPort'val :: Word32
_LnPort'val = Word32
y__}))
        (Word32 -> f Word32) -> Word32 -> f Word32
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message LnPort where
  messageName :: Proxy LnPort -> Text
messageName Proxy LnPort
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.LnPort"
  packedMessageDescriptor :: Proxy LnPort -> ByteString
packedMessageDescriptor Proxy LnPort
_
    = ByteString
"\n\
      \\ACKLnPort\DC2\DLE\n\
      \\ETXval\CAN\SOH \SOH(\rR\ETXval"
  packedFileDescriptor :: Proxy LnPort -> ByteString
packedFileDescriptor Proxy LnPort
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor LnPort)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor LnPort
val__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor LnPort Word32
-> FieldDescriptor LnPort
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (WireDefault Word32
-> Lens LnPort LnPort Word32 Word32 -> FieldAccessor LnPort Word32
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Word32
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val")) ::
              Data.ProtoLens.FieldDescriptor LnPort
      in
        [(Tag, FieldDescriptor LnPort)] -> Map Tag (FieldDescriptor LnPort)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor LnPort
val__field_descriptor)]
  unknownFields :: Lens' LnPort FieldSet
unknownFields
    = (LnPort -> FieldSet)
-> (LnPort -> FieldSet -> LnPort) -> Lens' LnPort FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        LnPort -> FieldSet
_LnPort'_unknownFields
        (\ LnPort
x__ FieldSet
y__ -> LnPort
x__ {_LnPort'_unknownFields :: FieldSet
_LnPort'_unknownFields = FieldSet
y__})
  defMessage :: LnPort
defMessage
    = LnPort'_constructor :: Word32 -> FieldSet -> LnPort
LnPort'_constructor
        {_LnPort'val :: Word32
_LnPort'val = Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _LnPort'_unknownFields :: FieldSet
_LnPort'_unknownFields = []}
  parseMessage :: Parser LnPort
parseMessage
    = let
        loop :: LnPort -> Data.ProtoLens.Encoding.Bytes.Parser LnPort
        loop :: LnPort -> Parser LnPort
loop LnPort
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      LnPort -> Parser LnPort
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter LnPort LnPort FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnPort -> LnPort
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter LnPort LnPort FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) LnPort
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Word32
y <- Parser Word32 -> String -> Parser Word32
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Word32) -> Parser Word64 -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                          Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt)
                                       String
"val"
                                LnPort -> Parser LnPort
loop (Setter LnPort LnPort Word32 Word32 -> Word32 -> LnPort -> LnPort
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Word32
y LnPort
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                LnPort -> Parser LnPort
loop
                                  (Setter LnPort LnPort FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnPort -> LnPort
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter LnPort LnPort FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) LnPort
x)
      in
        Parser LnPort -> String -> Parser LnPort
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do LnPort -> Parser LnPort
loop LnPort
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"LnPort"
  buildMessage :: LnPort -> Builder
buildMessage
    = \ LnPort
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: Word32
_v = FoldLike Word32 LnPort LnPort Word32 Word32 -> LnPort -> Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") LnPort
_x
              in
                if Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Word32
_v Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                      ((Word64 -> Builder) -> (Word32 -> Word64) -> Word32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word32
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet LnPort LnPort FieldSet FieldSet
-> LnPort -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet LnPort LnPort FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields LnPort
_x))
instance Control.DeepSeq.NFData LnPort where
  rnf :: LnPort -> ()
rnf
    = \ LnPort
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (LnPort -> FieldSet
_LnPort'_unknownFields LnPort
x__)
             (Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (LnPort -> Word32
_LnPort'val LnPort
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' LnPubKey Data.ByteString.ByteString@ -}
data LnPubKey
  = LnPubKey'_constructor {LnPubKey -> ByteString
_LnPubKey'val :: !Data.ByteString.ByteString,
                           LnPubKey -> FieldSet
_LnPubKey'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (LnPubKey -> LnPubKey -> Bool
(LnPubKey -> LnPubKey -> Bool)
-> (LnPubKey -> LnPubKey -> Bool) -> Eq LnPubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LnPubKey -> LnPubKey -> Bool
$c/= :: LnPubKey -> LnPubKey -> Bool
== :: LnPubKey -> LnPubKey -> Bool
$c== :: LnPubKey -> LnPubKey -> Bool
Prelude.Eq, Eq LnPubKey
Eq LnPubKey
-> (LnPubKey -> LnPubKey -> Ordering)
-> (LnPubKey -> LnPubKey -> Bool)
-> (LnPubKey -> LnPubKey -> Bool)
-> (LnPubKey -> LnPubKey -> Bool)
-> (LnPubKey -> LnPubKey -> Bool)
-> (LnPubKey -> LnPubKey -> LnPubKey)
-> (LnPubKey -> LnPubKey -> LnPubKey)
-> Ord LnPubKey
LnPubKey -> LnPubKey -> Bool
LnPubKey -> LnPubKey -> Ordering
LnPubKey -> LnPubKey -> LnPubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LnPubKey -> LnPubKey -> LnPubKey
$cmin :: LnPubKey -> LnPubKey -> LnPubKey
max :: LnPubKey -> LnPubKey -> LnPubKey
$cmax :: LnPubKey -> LnPubKey -> LnPubKey
>= :: LnPubKey -> LnPubKey -> Bool
$c>= :: LnPubKey -> LnPubKey -> Bool
> :: LnPubKey -> LnPubKey -> Bool
$c> :: LnPubKey -> LnPubKey -> Bool
<= :: LnPubKey -> LnPubKey -> Bool
$c<= :: LnPubKey -> LnPubKey -> Bool
< :: LnPubKey -> LnPubKey -> Bool
$c< :: LnPubKey -> LnPubKey -> Bool
compare :: LnPubKey -> LnPubKey -> Ordering
$ccompare :: LnPubKey -> LnPubKey -> Ordering
Prelude.Ord, (forall x. LnPubKey -> Rep LnPubKey x)
-> (forall x. Rep LnPubKey x -> LnPubKey) -> Generic LnPubKey
forall x. Rep LnPubKey x -> LnPubKey
forall x. LnPubKey -> Rep LnPubKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LnPubKey x -> LnPubKey
$cfrom :: forall x. LnPubKey -> Rep LnPubKey x
GHC.Generics.Generic)
instance Prelude.Show LnPubKey where
  showsPrec :: Int -> LnPubKey -> ShowS
showsPrec Int
_ LnPubKey
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (LnPubKey -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort LnPubKey
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out LnPubKey
instance Data.ProtoLens.Field.HasField LnPubKey "val" Data.ByteString.ByteString where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val"
-> (ByteString -> f ByteString) -> LnPubKey -> f LnPubKey
fieldOf Proxy# "val"
_
    = ((ByteString -> f ByteString) -> LnPubKey -> f LnPubKey)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> LnPubKey
-> f LnPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LnPubKey -> ByteString)
-> (LnPubKey -> ByteString -> LnPubKey)
-> Lens LnPubKey LnPubKey ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LnPubKey -> ByteString
_LnPubKey'val (\ LnPubKey
x__ ByteString
y__ -> LnPubKey
x__ {_LnPubKey'val :: ByteString
_LnPubKey'val = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message LnPubKey where
  messageName :: Proxy LnPubKey -> Text
messageName Proxy LnPubKey
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.LnPubKey"
  packedMessageDescriptor :: Proxy LnPubKey -> ByteString
packedMessageDescriptor Proxy LnPubKey
_
    = ByteString
"\n\
      \\bLnPubKey\DC2\DLE\n\
      \\ETXval\CAN\SOH \SOH(\fR\ETXval"
  packedFileDescriptor :: Proxy LnPubKey -> ByteString
packedFileDescriptor Proxy LnPubKey
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor LnPubKey)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor LnPubKey
val__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor LnPubKey ByteString
-> FieldDescriptor LnPubKey
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (WireDefault ByteString
-> Lens LnPubKey LnPubKey ByteString ByteString
-> FieldAccessor LnPubKey ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val")) ::
              Data.ProtoLens.FieldDescriptor LnPubKey
      in
        [(Tag, FieldDescriptor LnPubKey)]
-> Map Tag (FieldDescriptor LnPubKey)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor LnPubKey
val__field_descriptor)]
  unknownFields :: Lens' LnPubKey FieldSet
unknownFields
    = (LnPubKey -> FieldSet)
-> (LnPubKey -> FieldSet -> LnPubKey) -> Lens' LnPubKey FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        LnPubKey -> FieldSet
_LnPubKey'_unknownFields
        (\ LnPubKey
x__ FieldSet
y__ -> LnPubKey
x__ {_LnPubKey'_unknownFields :: FieldSet
_LnPubKey'_unknownFields = FieldSet
y__})
  defMessage :: LnPubKey
defMessage
    = LnPubKey'_constructor :: ByteString -> FieldSet -> LnPubKey
LnPubKey'_constructor
        {_LnPubKey'val :: ByteString
_LnPubKey'val = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _LnPubKey'_unknownFields :: FieldSet
_LnPubKey'_unknownFields = []}
  parseMessage :: Parser LnPubKey
parseMessage
    = let
        loop :: LnPubKey -> Data.ProtoLens.Encoding.Bytes.Parser LnPubKey
        loop :: LnPubKey -> Parser LnPubKey
loop LnPubKey
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      LnPubKey -> Parser LnPubKey
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter LnPubKey LnPubKey FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnPubKey -> LnPubKey
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter LnPubKey LnPubKey FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) LnPubKey
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do ByteString
y <- Parser ByteString -> String -> Parser ByteString
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len))
                                       String
"val"
                                LnPubKey -> Parser LnPubKey
loop (Setter LnPubKey LnPubKey ByteString ByteString
-> ByteString -> LnPubKey -> LnPubKey
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") ByteString
y LnPubKey
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                LnPubKey -> Parser LnPubKey
loop
                                  (Setter LnPubKey LnPubKey FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LnPubKey -> LnPubKey
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter LnPubKey LnPubKey FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) LnPubKey
x)
      in
        Parser LnPubKey -> String -> Parser LnPubKey
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do LnPubKey -> Parser LnPubKey
loop LnPubKey
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"LnPubKey"
  buildMessage :: LnPubKey -> Builder
buildMessage
    = \ LnPubKey
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: ByteString
_v = FoldLike ByteString LnPubKey LnPubKey ByteString ByteString
-> LnPubKey -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") LnPubKey
_x
              in
                if ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) ByteString
_v ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                      ((\ ByteString
bs
                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                  (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                               (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                         ByteString
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet LnPubKey LnPubKey FieldSet FieldSet
-> LnPubKey -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet LnPubKey LnPubKey FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields LnPubKey
_x))
instance Control.DeepSeq.NFData LnPubKey where
  rnf :: LnPubKey -> ()
rnf
    = \ LnPubKey
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (LnPubKey -> FieldSet
_LnPubKey'_unknownFields LnPubKey
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (LnPubKey -> ByteString
_LnPubKey'val LnPubKey
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' LocalBalance Proto.BtcLsp.Data.LowLevel.Msat@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' LocalBalance (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat)@ -}
data LocalBalance
  = LocalBalance'_constructor {LocalBalance -> Maybe Msat
_LocalBalance'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat),
                               LocalBalance -> FieldSet
_LocalBalance'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (LocalBalance -> LocalBalance -> Bool
(LocalBalance -> LocalBalance -> Bool)
-> (LocalBalance -> LocalBalance -> Bool) -> Eq LocalBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalBalance -> LocalBalance -> Bool
$c/= :: LocalBalance -> LocalBalance -> Bool
== :: LocalBalance -> LocalBalance -> Bool
$c== :: LocalBalance -> LocalBalance -> Bool
Prelude.Eq, Eq LocalBalance
Eq LocalBalance
-> (LocalBalance -> LocalBalance -> Ordering)
-> (LocalBalance -> LocalBalance -> Bool)
-> (LocalBalance -> LocalBalance -> Bool)
-> (LocalBalance -> LocalBalance -> Bool)
-> (LocalBalance -> LocalBalance -> Bool)
-> (LocalBalance -> LocalBalance -> LocalBalance)
-> (LocalBalance -> LocalBalance -> LocalBalance)
-> Ord LocalBalance
LocalBalance -> LocalBalance -> Bool
LocalBalance -> LocalBalance -> Ordering
LocalBalance -> LocalBalance -> LocalBalance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LocalBalance -> LocalBalance -> LocalBalance
$cmin :: LocalBalance -> LocalBalance -> LocalBalance
max :: LocalBalance -> LocalBalance -> LocalBalance
$cmax :: LocalBalance -> LocalBalance -> LocalBalance
>= :: LocalBalance -> LocalBalance -> Bool
$c>= :: LocalBalance -> LocalBalance -> Bool
> :: LocalBalance -> LocalBalance -> Bool
$c> :: LocalBalance -> LocalBalance -> Bool
<= :: LocalBalance -> LocalBalance -> Bool
$c<= :: LocalBalance -> LocalBalance -> Bool
< :: LocalBalance -> LocalBalance -> Bool
$c< :: LocalBalance -> LocalBalance -> Bool
compare :: LocalBalance -> LocalBalance -> Ordering
$ccompare :: LocalBalance -> LocalBalance -> Ordering
Prelude.Ord, (forall x. LocalBalance -> Rep LocalBalance x)
-> (forall x. Rep LocalBalance x -> LocalBalance)
-> Generic LocalBalance
forall x. Rep LocalBalance x -> LocalBalance
forall x. LocalBalance -> Rep LocalBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalBalance x -> LocalBalance
$cfrom :: forall x. LocalBalance -> Rep LocalBalance x
GHC.Generics.Generic)
instance Prelude.Show LocalBalance where
  showsPrec :: Int -> LocalBalance -> ShowS
showsPrec Int
_ LocalBalance
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (LocalBalance -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort LocalBalance
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out LocalBalance
instance Data.ProtoLens.Field.HasField LocalBalance "val" Proto.BtcLsp.Data.LowLevel.Msat where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Msat -> f Msat) -> LocalBalance -> f LocalBalance
fieldOf Proxy# "val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> LocalBalance -> f LocalBalance)
-> ((Msat -> f Msat) -> Maybe Msat -> f (Maybe Msat))
-> (Msat -> f Msat)
-> LocalBalance
-> f LocalBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LocalBalance -> Maybe Msat)
-> (LocalBalance -> Maybe Msat -> LocalBalance)
-> Lens LocalBalance LocalBalance (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LocalBalance -> Maybe Msat
_LocalBalance'val (\ LocalBalance
x__ Maybe Msat
y__ -> LocalBalance
x__ {_LocalBalance'val :: Maybe Msat
_LocalBalance'val = Maybe Msat
y__}))
        (Msat -> Lens' (Maybe Msat) Msat
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Msat
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField LocalBalance "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe Msat -> f (Maybe Msat)) -> LocalBalance -> f LocalBalance
fieldOf Proxy# "maybe'val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> LocalBalance -> f LocalBalance)
-> ((Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat))
-> (Maybe Msat -> f (Maybe Msat))
-> LocalBalance
-> f LocalBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((LocalBalance -> Maybe Msat)
-> (LocalBalance -> Maybe Msat -> LocalBalance)
-> Lens LocalBalance LocalBalance (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           LocalBalance -> Maybe Msat
_LocalBalance'val (\ LocalBalance
x__ Maybe Msat
y__ -> LocalBalance
x__ {_LocalBalance'val :: Maybe Msat
_LocalBalance'val = Maybe Msat
y__}))
        (Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message LocalBalance where
  messageName :: Proxy LocalBalance -> Text
messageName Proxy LocalBalance
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.LocalBalance"
  packedMessageDescriptor :: Proxy LocalBalance -> ByteString
packedMessageDescriptor Proxy LocalBalance
_
    = ByteString
"\n\
      \\fLocalBalance\DC2,\n\
      \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval"
  packedFileDescriptor :: Proxy LocalBalance -> ByteString
packedFileDescriptor Proxy LocalBalance
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor LocalBalance)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor LocalBalance
val__field_descriptor
          = String
-> FieldTypeDescriptor Msat
-> FieldAccessor LocalBalance Msat
-> FieldDescriptor LocalBalance
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor Msat
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.Msat)
              (Lens LocalBalance LocalBalance (Maybe Msat) (Maybe Msat)
-> FieldAccessor LocalBalance Msat
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor LocalBalance
      in
        [(Tag, FieldDescriptor LocalBalance)]
-> Map Tag (FieldDescriptor LocalBalance)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor LocalBalance
val__field_descriptor)]
  unknownFields :: Lens' LocalBalance FieldSet
unknownFields
    = (LocalBalance -> FieldSet)
-> (LocalBalance -> FieldSet -> LocalBalance)
-> Lens' LocalBalance FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        LocalBalance -> FieldSet
_LocalBalance'_unknownFields
        (\ LocalBalance
x__ FieldSet
y__ -> LocalBalance
x__ {_LocalBalance'_unknownFields :: FieldSet
_LocalBalance'_unknownFields = FieldSet
y__})
  defMessage :: LocalBalance
defMessage
    = LocalBalance'_constructor :: Maybe Msat -> FieldSet -> LocalBalance
LocalBalance'_constructor
        {_LocalBalance'val :: Maybe Msat
_LocalBalance'val = Maybe Msat
forall a. Maybe a
Prelude.Nothing,
         _LocalBalance'_unknownFields :: FieldSet
_LocalBalance'_unknownFields = []}
  parseMessage :: Parser LocalBalance
parseMessage
    = let
        loop ::
          LocalBalance -> Data.ProtoLens.Encoding.Bytes.Parser LocalBalance
        loop :: LocalBalance -> Parser LocalBalance
loop LocalBalance
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      LocalBalance -> Parser LocalBalance
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter LocalBalance LocalBalance FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LocalBalance -> LocalBalance
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter LocalBalance LocalBalance FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) LocalBalance
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Msat
y <- Parser Msat -> String -> Parser Msat
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser Msat -> Parser Msat
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser Msat
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                LocalBalance -> Parser LocalBalance
loop (Setter LocalBalance LocalBalance Msat Msat
-> Msat -> LocalBalance -> LocalBalance
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Msat
y LocalBalance
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                LocalBalance -> Parser LocalBalance
loop
                                  (Setter LocalBalance LocalBalance FieldSet FieldSet
-> (FieldSet -> FieldSet) -> LocalBalance -> LocalBalance
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter LocalBalance LocalBalance FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) LocalBalance
x)
      in
        Parser LocalBalance -> String -> Parser LocalBalance
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do LocalBalance -> Parser LocalBalance
loop LocalBalance
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"LocalBalance"
  buildMessage :: LocalBalance -> Builder
buildMessage
    = \ LocalBalance
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Msat) LocalBalance LocalBalance (Maybe Msat) (Maybe Msat)
-> LocalBalance -> Maybe Msat
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") LocalBalance
_x
              of
                Maybe Msat
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Msat
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder) -> (Msat -> ByteString) -> Msat -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Msat -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage Msat
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet LocalBalance LocalBalance FieldSet FieldSet
-> LocalBalance -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet LocalBalance LocalBalance FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields LocalBalance
_x))
instance Control.DeepSeq.NFData LocalBalance where
  rnf :: LocalBalance -> ()
rnf
    = \ LocalBalance
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (LocalBalance -> FieldSet
_LocalBalance'_unknownFields LocalBalance
x__)
             (Maybe Msat -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (LocalBalance -> Maybe Msat
_LocalBalance'val LocalBalance
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' Nonce Data.Word.Word64@ -}
data Nonce
  = Nonce'_constructor {Nonce -> Word64
_Nonce'val :: !Data.Word.Word64,
                        Nonce -> FieldSet
_Nonce'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (Nonce -> Nonce -> Bool
(Nonce -> Nonce -> Bool) -> (Nonce -> Nonce -> Bool) -> Eq Nonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nonce -> Nonce -> Bool
$c/= :: Nonce -> Nonce -> Bool
== :: Nonce -> Nonce -> Bool
$c== :: Nonce -> Nonce -> Bool
Prelude.Eq, Eq Nonce
Eq Nonce
-> (Nonce -> Nonce -> Ordering)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Nonce)
-> (Nonce -> Nonce -> Nonce)
-> Ord Nonce
Nonce -> Nonce -> Bool
Nonce -> Nonce -> Ordering
Nonce -> Nonce -> Nonce
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nonce -> Nonce -> Nonce
$cmin :: Nonce -> Nonce -> Nonce
max :: Nonce -> Nonce -> Nonce
$cmax :: Nonce -> Nonce -> Nonce
>= :: Nonce -> Nonce -> Bool
$c>= :: Nonce -> Nonce -> Bool
> :: Nonce -> Nonce -> Bool
$c> :: Nonce -> Nonce -> Bool
<= :: Nonce -> Nonce -> Bool
$c<= :: Nonce -> Nonce -> Bool
< :: Nonce -> Nonce -> Bool
$c< :: Nonce -> Nonce -> Bool
compare :: Nonce -> Nonce -> Ordering
$ccompare :: Nonce -> Nonce -> Ordering
Prelude.Ord, (forall x. Nonce -> Rep Nonce x)
-> (forall x. Rep Nonce x -> Nonce) -> Generic Nonce
forall x. Rep Nonce x -> Nonce
forall x. Nonce -> Rep Nonce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Nonce x -> Nonce
$cfrom :: forall x. Nonce -> Rep Nonce x
GHC.Generics.Generic)
instance Prelude.Show Nonce where
  showsPrec :: Int -> Nonce -> ShowS
showsPrec Int
_ Nonce
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (Nonce -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort Nonce
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out Nonce
instance Data.ProtoLens.Field.HasField Nonce "val" Data.Word.Word64 where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Word64 -> f Word64) -> Nonce -> f Nonce
fieldOf Proxy# "val"
_
    = ((Word64 -> f Word64) -> Nonce -> f Nonce)
-> ((Word64 -> f Word64) -> Word64 -> f Word64)
-> (Word64 -> f Word64)
-> Nonce
-> f Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((Nonce -> Word64)
-> (Nonce -> Word64 -> Nonce) -> Lens Nonce Nonce Word64 Word64
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Nonce -> Word64
_Nonce'val (\ Nonce
x__ Word64
y__ -> Nonce
x__ {_Nonce'val :: Word64
_Nonce'val = Word64
y__}))
        (Word64 -> f Word64) -> Word64 -> f Word64
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message Nonce where
  messageName :: Proxy Nonce -> Text
messageName Proxy Nonce
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.Nonce"
  packedMessageDescriptor :: Proxy Nonce -> ByteString
packedMessageDescriptor Proxy Nonce
_
    = ByteString
"\n\
      \\ENQNonce\DC2\DLE\n\
      \\ETXval\CAN\SOH \SOH(\EOTR\ETXval"
  packedFileDescriptor :: Proxy Nonce -> ByteString
packedFileDescriptor Proxy Nonce
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor Nonce)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor Nonce
val__field_descriptor
          = String
-> FieldTypeDescriptor Word64
-> FieldAccessor Nonce Word64
-> FieldDescriptor Nonce
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (ScalarField Word64 -> FieldTypeDescriptor Word64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word64
Data.ProtoLens.UInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64)
              (WireDefault Word64
-> Lens Nonce Nonce Word64 Word64 -> FieldAccessor Nonce Word64
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Word64
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val")) ::
              Data.ProtoLens.FieldDescriptor Nonce
      in
        [(Tag, FieldDescriptor Nonce)] -> Map Tag (FieldDescriptor Nonce)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor Nonce
val__field_descriptor)]
  unknownFields :: Lens' Nonce FieldSet
unknownFields
    = (Nonce -> FieldSet)
-> (Nonce -> FieldSet -> Nonce) -> Lens' Nonce FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        Nonce -> FieldSet
_Nonce'_unknownFields
        (\ Nonce
x__ FieldSet
y__ -> Nonce
x__ {_Nonce'_unknownFields :: FieldSet
_Nonce'_unknownFields = FieldSet
y__})
  defMessage :: Nonce
defMessage
    = Nonce'_constructor :: Word64 -> FieldSet -> Nonce
Nonce'_constructor
        {_Nonce'val :: Word64
_Nonce'val = Word64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _Nonce'_unknownFields :: FieldSet
_Nonce'_unknownFields = []}
  parseMessage :: Parser Nonce
parseMessage
    = let
        loop :: Nonce -> Data.ProtoLens.Encoding.Bytes.Parser Nonce
        loop :: Nonce -> Parser Nonce
loop Nonce
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      Nonce -> Parser Nonce
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter Nonce Nonce FieldSet FieldSet
-> (FieldSet -> FieldSet) -> Nonce -> Nonce
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter Nonce Nonce FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) Nonce
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Word64
y <- Parser Word64 -> String -> Parser Word64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt String
"val"
                                Nonce -> Parser Nonce
loop (Setter Nonce Nonce Word64 Word64 -> Word64 -> Nonce -> Nonce
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Word64
y Nonce
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                Nonce -> Parser Nonce
loop
                                  (Setter Nonce Nonce FieldSet FieldSet
-> (FieldSet -> FieldSet) -> Nonce -> Nonce
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter Nonce Nonce FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) Nonce
x)
      in
        Parser Nonce -> String -> Parser Nonce
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Nonce -> Parser Nonce
loop Nonce
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"Nonce"
  buildMessage :: Nonce -> Builder
buildMessage
    = \ Nonce
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: Word64
_v = FoldLike Word64 Nonce Nonce Word64 Word64 -> Nonce -> Word64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Nonce
_x
              in
                if Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Word64
_v Word64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet Nonce Nonce FieldSet FieldSet
-> Nonce -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet Nonce Nonce FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields Nonce
_x))
instance Control.DeepSeq.NFData Nonce where
  rnf :: Nonce -> ()
rnf
    = \ Nonce
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (Nonce -> FieldSet
_Nonce'_unknownFields Nonce
x__)
             (Word64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (Nonce -> Word64
_Nonce'val Nonce
x__) ())
newtype Privacy'UnrecognizedValue
  = Privacy'UnrecognizedValue Data.Int.Int32
  deriving stock (Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
(Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool)
-> (Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool)
-> Eq Privacy'UnrecognizedValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
$c/= :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
== :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
$c== :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
Prelude.Eq,
                  Eq Privacy'UnrecognizedValue
Eq Privacy'UnrecognizedValue
-> (Privacy'UnrecognizedValue
    -> Privacy'UnrecognizedValue -> Ordering)
-> (Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool)
-> (Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool)
-> (Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool)
-> (Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool)
-> (Privacy'UnrecognizedValue
    -> Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue)
-> (Privacy'UnrecognizedValue
    -> Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue)
-> Ord Privacy'UnrecognizedValue
Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Ordering
Privacy'UnrecognizedValue
-> Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Privacy'UnrecognizedValue
-> Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue
$cmin :: Privacy'UnrecognizedValue
-> Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue
max :: Privacy'UnrecognizedValue
-> Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue
$cmax :: Privacy'UnrecognizedValue
-> Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue
>= :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
$c>= :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
> :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
$c> :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
<= :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
$c<= :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
< :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
$c< :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Bool
compare :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Ordering
$ccompare :: Privacy'UnrecognizedValue -> Privacy'UnrecognizedValue -> Ordering
Prelude.Ord,
                  Int -> Privacy'UnrecognizedValue -> ShowS
[Privacy'UnrecognizedValue] -> ShowS
Privacy'UnrecognizedValue -> String
(Int -> Privacy'UnrecognizedValue -> ShowS)
-> (Privacy'UnrecognizedValue -> String)
-> ([Privacy'UnrecognizedValue] -> ShowS)
-> Show Privacy'UnrecognizedValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Privacy'UnrecognizedValue] -> ShowS
$cshowList :: [Privacy'UnrecognizedValue] -> ShowS
show :: Privacy'UnrecognizedValue -> String
$cshow :: Privacy'UnrecognizedValue -> String
showsPrec :: Int -> Privacy'UnrecognizedValue -> ShowS
$cshowsPrec :: Int -> Privacy'UnrecognizedValue -> ShowS
Prelude.Show,
                  (forall x.
 Privacy'UnrecognizedValue -> Rep Privacy'UnrecognizedValue x)
-> (forall x.
    Rep Privacy'UnrecognizedValue x -> Privacy'UnrecognizedValue)
-> Generic Privacy'UnrecognizedValue
forall x.
Rep Privacy'UnrecognizedValue x -> Privacy'UnrecognizedValue
forall x.
Privacy'UnrecognizedValue -> Rep Privacy'UnrecognizedValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep Privacy'UnrecognizedValue x -> Privacy'UnrecognizedValue
$cfrom :: forall x.
Privacy'UnrecognizedValue -> Rep Privacy'UnrecognizedValue x
GHC.Generics.Generic)
instance Text.PrettyPrint.GenericPretty.Out Privacy'UnrecognizedValue
data Privacy
  = PUBLIC |
    PRIVATE |
    Privacy'Unrecognized !Privacy'UnrecognizedValue
  deriving stock (Int -> Privacy -> ShowS
[Privacy] -> ShowS
Privacy -> String
(Int -> Privacy -> ShowS)
-> (Privacy -> String) -> ([Privacy] -> ShowS) -> Show Privacy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Privacy] -> ShowS
$cshowList :: [Privacy] -> ShowS
show :: Privacy -> String
$cshow :: Privacy -> String
showsPrec :: Int -> Privacy -> ShowS
$cshowsPrec :: Int -> Privacy -> ShowS
Prelude.Show,
                  Privacy -> Privacy -> Bool
(Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool) -> Eq Privacy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Privacy -> Privacy -> Bool
$c/= :: Privacy -> Privacy -> Bool
== :: Privacy -> Privacy -> Bool
$c== :: Privacy -> Privacy -> Bool
Prelude.Eq,
                  Eq Privacy
Eq Privacy
-> (Privacy -> Privacy -> Ordering)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Privacy)
-> (Privacy -> Privacy -> Privacy)
-> Ord Privacy
Privacy -> Privacy -> Bool
Privacy -> Privacy -> Ordering
Privacy -> Privacy -> Privacy
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Privacy -> Privacy -> Privacy
$cmin :: Privacy -> Privacy -> Privacy
max :: Privacy -> Privacy -> Privacy
$cmax :: Privacy -> Privacy -> Privacy
>= :: Privacy -> Privacy -> Bool
$c>= :: Privacy -> Privacy -> Bool
> :: Privacy -> Privacy -> Bool
$c> :: Privacy -> Privacy -> Bool
<= :: Privacy -> Privacy -> Bool
$c<= :: Privacy -> Privacy -> Bool
< :: Privacy -> Privacy -> Bool
$c< :: Privacy -> Privacy -> Bool
compare :: Privacy -> Privacy -> Ordering
$ccompare :: Privacy -> Privacy -> Ordering
Prelude.Ord,
                  (forall x. Privacy -> Rep Privacy x)
-> (forall x. Rep Privacy x -> Privacy) -> Generic Privacy
forall x. Rep Privacy x -> Privacy
forall x. Privacy -> Rep Privacy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Privacy x -> Privacy
$cfrom :: forall x. Privacy -> Rep Privacy x
GHC.Generics.Generic)
instance Data.ProtoLens.MessageEnum Privacy where
  maybeToEnum :: Int -> Maybe Privacy
maybeToEnum Int
0 = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Prelude.Just Privacy
PUBLIC
  maybeToEnum Int
1 = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Prelude.Just Privacy
PRIVATE
  maybeToEnum Int
k
    = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Prelude.Just
        (Privacy'UnrecognizedValue -> Privacy
Privacy'Unrecognized
           (Int32 -> Privacy'UnrecognizedValue
Privacy'UnrecognizedValue (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
k)))
  showEnum :: Privacy -> String
showEnum Privacy
PUBLIC = String
"PUBLIC"
  showEnum Privacy
PRIVATE = String
"PRIVATE"
  showEnum (Privacy'Unrecognized (Privacy'UnrecognizedValue Int32
k))
    = Int32 -> String
forall a. Show a => a -> String
Prelude.show Int32
k
  readEnum :: String -> Maybe Privacy
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"PUBLIC" = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Prelude.Just Privacy
PUBLIC
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"PRIVATE" = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Prelude.Just Privacy
PRIVATE
    | Bool
Prelude.otherwise
    = Maybe Int -> (Int -> Maybe Privacy) -> Maybe Privacy
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(Prelude.>>=) (String -> Maybe Int
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
k) Int -> Maybe Privacy
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded Privacy where
  minBound :: Privacy
minBound = Privacy
PUBLIC
  maxBound :: Privacy
maxBound = Privacy
PRIVATE
instance Prelude.Enum Privacy where
  toEnum :: Int -> Privacy
toEnum Int
k__
    = Privacy -> (Privacy -> Privacy) -> Maybe Privacy -> Privacy
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> Privacy
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum Privacy: " (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        Privacy -> Privacy
forall a. a -> a
Prelude.id (Int -> Maybe Privacy
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: Privacy -> Int
fromEnum Privacy
PUBLIC = Int
0
  fromEnum Privacy
PRIVATE = Int
1
  fromEnum (Privacy'Unrecognized (Privacy'UnrecognizedValue Int32
k))
    = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int32
k
  succ :: Privacy -> Privacy
succ Privacy
PRIVATE
    = String -> Privacy
forall a. HasCallStack => String -> a
Prelude.error
        String
"Privacy.succ: bad argument PRIVATE. This value would be out of bounds."
  succ Privacy
PUBLIC = Privacy
PRIVATE
  succ (Privacy'Unrecognized Privacy'UnrecognizedValue
_)
    = String -> Privacy
forall a. HasCallStack => String -> a
Prelude.error String
"Privacy.succ: bad argument: unrecognized value"
  pred :: Privacy -> Privacy
pred Privacy
PUBLIC
    = String -> Privacy
forall a. HasCallStack => String -> a
Prelude.error
        String
"Privacy.pred: bad argument PUBLIC. This value would be out of bounds."
  pred Privacy
PRIVATE = Privacy
PUBLIC
  pred (Privacy'Unrecognized Privacy'UnrecognizedValue
_)
    = String -> Privacy
forall a. HasCallStack => String -> a
Prelude.error String
"Privacy.pred: bad argument: unrecognized value"
  enumFrom :: Privacy -> [Privacy]
enumFrom = Privacy -> [Privacy]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: Privacy -> Privacy -> [Privacy]
enumFromTo = Privacy -> Privacy -> [Privacy]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: Privacy -> Privacy -> [Privacy]
enumFromThen = Privacy -> Privacy -> [Privacy]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: Privacy -> Privacy -> Privacy -> [Privacy]
enumFromThenTo = Privacy -> Privacy -> Privacy -> [Privacy]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault Privacy where
  fieldDefault :: Privacy
fieldDefault = Privacy
PUBLIC
instance Control.DeepSeq.NFData Privacy where
  rnf :: Privacy -> ()
rnf Privacy
x__ = Privacy -> () -> ()
Prelude.seq Privacy
x__ ()
instance Text.PrettyPrint.GenericPretty.Out Privacy
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' RefundMoney Proto.BtcLsp.Data.LowLevel.Msat@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' RefundMoney (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat)@ -}
data RefundMoney
  = RefundMoney'_constructor {RefundMoney -> Maybe Msat
_RefundMoney'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat),
                              RefundMoney -> FieldSet
_RefundMoney'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RefundMoney -> RefundMoney -> Bool
(RefundMoney -> RefundMoney -> Bool)
-> (RefundMoney -> RefundMoney -> Bool) -> Eq RefundMoney
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefundMoney -> RefundMoney -> Bool
$c/= :: RefundMoney -> RefundMoney -> Bool
== :: RefundMoney -> RefundMoney -> Bool
$c== :: RefundMoney -> RefundMoney -> Bool
Prelude.Eq, Eq RefundMoney
Eq RefundMoney
-> (RefundMoney -> RefundMoney -> Ordering)
-> (RefundMoney -> RefundMoney -> Bool)
-> (RefundMoney -> RefundMoney -> Bool)
-> (RefundMoney -> RefundMoney -> Bool)
-> (RefundMoney -> RefundMoney -> Bool)
-> (RefundMoney -> RefundMoney -> RefundMoney)
-> (RefundMoney -> RefundMoney -> RefundMoney)
-> Ord RefundMoney
RefundMoney -> RefundMoney -> Bool
RefundMoney -> RefundMoney -> Ordering
RefundMoney -> RefundMoney -> RefundMoney
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RefundMoney -> RefundMoney -> RefundMoney
$cmin :: RefundMoney -> RefundMoney -> RefundMoney
max :: RefundMoney -> RefundMoney -> RefundMoney
$cmax :: RefundMoney -> RefundMoney -> RefundMoney
>= :: RefundMoney -> RefundMoney -> Bool
$c>= :: RefundMoney -> RefundMoney -> Bool
> :: RefundMoney -> RefundMoney -> Bool
$c> :: RefundMoney -> RefundMoney -> Bool
<= :: RefundMoney -> RefundMoney -> Bool
$c<= :: RefundMoney -> RefundMoney -> Bool
< :: RefundMoney -> RefundMoney -> Bool
$c< :: RefundMoney -> RefundMoney -> Bool
compare :: RefundMoney -> RefundMoney -> Ordering
$ccompare :: RefundMoney -> RefundMoney -> Ordering
Prelude.Ord, (forall x. RefundMoney -> Rep RefundMoney x)
-> (forall x. Rep RefundMoney x -> RefundMoney)
-> Generic RefundMoney
forall x. Rep RefundMoney x -> RefundMoney
forall x. RefundMoney -> Rep RefundMoney x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RefundMoney x -> RefundMoney
$cfrom :: forall x. RefundMoney -> Rep RefundMoney x
GHC.Generics.Generic)
instance Prelude.Show RefundMoney where
  showsPrec :: Int -> RefundMoney -> ShowS
showsPrec Int
_ RefundMoney
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RefundMoney -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RefundMoney
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out RefundMoney
instance Data.ProtoLens.Field.HasField RefundMoney "val" Proto.BtcLsp.Data.LowLevel.Msat where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val" -> (Msat -> f Msat) -> RefundMoney -> f RefundMoney
fieldOf Proxy# "val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> RefundMoney -> f RefundMoney)
-> ((Msat -> f Msat) -> Maybe Msat -> f (Maybe Msat))
-> (Msat -> f Msat)
-> RefundMoney
-> f RefundMoney
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RefundMoney -> Maybe Msat)
-> (RefundMoney -> Maybe Msat -> RefundMoney)
-> Lens RefundMoney RefundMoney (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RefundMoney -> Maybe Msat
_RefundMoney'val (\ RefundMoney
x__ Maybe Msat
y__ -> RefundMoney
x__ {_RefundMoney'val :: Maybe Msat
_RefundMoney'val = Maybe Msat
y__}))
        (Msat -> Lens' (Maybe Msat) Msat
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Msat
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField RefundMoney "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe Msat -> f (Maybe Msat)) -> RefundMoney -> f RefundMoney
fieldOf Proxy# "maybe'val"
_
    = ((Maybe Msat -> f (Maybe Msat)) -> RefundMoney -> f RefundMoney)
-> ((Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat))
-> (Maybe Msat -> f (Maybe Msat))
-> RefundMoney
-> f RefundMoney
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RefundMoney -> Maybe Msat)
-> (RefundMoney -> Maybe Msat -> RefundMoney)
-> Lens RefundMoney RefundMoney (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RefundMoney -> Maybe Msat
_RefundMoney'val (\ RefundMoney
x__ Maybe Msat
y__ -> RefundMoney
x__ {_RefundMoney'val :: Maybe Msat
_RefundMoney'val = Maybe Msat
y__}))
        (Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RefundMoney where
  messageName :: Proxy RefundMoney -> Text
messageName Proxy RefundMoney
_ = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.RefundMoney"
  packedMessageDescriptor :: Proxy RefundMoney -> ByteString
packedMessageDescriptor Proxy RefundMoney
_
    = ByteString
"\n\
      \\vRefundMoney\DC2,\n\
      \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval"
  packedFileDescriptor :: Proxy RefundMoney -> ByteString
packedFileDescriptor Proxy RefundMoney
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RefundMoney)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor RefundMoney
val__field_descriptor
          = String
-> FieldTypeDescriptor Msat
-> FieldAccessor RefundMoney Msat
-> FieldDescriptor RefundMoney
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor Msat
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.Msat)
              (Lens RefundMoney RefundMoney (Maybe Msat) (Maybe Msat)
-> FieldAccessor RefundMoney Msat
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor RefundMoney
      in
        [(Tag, FieldDescriptor RefundMoney)]
-> Map Tag (FieldDescriptor RefundMoney)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RefundMoney
val__field_descriptor)]
  unknownFields :: Lens' RefundMoney FieldSet
unknownFields
    = (RefundMoney -> FieldSet)
-> (RefundMoney -> FieldSet -> RefundMoney)
-> Lens' RefundMoney FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RefundMoney -> FieldSet
_RefundMoney'_unknownFields
        (\ RefundMoney
x__ FieldSet
y__ -> RefundMoney
x__ {_RefundMoney'_unknownFields :: FieldSet
_RefundMoney'_unknownFields = FieldSet
y__})
  defMessage :: RefundMoney
defMessage
    = RefundMoney'_constructor :: Maybe Msat -> FieldSet -> RefundMoney
RefundMoney'_constructor
        {_RefundMoney'val :: Maybe Msat
_RefundMoney'val = Maybe Msat
forall a. Maybe a
Prelude.Nothing,
         _RefundMoney'_unknownFields :: FieldSet
_RefundMoney'_unknownFields = []}
  parseMessage :: Parser RefundMoney
parseMessage
    = let
        loop ::
          RefundMoney -> Data.ProtoLens.Encoding.Bytes.Parser RefundMoney
        loop :: RefundMoney -> Parser RefundMoney
loop RefundMoney
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      RefundMoney -> Parser RefundMoney
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RefundMoney RefundMoney FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RefundMoney -> RefundMoney
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter RefundMoney RefundMoney FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RefundMoney
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Msat
y <- Parser Msat -> String -> Parser Msat
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser Msat -> Parser Msat
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser Msat
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                RefundMoney -> Parser RefundMoney
loop (Setter RefundMoney RefundMoney Msat Msat
-> Msat -> RefundMoney -> RefundMoney
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Msat
y RefundMoney
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RefundMoney -> Parser RefundMoney
loop
                                  (Setter RefundMoney RefundMoney FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RefundMoney -> RefundMoney
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter RefundMoney RefundMoney FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RefundMoney
x)
      in
        Parser RefundMoney -> String -> Parser RefundMoney
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RefundMoney -> Parser RefundMoney
loop RefundMoney
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RefundMoney"
  buildMessage :: RefundMoney -> Builder
buildMessage
    = \ RefundMoney
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Msat) RefundMoney RefundMoney (Maybe Msat) (Maybe Msat)
-> RefundMoney -> Maybe Msat
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") RefundMoney
_x
              of
                Maybe Msat
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Msat
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder) -> (Msat -> ByteString) -> Msat -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Msat -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage Msat
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet RefundMoney RefundMoney FieldSet FieldSet
-> RefundMoney -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RefundMoney RefundMoney FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RefundMoney
_x))
instance Control.DeepSeq.NFData RefundMoney where
  rnf :: RefundMoney -> ()
rnf
    = \ RefundMoney
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RefundMoney -> FieldSet
_RefundMoney'_unknownFields RefundMoney
x__)
             (Maybe Msat -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RefundMoney -> Maybe Msat
_RefundMoney'val RefundMoney
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' RefundOnChainAddress Proto.BtcLsp.Data.LowLevel.OnChainAddress@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' RefundOnChainAddress (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.OnChainAddress)@ -}
data RefundOnChainAddress
  = RefundOnChainAddress'_constructor {RefundOnChainAddress -> Maybe OnChainAddress
_RefundOnChainAddress'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.OnChainAddress),
                                       RefundOnChainAddress -> FieldSet
_RefundOnChainAddress'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RefundOnChainAddress -> RefundOnChainAddress -> Bool
(RefundOnChainAddress -> RefundOnChainAddress -> Bool)
-> (RefundOnChainAddress -> RefundOnChainAddress -> Bool)
-> Eq RefundOnChainAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
$c/= :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
== :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
$c== :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
Prelude.Eq, Eq RefundOnChainAddress
Eq RefundOnChainAddress
-> (RefundOnChainAddress -> RefundOnChainAddress -> Ordering)
-> (RefundOnChainAddress -> RefundOnChainAddress -> Bool)
-> (RefundOnChainAddress -> RefundOnChainAddress -> Bool)
-> (RefundOnChainAddress -> RefundOnChainAddress -> Bool)
-> (RefundOnChainAddress -> RefundOnChainAddress -> Bool)
-> (RefundOnChainAddress
    -> RefundOnChainAddress -> RefundOnChainAddress)
-> (RefundOnChainAddress
    -> RefundOnChainAddress -> RefundOnChainAddress)
-> Ord RefundOnChainAddress
RefundOnChainAddress -> RefundOnChainAddress -> Bool
RefundOnChainAddress -> RefundOnChainAddress -> Ordering
RefundOnChainAddress
-> RefundOnChainAddress -> RefundOnChainAddress
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RefundOnChainAddress
-> RefundOnChainAddress -> RefundOnChainAddress
$cmin :: RefundOnChainAddress
-> RefundOnChainAddress -> RefundOnChainAddress
max :: RefundOnChainAddress
-> RefundOnChainAddress -> RefundOnChainAddress
$cmax :: RefundOnChainAddress
-> RefundOnChainAddress -> RefundOnChainAddress
>= :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
$c>= :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
> :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
$c> :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
<= :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
$c<= :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
< :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
$c< :: RefundOnChainAddress -> RefundOnChainAddress -> Bool
compare :: RefundOnChainAddress -> RefundOnChainAddress -> Ordering
$ccompare :: RefundOnChainAddress -> RefundOnChainAddress -> Ordering
Prelude.Ord, (forall x. RefundOnChainAddress -> Rep RefundOnChainAddress x)
-> (forall x. Rep RefundOnChainAddress x -> RefundOnChainAddress)
-> Generic RefundOnChainAddress
forall x. Rep RefundOnChainAddress x -> RefundOnChainAddress
forall x. RefundOnChainAddress -> Rep RefundOnChainAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RefundOnChainAddress x -> RefundOnChainAddress
$cfrom :: forall x. RefundOnChainAddress -> Rep RefundOnChainAddress x
GHC.Generics.Generic)
instance Prelude.Show RefundOnChainAddress where
  showsPrec :: Int -> RefundOnChainAddress -> ShowS
showsPrec Int
_ RefundOnChainAddress
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RefundOnChainAddress -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RefundOnChainAddress
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out RefundOnChainAddress
instance Data.ProtoLens.Field.HasField RefundOnChainAddress "val" Proto.BtcLsp.Data.LowLevel.OnChainAddress where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val"
-> (OnChainAddress -> f OnChainAddress)
-> RefundOnChainAddress
-> f RefundOnChainAddress
fieldOf Proxy# "val"
_
    = ((Maybe OnChainAddress -> f (Maybe OnChainAddress))
 -> RefundOnChainAddress -> f RefundOnChainAddress)
-> ((OnChainAddress -> f OnChainAddress)
    -> Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> (OnChainAddress -> f OnChainAddress)
-> RefundOnChainAddress
-> f RefundOnChainAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RefundOnChainAddress -> Maybe OnChainAddress)
-> (RefundOnChainAddress
    -> Maybe OnChainAddress -> RefundOnChainAddress)
-> Lens
     RefundOnChainAddress
     RefundOnChainAddress
     (Maybe OnChainAddress)
     (Maybe OnChainAddress)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RefundOnChainAddress -> Maybe OnChainAddress
_RefundOnChainAddress'val
           (\ RefundOnChainAddress
x__ Maybe OnChainAddress
y__ -> RefundOnChainAddress
x__ {_RefundOnChainAddress'val :: Maybe OnChainAddress
_RefundOnChainAddress'val = Maybe OnChainAddress
y__}))
        (OnChainAddress -> Lens' (Maybe OnChainAddress) OnChainAddress
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens OnChainAddress
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField RefundOnChainAddress "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.OnChainAddress) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> RefundOnChainAddress
-> f RefundOnChainAddress
fieldOf Proxy# "maybe'val"
_
    = ((Maybe OnChainAddress -> f (Maybe OnChainAddress))
 -> RefundOnChainAddress -> f RefundOnChainAddress)
-> ((Maybe OnChainAddress -> f (Maybe OnChainAddress))
    -> Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> (Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> RefundOnChainAddress
-> f RefundOnChainAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RefundOnChainAddress -> Maybe OnChainAddress)
-> (RefundOnChainAddress
    -> Maybe OnChainAddress -> RefundOnChainAddress)
-> Lens
     RefundOnChainAddress
     RefundOnChainAddress
     (Maybe OnChainAddress)
     (Maybe OnChainAddress)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RefundOnChainAddress -> Maybe OnChainAddress
_RefundOnChainAddress'val
           (\ RefundOnChainAddress
x__ Maybe OnChainAddress
y__ -> RefundOnChainAddress
x__ {_RefundOnChainAddress'val :: Maybe OnChainAddress
_RefundOnChainAddress'val = Maybe OnChainAddress
y__}))
        (Maybe OnChainAddress -> f (Maybe OnChainAddress))
-> Maybe OnChainAddress -> f (Maybe OnChainAddress)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RefundOnChainAddress where
  messageName :: Proxy RefundOnChainAddress -> Text
messageName Proxy RefundOnChainAddress
_
    = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.RefundOnChainAddress"
  packedMessageDescriptor :: Proxy RefundOnChainAddress -> ByteString
packedMessageDescriptor Proxy RefundOnChainAddress
_
    = ByteString
"\n\
      \\DC4RefundOnChainAddress\DC26\n\
      \\ETXval\CAN\SOH \SOH(\v2$.BtcLsp.Data.LowLevel.OnChainAddressR\ETXval"
  packedFileDescriptor :: Proxy RefundOnChainAddress -> ByteString
packedFileDescriptor Proxy RefundOnChainAddress
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RefundOnChainAddress)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor RefundOnChainAddress
val__field_descriptor
          = String
-> FieldTypeDescriptor OnChainAddress
-> FieldAccessor RefundOnChainAddress OnChainAddress
-> FieldDescriptor RefundOnChainAddress
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor OnChainAddress
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.OnChainAddress)
              (Lens
  RefundOnChainAddress
  RefundOnChainAddress
  (Maybe OnChainAddress)
  (Maybe OnChainAddress)
-> FieldAccessor RefundOnChainAddress OnChainAddress
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor RefundOnChainAddress
      in
        [(Tag, FieldDescriptor RefundOnChainAddress)]
-> Map Tag (FieldDescriptor RefundOnChainAddress)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RefundOnChainAddress
val__field_descriptor)]
  unknownFields :: Lens' RefundOnChainAddress FieldSet
unknownFields
    = (RefundOnChainAddress -> FieldSet)
-> (RefundOnChainAddress -> FieldSet -> RefundOnChainAddress)
-> Lens' RefundOnChainAddress FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RefundOnChainAddress -> FieldSet
_RefundOnChainAddress'_unknownFields
        (\ RefundOnChainAddress
x__ FieldSet
y__ -> RefundOnChainAddress
x__ {_RefundOnChainAddress'_unknownFields :: FieldSet
_RefundOnChainAddress'_unknownFields = FieldSet
y__})
  defMessage :: RefundOnChainAddress
defMessage
    = RefundOnChainAddress'_constructor :: Maybe OnChainAddress -> FieldSet -> RefundOnChainAddress
RefundOnChainAddress'_constructor
        {_RefundOnChainAddress'val :: Maybe OnChainAddress
_RefundOnChainAddress'val = Maybe OnChainAddress
forall a. Maybe a
Prelude.Nothing,
         _RefundOnChainAddress'_unknownFields :: FieldSet
_RefundOnChainAddress'_unknownFields = []}
  parseMessage :: Parser RefundOnChainAddress
parseMessage
    = let
        loop ::
          RefundOnChainAddress
          -> Data.ProtoLens.Encoding.Bytes.Parser RefundOnChainAddress
        loop :: RefundOnChainAddress -> Parser RefundOnChainAddress
loop RefundOnChainAddress
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      RefundOnChainAddress -> Parser RefundOnChainAddress
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RefundOnChainAddress RefundOnChainAddress FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RefundOnChainAddress
-> RefundOnChainAddress
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter RefundOnChainAddress RefundOnChainAddress FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RefundOnChainAddress
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do OnChainAddress
y <- Parser OnChainAddress -> String -> Parser OnChainAddress
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser OnChainAddress -> Parser OnChainAddress
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser OnChainAddress
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                RefundOnChainAddress -> Parser RefundOnChainAddress
loop (Setter
  RefundOnChainAddress
  RefundOnChainAddress
  OnChainAddress
  OnChainAddress
-> OnChainAddress -> RefundOnChainAddress -> RefundOnChainAddress
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") OnChainAddress
y RefundOnChainAddress
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RefundOnChainAddress -> Parser RefundOnChainAddress
loop
                                  (Setter RefundOnChainAddress RefundOnChainAddress FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RefundOnChainAddress
-> RefundOnChainAddress
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter RefundOnChainAddress RefundOnChainAddress FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RefundOnChainAddress
x)
      in
        Parser RefundOnChainAddress
-> String -> Parser RefundOnChainAddress
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RefundOnChainAddress -> Parser RefundOnChainAddress
loop RefundOnChainAddress
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RefundOnChainAddress"
  buildMessage :: RefundOnChainAddress -> Builder
buildMessage
    = \ RefundOnChainAddress
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe OnChainAddress)
  RefundOnChainAddress
  RefundOnChainAddress
  (Maybe OnChainAddress)
  (Maybe OnChainAddress)
-> RefundOnChainAddress -> Maybe OnChainAddress
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") RefundOnChainAddress
_x
              of
                Maybe OnChainAddress
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just OnChainAddress
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (OnChainAddress -> ByteString) -> OnChainAddress -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          OnChainAddress -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage OnChainAddress
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RefundOnChainAddress
  RefundOnChainAddress
  FieldSet
  FieldSet
-> RefundOnChainAddress -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RefundOnChainAddress
  RefundOnChainAddress
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RefundOnChainAddress
_x))
instance Control.DeepSeq.NFData RefundOnChainAddress where
  rnf :: RefundOnChainAddress -> ()
rnf
    = \ RefundOnChainAddress
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RefundOnChainAddress -> FieldSet
_RefundOnChainAddress'_unknownFields RefundOnChainAddress
x__)
             (Maybe OnChainAddress -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RefundOnChainAddress -> Maybe OnChainAddress
_RefundOnChainAddress'val RefundOnChainAddress
x__) ())
{- | Fields :
     
         * 'Proto.BtcLsp.Data.HighLevel_Fields.val' @:: Lens' RemoteBalance Proto.BtcLsp.Data.LowLevel.Msat@
         * 'Proto.BtcLsp.Data.HighLevel_Fields.maybe'val' @:: Lens' RemoteBalance (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat)@ -}
data RemoteBalance
  = RemoteBalance'_constructor {RemoteBalance -> Maybe Msat
_RemoteBalance'val :: !(Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat),
                                RemoteBalance -> FieldSet
_RemoteBalance'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RemoteBalance -> RemoteBalance -> Bool
(RemoteBalance -> RemoteBalance -> Bool)
-> (RemoteBalance -> RemoteBalance -> Bool) -> Eq RemoteBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteBalance -> RemoteBalance -> Bool
$c/= :: RemoteBalance -> RemoteBalance -> Bool
== :: RemoteBalance -> RemoteBalance -> Bool
$c== :: RemoteBalance -> RemoteBalance -> Bool
Prelude.Eq, Eq RemoteBalance
Eq RemoteBalance
-> (RemoteBalance -> RemoteBalance -> Ordering)
-> (RemoteBalance -> RemoteBalance -> Bool)
-> (RemoteBalance -> RemoteBalance -> Bool)
-> (RemoteBalance -> RemoteBalance -> Bool)
-> (RemoteBalance -> RemoteBalance -> Bool)
-> (RemoteBalance -> RemoteBalance -> RemoteBalance)
-> (RemoteBalance -> RemoteBalance -> RemoteBalance)
-> Ord RemoteBalance
RemoteBalance -> RemoteBalance -> Bool
RemoteBalance -> RemoteBalance -> Ordering
RemoteBalance -> RemoteBalance -> RemoteBalance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RemoteBalance -> RemoteBalance -> RemoteBalance
$cmin :: RemoteBalance -> RemoteBalance -> RemoteBalance
max :: RemoteBalance -> RemoteBalance -> RemoteBalance
$cmax :: RemoteBalance -> RemoteBalance -> RemoteBalance
>= :: RemoteBalance -> RemoteBalance -> Bool
$c>= :: RemoteBalance -> RemoteBalance -> Bool
> :: RemoteBalance -> RemoteBalance -> Bool
$c> :: RemoteBalance -> RemoteBalance -> Bool
<= :: RemoteBalance -> RemoteBalance -> Bool
$c<= :: RemoteBalance -> RemoteBalance -> Bool
< :: RemoteBalance -> RemoteBalance -> Bool
$c< :: RemoteBalance -> RemoteBalance -> Bool
compare :: RemoteBalance -> RemoteBalance -> Ordering
$ccompare :: RemoteBalance -> RemoteBalance -> Ordering
Prelude.Ord, (forall x. RemoteBalance -> Rep RemoteBalance x)
-> (forall x. Rep RemoteBalance x -> RemoteBalance)
-> Generic RemoteBalance
forall x. Rep RemoteBalance x -> RemoteBalance
forall x. RemoteBalance -> Rep RemoteBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoteBalance x -> RemoteBalance
$cfrom :: forall x. RemoteBalance -> Rep RemoteBalance x
GHC.Generics.Generic)
instance Prelude.Show RemoteBalance where
  showsPrec :: Int -> RemoteBalance -> ShowS
showsPrec Int
_ RemoteBalance
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RemoteBalance -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RemoteBalance
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Text.PrettyPrint.GenericPretty.Out RemoteBalance
instance Data.ProtoLens.Field.HasField RemoteBalance "val" Proto.BtcLsp.Data.LowLevel.Msat where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "val"
-> (Msat -> f Msat) -> RemoteBalance -> f RemoteBalance
fieldOf Proxy# "val"
_
    = ((Maybe Msat -> f (Maybe Msat))
 -> RemoteBalance -> f RemoteBalance)
-> ((Msat -> f Msat) -> Maybe Msat -> f (Maybe Msat))
-> (Msat -> f Msat)
-> RemoteBalance
-> f RemoteBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RemoteBalance -> Maybe Msat)
-> (RemoteBalance -> Maybe Msat -> RemoteBalance)
-> Lens RemoteBalance RemoteBalance (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RemoteBalance -> Maybe Msat
_RemoteBalance'val (\ RemoteBalance
x__ Maybe Msat
y__ -> RemoteBalance
x__ {_RemoteBalance'val :: Maybe Msat
_RemoteBalance'val = Maybe Msat
y__}))
        (Msat -> Lens' (Maybe Msat) Msat
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Msat
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField RemoteBalance "maybe'val" (Prelude.Maybe Proto.BtcLsp.Data.LowLevel.Msat) where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# "maybe'val"
-> (Maybe Msat -> f (Maybe Msat))
-> RemoteBalance
-> f RemoteBalance
fieldOf Proxy# "maybe'val"
_
    = ((Maybe Msat -> f (Maybe Msat))
 -> RemoteBalance -> f RemoteBalance)
-> ((Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat))
-> (Maybe Msat -> f (Maybe Msat))
-> RemoteBalance
-> f RemoteBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RemoteBalance -> Maybe Msat)
-> (RemoteBalance -> Maybe Msat -> RemoteBalance)
-> Lens RemoteBalance RemoteBalance (Maybe Msat) (Maybe Msat)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RemoteBalance -> Maybe Msat
_RemoteBalance'val (\ RemoteBalance
x__ Maybe Msat
y__ -> RemoteBalance
x__ {_RemoteBalance'val :: Maybe Msat
_RemoteBalance'val = Maybe Msat
y__}))
        (Maybe Msat -> f (Maybe Msat)) -> Maybe Msat -> f (Maybe Msat)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RemoteBalance where
  messageName :: Proxy RemoteBalance -> Text
messageName Proxy RemoteBalance
_
    = String -> Text
Data.Text.pack String
"BtcLsp.Data.HighLevel.RemoteBalance"
  packedMessageDescriptor :: Proxy RemoteBalance -> ByteString
packedMessageDescriptor Proxy RemoteBalance
_
    = ByteString
"\n\
      \\rRemoteBalance\DC2,\n\
      \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval"
  packedFileDescriptor :: Proxy RemoteBalance -> ByteString
packedFileDescriptor Proxy RemoteBalance
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RemoteBalance)
fieldsByTag
    = let
        val__field_descriptor :: FieldDescriptor RemoteBalance
val__field_descriptor
          = String
-> FieldTypeDescriptor Msat
-> FieldAccessor RemoteBalance Msat
-> FieldDescriptor RemoteBalance
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"val"
              (MessageOrGroup -> FieldTypeDescriptor Msat
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor Proto.BtcLsp.Data.LowLevel.Msat)
              (Lens RemoteBalance RemoteBalance (Maybe Msat) (Maybe Msat)
-> FieldAccessor RemoteBalance Msat
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val")) ::
              Data.ProtoLens.FieldDescriptor RemoteBalance
      in
        [(Tag, FieldDescriptor RemoteBalance)]
-> Map Tag (FieldDescriptor RemoteBalance)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RemoteBalance
val__field_descriptor)]
  unknownFields :: Lens' RemoteBalance FieldSet
unknownFields
    = (RemoteBalance -> FieldSet)
-> (RemoteBalance -> FieldSet -> RemoteBalance)
-> Lens' RemoteBalance FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RemoteBalance -> FieldSet
_RemoteBalance'_unknownFields
        (\ RemoteBalance
x__ FieldSet
y__ -> RemoteBalance
x__ {_RemoteBalance'_unknownFields :: FieldSet
_RemoteBalance'_unknownFields = FieldSet
y__})
  defMessage :: RemoteBalance
defMessage
    = RemoteBalance'_constructor :: Maybe Msat -> FieldSet -> RemoteBalance
RemoteBalance'_constructor
        {_RemoteBalance'val :: Maybe Msat
_RemoteBalance'val = Maybe Msat
forall a. Maybe a
Prelude.Nothing,
         _RemoteBalance'_unknownFields :: FieldSet
_RemoteBalance'_unknownFields = []}
  parseMessage :: Parser RemoteBalance
parseMessage
    = let
        loop ::
          RemoteBalance -> Data.ProtoLens.Encoding.Bytes.Parser RemoteBalance
        loop :: RemoteBalance -> Parser RemoteBalance
loop RemoteBalance
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      RemoteBalance -> Parser RemoteBalance
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RemoteBalance RemoteBalance FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RemoteBalance -> RemoteBalance
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter RemoteBalance RemoteBalance FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RemoteBalance
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Msat
y <- Parser Msat -> String -> Parser Msat
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser Msat -> Parser Msat
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser Msat
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"val"
                                RemoteBalance -> Parser RemoteBalance
loop (Setter RemoteBalance RemoteBalance Msat Msat
-> Msat -> RemoteBalance -> RemoteBalance
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"val") Msat
y RemoteBalance
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RemoteBalance -> Parser RemoteBalance
loop
                                  (Setter RemoteBalance RemoteBalance FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RemoteBalance -> RemoteBalance
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter RemoteBalance RemoteBalance FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RemoteBalance
x)
      in
        Parser RemoteBalance -> String -> Parser RemoteBalance
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RemoteBalance -> Parser RemoteBalance
loop RemoteBalance
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RemoteBalance"
  buildMessage :: RemoteBalance -> Builder
buildMessage
    = \ RemoteBalance
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Msat) RemoteBalance RemoteBalance (Maybe Msat) (Maybe Msat)
-> RemoteBalance -> Maybe Msat
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'val") RemoteBalance
_x
              of
                Maybe Msat
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Msat
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder) -> (Msat -> ByteString) -> Msat -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Msat -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage Msat
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet RemoteBalance RemoteBalance FieldSet FieldSet
-> RemoteBalance -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RemoteBalance RemoteBalance FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RemoteBalance
_x))
instance Control.DeepSeq.NFData RemoteBalance where
  rnf :: RemoteBalance -> ()
rnf
    = \ RemoteBalance
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RemoteBalance -> FieldSet
_RemoteBalance'_unknownFields RemoteBalance
x__)
             (Maybe Msat -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RemoteBalance -> Maybe Msat
_RemoteBalance'val RemoteBalance
x__) ())
packedFileDescriptor :: Data.ByteString.ByteString
packedFileDescriptor :: ByteString
packedFileDescriptor
  = ByteString
"\n\
    \\GSbtc_lsp/data/high_level.proto\DC2\NAKBtcLsp.Data.HighLevel\SUB\FSbtc_lsp/data/low_level.proto\"<\n\
    \\aFeeRate\DC21\n\
    \\ETXval\CAN\SOH \SOH(\v2\US.BtcLsp.Data.LowLevel.UrationalR\ETXval\"8\n\
    \\bFeeMoney\DC2,\n\
    \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval\"9\n\
    \\tFundMoney\DC2,\n\
    \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval\";\n\
    \\vRefundMoney\DC2,\n\
    \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval\"<\n\
    \\fLocalBalance\DC2,\n\
    \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval\"=\n\
    \\rRemoteBalance\DC2,\n\
    \\ETXval\CAN\SOH \SOH(\v2\SUB.BtcLsp.Data.LowLevel.MsatR\ETXval\"B\n\
    \\rFundLnInvoice\DC21\n\
    \\ETXval\CAN\SOH \SOH(\v2\US.BtcLsp.Data.LowLevel.LnInvoiceR\ETXval\"J\n\
    \\DC1FundLnHodlInvoice\DC25\n\
    \\ETXval\CAN\SOH \SOH(\v2#.BtcLsp.Data.LowLevel.LnHodlInvoiceR\ETXval\"L\n\
    \\DC2FundOnChainAddress\DC26\n\
    \\ETXval\CAN\SOH \SOH(\v2$.BtcLsp.Data.LowLevel.OnChainAddressR\ETXval\"N\n\
    \\DC4RefundOnChainAddress\DC26\n\
    \\ETXval\CAN\SOH \SOH(\v2$.BtcLsp.Data.LowLevel.OnChainAddressR\ETXval\"x\n\
    \\ETXCtx\DC22\n\
    \\ENQnonce\CAN\SOH \SOH(\v2\FS.BtcLsp.Data.HighLevel.NonceR\ENQnonce\DC2=\n\
    \\n\
    \ln_pub_key\CAN\STX \SOH(\v2\US.BtcLsp.Data.HighLevel.LnPubKeyR\blnPubKey\"\EM\n\
    \\ENQNonce\DC2\DLE\n\
    \\ETXval\CAN\SOH \SOH(\EOTR\ETXval\"\FS\n\
    \\bLnPubKey\DC2\DLE\n\
    \\ETXval\CAN\SOH \SOH(\fR\ETXval\"\SUB\n\
    \\ACKLnHost\DC2\DLE\n\
    \\ETXval\CAN\SOH \SOH(\tR\ETXval\"\SUB\n\
    \\ACKLnPort\DC2\DLE\n\
    \\ETXval\CAN\SOH \SOH(\rR\ETXval\"\168\SOH\n\
    \\ACKLnPeer\DC28\n\
    \\apub_key\CAN\SOH \SOH(\v2\US.BtcLsp.Data.HighLevel.LnPubKeyR\ACKpubKey\DC21\n\
    \\EOThost\CAN\STX \SOH(\v2\GS.BtcLsp.Data.HighLevel.LnHostR\EOThost\DC21\n\
    \\EOTport\CAN\ETX \SOH(\v2\GS.BtcLsp.Data.HighLevel.LnPortR\EOTport\"\149\SOH\n\
    \\fInputFailure\DC2H\n\
    \\SOfield_location\CAN\SOH \ETX(\v2!.BtcLsp.Data.HighLevel.FieldIndexR\rfieldLocation\DC2;\n\
    \\EOTkind\CAN\STX \SOH(\SO2'.BtcLsp.Data.HighLevel.InputFailureKindR\EOTkind\"\RS\n\
    \\n\
    \FieldIndex\DC2\DLE\n\
    \\ETXval\CAN\SOH \SOH(\rR\ETXval\"r\n\
    \\SIInternalFailure\DC2\FS\n\
    \\bredacted\CAN\SOH \SOH(\bH\NULR\bredacted\DC2!\n\
    \\vgrpc_server\CAN\STX \SOH(\tH\NULR\n\
    \grpcServer\DC2\DC4\n\
    \\EOTmath\CAN\ETX \SOH(\tH\NULR\EOTmathB\b\n\
    \\ACKeither*\\\n\
    \\DLEInputFailureKind\DC2\f\n\
    \\bREQUIRED\DLE\NUL\DC2\r\n\
    \\tNOT_FOUND\DLE\SOH\DC2\DC2\n\
    \\SOPARSING_FAILED\DLE\STX\DC2\ETB\n\
    \\DC3VERIFICATION_FAILED\DLE\ETX*\"\n\
    \\aPrivacy\DC2\n\
    \\n\
    \\ACKPUBLIC\DLE\NUL\DC2\v\n\
    \\aPRIVATE\DLE\SOHJ\165\EM\n\
    \\ACK\DC2\EOT\NUL\NUL\DEL\SOH\n\
    \\b\n\
    \\SOH\f\DC2\ETX\NUL\NUL\DLE\n\
    \P\n\
    \\SOH\STX\DC2\ETX\a\NUL\RS2F\n\
    \ HighLevel types are the only types\n\
    \ used directly in Grpc Methods.\n\
    \\n\
    \\n\
    \\t\n\
    \\STX\ETX\NUL\DC2\ETX\t\NUL&\n\
    \\n\
    \\n\
    \\STX\EOT\NUL\DC2\EOT\v\NUL\r\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\NUL\SOH\DC2\ETX\v\b\SI\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\NUL\DC2\ETX\f\STX*\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\ACK\DC2\ETX\f\STX!\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\SOH\DC2\ETX\f\"%\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\ETX\DC2\ETX\f()\n\
    \\n\
    \\n\
    \\STX\EOT\SOH\DC2\EOT\SI\NUL\DC1\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\SOH\SOH\DC2\ETX\SI\b\DLE\n\
    \\v\n\
    \\EOT\EOT\SOH\STX\NUL\DC2\ETX\DLE\STX%\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\ACK\DC2\ETX\DLE\STX\FS\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\SOH\DC2\ETX\DLE\GS \n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\ETX\DC2\ETX\DLE#$\n\
    \\n\
    \\n\
    \\STX\EOT\STX\DC2\EOT\DC3\NUL\NAK\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\STX\SOH\DC2\ETX\DC3\b\DC1\n\
    \\v\n\
    \\EOT\EOT\STX\STX\NUL\DC2\ETX\DC4\STX%\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\ACK\DC2\ETX\DC4\STX\FS\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\SOH\DC2\ETX\DC4\GS \n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX\DC4#$\n\
    \\n\
    \\n\
    \\STX\EOT\ETX\DC2\EOT\ETB\NUL\EM\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\ETX\SOH\DC2\ETX\ETB\b\DC3\n\
    \\v\n\
    \\EOT\EOT\ETX\STX\NUL\DC2\ETX\CAN\STX%\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\ACK\DC2\ETX\CAN\STX\FS\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\SOH\DC2\ETX\CAN\GS \n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\ETX\DC2\ETX\CAN#$\n\
    \\n\
    \\n\
    \\STX\EOT\EOT\DC2\EOT\ESC\NUL\GS\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\EOT\SOH\DC2\ETX\ESC\b\DC4\n\
    \\v\n\
    \\EOT\EOT\EOT\STX\NUL\DC2\ETX\FS\STX%\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\ACK\DC2\ETX\FS\STX\FS\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\SOH\DC2\ETX\FS\GS \n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\ETX\DC2\ETX\FS#$\n\
    \\n\
    \\n\
    \\STX\EOT\ENQ\DC2\EOT\US\NUL!\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\ENQ\SOH\DC2\ETX\US\b\NAK\n\
    \\v\n\
    \\EOT\EOT\ENQ\STX\NUL\DC2\ETX \STX%\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\ACK\DC2\ETX \STX\FS\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\SOH\DC2\ETX \GS \n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\ETX\DC2\ETX #$\n\
    \\n\
    \\n\
    \\STX\EOT\ACK\DC2\EOT#\NUL%\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\ACK\SOH\DC2\ETX#\b\NAK\n\
    \\v\n\
    \\EOT\EOT\ACK\STX\NUL\DC2\ETX$\STX*\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\NUL\ACK\DC2\ETX$\STX!\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\NUL\SOH\DC2\ETX$\"%\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\NUL\ETX\DC2\ETX$()\n\
    \\n\
    \\n\
    \\STX\EOT\a\DC2\EOT'\NUL)\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\a\SOH\DC2\ETX'\b\EM\n\
    \\v\n\
    \\EOT\EOT\a\STX\NUL\DC2\ETX(\STX.\n\
    \\f\n\
    \\ENQ\EOT\a\STX\NUL\ACK\DC2\ETX(\STX%\n\
    \\f\n\
    \\ENQ\EOT\a\STX\NUL\SOH\DC2\ETX(&)\n\
    \\f\n\
    \\ENQ\EOT\a\STX\NUL\ETX\DC2\ETX(,-\n\
    \\n\
    \\n\
    \\STX\EOT\b\DC2\EOT+\NUL-\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\b\SOH\DC2\ETX+\b\SUB\n\
    \\v\n\
    \\EOT\EOT\b\STX\NUL\DC2\ETX,\STX/\n\
    \\f\n\
    \\ENQ\EOT\b\STX\NUL\ACK\DC2\ETX,\STX&\n\
    \\f\n\
    \\ENQ\EOT\b\STX\NUL\SOH\DC2\ETX,'*\n\
    \\f\n\
    \\ENQ\EOT\b\STX\NUL\ETX\DC2\ETX,-.\n\
    \\n\
    \\n\
    \\STX\EOT\t\DC2\EOT/\NUL1\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\t\SOH\DC2\ETX/\b\FS\n\
    \\v\n\
    \\EOT\EOT\t\STX\NUL\DC2\ETX0\STX/\n\
    \\f\n\
    \\ENQ\EOT\t\STX\NUL\ACK\DC2\ETX0\STX&\n\
    \\f\n\
    \\ENQ\EOT\t\STX\NUL\SOH\DC2\ETX0'*\n\
    \\f\n\
    \\ENQ\EOT\t\STX\NUL\ETX\DC2\ETX0-.\n\
    \\n\
    \\n\
    \\STX\EOT\n\
    \\DC2\EOT3\NUL6\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\n\
    \\SOH\DC2\ETX3\b\v\n\
    \\v\n\
    \\EOT\EOT\n\
    \\STX\NUL\DC2\ETX4\STX\DC2\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\NUL\ACK\DC2\ETX4\STX\a\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\NUL\SOH\DC2\ETX4\b\r\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\NUL\ETX\DC2\ETX4\DLE\DC1\n\
    \\v\n\
    \\EOT\EOT\n\
    \\STX\SOH\DC2\ETX5\STX\SUB\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\SOH\ACK\DC2\ETX5\STX\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\SOH\SOH\DC2\ETX5\v\NAK\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\SOH\ETX\DC2\ETX5\CAN\EM\n\
    \\233\STX\n\
    \\STX\EOT\v\DC2\EOTB\NULD\SOH2\220\STX\n\
    \ All requests do require a nonce. The nonce is used\n\
    \ for security reasons and is used to guard against\n\
    \ replay attacks. The server will reject any request\n\
    \ that comes with an incorrect nonce. The only requirement\n\
    \ for the nonce is that it needs to be strictly increasing.\n\
    \ Nonce generation is often achieved by using the\n\
    \ current UNIX timestamp.\n\
    \\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\v\SOH\DC2\ETXB\b\r\n\
    \\v\n\
    \\EOT\EOT\v\STX\NUL\DC2\ETXC\STX\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NUL\ENQ\DC2\ETXC\STX\b\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NUL\SOH\DC2\ETXC\t\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NUL\ETX\DC2\ETXC\SI\DLE\n\
    \\n\
    \\n\
    \\STX\EOT\f\DC2\EOTF\NULH\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\f\SOH\DC2\ETXF\b\DLE\n\
    \\v\n\
    \\EOT\EOT\f\STX\NUL\DC2\ETXG\STX\DLE\n\
    \\f\n\
    \\ENQ\EOT\f\STX\NUL\ENQ\DC2\ETXG\STX\a\n\
    \\f\n\
    \\ENQ\EOT\f\STX\NUL\SOH\DC2\ETXG\b\v\n\
    \\f\n\
    \\ENQ\EOT\f\STX\NUL\ETX\DC2\ETXG\SO\SI\n\
    \\n\
    \\n\
    \\STX\EOT\r\DC2\EOTJ\NULL\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\r\SOH\DC2\ETXJ\b\SO\n\
    \\v\n\
    \\EOT\EOT\r\STX\NUL\DC2\ETXK\STX\DC1\n\
    \\f\n\
    \\ENQ\EOT\r\STX\NUL\ENQ\DC2\ETXK\STX\b\n\
    \\f\n\
    \\ENQ\EOT\r\STX\NUL\SOH\DC2\ETXK\t\f\n\
    \\f\n\
    \\ENQ\EOT\r\STX\NUL\ETX\DC2\ETXK\SI\DLE\n\
    \\n\
    \\n\
    \\STX\EOT\SO\DC2\EOTN\NULP\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\SO\SOH\DC2\ETXN\b\SO\n\
    \\v\n\
    \\EOT\EOT\SO\STX\NUL\DC2\ETXO\STX\DC1\n\
    \\f\n\
    \\ENQ\EOT\SO\STX\NUL\ENQ\DC2\ETXO\STX\b\n\
    \\f\n\
    \\ENQ\EOT\SO\STX\NUL\SOH\DC2\ETXO\t\f\n\
    \\f\n\
    \\ENQ\EOT\SO\STX\NUL\ETX\DC2\ETXO\SI\DLE\n\
    \\n\
    \\n\
    \\STX\EOT\SI\DC2\EOTR\NULV\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\SI\SOH\DC2\ETXR\b\SO\n\
    \\v\n\
    \\EOT\EOT\SI\STX\NUL\DC2\ETXS\STX\ETB\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\NUL\ACK\DC2\ETXS\STX\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\NUL\SOH\DC2\ETXS\v\DC2\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\NUL\ETX\DC2\ETXS\NAK\SYN\n\
    \\v\n\
    \\EOT\EOT\SI\STX\SOH\DC2\ETXT\STX\DC2\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\SOH\ACK\DC2\ETXT\STX\b\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\SOH\SOH\DC2\ETXT\t\r\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\SOH\ETX\DC2\ETXT\DLE\DC1\n\
    \\v\n\
    \\EOT\EOT\SI\STX\STX\DC2\ETXU\STX\DC2\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\STX\ACK\DC2\ETXU\STX\b\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\STX\SOH\DC2\ETXU\t\r\n\
    \\f\n\
    \\ENQ\EOT\SI\STX\STX\ETX\DC2\ETXU\DLE\DC1\n\
    \\n\
    \\n\
    \\STX\EOT\DLE\DC2\EOTX\NUL[\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\DLE\SOH\DC2\ETXX\b\DC4\n\
    \\v\n\
    \\EOT\EOT\DLE\STX\NUL\DC2\ETXY\STX)\n\
    \\f\n\
    \\ENQ\EOT\DLE\STX\NUL\EOT\DC2\ETXY\STX\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\DLE\STX\NUL\ACK\DC2\ETXY\v\NAK\n\
    \\f\n\
    \\ENQ\EOT\DLE\STX\NUL\SOH\DC2\ETXY\SYN$\n\
    \\f\n\
    \\ENQ\EOT\DLE\STX\NUL\ETX\DC2\ETXY'(\n\
    \\v\n\
    \\EOT\EOT\DLE\STX\SOH\DC2\ETXZ\STX\FS\n\
    \\f\n\
    \\ENQ\EOT\DLE\STX\SOH\ACK\DC2\ETXZ\STX\DC2\n\
    \\f\n\
    \\ENQ\EOT\DLE\STX\SOH\SOH\DC2\ETXZ\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\DLE\STX\SOH\ETX\DC2\ETXZ\SUB\ESC\n\
    \\n\
    \\n\
    \\STX\EOT\DC1\DC2\EOT]\NUL_\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\DC1\SOH\DC2\ETX]\b\DC2\n\
    \\v\n\
    \\EOT\EOT\DC1\STX\NUL\DC2\ETX^\STX\DC1\n\
    \\f\n\
    \\ENQ\EOT\DC1\STX\NUL\ENQ\DC2\ETX^\STX\b\n\
    \\f\n\
    \\ENQ\EOT\DC1\STX\NUL\SOH\DC2\ETX^\t\f\n\
    \\f\n\
    \\ENQ\EOT\DC1\STX\NUL\ETX\DC2\ETX^\SI\DLE\n\
    \\n\
    \\n\
    \\STX\ENQ\NUL\DC2\EOTa\NULr\SOH\n\
    \\n\
    \\n\
    \\ETX\ENQ\NUL\SOH\DC2\ETXa\ENQ\NAK\n\
    \l\n\
    \\EOT\ENQ\NUL\STX\NUL\DC2\ETXd\STX\SI\SUB_ All proto3 messages are optional, but sometimes\n\
    \ message presence is required by source code.\n\
    \\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\NUL\SOH\DC2\ETXd\STX\n\
    \\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\NUL\STX\DC2\ETXd\r\SO\n\
    \\182\SOH\n\
    \\EOT\ENQ\NUL\STX\SOH\DC2\ETXh\STX\DLE\SUB\168\SOH Sometimes protobuf term is not data itself, but reference\n\
    \ to some other data, located somewhere else, for example\n\
    \ in database, and this resource might be not found.\n\
    \\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\SOH\SOH\DC2\ETXh\STX\v\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\SOH\STX\DC2\ETXh\SO\SI\n\
    \\201\SOH\n\
    \\EOT\ENQ\NUL\STX\STX\DC2\ETXm\STX\NAK\SUB\187\SOH Sometimes data is required to be in some\n\
    \ specific format (for example DER binary encoding)\n\
    \ which is not the part of proto3 type system.\n\
    \ This error shows the failure of custom parser.\n\
    \\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\STX\SOH\DC2\ETXm\STX\DLE\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\STX\STX\DC2\ETXm\DC3\DC4\n\
    \\157\SOH\n\
    \\EOT\ENQ\NUL\STX\ETX\DC2\ETXq\STX\SUB\SUB\143\SOH Even if custom parser succeeded, sometimes data\n\
    \ needs to be verified somehow, for example\n\
    \ signature needs to be cryptographically verified.\n\
    \\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\ETX\SOH\DC2\ETXq\STX\NAK\n\
    \\f\n\
    \\ENQ\ENQ\NUL\STX\ETX\STX\DC2\ETXq\CAN\EM\n\
    \\n\
    \\n\
    \\STX\ENQ\SOH\DC2\EOTt\NULw\SOH\n\
    \\n\
    \\n\
    \\ETX\ENQ\SOH\SOH\DC2\ETXt\ENQ\f\n\
    \\v\n\
    \\EOT\ENQ\SOH\STX\NUL\DC2\ETXu\STX\r\n\
    \\f\n\
    \\ENQ\ENQ\SOH\STX\NUL\SOH\DC2\ETXu\STX\b\n\
    \\f\n\
    \\ENQ\ENQ\SOH\STX\NUL\STX\DC2\ETXu\v\f\n\
    \\v\n\
    \\EOT\ENQ\SOH\STX\SOH\DC2\ETXv\STX\SO\n\
    \\f\n\
    \\ENQ\ENQ\SOH\STX\SOH\SOH\DC2\ETXv\STX\t\n\
    \\f\n\
    \\ENQ\ENQ\SOH\STX\SOH\STX\DC2\ETXv\f\r\n\
    \\n\
    \\n\
    \\STX\EOT\DC2\DC2\EOTy\NUL\DEL\SOH\n\
    \\n\
    \\n\
    \\ETX\EOT\DC2\SOH\DC2\ETXy\b\ETB\n\
    \\f\n\
    \\EOT\EOT\DC2\b\NUL\DC2\EOTz\STX~\ETX\n\
    \\f\n\
    \\ENQ\EOT\DC2\b\NUL\SOH\DC2\ETXz\b\SO\n\
    \\v\n\
    \\EOT\EOT\DC2\STX\NUL\DC2\ETX{\EOT\SYN\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\NUL\ENQ\DC2\ETX{\EOT\b\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\NUL\SOH\DC2\ETX{\t\DC1\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\NUL\ETX\DC2\ETX{\DC4\NAK\n\
    \\v\n\
    \\EOT\EOT\DC2\STX\SOH\DC2\ETX|\EOT\ESC\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\SOH\ENQ\DC2\ETX|\EOT\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\SOH\SOH\DC2\ETX|\v\SYN\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\SOH\ETX\DC2\ETX|\EM\SUB\n\
    \\v\n\
    \\EOT\EOT\DC2\STX\STX\DC2\ETX}\EOT\DC4\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\STX\ENQ\DC2\ETX}\EOT\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\STX\SOH\DC2\ETX}\v\SI\n\
    \\f\n\
    \\ENQ\EOT\DC2\STX\STX\ETX\DC2\ETX}\DC2\DC3b\ACKproto3"