{- This file was auto-generated from riak.proto by the proto-lens-protoc program. -}
{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds, BangPatterns, TypeApplications, OverloadedStrings, DerivingStrategies#-}
{-# OPTIONS_GHC -Wno-unused-imports#-}
{-# OPTIONS_GHC -Wno-duplicate-exports#-}
{-# OPTIONS_GHC -Wno-dodgy-exports#-}
module Proto.Riak (
        CounterOp(), DtFetchReq(), DtFetchResp(), DtFetchResp'DataType(..),
        DtFetchResp'DataType(), DtOp(), DtUpdateReq(), DtUpdateResp(),
        DtValue(), GSetOp(), HllOp(), MapEntry(), MapField(),
        MapField'MapFieldType(..), MapField'MapFieldType(), MapOp(),
        MapUpdate(), MapUpdate'FlagOp(..), MapUpdate'FlagOp(),
        RpbAuthReq(), RpbAuthResp(), RpbBucketKeyPreflistItem(),
        RpbBucketProps(), RpbBucketProps'RpbReplMode(..),
        RpbBucketProps'RpbReplMode(), RpbCSBucketReq(), RpbCSBucketResp(),
        RpbCommitHook(), RpbContent(), RpbCounterGetReq(),
        RpbCounterGetResp(), RpbCounterUpdateReq(), RpbCounterUpdateResp(),
        RpbCoverageEntry(), RpbCoverageReq(), RpbCoverageResp(),
        RpbDelReq(), RpbDelResp(), RpbErrorResp(),
        RpbGetBucketKeyPreflistReq(), RpbGetBucketKeyPreflistResp(),
        RpbGetBucketReq(), RpbGetBucketResp(), RpbGetBucketTypeReq(),
        RpbGetClientIdReq(), RpbGetClientIdResp(), RpbGetReq(),
        RpbGetResp(), RpbGetServerInfoReq(), RpbGetServerInfoResp(),
        RpbIndexBodyResp(), RpbIndexObject(), RpbIndexReq(),
        RpbIndexReq'IndexQueryType(..), RpbIndexReq'IndexQueryType(),
        RpbIndexResp(), RpbLink(), RpbListBucketsReq(),
        RpbListBucketsResp(), RpbListKeysReq(), RpbListKeysResp(),
        RpbMapRedReq(), RpbMapRedResp(), RpbModFun(), RpbPair(),
        RpbPingReq(), RpbPingResp(), RpbPutReq(), RpbPutResp(),
        RpbResetBucketReq(), RpbResetBucketResp(), RpbSearchDoc(),
        RpbSearchQueryReq(), RpbSearchQueryResp(), RpbSetBucketReq(),
        RpbSetBucketResp(), RpbSetBucketTypeReq(), RpbSetClientIdReq(),
        RpbYokozunaIndex(), RpbYokozunaIndexDeleteReq(),
        RpbYokozunaIndexGetReq(), RpbYokozunaIndexGetResp(),
        RpbYokozunaIndexPutReq(), RpbYokozunaSchema(),
        RpbYokozunaSchemaGetReq(), RpbYokozunaSchemaGetResp(),
        RpbYokozunaSchemaPutReq(), SetOp(), TsCell(),
        TsColumnDescription(), TsColumnType(..), TsColumnType(),
        TsCoverageEntry(), TsCoverageReq(), TsCoverageResp(), TsDelReq(),
        TsDelResp(), TsGetReq(), TsGetResp(), TsInterpolation(),
        TsListKeysReq(), TsListKeysResp(), TsPutReq(), TsPutResp(),
        TsQueryReq(), TsQueryResp(), TsRange(), TsRow()
    ) 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 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
{- | Fields :
     
         * 'Proto.Riak_Fields.increment' @:: Lens' CounterOp Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'increment' @:: Lens' CounterOp (Prelude.Maybe Data.Int.Int64)@ -}
data CounterOp
  = CounterOp'_constructor {CounterOp -> Maybe Int64
_CounterOp'increment :: !(Prelude.Maybe Data.Int.Int64),
                            CounterOp -> FieldSet
_CounterOp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (CounterOp -> CounterOp -> Bool
(CounterOp -> CounterOp -> Bool)
-> (CounterOp -> CounterOp -> Bool) -> Eq CounterOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CounterOp -> CounterOp -> Bool
$c/= :: CounterOp -> CounterOp -> Bool
== :: CounterOp -> CounterOp -> Bool
$c== :: CounterOp -> CounterOp -> Bool
Prelude.Eq, Eq CounterOp
Eq CounterOp
-> (CounterOp -> CounterOp -> Ordering)
-> (CounterOp -> CounterOp -> Bool)
-> (CounterOp -> CounterOp -> Bool)
-> (CounterOp -> CounterOp -> Bool)
-> (CounterOp -> CounterOp -> Bool)
-> (CounterOp -> CounterOp -> CounterOp)
-> (CounterOp -> CounterOp -> CounterOp)
-> Ord CounterOp
CounterOp -> CounterOp -> Bool
CounterOp -> CounterOp -> Ordering
CounterOp -> CounterOp -> CounterOp
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 :: CounterOp -> CounterOp -> CounterOp
$cmin :: CounterOp -> CounterOp -> CounterOp
max :: CounterOp -> CounterOp -> CounterOp
$cmax :: CounterOp -> CounterOp -> CounterOp
>= :: CounterOp -> CounterOp -> Bool
$c>= :: CounterOp -> CounterOp -> Bool
> :: CounterOp -> CounterOp -> Bool
$c> :: CounterOp -> CounterOp -> Bool
<= :: CounterOp -> CounterOp -> Bool
$c<= :: CounterOp -> CounterOp -> Bool
< :: CounterOp -> CounterOp -> Bool
$c< :: CounterOp -> CounterOp -> Bool
compare :: CounterOp -> CounterOp -> Ordering
$ccompare :: CounterOp -> CounterOp -> Ordering
$cp1Ord :: Eq CounterOp
Prelude.Ord)
instance Prelude.Show CounterOp where
  showsPrec :: Int -> CounterOp -> ShowS
showsPrec Int
_ CounterOp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (CounterOp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort CounterOp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField CounterOp "increment" Data.Int.Int64 where
  fieldOf :: Proxy# "increment"
-> (Int64 -> f Int64) -> CounterOp -> f CounterOp
fieldOf Proxy# "increment"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> CounterOp -> f CounterOp)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> CounterOp
-> f CounterOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((CounterOp -> Maybe Int64)
-> (CounterOp -> Maybe Int64 -> CounterOp)
-> Lens CounterOp CounterOp (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           CounterOp -> Maybe Int64
_CounterOp'increment
           (\ CounterOp
x__ Maybe Int64
y__ -> CounterOp
x__ {_CounterOp'increment :: Maybe Int64
_CounterOp'increment = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField CounterOp "maybe'increment" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'increment"
-> (Maybe Int64 -> f (Maybe Int64)) -> CounterOp -> f CounterOp
fieldOf Proxy# "maybe'increment"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> CounterOp -> f CounterOp)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> CounterOp
-> f CounterOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((CounterOp -> Maybe Int64)
-> (CounterOp -> Maybe Int64 -> CounterOp)
-> Lens CounterOp CounterOp (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           CounterOp -> Maybe Int64
_CounterOp'increment
           (\ CounterOp
x__ Maybe Int64
y__ -> CounterOp
x__ {_CounterOp'increment :: Maybe Int64
_CounterOp'increment = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message CounterOp where
  messageName :: Proxy CounterOp -> Text
messageName Proxy CounterOp
_ = String -> Text
Data.Text.pack String
"CounterOp"
  packedMessageDescriptor :: Proxy CounterOp -> ByteString
packedMessageDescriptor Proxy CounterOp
_
    = ByteString
"\n\
      \\tCounterOp\DC2\FS\n\
      \\tincrement\CAN\SOH \SOH(\DC2R\tincrement"
  packedFileDescriptor :: Proxy CounterOp -> ByteString
packedFileDescriptor Proxy CounterOp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor CounterOp)
fieldsByTag
    = let
        increment__field_descriptor :: FieldDescriptor CounterOp
increment__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor CounterOp Int64
-> FieldDescriptor CounterOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"increment"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens CounterOp CounterOp (Maybe Int64) (Maybe Int64)
-> FieldAccessor CounterOp Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'increment" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'increment")) ::
              Data.ProtoLens.FieldDescriptor CounterOp
      in
        [(Tag, FieldDescriptor CounterOp)]
-> Map Tag (FieldDescriptor CounterOp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor CounterOp
increment__field_descriptor)]
  unknownFields :: LensLike' f CounterOp FieldSet
unknownFields
    = (CounterOp -> FieldSet)
-> (CounterOp -> FieldSet -> CounterOp) -> Lens' CounterOp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        CounterOp -> FieldSet
_CounterOp'_unknownFields
        (\ CounterOp
x__ FieldSet
y__ -> CounterOp
x__ {_CounterOp'_unknownFields :: FieldSet
_CounterOp'_unknownFields = FieldSet
y__})
  defMessage :: CounterOp
defMessage
    = CounterOp'_constructor :: Maybe Int64 -> FieldSet -> CounterOp
CounterOp'_constructor
        {_CounterOp'increment :: Maybe Int64
_CounterOp'increment = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _CounterOp'_unknownFields :: FieldSet
_CounterOp'_unknownFields = []}
  parseMessage :: Parser CounterOp
parseMessage
    = let
        loop :: CounterOp -> Data.ProtoLens.Encoding.Bytes.Parser CounterOp
        loop :: CounterOp -> Parser CounterOp
loop CounterOp
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]))))
                      CounterOp -> Parser CounterOp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter CounterOp CounterOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> CounterOp -> CounterOp
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 CounterOp CounterOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) CounterOp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"increment"
                                CounterOp -> Parser CounterOp
loop
                                  (Setter CounterOp CounterOp Int64 Int64
-> Int64 -> CounterOp -> CounterOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "increment" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"increment") Int64
y CounterOp
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                CounterOp -> Parser CounterOp
loop
                                  (Setter CounterOp CounterOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> CounterOp -> CounterOp
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 CounterOp CounterOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) CounterOp
x)
      in
        Parser CounterOp -> String -> Parser CounterOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do CounterOp -> Parser CounterOp
loop CounterOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"CounterOp"
  buildMessage :: CounterOp -> Builder
buildMessage
    = \ CounterOp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Int64) CounterOp CounterOp (Maybe Int64) (Maybe Int64)
-> CounterOp -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                    (forall s a (f :: * -> *).
(HasField s "maybe'increment" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'increment") CounterOp
_x
              of
                Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Int64
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                       ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                          Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                          Int64
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet CounterOp CounterOp FieldSet FieldSet
-> CounterOp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet CounterOp CounterOp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields CounterOp
_x))
instance Control.DeepSeq.NFData CounterOp where
  rnf :: CounterOp -> ()
rnf
    = \ CounterOp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (CounterOp -> FieldSet
_CounterOp'_unknownFields CounterOp
x__)
             (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (CounterOp -> Maybe Int64
_CounterOp'increment CounterOp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' DtFetchReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' DtFetchReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.type'' @:: Lens' DtFetchReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.r' @:: Lens' DtFetchReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'r' @:: Lens' DtFetchReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pr' @:: Lens' DtFetchReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pr' @:: Lens' DtFetchReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.basicQuorum' @:: Lens' DtFetchReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'basicQuorum' @:: Lens' DtFetchReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.notfoundOk' @:: Lens' DtFetchReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'notfoundOk' @:: Lens' DtFetchReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' DtFetchReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' DtFetchReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.sloppyQuorum' @:: Lens' DtFetchReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'sloppyQuorum' @:: Lens' DtFetchReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.nVal' @:: Lens' DtFetchReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'nVal' @:: Lens' DtFetchReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.includeContext' @:: Lens' DtFetchReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'includeContext' @:: Lens' DtFetchReq (Prelude.Maybe Prelude.Bool)@ -}
data DtFetchReq
  = DtFetchReq'_constructor {DtFetchReq -> ByteString
_DtFetchReq'bucket :: !Data.ByteString.ByteString,
                             DtFetchReq -> ByteString
_DtFetchReq'key :: !Data.ByteString.ByteString,
                             DtFetchReq -> ByteString
_DtFetchReq'type' :: !Data.ByteString.ByteString,
                             DtFetchReq -> Maybe Word32
_DtFetchReq'r :: !(Prelude.Maybe Data.Word.Word32),
                             DtFetchReq -> Maybe Word32
_DtFetchReq'pr :: !(Prelude.Maybe Data.Word.Word32),
                             DtFetchReq -> Maybe Bool
_DtFetchReq'basicQuorum :: !(Prelude.Maybe Prelude.Bool),
                             DtFetchReq -> Maybe Bool
_DtFetchReq'notfoundOk :: !(Prelude.Maybe Prelude.Bool),
                             DtFetchReq -> Maybe Word32
_DtFetchReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                             DtFetchReq -> Maybe Bool
_DtFetchReq'sloppyQuorum :: !(Prelude.Maybe Prelude.Bool),
                             DtFetchReq -> Maybe Word32
_DtFetchReq'nVal :: !(Prelude.Maybe Data.Word.Word32),
                             DtFetchReq -> Maybe Bool
_DtFetchReq'includeContext :: !(Prelude.Maybe Prelude.Bool),
                             DtFetchReq -> FieldSet
_DtFetchReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (DtFetchReq -> DtFetchReq -> Bool
(DtFetchReq -> DtFetchReq -> Bool)
-> (DtFetchReq -> DtFetchReq -> Bool) -> Eq DtFetchReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DtFetchReq -> DtFetchReq -> Bool
$c/= :: DtFetchReq -> DtFetchReq -> Bool
== :: DtFetchReq -> DtFetchReq -> Bool
$c== :: DtFetchReq -> DtFetchReq -> Bool
Prelude.Eq, Eq DtFetchReq
Eq DtFetchReq
-> (DtFetchReq -> DtFetchReq -> Ordering)
-> (DtFetchReq -> DtFetchReq -> Bool)
-> (DtFetchReq -> DtFetchReq -> Bool)
-> (DtFetchReq -> DtFetchReq -> Bool)
-> (DtFetchReq -> DtFetchReq -> Bool)
-> (DtFetchReq -> DtFetchReq -> DtFetchReq)
-> (DtFetchReq -> DtFetchReq -> DtFetchReq)
-> Ord DtFetchReq
DtFetchReq -> DtFetchReq -> Bool
DtFetchReq -> DtFetchReq -> Ordering
DtFetchReq -> DtFetchReq -> DtFetchReq
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 :: DtFetchReq -> DtFetchReq -> DtFetchReq
$cmin :: DtFetchReq -> DtFetchReq -> DtFetchReq
max :: DtFetchReq -> DtFetchReq -> DtFetchReq
$cmax :: DtFetchReq -> DtFetchReq -> DtFetchReq
>= :: DtFetchReq -> DtFetchReq -> Bool
$c>= :: DtFetchReq -> DtFetchReq -> Bool
> :: DtFetchReq -> DtFetchReq -> Bool
$c> :: DtFetchReq -> DtFetchReq -> Bool
<= :: DtFetchReq -> DtFetchReq -> Bool
$c<= :: DtFetchReq -> DtFetchReq -> Bool
< :: DtFetchReq -> DtFetchReq -> Bool
$c< :: DtFetchReq -> DtFetchReq -> Bool
compare :: DtFetchReq -> DtFetchReq -> Ordering
$ccompare :: DtFetchReq -> DtFetchReq -> Ordering
$cp1Ord :: Eq DtFetchReq
Prelude.Ord)
instance Prelude.Show DtFetchReq where
  showsPrec :: Int -> DtFetchReq -> ShowS
showsPrec Int
_ DtFetchReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (DtFetchReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort DtFetchReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField DtFetchReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString) -> DtFetchReq -> f DtFetchReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> ByteString)
-> (DtFetchReq -> ByteString -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> ByteString
_DtFetchReq'bucket (\ DtFetchReq
x__ ByteString
y__ -> DtFetchReq
x__ {_DtFetchReq'bucket :: ByteString
_DtFetchReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString) -> DtFetchReq -> f DtFetchReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> ByteString)
-> (DtFetchReq -> ByteString -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> ByteString
_DtFetchReq'key (\ DtFetchReq
x__ ByteString
y__ -> DtFetchReq
x__ {_DtFetchReq'key :: ByteString
_DtFetchReq'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "type'"
_
    = ((ByteString -> f ByteString) -> DtFetchReq -> f DtFetchReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> ByteString)
-> (DtFetchReq -> ByteString -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> ByteString
_DtFetchReq'type' (\ DtFetchReq
x__ ByteString
y__ -> DtFetchReq
x__ {_DtFetchReq'type' :: ByteString
_DtFetchReq'type' = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "r" Data.Word.Word32 where
  fieldOf :: Proxy# "r" -> (Word32 -> f Word32) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "r"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'r (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'r :: Maybe Word32
_DtFetchReq'r = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtFetchReq "maybe'r" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'r"
-> (Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'r"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'r (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'r :: Maybe Word32
_DtFetchReq'r = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "pr" Data.Word.Word32 where
  fieldOf :: Proxy# "pr" -> (Word32 -> f Word32) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "pr"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'pr (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'pr :: Maybe Word32
_DtFetchReq'pr = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtFetchReq "maybe'pr" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pr"
-> (Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'pr"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'pr (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'pr :: Maybe Word32
_DtFetchReq'pr = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "basicQuorum" Prelude.Bool where
  fieldOf :: Proxy# "basicQuorum"
-> (Bool -> f Bool) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'basicQuorum
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'basicQuorum :: Maybe Bool
_DtFetchReq'basicQuorum = 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 DtFetchReq "maybe'basicQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'basicQuorum"
-> (Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'basicQuorum
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'basicQuorum :: Maybe Bool
_DtFetchReq'basicQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "notfoundOk" Prelude.Bool where
  fieldOf :: Proxy# "notfoundOk"
-> (Bool -> f Bool) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'notfoundOk
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'notfoundOk :: Maybe Bool
_DtFetchReq'notfoundOk = 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 DtFetchReq "maybe'notfoundOk" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'notfoundOk"
-> (Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'notfoundOk
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'notfoundOk :: Maybe Bool
_DtFetchReq'notfoundOk = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'timeout (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'timeout :: Maybe Word32
_DtFetchReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtFetchReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'timeout (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'timeout :: Maybe Word32
_DtFetchReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "sloppyQuorum" Prelude.Bool where
  fieldOf :: Proxy# "sloppyQuorum"
-> (Bool -> f Bool) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'sloppyQuorum
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'sloppyQuorum :: Maybe Bool
_DtFetchReq'sloppyQuorum = 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 DtFetchReq "maybe'sloppyQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'sloppyQuorum"
-> (Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'sloppyQuorum
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'sloppyQuorum :: Maybe Bool
_DtFetchReq'sloppyQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "nVal" Data.Word.Word32 where
  fieldOf :: Proxy# "nVal" -> (Word32 -> f Word32) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'nVal (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'nVal :: Maybe Word32
_DtFetchReq'nVal = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtFetchReq "maybe'nVal" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'nVal"
-> (Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Word32)
-> (DtFetchReq -> Maybe Word32 -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Word32
_DtFetchReq'nVal (\ DtFetchReq
x__ Maybe Word32
y__ -> DtFetchReq
x__ {_DtFetchReq'nVal :: Maybe Word32
_DtFetchReq'nVal = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchReq "includeContext" Prelude.Bool where
  fieldOf :: Proxy# "includeContext"
-> (Bool -> f Bool) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "includeContext"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'includeContext
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'includeContext :: Maybe Bool
_DtFetchReq'includeContext = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.True)
instance Data.ProtoLens.Field.HasField DtFetchReq "maybe'includeContext" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'includeContext"
-> (Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq
fieldOf Proxy# "maybe'includeContext"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtFetchReq -> f DtFetchReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> DtFetchReq
-> f DtFetchReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchReq -> Maybe Bool)
-> (DtFetchReq -> Maybe Bool -> DtFetchReq)
-> Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchReq -> Maybe Bool
_DtFetchReq'includeContext
           (\ DtFetchReq
x__ Maybe Bool
y__ -> DtFetchReq
x__ {_DtFetchReq'includeContext :: Maybe Bool
_DtFetchReq'includeContext = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message DtFetchReq where
  messageName :: Proxy DtFetchReq -> Text
messageName Proxy DtFetchReq
_ = String -> Text
Data.Text.pack String
"DtFetchReq"
  packedMessageDescriptor :: Proxy DtFetchReq -> ByteString
packedMessageDescriptor Proxy DtFetchReq
_
    = ByteString
"\n\
      \\n\
      \DtFetchReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\DC2\n\
      \\EOTtype\CAN\ETX \STX(\fR\EOTtype\DC2\f\n\
      \\SOHr\CAN\EOT \SOH(\rR\SOHr\DC2\SO\n\
      \\STXpr\CAN\ENQ \SOH(\rR\STXpr\DC2!\n\
      \\fbasic_quorum\CAN\ACK \SOH(\bR\vbasicQuorum\DC2\US\n\
      \\vnotfound_ok\CAN\a \SOH(\bR\n\
      \notfoundOk\DC2\CAN\n\
      \\atimeout\CAN\b \SOH(\rR\atimeout\DC2#\n\
      \\rsloppy_quorum\CAN\t \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
      \\ENQn_val\CAN\n\
      \ \SOH(\rR\EOTnVal\DC2-\n\
      \\SIinclude_context\CAN\v \SOH(\b:\EOTtrueR\SOincludeContext"
  packedFileDescriptor :: Proxy DtFetchReq -> ByteString
packedFileDescriptor Proxy DtFetchReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor DtFetchReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor DtFetchReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtFetchReq ByteString
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 DtFetchReq DtFetchReq ByteString ByteString
-> FieldAccessor DtFetchReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        key__field_descriptor :: FieldDescriptor DtFetchReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtFetchReq ByteString
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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 DtFetchReq DtFetchReq ByteString ByteString
-> FieldAccessor DtFetchReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        type'__field_descriptor :: FieldDescriptor DtFetchReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtFetchReq ByteString
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (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 DtFetchReq DtFetchReq ByteString ByteString
-> FieldAccessor DtFetchReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        r__field_descriptor :: FieldDescriptor DtFetchReq
r__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtFetchReq Word32
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"r"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtFetchReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        pr__field_descriptor :: FieldDescriptor DtFetchReq
pr__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtFetchReq Word32
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pr"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtFetchReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        basicQuorum__field_descriptor :: FieldDescriptor DtFetchReq
basicQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor DtFetchReq Bool
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"basic_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor DtFetchReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'basicQuorum")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        notfoundOk__field_descriptor :: FieldDescriptor DtFetchReq
notfoundOk__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor DtFetchReq Bool
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"notfound_ok"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor DtFetchReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'notfoundOk")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        timeout__field_descriptor :: FieldDescriptor DtFetchReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtFetchReq Word32
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtFetchReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        sloppyQuorum__field_descriptor :: FieldDescriptor DtFetchReq
sloppyQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor DtFetchReq Bool
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"sloppy_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor DtFetchReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        nVal__field_descriptor :: FieldDescriptor DtFetchReq
nVal__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtFetchReq Word32
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"n_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)
              (Lens DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtFetchReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
        includeContext__field_descriptor :: FieldDescriptor DtFetchReq
includeContext__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor DtFetchReq Bool
-> FieldDescriptor DtFetchReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"include_context"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor DtFetchReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'includeContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'includeContext")) ::
              Data.ProtoLens.FieldDescriptor DtFetchReq
      in
        [(Tag, FieldDescriptor DtFetchReq)]
-> Map Tag (FieldDescriptor DtFetchReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor DtFetchReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor DtFetchReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor DtFetchReq
type'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor DtFetchReq
r__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor DtFetchReq
pr__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor DtFetchReq
basicQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor DtFetchReq
notfoundOk__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor DtFetchReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor DtFetchReq
sloppyQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor DtFetchReq
nVal__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor DtFetchReq
includeContext__field_descriptor)]
  unknownFields :: LensLike' f DtFetchReq FieldSet
unknownFields
    = (DtFetchReq -> FieldSet)
-> (DtFetchReq -> FieldSet -> DtFetchReq)
-> Lens' DtFetchReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        DtFetchReq -> FieldSet
_DtFetchReq'_unknownFields
        (\ DtFetchReq
x__ FieldSet
y__ -> DtFetchReq
x__ {_DtFetchReq'_unknownFields :: FieldSet
_DtFetchReq'_unknownFields = FieldSet
y__})
  defMessage :: DtFetchReq
defMessage
    = DtFetchReq'_constructor :: ByteString
-> ByteString
-> ByteString
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Maybe Word32
-> Maybe Bool
-> Maybe Word32
-> Maybe Bool
-> FieldSet
-> DtFetchReq
DtFetchReq'_constructor
        {_DtFetchReq'bucket :: ByteString
_DtFetchReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _DtFetchReq'key :: ByteString
_DtFetchReq'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _DtFetchReq'type' :: ByteString
_DtFetchReq'type' = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _DtFetchReq'r :: Maybe Word32
_DtFetchReq'r = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _DtFetchReq'pr :: Maybe Word32
_DtFetchReq'pr = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtFetchReq'basicQuorum :: Maybe Bool
_DtFetchReq'basicQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _DtFetchReq'notfoundOk :: Maybe Bool
_DtFetchReq'notfoundOk = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _DtFetchReq'timeout :: Maybe Word32
_DtFetchReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtFetchReq'sloppyQuorum :: Maybe Bool
_DtFetchReq'sloppyQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _DtFetchReq'nVal :: Maybe Word32
_DtFetchReq'nVal = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtFetchReq'includeContext :: Maybe Bool
_DtFetchReq'includeContext = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _DtFetchReq'_unknownFields :: FieldSet
_DtFetchReq'_unknownFields = []}
  parseMessage :: Parser DtFetchReq
parseMessage
    = let
        loop ::
          DtFetchReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser DtFetchReq
        loop :: DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop DtFetchReq
x Bool
required'bucket Bool
required'key Bool
required'type'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'type' then (:) String
"type" else [String] -> [String]
forall a. a -> a
Prelude.id) []))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      DtFetchReq -> Parser DtFetchReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter DtFetchReq DtFetchReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtFetchReq -> DtFetchReq
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 DtFetchReq DtFetchReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) DtFetchReq
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
"bucket"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq ByteString ByteString
-> ByteString -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y DtFetchReq
x)
                                  Bool
Prelude.False
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
18
                          -> 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
"key"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq ByteString ByteString
-> ByteString -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                                  Bool
required'type'
                        Word64
26
                          -> 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
"type"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq ByteString ByteString
-> ByteString -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
Prelude.False
                        Word64
32
                          -> 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
"r"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Word32 Word32
-> Word32 -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"r") Word32
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
40
                          -> 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
"pr"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Word32 Word32
-> Word32 -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pr") Word32
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
48
                          -> 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
"basic_quorum"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Bool Bool
-> Bool -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"basicQuorum") Bool
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
56
                          -> 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
"notfound_ok"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Bool Bool
-> Bool -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"notfoundOk") Bool
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
64
                          -> 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
"timeout"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Word32 Word32
-> Word32 -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
72
                          -> 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
"sloppy_quorum"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Bool Bool
-> Bool -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"sloppyQuorum") Bool
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
80
                          -> 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
"n_val"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Word32 Word32
-> Word32 -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nVal") Word32
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
88
                          -> 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
"include_context"
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq Bool Bool
-> Bool -> DtFetchReq -> DtFetchReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "includeContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"includeContext") Bool
y DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                                  (Setter DtFetchReq DtFetchReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtFetchReq -> DtFetchReq
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 DtFetchReq DtFetchReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) DtFetchReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                                  Bool
required'type'
      in
        Parser DtFetchReq -> String -> Parser DtFetchReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do DtFetchReq -> Bool -> Bool -> Bool -> Parser DtFetchReq
loop
                DtFetchReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Bool
Prelude.True)
          String
"DtFetchReq"
  buildMessage :: DtFetchReq -> Builder
buildMessage
    = \ DtFetchReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString DtFetchReq DtFetchReq ByteString ByteString
-> DtFetchReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") DtFetchReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike ByteString DtFetchReq DtFetchReq ByteString ByteString
-> DtFetchReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") DtFetchReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                      ((\ 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))
                         (FoldLike ByteString DtFetchReq DtFetchReq ByteString ByteString
-> DtFetchReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") DtFetchReq
_x)))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Word32) DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> DtFetchReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r") DtFetchReq
_x
                       of
                         Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Word32
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe Word32) DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> DtFetchReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr") DtFetchReq
_x
                          of
                            Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Word32
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe Bool) DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> DtFetchReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                   (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'basicQuorum") DtFetchReq
_x
                             of
                               Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Bool
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      ((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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Bool) DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> DtFetchReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'notfoundOk") DtFetchReq
_x
                                of
                                  Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Bool
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe Word32) DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> DtFetchReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                         (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") DtFetchReq
_x
                                   of
                                     Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Word32
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike
  (Maybe Bool) DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> DtFetchReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum") DtFetchReq
_x
                                      of
                                        Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just Bool
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
72)
                                               ((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))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe Word32) DtFetchReq DtFetchReq (Maybe Word32) (Maybe Word32)
-> DtFetchReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal") DtFetchReq
_x
                                         of
                                           Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just Word32
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
80)
                                                  ((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))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike
  (Maybe Bool) DtFetchReq DtFetchReq (Maybe Bool) (Maybe Bool)
-> DtFetchReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'includeContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                     @"maybe'includeContext")
                                                  DtFetchReq
_x
                                            of
                                              Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Bool
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                                              (FoldLike FieldSet DtFetchReq DtFetchReq FieldSet FieldSet
-> DtFetchReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                 FoldLike FieldSet DtFetchReq DtFetchReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields DtFetchReq
_x))))))))))))
instance Control.DeepSeq.NFData DtFetchReq where
  rnf :: DtFetchReq -> ()
rnf
    = \ DtFetchReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (DtFetchReq -> FieldSet
_DtFetchReq'_unknownFields DtFetchReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (DtFetchReq -> ByteString
_DtFetchReq'bucket DtFetchReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (DtFetchReq -> ByteString
_DtFetchReq'key DtFetchReq
x__)
                   (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (DtFetchReq -> ByteString
_DtFetchReq'type' DtFetchReq
x__)
                      (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (DtFetchReq -> Maybe Word32
_DtFetchReq'r DtFetchReq
x__)
                         (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (DtFetchReq -> Maybe Word32
_DtFetchReq'pr DtFetchReq
x__)
                            (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (DtFetchReq -> Maybe Bool
_DtFetchReq'basicQuorum DtFetchReq
x__)
                               (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (DtFetchReq -> Maybe Bool
_DtFetchReq'notfoundOk DtFetchReq
x__)
                                  (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (DtFetchReq -> Maybe Word32
_DtFetchReq'timeout DtFetchReq
x__)
                                     (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (DtFetchReq -> Maybe Bool
_DtFetchReq'sloppyQuorum DtFetchReq
x__)
                                        (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (DtFetchReq -> Maybe Word32
_DtFetchReq'nVal DtFetchReq
x__)
                                           (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (DtFetchReq -> Maybe Bool
_DtFetchReq'includeContext DtFetchReq
x__) ())))))))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.context' @:: Lens' DtFetchResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'context' @:: Lens' DtFetchResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.type'' @:: Lens' DtFetchResp DtFetchResp'DataType@
         * 'Proto.Riak_Fields.value' @:: Lens' DtFetchResp DtValue@
         * 'Proto.Riak_Fields.maybe'value' @:: Lens' DtFetchResp (Prelude.Maybe DtValue)@ -}
data DtFetchResp
  = DtFetchResp'_constructor {DtFetchResp -> Maybe ByteString
_DtFetchResp'context :: !(Prelude.Maybe Data.ByteString.ByteString),
                              DtFetchResp -> DtFetchResp'DataType
_DtFetchResp'type' :: !DtFetchResp'DataType,
                              DtFetchResp -> Maybe DtValue
_DtFetchResp'value :: !(Prelude.Maybe DtValue),
                              DtFetchResp -> FieldSet
_DtFetchResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (DtFetchResp -> DtFetchResp -> Bool
(DtFetchResp -> DtFetchResp -> Bool)
-> (DtFetchResp -> DtFetchResp -> Bool) -> Eq DtFetchResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DtFetchResp -> DtFetchResp -> Bool
$c/= :: DtFetchResp -> DtFetchResp -> Bool
== :: DtFetchResp -> DtFetchResp -> Bool
$c== :: DtFetchResp -> DtFetchResp -> Bool
Prelude.Eq, Eq DtFetchResp
Eq DtFetchResp
-> (DtFetchResp -> DtFetchResp -> Ordering)
-> (DtFetchResp -> DtFetchResp -> Bool)
-> (DtFetchResp -> DtFetchResp -> Bool)
-> (DtFetchResp -> DtFetchResp -> Bool)
-> (DtFetchResp -> DtFetchResp -> Bool)
-> (DtFetchResp -> DtFetchResp -> DtFetchResp)
-> (DtFetchResp -> DtFetchResp -> DtFetchResp)
-> Ord DtFetchResp
DtFetchResp -> DtFetchResp -> Bool
DtFetchResp -> DtFetchResp -> Ordering
DtFetchResp -> DtFetchResp -> DtFetchResp
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 :: DtFetchResp -> DtFetchResp -> DtFetchResp
$cmin :: DtFetchResp -> DtFetchResp -> DtFetchResp
max :: DtFetchResp -> DtFetchResp -> DtFetchResp
$cmax :: DtFetchResp -> DtFetchResp -> DtFetchResp
>= :: DtFetchResp -> DtFetchResp -> Bool
$c>= :: DtFetchResp -> DtFetchResp -> Bool
> :: DtFetchResp -> DtFetchResp -> Bool
$c> :: DtFetchResp -> DtFetchResp -> Bool
<= :: DtFetchResp -> DtFetchResp -> Bool
$c<= :: DtFetchResp -> DtFetchResp -> Bool
< :: DtFetchResp -> DtFetchResp -> Bool
$c< :: DtFetchResp -> DtFetchResp -> Bool
compare :: DtFetchResp -> DtFetchResp -> Ordering
$ccompare :: DtFetchResp -> DtFetchResp -> Ordering
$cp1Ord :: Eq DtFetchResp
Prelude.Ord)
instance Prelude.Show DtFetchResp where
  showsPrec :: Int -> DtFetchResp -> ShowS
showsPrec Int
_ DtFetchResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (DtFetchResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort DtFetchResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField DtFetchResp "context" Data.ByteString.ByteString where
  fieldOf :: Proxy# "context"
-> (ByteString -> f ByteString) -> DtFetchResp -> f DtFetchResp
fieldOf Proxy# "context"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtFetchResp -> f DtFetchResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> DtFetchResp
-> f DtFetchResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchResp -> Maybe ByteString)
-> (DtFetchResp -> Maybe ByteString -> DtFetchResp)
-> Lens
     DtFetchResp DtFetchResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchResp -> Maybe ByteString
_DtFetchResp'context
           (\ DtFetchResp
x__ Maybe ByteString
y__ -> DtFetchResp
x__ {_DtFetchResp'context :: Maybe ByteString
_DtFetchResp'context = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtFetchResp "maybe'context" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'context"
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtFetchResp
-> f DtFetchResp
fieldOf Proxy# "maybe'context"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtFetchResp -> f DtFetchResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtFetchResp
-> f DtFetchResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchResp -> Maybe ByteString)
-> (DtFetchResp -> Maybe ByteString -> DtFetchResp)
-> Lens
     DtFetchResp DtFetchResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchResp -> Maybe ByteString
_DtFetchResp'context
           (\ DtFetchResp
x__ Maybe ByteString
y__ -> DtFetchResp
x__ {_DtFetchResp'context :: Maybe ByteString
_DtFetchResp'context = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchResp "type'" DtFetchResp'DataType where
  fieldOf :: Proxy# "type'"
-> (DtFetchResp'DataType -> f DtFetchResp'DataType)
-> DtFetchResp
-> f DtFetchResp
fieldOf Proxy# "type'"
_
    = ((DtFetchResp'DataType -> f DtFetchResp'DataType)
 -> DtFetchResp -> f DtFetchResp)
-> ((DtFetchResp'DataType -> f DtFetchResp'DataType)
    -> DtFetchResp'DataType -> f DtFetchResp'DataType)
-> (DtFetchResp'DataType -> f DtFetchResp'DataType)
-> DtFetchResp
-> f DtFetchResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchResp -> DtFetchResp'DataType)
-> (DtFetchResp -> DtFetchResp'DataType -> DtFetchResp)
-> Lens
     DtFetchResp DtFetchResp DtFetchResp'DataType DtFetchResp'DataType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchResp -> DtFetchResp'DataType
_DtFetchResp'type' (\ DtFetchResp
x__ DtFetchResp'DataType
y__ -> DtFetchResp
x__ {_DtFetchResp'type' :: DtFetchResp'DataType
_DtFetchResp'type' = DtFetchResp'DataType
y__}))
        (DtFetchResp'DataType -> f DtFetchResp'DataType)
-> DtFetchResp'DataType -> f DtFetchResp'DataType
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtFetchResp "value" DtValue where
  fieldOf :: Proxy# "value"
-> (DtValue -> f DtValue) -> DtFetchResp -> f DtFetchResp
fieldOf Proxy# "value"
_
    = ((Maybe DtValue -> f (Maybe DtValue))
 -> DtFetchResp -> f DtFetchResp)
-> ((DtValue -> f DtValue) -> Maybe DtValue -> f (Maybe DtValue))
-> (DtValue -> f DtValue)
-> DtFetchResp
-> f DtFetchResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchResp -> Maybe DtValue)
-> (DtFetchResp -> Maybe DtValue -> DtFetchResp)
-> Lens DtFetchResp DtFetchResp (Maybe DtValue) (Maybe DtValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchResp -> Maybe DtValue
_DtFetchResp'value (\ DtFetchResp
x__ Maybe DtValue
y__ -> DtFetchResp
x__ {_DtFetchResp'value :: Maybe DtValue
_DtFetchResp'value = Maybe DtValue
y__}))
        (DtValue -> Lens' (Maybe DtValue) DtValue
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens DtValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField DtFetchResp "maybe'value" (Prelude.Maybe DtValue) where
  fieldOf :: Proxy# "maybe'value"
-> (Maybe DtValue -> f (Maybe DtValue))
-> DtFetchResp
-> f DtFetchResp
fieldOf Proxy# "maybe'value"
_
    = ((Maybe DtValue -> f (Maybe DtValue))
 -> DtFetchResp -> f DtFetchResp)
-> ((Maybe DtValue -> f (Maybe DtValue))
    -> Maybe DtValue -> f (Maybe DtValue))
-> (Maybe DtValue -> f (Maybe DtValue))
-> DtFetchResp
-> f DtFetchResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtFetchResp -> Maybe DtValue)
-> (DtFetchResp -> Maybe DtValue -> DtFetchResp)
-> Lens DtFetchResp DtFetchResp (Maybe DtValue) (Maybe DtValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtFetchResp -> Maybe DtValue
_DtFetchResp'value (\ DtFetchResp
x__ Maybe DtValue
y__ -> DtFetchResp
x__ {_DtFetchResp'value :: Maybe DtValue
_DtFetchResp'value = Maybe DtValue
y__}))
        (Maybe DtValue -> f (Maybe DtValue))
-> Maybe DtValue -> f (Maybe DtValue)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message DtFetchResp where
  messageName :: Proxy DtFetchResp -> Text
messageName Proxy DtFetchResp
_ = String -> Text
Data.Text.pack String
"DtFetchResp"
  packedMessageDescriptor :: Proxy DtFetchResp -> ByteString
packedMessageDescriptor Proxy DtFetchResp
_
    = ByteString
"\n\
      \\vDtFetchResp\DC2\CAN\n\
      \\acontext\CAN\SOH \SOH(\fR\acontext\DC2)\n\
      \\EOTtype\CAN\STX \STX(\SO2\NAK.DtFetchResp.DataTypeR\EOTtype\DC2\RS\n\
      \\ENQvalue\CAN\ETX \SOH(\v2\b.DtValueR\ENQvalue\"<\n\
      \\bDataType\DC2\v\n\
      \\aCOUNTER\DLE\SOH\DC2\a\n\
      \\ETXSET\DLE\STX\DC2\a\n\
      \\ETXMAP\DLE\ETX\DC2\a\n\
      \\ETXHLL\DLE\EOT\DC2\b\n\
      \\EOTGSET\DLE\ENQ"
  packedFileDescriptor :: Proxy DtFetchResp -> ByteString
packedFileDescriptor Proxy DtFetchResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor DtFetchResp)
fieldsByTag
    = let
        context__field_descriptor :: FieldDescriptor DtFetchResp
context__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtFetchResp ByteString
-> FieldDescriptor DtFetchResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"context"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens DtFetchResp DtFetchResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor DtFetchResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'context")) ::
              Data.ProtoLens.FieldDescriptor DtFetchResp
        type'__field_descriptor :: FieldDescriptor DtFetchResp
type'__field_descriptor
          = String
-> FieldTypeDescriptor DtFetchResp'DataType
-> FieldAccessor DtFetchResp DtFetchResp'DataType
-> FieldDescriptor DtFetchResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField DtFetchResp'DataType
-> FieldTypeDescriptor DtFetchResp'DataType
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField DtFetchResp'DataType
forall t. MessageEnum t => ScalarField t
Data.ProtoLens.EnumField ::
                 Data.ProtoLens.FieldTypeDescriptor DtFetchResp'DataType)
              (WireDefault DtFetchResp'DataType
-> Lens
     DtFetchResp DtFetchResp DtFetchResp'DataType DtFetchResp'DataType
-> FieldAccessor DtFetchResp DtFetchResp'DataType
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault DtFetchResp'DataType
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'")) ::
              Data.ProtoLens.FieldDescriptor DtFetchResp
        value__field_descriptor :: FieldDescriptor DtFetchResp
value__field_descriptor
          = String
-> FieldTypeDescriptor DtValue
-> FieldAccessor DtFetchResp DtValue
-> FieldDescriptor DtFetchResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"value"
              (MessageOrGroup -> FieldTypeDescriptor DtValue
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor DtValue)
              (Lens DtFetchResp DtFetchResp (Maybe DtValue) (Maybe DtValue)
-> FieldAccessor DtFetchResp DtValue
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value")) ::
              Data.ProtoLens.FieldDescriptor DtFetchResp
      in
        [(Tag, FieldDescriptor DtFetchResp)]
-> Map Tag (FieldDescriptor DtFetchResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor DtFetchResp
context__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor DtFetchResp
type'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor DtFetchResp
value__field_descriptor)]
  unknownFields :: LensLike' f DtFetchResp FieldSet
unknownFields
    = (DtFetchResp -> FieldSet)
-> (DtFetchResp -> FieldSet -> DtFetchResp)
-> Lens' DtFetchResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        DtFetchResp -> FieldSet
_DtFetchResp'_unknownFields
        (\ DtFetchResp
x__ FieldSet
y__ -> DtFetchResp
x__ {_DtFetchResp'_unknownFields :: FieldSet
_DtFetchResp'_unknownFields = FieldSet
y__})
  defMessage :: DtFetchResp
defMessage
    = DtFetchResp'_constructor :: Maybe ByteString
-> DtFetchResp'DataType -> Maybe DtValue -> FieldSet -> DtFetchResp
DtFetchResp'_constructor
        {_DtFetchResp'context :: Maybe ByteString
_DtFetchResp'context = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _DtFetchResp'type' :: DtFetchResp'DataType
_DtFetchResp'type' = DtFetchResp'DataType
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _DtFetchResp'value :: Maybe DtValue
_DtFetchResp'value = Maybe DtValue
forall a. Maybe a
Prelude.Nothing,
         _DtFetchResp'_unknownFields :: FieldSet
_DtFetchResp'_unknownFields = []}
  parseMessage :: Parser DtFetchResp
parseMessage
    = let
        loop ::
          DtFetchResp
          -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser DtFetchResp
        loop :: DtFetchResp -> Bool -> Parser DtFetchResp
loop DtFetchResp
x Bool
required'type'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'type' then (:) String
"type" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      DtFetchResp -> Parser DtFetchResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter DtFetchResp DtFetchResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtFetchResp -> DtFetchResp
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 DtFetchResp DtFetchResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) DtFetchResp
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
"context"
                                DtFetchResp -> Bool -> Parser DtFetchResp
loop
                                  (Setter DtFetchResp DtFetchResp ByteString ByteString
-> ByteString -> DtFetchResp -> DtFetchResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"context") ByteString
y DtFetchResp
x)
                                  Bool
required'type'
                        Word64
16
                          -> do DtFetchResp'DataType
y <- Parser DtFetchResp'DataType
-> String -> Parser DtFetchResp'DataType
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Int -> DtFetchResp'DataType)
-> Parser Int -> Parser DtFetchResp'DataType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Int -> DtFetchResp'DataType
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
"type"
                                DtFetchResp -> Bool -> Parser DtFetchResp
loop
                                  (Setter
  DtFetchResp DtFetchResp DtFetchResp'DataType DtFetchResp'DataType
-> DtFetchResp'DataType -> DtFetchResp -> DtFetchResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") DtFetchResp'DataType
y DtFetchResp
x)
                                  Bool
Prelude.False
                        Word64
26
                          -> do DtValue
y <- Parser DtValue -> String -> Parser DtValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser DtValue -> Parser DtValue
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 DtValue
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"value"
                                DtFetchResp -> Bool -> Parser DtFetchResp
loop
                                  (Setter DtFetchResp DtFetchResp DtValue DtValue
-> DtValue -> DtFetchResp -> DtFetchResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") DtValue
y DtFetchResp
x)
                                  Bool
required'type'
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                DtFetchResp -> Bool -> Parser DtFetchResp
loop
                                  (Setter DtFetchResp DtFetchResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtFetchResp -> DtFetchResp
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 DtFetchResp DtFetchResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) DtFetchResp
x)
                                  Bool
required'type'
      in
        Parser DtFetchResp -> String -> Parser DtFetchResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do DtFetchResp -> Bool -> Parser DtFetchResp
loop DtFetchResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"DtFetchResp"
  buildMessage :: DtFetchResp -> Builder
buildMessage
    = \ DtFetchResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe ByteString)
  DtFetchResp
  DtFetchResp
  (Maybe ByteString)
  (Maybe ByteString)
-> DtFetchResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'context") DtFetchResp
_x
              of
                Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just ByteString
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                   ((Int -> Builder)
-> (DtFetchResp'DataType -> Int) -> DtFetchResp'DataType -> 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)
                      DtFetchResp'DataType -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum
                      (FoldLike
  DtFetchResp'DataType
  DtFetchResp
  DtFetchResp
  DtFetchResp'DataType
  DtFetchResp'DataType
-> DtFetchResp -> DtFetchResp'DataType
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") DtFetchResp
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe DtValue)
  DtFetchResp
  DtFetchResp
  (Maybe DtValue)
  (Maybe DtValue)
-> DtFetchResp -> Maybe DtValue
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value") DtFetchResp
_x
                    of
                      Maybe DtValue
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just DtValue
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((ByteString -> Builder)
-> (DtValue -> ByteString) -> DtValue -> 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))
                                DtValue -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                DtValue
_v))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike FieldSet DtFetchResp DtFetchResp FieldSet FieldSet
-> DtFetchResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet DtFetchResp DtFetchResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields DtFetchResp
_x))))
instance Control.DeepSeq.NFData DtFetchResp where
  rnf :: DtFetchResp -> ()
rnf
    = \ DtFetchResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (DtFetchResp -> FieldSet
_DtFetchResp'_unknownFields DtFetchResp
x__)
             (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (DtFetchResp -> Maybe ByteString
_DtFetchResp'context DtFetchResp
x__)
                (DtFetchResp'DataType -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (DtFetchResp -> DtFetchResp'DataType
_DtFetchResp'type' DtFetchResp
x__)
                   (Maybe DtValue -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (DtFetchResp -> Maybe DtValue
_DtFetchResp'value DtFetchResp
x__) ())))
data DtFetchResp'DataType
  = DtFetchResp'COUNTER |
    DtFetchResp'SET |
    DtFetchResp'MAP |
    DtFetchResp'HLL |
    DtFetchResp'GSET
  deriving stock (Int -> DtFetchResp'DataType -> ShowS
[DtFetchResp'DataType] -> ShowS
DtFetchResp'DataType -> String
(Int -> DtFetchResp'DataType -> ShowS)
-> (DtFetchResp'DataType -> String)
-> ([DtFetchResp'DataType] -> ShowS)
-> Show DtFetchResp'DataType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DtFetchResp'DataType] -> ShowS
$cshowList :: [DtFetchResp'DataType] -> ShowS
show :: DtFetchResp'DataType -> String
$cshow :: DtFetchResp'DataType -> String
showsPrec :: Int -> DtFetchResp'DataType -> ShowS
$cshowsPrec :: Int -> DtFetchResp'DataType -> ShowS
Prelude.Show, DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
(DtFetchResp'DataType -> DtFetchResp'DataType -> Bool)
-> (DtFetchResp'DataType -> DtFetchResp'DataType -> Bool)
-> Eq DtFetchResp'DataType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
$c/= :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
== :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
$c== :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
Prelude.Eq, Eq DtFetchResp'DataType
Eq DtFetchResp'DataType
-> (DtFetchResp'DataType -> DtFetchResp'DataType -> Ordering)
-> (DtFetchResp'DataType -> DtFetchResp'DataType -> Bool)
-> (DtFetchResp'DataType -> DtFetchResp'DataType -> Bool)
-> (DtFetchResp'DataType -> DtFetchResp'DataType -> Bool)
-> (DtFetchResp'DataType -> DtFetchResp'DataType -> Bool)
-> (DtFetchResp'DataType
    -> DtFetchResp'DataType -> DtFetchResp'DataType)
-> (DtFetchResp'DataType
    -> DtFetchResp'DataType -> DtFetchResp'DataType)
-> Ord DtFetchResp'DataType
DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
DtFetchResp'DataType -> DtFetchResp'DataType -> Ordering
DtFetchResp'DataType
-> DtFetchResp'DataType -> DtFetchResp'DataType
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 :: DtFetchResp'DataType
-> DtFetchResp'DataType -> DtFetchResp'DataType
$cmin :: DtFetchResp'DataType
-> DtFetchResp'DataType -> DtFetchResp'DataType
max :: DtFetchResp'DataType
-> DtFetchResp'DataType -> DtFetchResp'DataType
$cmax :: DtFetchResp'DataType
-> DtFetchResp'DataType -> DtFetchResp'DataType
>= :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
$c>= :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
> :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
$c> :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
<= :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
$c<= :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
< :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
$c< :: DtFetchResp'DataType -> DtFetchResp'DataType -> Bool
compare :: DtFetchResp'DataType -> DtFetchResp'DataType -> Ordering
$ccompare :: DtFetchResp'DataType -> DtFetchResp'DataType -> Ordering
$cp1Ord :: Eq DtFetchResp'DataType
Prelude.Ord)
instance Data.ProtoLens.MessageEnum DtFetchResp'DataType where
  maybeToEnum :: Int -> Maybe DtFetchResp'DataType
maybeToEnum Int
1 = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'COUNTER
  maybeToEnum Int
2 = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'SET
  maybeToEnum Int
3 = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'MAP
  maybeToEnum Int
4 = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'HLL
  maybeToEnum Int
5 = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'GSET
  maybeToEnum Int
_ = Maybe DtFetchResp'DataType
forall a. Maybe a
Prelude.Nothing
  showEnum :: DtFetchResp'DataType -> String
showEnum DtFetchResp'DataType
DtFetchResp'COUNTER = String
"COUNTER"
  showEnum DtFetchResp'DataType
DtFetchResp'SET = String
"SET"
  showEnum DtFetchResp'DataType
DtFetchResp'MAP = String
"MAP"
  showEnum DtFetchResp'DataType
DtFetchResp'HLL = String
"HLL"
  showEnum DtFetchResp'DataType
DtFetchResp'GSET = String
"GSET"
  readEnum :: String -> Maybe DtFetchResp'DataType
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"COUNTER" = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'COUNTER
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"SET" = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'SET
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"MAP" = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'MAP
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"HLL" = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'HLL
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"GSET" = DtFetchResp'DataType -> Maybe DtFetchResp'DataType
forall a. a -> Maybe a
Prelude.Just DtFetchResp'DataType
DtFetchResp'GSET
    | Bool
Prelude.otherwise
    = Maybe Int
-> (Int -> Maybe DtFetchResp'DataType)
-> Maybe DtFetchResp'DataType
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 DtFetchResp'DataType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded DtFetchResp'DataType where
  minBound :: DtFetchResp'DataType
minBound = DtFetchResp'DataType
DtFetchResp'COUNTER
  maxBound :: DtFetchResp'DataType
maxBound = DtFetchResp'DataType
DtFetchResp'GSET
instance Prelude.Enum DtFetchResp'DataType where
  toEnum :: Int -> DtFetchResp'DataType
toEnum Int
k__
    = DtFetchResp'DataType
-> (DtFetchResp'DataType -> DtFetchResp'DataType)
-> Maybe DtFetchResp'DataType
-> DtFetchResp'DataType
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> DtFetchResp'DataType
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum DataType: " (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        DtFetchResp'DataType -> DtFetchResp'DataType
forall a. a -> a
Prelude.id
        (Int -> Maybe DtFetchResp'DataType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: DtFetchResp'DataType -> Int
fromEnum DtFetchResp'DataType
DtFetchResp'COUNTER = Int
1
  fromEnum DtFetchResp'DataType
DtFetchResp'SET = Int
2
  fromEnum DtFetchResp'DataType
DtFetchResp'MAP = Int
3
  fromEnum DtFetchResp'DataType
DtFetchResp'HLL = Int
4
  fromEnum DtFetchResp'DataType
DtFetchResp'GSET = Int
5
  succ :: DtFetchResp'DataType -> DtFetchResp'DataType
succ DtFetchResp'DataType
DtFetchResp'GSET
    = String -> DtFetchResp'DataType
forall a. HasCallStack => String -> a
Prelude.error
        String
"DtFetchResp'DataType.succ: bad argument DtFetchResp'GSET. This value would be out of bounds."
  succ DtFetchResp'DataType
DtFetchResp'COUNTER = DtFetchResp'DataType
DtFetchResp'SET
  succ DtFetchResp'DataType
DtFetchResp'SET = DtFetchResp'DataType
DtFetchResp'MAP
  succ DtFetchResp'DataType
DtFetchResp'MAP = DtFetchResp'DataType
DtFetchResp'HLL
  succ DtFetchResp'DataType
DtFetchResp'HLL = DtFetchResp'DataType
DtFetchResp'GSET
  pred :: DtFetchResp'DataType -> DtFetchResp'DataType
pred DtFetchResp'DataType
DtFetchResp'COUNTER
    = String -> DtFetchResp'DataType
forall a. HasCallStack => String -> a
Prelude.error
        String
"DtFetchResp'DataType.pred: bad argument DtFetchResp'COUNTER. This value would be out of bounds."
  pred DtFetchResp'DataType
DtFetchResp'SET = DtFetchResp'DataType
DtFetchResp'COUNTER
  pred DtFetchResp'DataType
DtFetchResp'MAP = DtFetchResp'DataType
DtFetchResp'SET
  pred DtFetchResp'DataType
DtFetchResp'HLL = DtFetchResp'DataType
DtFetchResp'MAP
  pred DtFetchResp'DataType
DtFetchResp'GSET = DtFetchResp'DataType
DtFetchResp'HLL
  enumFrom :: DtFetchResp'DataType -> [DtFetchResp'DataType]
enumFrom = DtFetchResp'DataType -> [DtFetchResp'DataType]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: DtFetchResp'DataType
-> DtFetchResp'DataType -> [DtFetchResp'DataType]
enumFromTo = DtFetchResp'DataType
-> DtFetchResp'DataType -> [DtFetchResp'DataType]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: DtFetchResp'DataType
-> DtFetchResp'DataType -> [DtFetchResp'DataType]
enumFromThen = DtFetchResp'DataType
-> DtFetchResp'DataType -> [DtFetchResp'DataType]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: DtFetchResp'DataType
-> DtFetchResp'DataType
-> DtFetchResp'DataType
-> [DtFetchResp'DataType]
enumFromThenTo = DtFetchResp'DataType
-> DtFetchResp'DataType
-> DtFetchResp'DataType
-> [DtFetchResp'DataType]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault DtFetchResp'DataType where
  fieldDefault :: DtFetchResp'DataType
fieldDefault = DtFetchResp'DataType
DtFetchResp'COUNTER
instance Control.DeepSeq.NFData DtFetchResp'DataType where
  rnf :: DtFetchResp'DataType -> ()
rnf DtFetchResp'DataType
x__ = DtFetchResp'DataType -> () -> ()
Prelude.seq DtFetchResp'DataType
x__ ()
{- | Fields :
     
         * 'Proto.Riak_Fields.counterOp' @:: Lens' DtOp CounterOp@
         * 'Proto.Riak_Fields.maybe'counterOp' @:: Lens' DtOp (Prelude.Maybe CounterOp)@
         * 'Proto.Riak_Fields.setOp' @:: Lens' DtOp SetOp@
         * 'Proto.Riak_Fields.maybe'setOp' @:: Lens' DtOp (Prelude.Maybe SetOp)@
         * 'Proto.Riak_Fields.mapOp' @:: Lens' DtOp MapOp@
         * 'Proto.Riak_Fields.maybe'mapOp' @:: Lens' DtOp (Prelude.Maybe MapOp)@
         * 'Proto.Riak_Fields.hllOp' @:: Lens' DtOp HllOp@
         * 'Proto.Riak_Fields.maybe'hllOp' @:: Lens' DtOp (Prelude.Maybe HllOp)@
         * 'Proto.Riak_Fields.gsetOp' @:: Lens' DtOp GSetOp@
         * 'Proto.Riak_Fields.maybe'gsetOp' @:: Lens' DtOp (Prelude.Maybe GSetOp)@ -}
data DtOp
  = DtOp'_constructor {DtOp -> Maybe CounterOp
_DtOp'counterOp :: !(Prelude.Maybe CounterOp),
                       DtOp -> Maybe SetOp
_DtOp'setOp :: !(Prelude.Maybe SetOp),
                       DtOp -> Maybe MapOp
_DtOp'mapOp :: !(Prelude.Maybe MapOp),
                       DtOp -> Maybe HllOp
_DtOp'hllOp :: !(Prelude.Maybe HllOp),
                       DtOp -> Maybe GSetOp
_DtOp'gsetOp :: !(Prelude.Maybe GSetOp),
                       DtOp -> FieldSet
_DtOp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (DtOp -> DtOp -> Bool
(DtOp -> DtOp -> Bool) -> (DtOp -> DtOp -> Bool) -> Eq DtOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DtOp -> DtOp -> Bool
$c/= :: DtOp -> DtOp -> Bool
== :: DtOp -> DtOp -> Bool
$c== :: DtOp -> DtOp -> Bool
Prelude.Eq, Eq DtOp
Eq DtOp
-> (DtOp -> DtOp -> Ordering)
-> (DtOp -> DtOp -> Bool)
-> (DtOp -> DtOp -> Bool)
-> (DtOp -> DtOp -> Bool)
-> (DtOp -> DtOp -> Bool)
-> (DtOp -> DtOp -> DtOp)
-> (DtOp -> DtOp -> DtOp)
-> Ord DtOp
DtOp -> DtOp -> Bool
DtOp -> DtOp -> Ordering
DtOp -> DtOp -> DtOp
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 :: DtOp -> DtOp -> DtOp
$cmin :: DtOp -> DtOp -> DtOp
max :: DtOp -> DtOp -> DtOp
$cmax :: DtOp -> DtOp -> DtOp
>= :: DtOp -> DtOp -> Bool
$c>= :: DtOp -> DtOp -> Bool
> :: DtOp -> DtOp -> Bool
$c> :: DtOp -> DtOp -> Bool
<= :: DtOp -> DtOp -> Bool
$c<= :: DtOp -> DtOp -> Bool
< :: DtOp -> DtOp -> Bool
$c< :: DtOp -> DtOp -> Bool
compare :: DtOp -> DtOp -> Ordering
$ccompare :: DtOp -> DtOp -> Ordering
$cp1Ord :: Eq DtOp
Prelude.Ord)
instance Prelude.Show DtOp where
  showsPrec :: Int -> DtOp -> ShowS
showsPrec Int
_ DtOp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (DtOp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort DtOp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField DtOp "counterOp" CounterOp where
  fieldOf :: Proxy# "counterOp" -> (CounterOp -> f CounterOp) -> DtOp -> f DtOp
fieldOf Proxy# "counterOp"
_
    = ((Maybe CounterOp -> f (Maybe CounterOp)) -> DtOp -> f DtOp)
-> ((CounterOp -> f CounterOp)
    -> Maybe CounterOp -> f (Maybe CounterOp))
-> (CounterOp -> f CounterOp)
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe CounterOp)
-> (DtOp -> Maybe CounterOp -> DtOp)
-> Lens DtOp DtOp (Maybe CounterOp) (Maybe CounterOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe CounterOp
_DtOp'counterOp (\ DtOp
x__ Maybe CounterOp
y__ -> DtOp
x__ {_DtOp'counterOp :: Maybe CounterOp
_DtOp'counterOp = Maybe CounterOp
y__}))
        (CounterOp -> Lens' (Maybe CounterOp) CounterOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens CounterOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField DtOp "maybe'counterOp" (Prelude.Maybe CounterOp) where
  fieldOf :: Proxy# "maybe'counterOp"
-> (Maybe CounterOp -> f (Maybe CounterOp)) -> DtOp -> f DtOp
fieldOf Proxy# "maybe'counterOp"
_
    = ((Maybe CounterOp -> f (Maybe CounterOp)) -> DtOp -> f DtOp)
-> ((Maybe CounterOp -> f (Maybe CounterOp))
    -> Maybe CounterOp -> f (Maybe CounterOp))
-> (Maybe CounterOp -> f (Maybe CounterOp))
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe CounterOp)
-> (DtOp -> Maybe CounterOp -> DtOp)
-> Lens DtOp DtOp (Maybe CounterOp) (Maybe CounterOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe CounterOp
_DtOp'counterOp (\ DtOp
x__ Maybe CounterOp
y__ -> DtOp
x__ {_DtOp'counterOp :: Maybe CounterOp
_DtOp'counterOp = Maybe CounterOp
y__}))
        (Maybe CounterOp -> f (Maybe CounterOp))
-> Maybe CounterOp -> f (Maybe CounterOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtOp "setOp" SetOp where
  fieldOf :: Proxy# "setOp" -> (SetOp -> f SetOp) -> DtOp -> f DtOp
fieldOf Proxy# "setOp"
_
    = ((Maybe SetOp -> f (Maybe SetOp)) -> DtOp -> f DtOp)
-> ((SetOp -> f SetOp) -> Maybe SetOp -> f (Maybe SetOp))
-> (SetOp -> f SetOp)
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe SetOp)
-> (DtOp -> Maybe SetOp -> DtOp)
-> Lens DtOp DtOp (Maybe SetOp) (Maybe SetOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe SetOp
_DtOp'setOp (\ DtOp
x__ Maybe SetOp
y__ -> DtOp
x__ {_DtOp'setOp :: Maybe SetOp
_DtOp'setOp = Maybe SetOp
y__}))
        (SetOp -> Lens' (Maybe SetOp) SetOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens SetOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField DtOp "maybe'setOp" (Prelude.Maybe SetOp) where
  fieldOf :: Proxy# "maybe'setOp"
-> (Maybe SetOp -> f (Maybe SetOp)) -> DtOp -> f DtOp
fieldOf Proxy# "maybe'setOp"
_
    = ((Maybe SetOp -> f (Maybe SetOp)) -> DtOp -> f DtOp)
-> ((Maybe SetOp -> f (Maybe SetOp))
    -> Maybe SetOp -> f (Maybe SetOp))
-> (Maybe SetOp -> f (Maybe SetOp))
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe SetOp)
-> (DtOp -> Maybe SetOp -> DtOp)
-> Lens DtOp DtOp (Maybe SetOp) (Maybe SetOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe SetOp
_DtOp'setOp (\ DtOp
x__ Maybe SetOp
y__ -> DtOp
x__ {_DtOp'setOp :: Maybe SetOp
_DtOp'setOp = Maybe SetOp
y__}))
        (Maybe SetOp -> f (Maybe SetOp)) -> Maybe SetOp -> f (Maybe SetOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtOp "mapOp" MapOp where
  fieldOf :: Proxy# "mapOp" -> (MapOp -> f MapOp) -> DtOp -> f DtOp
fieldOf Proxy# "mapOp"
_
    = ((Maybe MapOp -> f (Maybe MapOp)) -> DtOp -> f DtOp)
-> ((MapOp -> f MapOp) -> Maybe MapOp -> f (Maybe MapOp))
-> (MapOp -> f MapOp)
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe MapOp)
-> (DtOp -> Maybe MapOp -> DtOp)
-> Lens DtOp DtOp (Maybe MapOp) (Maybe MapOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe MapOp
_DtOp'mapOp (\ DtOp
x__ Maybe MapOp
y__ -> DtOp
x__ {_DtOp'mapOp :: Maybe MapOp
_DtOp'mapOp = Maybe MapOp
y__}))
        (MapOp -> Lens' (Maybe MapOp) MapOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens MapOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField DtOp "maybe'mapOp" (Prelude.Maybe MapOp) where
  fieldOf :: Proxy# "maybe'mapOp"
-> (Maybe MapOp -> f (Maybe MapOp)) -> DtOp -> f DtOp
fieldOf Proxy# "maybe'mapOp"
_
    = ((Maybe MapOp -> f (Maybe MapOp)) -> DtOp -> f DtOp)
-> ((Maybe MapOp -> f (Maybe MapOp))
    -> Maybe MapOp -> f (Maybe MapOp))
-> (Maybe MapOp -> f (Maybe MapOp))
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe MapOp)
-> (DtOp -> Maybe MapOp -> DtOp)
-> Lens DtOp DtOp (Maybe MapOp) (Maybe MapOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe MapOp
_DtOp'mapOp (\ DtOp
x__ Maybe MapOp
y__ -> DtOp
x__ {_DtOp'mapOp :: Maybe MapOp
_DtOp'mapOp = Maybe MapOp
y__}))
        (Maybe MapOp -> f (Maybe MapOp)) -> Maybe MapOp -> f (Maybe MapOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtOp "hllOp" HllOp where
  fieldOf :: Proxy# "hllOp" -> (HllOp -> f HllOp) -> DtOp -> f DtOp
fieldOf Proxy# "hllOp"
_
    = ((Maybe HllOp -> f (Maybe HllOp)) -> DtOp -> f DtOp)
-> ((HllOp -> f HllOp) -> Maybe HllOp -> f (Maybe HllOp))
-> (HllOp -> f HllOp)
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe HllOp)
-> (DtOp -> Maybe HllOp -> DtOp)
-> Lens DtOp DtOp (Maybe HllOp) (Maybe HllOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe HllOp
_DtOp'hllOp (\ DtOp
x__ Maybe HllOp
y__ -> DtOp
x__ {_DtOp'hllOp :: Maybe HllOp
_DtOp'hllOp = Maybe HllOp
y__}))
        (HllOp -> Lens' (Maybe HllOp) HllOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens HllOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField DtOp "maybe'hllOp" (Prelude.Maybe HllOp) where
  fieldOf :: Proxy# "maybe'hllOp"
-> (Maybe HllOp -> f (Maybe HllOp)) -> DtOp -> f DtOp
fieldOf Proxy# "maybe'hllOp"
_
    = ((Maybe HllOp -> f (Maybe HllOp)) -> DtOp -> f DtOp)
-> ((Maybe HllOp -> f (Maybe HllOp))
    -> Maybe HllOp -> f (Maybe HllOp))
-> (Maybe HllOp -> f (Maybe HllOp))
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe HllOp)
-> (DtOp -> Maybe HllOp -> DtOp)
-> Lens DtOp DtOp (Maybe HllOp) (Maybe HllOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe HllOp
_DtOp'hllOp (\ DtOp
x__ Maybe HllOp
y__ -> DtOp
x__ {_DtOp'hllOp :: Maybe HllOp
_DtOp'hllOp = Maybe HllOp
y__}))
        (Maybe HllOp -> f (Maybe HllOp)) -> Maybe HllOp -> f (Maybe HllOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtOp "gsetOp" GSetOp where
  fieldOf :: Proxy# "gsetOp" -> (GSetOp -> f GSetOp) -> DtOp -> f DtOp
fieldOf Proxy# "gsetOp"
_
    = ((Maybe GSetOp -> f (Maybe GSetOp)) -> DtOp -> f DtOp)
-> ((GSetOp -> f GSetOp) -> Maybe GSetOp -> f (Maybe GSetOp))
-> (GSetOp -> f GSetOp)
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe GSetOp)
-> (DtOp -> Maybe GSetOp -> DtOp)
-> Lens DtOp DtOp (Maybe GSetOp) (Maybe GSetOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe GSetOp
_DtOp'gsetOp (\ DtOp
x__ Maybe GSetOp
y__ -> DtOp
x__ {_DtOp'gsetOp :: Maybe GSetOp
_DtOp'gsetOp = Maybe GSetOp
y__}))
        (GSetOp -> Lens' (Maybe GSetOp) GSetOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens GSetOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField DtOp "maybe'gsetOp" (Prelude.Maybe GSetOp) where
  fieldOf :: Proxy# "maybe'gsetOp"
-> (Maybe GSetOp -> f (Maybe GSetOp)) -> DtOp -> f DtOp
fieldOf Proxy# "maybe'gsetOp"
_
    = ((Maybe GSetOp -> f (Maybe GSetOp)) -> DtOp -> f DtOp)
-> ((Maybe GSetOp -> f (Maybe GSetOp))
    -> Maybe GSetOp -> f (Maybe GSetOp))
-> (Maybe GSetOp -> f (Maybe GSetOp))
-> DtOp
-> f DtOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtOp -> Maybe GSetOp)
-> (DtOp -> Maybe GSetOp -> DtOp)
-> Lens DtOp DtOp (Maybe GSetOp) (Maybe GSetOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtOp -> Maybe GSetOp
_DtOp'gsetOp (\ DtOp
x__ Maybe GSetOp
y__ -> DtOp
x__ {_DtOp'gsetOp :: Maybe GSetOp
_DtOp'gsetOp = Maybe GSetOp
y__}))
        (Maybe GSetOp -> f (Maybe GSetOp))
-> Maybe GSetOp -> f (Maybe GSetOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message DtOp where
  messageName :: Proxy DtOp -> Text
messageName Proxy DtOp
_ = String -> Text
Data.Text.pack String
"DtOp"
  packedMessageDescriptor :: Proxy DtOp -> ByteString
packedMessageDescriptor Proxy DtOp
_
    = ByteString
"\n\
      \\EOTDtOp\DC2)\n\
      \\n\
      \counter_op\CAN\SOH \SOH(\v2\n\
      \.CounterOpR\tcounterOp\DC2\GS\n\
      \\ACKset_op\CAN\STX \SOH(\v2\ACK.SetOpR\ENQsetOp\DC2\GS\n\
      \\ACKmap_op\CAN\ETX \SOH(\v2\ACK.MapOpR\ENQmapOp\DC2\GS\n\
      \\ACKhll_op\CAN\EOT \SOH(\v2\ACK.HllOpR\ENQhllOp\DC2 \n\
      \\agset_op\CAN\ENQ \SOH(\v2\a.GSetOpR\ACKgsetOp"
  packedFileDescriptor :: Proxy DtOp -> ByteString
packedFileDescriptor Proxy DtOp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor DtOp)
fieldsByTag
    = let
        counterOp__field_descriptor :: FieldDescriptor DtOp
counterOp__field_descriptor
          = String
-> FieldTypeDescriptor CounterOp
-> FieldAccessor DtOp CounterOp
-> FieldDescriptor DtOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"counter_op"
              (MessageOrGroup -> FieldTypeDescriptor CounterOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor CounterOp)
              (Lens DtOp DtOp (Maybe CounterOp) (Maybe CounterOp)
-> FieldAccessor DtOp CounterOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'counterOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterOp")) ::
              Data.ProtoLens.FieldDescriptor DtOp
        setOp__field_descriptor :: FieldDescriptor DtOp
setOp__field_descriptor
          = String
-> FieldTypeDescriptor SetOp
-> FieldAccessor DtOp SetOp
-> FieldDescriptor DtOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"set_op"
              (MessageOrGroup -> FieldTypeDescriptor SetOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor SetOp)
              (Lens DtOp DtOp (Maybe SetOp) (Maybe SetOp)
-> FieldAccessor DtOp SetOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'setOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'setOp")) ::
              Data.ProtoLens.FieldDescriptor DtOp
        mapOp__field_descriptor :: FieldDescriptor DtOp
mapOp__field_descriptor
          = String
-> FieldTypeDescriptor MapOp
-> FieldAccessor DtOp MapOp
-> FieldDescriptor DtOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"map_op"
              (MessageOrGroup -> FieldTypeDescriptor MapOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapOp)
              (Lens DtOp DtOp (Maybe MapOp) (Maybe MapOp)
-> FieldAccessor DtOp MapOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'mapOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'mapOp")) ::
              Data.ProtoLens.FieldDescriptor DtOp
        hllOp__field_descriptor :: FieldDescriptor DtOp
hllOp__field_descriptor
          = String
-> FieldTypeDescriptor HllOp
-> FieldAccessor DtOp HllOp
-> FieldDescriptor DtOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"hll_op"
              (MessageOrGroup -> FieldTypeDescriptor HllOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor HllOp)
              (Lens DtOp DtOp (Maybe HllOp) (Maybe HllOp)
-> FieldAccessor DtOp HllOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'hllOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hllOp")) ::
              Data.ProtoLens.FieldDescriptor DtOp
        gsetOp__field_descriptor :: FieldDescriptor DtOp
gsetOp__field_descriptor
          = String
-> FieldTypeDescriptor GSetOp
-> FieldAccessor DtOp GSetOp
-> FieldDescriptor DtOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"gset_op"
              (MessageOrGroup -> FieldTypeDescriptor GSetOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor GSetOp)
              (Lens DtOp DtOp (Maybe GSetOp) (Maybe GSetOp)
-> FieldAccessor DtOp GSetOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'gsetOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'gsetOp")) ::
              Data.ProtoLens.FieldDescriptor DtOp
      in
        [(Tag, FieldDescriptor DtOp)] -> Map Tag (FieldDescriptor DtOp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor DtOp
counterOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor DtOp
setOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor DtOp
mapOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor DtOp
hllOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor DtOp
gsetOp__field_descriptor)]
  unknownFields :: LensLike' f DtOp FieldSet
unknownFields
    = (DtOp -> FieldSet)
-> (DtOp -> FieldSet -> DtOp) -> Lens' DtOp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        DtOp -> FieldSet
_DtOp'_unknownFields
        (\ DtOp
x__ FieldSet
y__ -> DtOp
x__ {_DtOp'_unknownFields :: FieldSet
_DtOp'_unknownFields = FieldSet
y__})
  defMessage :: DtOp
defMessage
    = DtOp'_constructor :: Maybe CounterOp
-> Maybe SetOp
-> Maybe MapOp
-> Maybe HllOp
-> Maybe GSetOp
-> FieldSet
-> DtOp
DtOp'_constructor
        {_DtOp'counterOp :: Maybe CounterOp
_DtOp'counterOp = Maybe CounterOp
forall a. Maybe a
Prelude.Nothing, _DtOp'setOp :: Maybe SetOp
_DtOp'setOp = Maybe SetOp
forall a. Maybe a
Prelude.Nothing,
         _DtOp'mapOp :: Maybe MapOp
_DtOp'mapOp = Maybe MapOp
forall a. Maybe a
Prelude.Nothing, _DtOp'hllOp :: Maybe HllOp
_DtOp'hllOp = Maybe HllOp
forall a. Maybe a
Prelude.Nothing,
         _DtOp'gsetOp :: Maybe GSetOp
_DtOp'gsetOp = Maybe GSetOp
forall a. Maybe a
Prelude.Nothing, _DtOp'_unknownFields :: FieldSet
_DtOp'_unknownFields = []}
  parseMessage :: Parser DtOp
parseMessage
    = let
        loop :: DtOp -> Data.ProtoLens.Encoding.Bytes.Parser DtOp
        loop :: DtOp -> Parser DtOp
loop DtOp
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]))))
                      DtOp -> Parser DtOp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter DtOp DtOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtOp -> DtOp
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 DtOp DtOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) DtOp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do CounterOp
y <- Parser CounterOp -> String -> Parser CounterOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser CounterOp -> Parser CounterOp
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 CounterOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"counter_op"
                                DtOp -> Parser DtOp
loop
                                  (Setter DtOp DtOp CounterOp CounterOp -> CounterOp -> DtOp -> DtOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "counterOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"counterOp") CounterOp
y DtOp
x)
                        Word64
18
                          -> do SetOp
y <- Parser SetOp -> String -> Parser SetOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser SetOp -> Parser SetOp
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 SetOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"set_op"
                                DtOp -> Parser DtOp
loop (Setter DtOp DtOp SetOp SetOp -> SetOp -> DtOp -> DtOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "setOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"setOp") SetOp
y DtOp
x)
                        Word64
26
                          -> do MapOp
y <- Parser MapOp -> String -> Parser MapOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser MapOp -> Parser MapOp
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 MapOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"map_op"
                                DtOp -> Parser DtOp
loop (Setter DtOp DtOp MapOp MapOp -> MapOp -> DtOp -> DtOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "mapOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"mapOp") MapOp
y DtOp
x)
                        Word64
34
                          -> do HllOp
y <- Parser HllOp -> String -> Parser HllOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser HllOp -> Parser HllOp
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 HllOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"hll_op"
                                DtOp -> Parser DtOp
loop (Setter DtOp DtOp HllOp HllOp -> HllOp -> DtOp -> DtOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "hllOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"hllOp") HllOp
y DtOp
x)
                        Word64
42
                          -> do GSetOp
y <- Parser GSetOp -> String -> Parser GSetOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser GSetOp -> Parser GSetOp
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 GSetOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"gset_op"
                                DtOp -> Parser DtOp
loop (Setter DtOp DtOp GSetOp GSetOp -> GSetOp -> DtOp -> DtOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "gsetOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"gsetOp") GSetOp
y DtOp
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                DtOp -> Parser DtOp
loop
                                  (Setter DtOp DtOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtOp -> DtOp
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 DtOp DtOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) DtOp
x)
      in
        Parser DtOp -> String -> Parser DtOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do DtOp -> Parser DtOp
loop DtOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"DtOp"
  buildMessage :: DtOp -> Builder
buildMessage
    = \ DtOp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe CounterOp) DtOp DtOp (Maybe CounterOp) (Maybe CounterOp)
-> DtOp -> Maybe CounterOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                    (forall s a (f :: * -> *).
(HasField s "maybe'counterOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterOp") DtOp
_x
              of
                Maybe CounterOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just CounterOp
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (CounterOp -> ByteString) -> CounterOp -> 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))
                          CounterOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                          CounterOp
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike (Maybe SetOp) DtOp DtOp (Maybe SetOp) (Maybe SetOp)
-> DtOp -> Maybe SetOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'setOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'setOp") DtOp
_x
                 of
                   Maybe SetOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just SetOp
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((ByteString -> Builder)
-> (SetOp -> ByteString) -> SetOp -> 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))
                             SetOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                             SetOp
_v))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike (Maybe MapOp) DtOp DtOp (Maybe MapOp) (Maybe MapOp)
-> DtOp -> Maybe MapOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'mapOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'mapOp") DtOp
_x
                    of
                      Maybe MapOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just MapOp
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((ByteString -> Builder)
-> (MapOp -> ByteString) -> MapOp -> 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))
                                MapOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                MapOp
_v))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike (Maybe HllOp) DtOp DtOp (Maybe HllOp) (Maybe HllOp)
-> DtOp -> Maybe HllOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'hllOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hllOp") DtOp
_x
                       of
                         Maybe HllOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just HllOp
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((ByteString -> Builder)
-> (HllOp -> ByteString) -> HllOp -> 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))
                                   HllOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                   HllOp
_v))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike (Maybe GSetOp) DtOp DtOp (Maybe GSetOp) (Maybe GSetOp)
-> DtOp -> Maybe GSetOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'gsetOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'gsetOp") DtOp
_x
                          of
                            Maybe GSetOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just GSetOp
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                                   ((ByteString -> Builder)
-> (GSetOp -> ByteString) -> GSetOp -> 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))
                                      GSetOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                      GSetOp
_v))
                         (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                            (FoldLike FieldSet DtOp DtOp FieldSet FieldSet -> DtOp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet DtOp DtOp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields DtOp
_x))))))
instance Control.DeepSeq.NFData DtOp where
  rnf :: DtOp -> ()
rnf
    = \ DtOp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (DtOp -> FieldSet
_DtOp'_unknownFields DtOp
x__)
             (Maybe CounterOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (DtOp -> Maybe CounterOp
_DtOp'counterOp DtOp
x__)
                (Maybe SetOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (DtOp -> Maybe SetOp
_DtOp'setOp DtOp
x__)
                   (Maybe MapOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (DtOp -> Maybe MapOp
_DtOp'mapOp DtOp
x__)
                      (Maybe HllOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (DtOp -> Maybe HllOp
_DtOp'hllOp DtOp
x__)
                         (Maybe GSetOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (DtOp -> Maybe GSetOp
_DtOp'gsetOp DtOp
x__) ())))))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' DtUpdateReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' DtUpdateReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'key' @:: Lens' DtUpdateReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.type'' @:: Lens' DtUpdateReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.context' @:: Lens' DtUpdateReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'context' @:: Lens' DtUpdateReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.op' @:: Lens' DtUpdateReq DtOp@
         * 'Proto.Riak_Fields.w' @:: Lens' DtUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'w' @:: Lens' DtUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.dw' @:: Lens' DtUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'dw' @:: Lens' DtUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pw' @:: Lens' DtUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pw' @:: Lens' DtUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.returnBody' @:: Lens' DtUpdateReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'returnBody' @:: Lens' DtUpdateReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' DtUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' DtUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.sloppyQuorum' @:: Lens' DtUpdateReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'sloppyQuorum' @:: Lens' DtUpdateReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.nVal' @:: Lens' DtUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'nVal' @:: Lens' DtUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.includeContext' @:: Lens' DtUpdateReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'includeContext' @:: Lens' DtUpdateReq (Prelude.Maybe Prelude.Bool)@ -}
data DtUpdateReq
  = DtUpdateReq'_constructor {DtUpdateReq -> ByteString
_DtUpdateReq'bucket :: !Data.ByteString.ByteString,
                              DtUpdateReq -> Maybe ByteString
_DtUpdateReq'key :: !(Prelude.Maybe Data.ByteString.ByteString),
                              DtUpdateReq -> ByteString
_DtUpdateReq'type' :: !Data.ByteString.ByteString,
                              DtUpdateReq -> Maybe ByteString
_DtUpdateReq'context :: !(Prelude.Maybe Data.ByteString.ByteString),
                              DtUpdateReq -> DtOp
_DtUpdateReq'op :: !DtOp,
                              DtUpdateReq -> Maybe Word32
_DtUpdateReq'w :: !(Prelude.Maybe Data.Word.Word32),
                              DtUpdateReq -> Maybe Word32
_DtUpdateReq'dw :: !(Prelude.Maybe Data.Word.Word32),
                              DtUpdateReq -> Maybe Word32
_DtUpdateReq'pw :: !(Prelude.Maybe Data.Word.Word32),
                              DtUpdateReq -> Maybe Bool
_DtUpdateReq'returnBody :: !(Prelude.Maybe Prelude.Bool),
                              DtUpdateReq -> Maybe Word32
_DtUpdateReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                              DtUpdateReq -> Maybe Bool
_DtUpdateReq'sloppyQuorum :: !(Prelude.Maybe Prelude.Bool),
                              DtUpdateReq -> Maybe Word32
_DtUpdateReq'nVal :: !(Prelude.Maybe Data.Word.Word32),
                              DtUpdateReq -> Maybe Bool
_DtUpdateReq'includeContext :: !(Prelude.Maybe Prelude.Bool),
                              DtUpdateReq -> FieldSet
_DtUpdateReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (DtUpdateReq -> DtUpdateReq -> Bool
(DtUpdateReq -> DtUpdateReq -> Bool)
-> (DtUpdateReq -> DtUpdateReq -> Bool) -> Eq DtUpdateReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DtUpdateReq -> DtUpdateReq -> Bool
$c/= :: DtUpdateReq -> DtUpdateReq -> Bool
== :: DtUpdateReq -> DtUpdateReq -> Bool
$c== :: DtUpdateReq -> DtUpdateReq -> Bool
Prelude.Eq, Eq DtUpdateReq
Eq DtUpdateReq
-> (DtUpdateReq -> DtUpdateReq -> Ordering)
-> (DtUpdateReq -> DtUpdateReq -> Bool)
-> (DtUpdateReq -> DtUpdateReq -> Bool)
-> (DtUpdateReq -> DtUpdateReq -> Bool)
-> (DtUpdateReq -> DtUpdateReq -> Bool)
-> (DtUpdateReq -> DtUpdateReq -> DtUpdateReq)
-> (DtUpdateReq -> DtUpdateReq -> DtUpdateReq)
-> Ord DtUpdateReq
DtUpdateReq -> DtUpdateReq -> Bool
DtUpdateReq -> DtUpdateReq -> Ordering
DtUpdateReq -> DtUpdateReq -> DtUpdateReq
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 :: DtUpdateReq -> DtUpdateReq -> DtUpdateReq
$cmin :: DtUpdateReq -> DtUpdateReq -> DtUpdateReq
max :: DtUpdateReq -> DtUpdateReq -> DtUpdateReq
$cmax :: DtUpdateReq -> DtUpdateReq -> DtUpdateReq
>= :: DtUpdateReq -> DtUpdateReq -> Bool
$c>= :: DtUpdateReq -> DtUpdateReq -> Bool
> :: DtUpdateReq -> DtUpdateReq -> Bool
$c> :: DtUpdateReq -> DtUpdateReq -> Bool
<= :: DtUpdateReq -> DtUpdateReq -> Bool
$c<= :: DtUpdateReq -> DtUpdateReq -> Bool
< :: DtUpdateReq -> DtUpdateReq -> Bool
$c< :: DtUpdateReq -> DtUpdateReq -> Bool
compare :: DtUpdateReq -> DtUpdateReq -> Ordering
$ccompare :: DtUpdateReq -> DtUpdateReq -> Ordering
$cp1Ord :: Eq DtUpdateReq
Prelude.Ord)
instance Prelude.Show DtUpdateReq where
  showsPrec :: Int -> DtUpdateReq -> ShowS
showsPrec Int
_ DtUpdateReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (DtUpdateReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort DtUpdateReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField DtUpdateReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString) -> DtUpdateReq -> f DtUpdateReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> ByteString)
-> (DtUpdateReq -> ByteString -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> ByteString
_DtUpdateReq'bucket (\ DtUpdateReq
x__ ByteString
y__ -> DtUpdateReq
x__ {_DtUpdateReq'bucket :: ByteString
_DtUpdateReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe ByteString)
-> (DtUpdateReq -> Maybe ByteString -> DtUpdateReq)
-> Lens
     DtUpdateReq DtUpdateReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe ByteString
_DtUpdateReq'key (\ DtUpdateReq
x__ Maybe ByteString
y__ -> DtUpdateReq
x__ {_DtUpdateReq'key :: Maybe ByteString
_DtUpdateReq'key = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'key" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'key"
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateReq
-> f DtUpdateReq
fieldOf Proxy# "maybe'key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe ByteString)
-> (DtUpdateReq -> Maybe ByteString -> DtUpdateReq)
-> Lens
     DtUpdateReq DtUpdateReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe ByteString
_DtUpdateReq'key (\ DtUpdateReq
x__ Maybe ByteString
y__ -> DtUpdateReq
x__ {_DtUpdateReq'key :: Maybe ByteString
_DtUpdateReq'key = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "type'"
_
    = ((ByteString -> f ByteString) -> DtUpdateReq -> f DtUpdateReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> ByteString)
-> (DtUpdateReq -> ByteString -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> ByteString
_DtUpdateReq'type' (\ DtUpdateReq
x__ ByteString
y__ -> DtUpdateReq
x__ {_DtUpdateReq'type' :: ByteString
_DtUpdateReq'type' = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "context" Data.ByteString.ByteString where
  fieldOf :: Proxy# "context"
-> (ByteString -> f ByteString) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "context"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe ByteString)
-> (DtUpdateReq -> Maybe ByteString -> DtUpdateReq)
-> Lens
     DtUpdateReq DtUpdateReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe ByteString
_DtUpdateReq'context
           (\ DtUpdateReq
x__ Maybe ByteString
y__ -> DtUpdateReq
x__ {_DtUpdateReq'context :: Maybe ByteString
_DtUpdateReq'context = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'context" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'context"
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateReq
-> f DtUpdateReq
fieldOf Proxy# "maybe'context"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe ByteString)
-> (DtUpdateReq -> Maybe ByteString -> DtUpdateReq)
-> Lens
     DtUpdateReq DtUpdateReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe ByteString
_DtUpdateReq'context
           (\ DtUpdateReq
x__ Maybe ByteString
y__ -> DtUpdateReq
x__ {_DtUpdateReq'context :: Maybe ByteString
_DtUpdateReq'context = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "op" DtOp where
  fieldOf :: Proxy# "op" -> (DtOp -> f DtOp) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "op"
_
    = ((DtOp -> f DtOp) -> DtUpdateReq -> f DtUpdateReq)
-> ((DtOp -> f DtOp) -> DtOp -> f DtOp)
-> (DtOp -> f DtOp)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> DtOp)
-> (DtUpdateReq -> DtOp -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq DtOp DtOp
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> DtOp
_DtUpdateReq'op (\ DtUpdateReq
x__ DtOp
y__ -> DtUpdateReq
x__ {_DtUpdateReq'op :: DtOp
_DtUpdateReq'op = DtOp
y__}))
        (DtOp -> f DtOp) -> DtOp -> f DtOp
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "w" Data.Word.Word32 where
  fieldOf :: Proxy# "w" -> (Word32 -> f Word32) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "w"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'w (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'w :: Maybe Word32
_DtUpdateReq'w = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'w" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'w"
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
fieldOf Proxy# "maybe'w"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'w (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'w :: Maybe Word32
_DtUpdateReq'w = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "dw" Data.Word.Word32 where
  fieldOf :: Proxy# "dw" -> (Word32 -> f Word32) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "dw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'dw (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'dw :: Maybe Word32
_DtUpdateReq'dw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'dw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'dw"
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
fieldOf Proxy# "maybe'dw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'dw (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'dw :: Maybe Word32
_DtUpdateReq'dw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "pw" Data.Word.Word32 where
  fieldOf :: Proxy# "pw" -> (Word32 -> f Word32) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "pw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'pw (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'pw :: Maybe Word32
_DtUpdateReq'pw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'pw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pw"
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
fieldOf Proxy# "maybe'pw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'pw (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'pw :: Maybe Word32
_DtUpdateReq'pw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "returnBody" Prelude.Bool where
  fieldOf :: Proxy# "returnBody"
-> (Bool -> f Bool) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "returnBody"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Bool)
-> (DtUpdateReq -> Maybe Bool -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Bool
_DtUpdateReq'returnBody
           (\ DtUpdateReq
x__ Maybe Bool
y__ -> DtUpdateReq
x__ {_DtUpdateReq'returnBody :: Maybe Bool
_DtUpdateReq'returnBody = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.False)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'returnBody" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'returnBody"
-> (Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "maybe'returnBody"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Bool)
-> (DtUpdateReq -> Maybe Bool -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Bool
_DtUpdateReq'returnBody
           (\ DtUpdateReq
x__ Maybe Bool
y__ -> DtUpdateReq
x__ {_DtUpdateReq'returnBody :: Maybe Bool
_DtUpdateReq'returnBody = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'timeout
           (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'timeout :: Maybe Word32
_DtUpdateReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'timeout
           (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'timeout :: Maybe Word32
_DtUpdateReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "sloppyQuorum" Prelude.Bool where
  fieldOf :: Proxy# "sloppyQuorum"
-> (Bool -> f Bool) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Bool)
-> (DtUpdateReq -> Maybe Bool -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Bool
_DtUpdateReq'sloppyQuorum
           (\ DtUpdateReq
x__ Maybe Bool
y__ -> DtUpdateReq
x__ {_DtUpdateReq'sloppyQuorum :: Maybe Bool
_DtUpdateReq'sloppyQuorum = 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 DtUpdateReq "maybe'sloppyQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'sloppyQuorum"
-> (Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "maybe'sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Bool)
-> (DtUpdateReq -> Maybe Bool -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Bool
_DtUpdateReq'sloppyQuorum
           (\ DtUpdateReq
x__ Maybe Bool
y__ -> DtUpdateReq
x__ {_DtUpdateReq'sloppyQuorum :: Maybe Bool
_DtUpdateReq'sloppyQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "nVal" Data.Word.Word32 where
  fieldOf :: Proxy# "nVal"
-> (Word32 -> f Word32) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'nVal (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'nVal :: Maybe Word32
_DtUpdateReq'nVal = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'nVal" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'nVal"
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
fieldOf Proxy# "maybe'nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Word32)
-> (DtUpdateReq -> Maybe Word32 -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Word32
_DtUpdateReq'nVal (\ DtUpdateReq
x__ Maybe Word32
y__ -> DtUpdateReq
x__ {_DtUpdateReq'nVal :: Maybe Word32
_DtUpdateReq'nVal = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateReq "includeContext" Prelude.Bool where
  fieldOf :: Proxy# "includeContext"
-> (Bool -> f Bool) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "includeContext"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Bool)
-> (DtUpdateReq -> Maybe Bool -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Bool
_DtUpdateReq'includeContext
           (\ DtUpdateReq
x__ Maybe Bool
y__ -> DtUpdateReq
x__ {_DtUpdateReq'includeContext :: Maybe Bool
_DtUpdateReq'includeContext = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.True)
instance Data.ProtoLens.Field.HasField DtUpdateReq "maybe'includeContext" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'includeContext"
-> (Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq
fieldOf Proxy# "maybe'includeContext"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> DtUpdateReq -> f DtUpdateReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> DtUpdateReq
-> f DtUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateReq -> Maybe Bool)
-> (DtUpdateReq -> Maybe Bool -> DtUpdateReq)
-> Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateReq -> Maybe Bool
_DtUpdateReq'includeContext
           (\ DtUpdateReq
x__ Maybe Bool
y__ -> DtUpdateReq
x__ {_DtUpdateReq'includeContext :: Maybe Bool
_DtUpdateReq'includeContext = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message DtUpdateReq where
  messageName :: Proxy DtUpdateReq -> Text
messageName Proxy DtUpdateReq
_ = String -> Text
Data.Text.pack String
"DtUpdateReq"
  packedMessageDescriptor :: Proxy DtUpdateReq -> ByteString
packedMessageDescriptor Proxy DtUpdateReq
_
    = ByteString
"\n\
      \\vDtUpdateReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \SOH(\fR\ETXkey\DC2\DC2\n\
      \\EOTtype\CAN\ETX \STX(\fR\EOTtype\DC2\CAN\n\
      \\acontext\CAN\EOT \SOH(\fR\acontext\DC2\NAK\n\
      \\STXop\CAN\ENQ \STX(\v2\ENQ.DtOpR\STXop\DC2\f\n\
      \\SOHw\CAN\ACK \SOH(\rR\SOHw\DC2\SO\n\
      \\STXdw\CAN\a \SOH(\rR\STXdw\DC2\SO\n\
      \\STXpw\CAN\b \SOH(\rR\STXpw\DC2&\n\
      \\vreturn_body\CAN\t \SOH(\b:\ENQfalseR\n\
      \returnBody\DC2\CAN\n\
      \\atimeout\CAN\n\
      \ \SOH(\rR\atimeout\DC2#\n\
      \\rsloppy_quorum\CAN\v \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
      \\ENQn_val\CAN\f \SOH(\rR\EOTnVal\DC2-\n\
      \\SIinclude_context\CAN\r \SOH(\b:\EOTtrueR\SOincludeContext"
  packedFileDescriptor :: Proxy DtUpdateReq -> ByteString
packedFileDescriptor Proxy DtUpdateReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor DtUpdateReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor DtUpdateReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateReq ByteString
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 DtUpdateReq DtUpdateReq ByteString ByteString
-> FieldAccessor DtUpdateReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        key__field_descriptor :: FieldDescriptor DtUpdateReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateReq ByteString
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens DtUpdateReq DtUpdateReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor DtUpdateReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        type'__field_descriptor :: FieldDescriptor DtUpdateReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateReq ByteString
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (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 DtUpdateReq DtUpdateReq ByteString ByteString
-> FieldAccessor DtUpdateReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        context__field_descriptor :: FieldDescriptor DtUpdateReq
context__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateReq ByteString
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"context"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens DtUpdateReq DtUpdateReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor DtUpdateReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'context")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        op__field_descriptor :: FieldDescriptor DtUpdateReq
op__field_descriptor
          = String
-> FieldTypeDescriptor DtOp
-> FieldAccessor DtUpdateReq DtOp
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"op"
              (MessageOrGroup -> FieldTypeDescriptor DtOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor DtOp)
              (WireDefault DtOp
-> Lens DtUpdateReq DtUpdateReq DtOp DtOp
-> FieldAccessor DtUpdateReq DtOp
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault DtOp
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "op" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"op")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        w__field_descriptor :: FieldDescriptor DtUpdateReq
w__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtUpdateReq Word32
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"w"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        dw__field_descriptor :: FieldDescriptor DtUpdateReq
dw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtUpdateReq Word32
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"dw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        pw__field_descriptor :: FieldDescriptor DtUpdateReq
pw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtUpdateReq Word32
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        returnBody__field_descriptor :: FieldDescriptor DtUpdateReq
returnBody__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor DtUpdateReq Bool
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"return_body"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor DtUpdateReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnBody")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        timeout__field_descriptor :: FieldDescriptor DtUpdateReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtUpdateReq Word32
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        sloppyQuorum__field_descriptor :: FieldDescriptor DtUpdateReq
sloppyQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor DtUpdateReq Bool
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"sloppy_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor DtUpdateReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        nVal__field_descriptor :: FieldDescriptor DtUpdateReq
nVal__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor DtUpdateReq Word32
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"n_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)
              (Lens DtUpdateReq DtUpdateReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor DtUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
        includeContext__field_descriptor :: FieldDescriptor DtUpdateReq
includeContext__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor DtUpdateReq Bool
-> FieldDescriptor DtUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"include_context"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor DtUpdateReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'includeContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'includeContext")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateReq
      in
        [(Tag, FieldDescriptor DtUpdateReq)]
-> Map Tag (FieldDescriptor DtUpdateReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor DtUpdateReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor DtUpdateReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor DtUpdateReq
type'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor DtUpdateReq
context__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor DtUpdateReq
op__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor DtUpdateReq
w__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor DtUpdateReq
dw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor DtUpdateReq
pw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor DtUpdateReq
returnBody__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor DtUpdateReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor DtUpdateReq
sloppyQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
12, FieldDescriptor DtUpdateReq
nVal__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
13, FieldDescriptor DtUpdateReq
includeContext__field_descriptor)]
  unknownFields :: LensLike' f DtUpdateReq FieldSet
unknownFields
    = (DtUpdateReq -> FieldSet)
-> (DtUpdateReq -> FieldSet -> DtUpdateReq)
-> Lens' DtUpdateReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        DtUpdateReq -> FieldSet
_DtUpdateReq'_unknownFields
        (\ DtUpdateReq
x__ FieldSet
y__ -> DtUpdateReq
x__ {_DtUpdateReq'_unknownFields :: FieldSet
_DtUpdateReq'_unknownFields = FieldSet
y__})
  defMessage :: DtUpdateReq
defMessage
    = DtUpdateReq'_constructor :: ByteString
-> Maybe ByteString
-> ByteString
-> Maybe ByteString
-> DtOp
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Word32
-> Maybe Bool
-> Maybe Word32
-> Maybe Bool
-> FieldSet
-> DtUpdateReq
DtUpdateReq'_constructor
        {_DtUpdateReq'bucket :: ByteString
_DtUpdateReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _DtUpdateReq'key :: Maybe ByteString
_DtUpdateReq'key = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'type' :: ByteString
_DtUpdateReq'type' = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _DtUpdateReq'context :: Maybe ByteString
_DtUpdateReq'context = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'op :: DtOp
_DtUpdateReq'op = DtOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _DtUpdateReq'w :: Maybe Word32
_DtUpdateReq'w = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'dw :: Maybe Word32
_DtUpdateReq'dw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'pw :: Maybe Word32
_DtUpdateReq'pw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'returnBody :: Maybe Bool
_DtUpdateReq'returnBody = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'timeout :: Maybe Word32
_DtUpdateReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'sloppyQuorum :: Maybe Bool
_DtUpdateReq'sloppyQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'nVal :: Maybe Word32
_DtUpdateReq'nVal = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'includeContext :: Maybe Bool
_DtUpdateReq'includeContext = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateReq'_unknownFields :: FieldSet
_DtUpdateReq'_unknownFields = []}
  parseMessage :: Parser DtUpdateReq
parseMessage
    = let
        loop ::
          DtUpdateReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser DtUpdateReq
        loop :: DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop DtUpdateReq
x Bool
required'bucket Bool
required'op Bool
required'type'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'op then (:) String
"op" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'type' then (:) String
"type" else [String] -> [String]
forall a. a -> a
Prelude.id) []))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      DtUpdateReq -> Parser DtUpdateReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter DtUpdateReq DtUpdateReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtUpdateReq -> DtUpdateReq
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 DtUpdateReq DtUpdateReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) DtUpdateReq
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
"bucket"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq ByteString ByteString
-> ByteString -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y DtUpdateReq
x)
                                  Bool
Prelude.False
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
18
                          -> 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
"key"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq ByteString ByteString
-> ByteString -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
26
                          -> 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
"type"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq ByteString ByteString
-> ByteString -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
Prelude.False
                        Word64
34
                          -> 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
"context"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq ByteString ByteString
-> ByteString -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"context") ByteString
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
42
                          -> do DtOp
y <- Parser DtOp -> String -> Parser DtOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser DtOp -> Parser DtOp
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 DtOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"op"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq DtOp DtOp
-> DtOp -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "op" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"op") DtOp
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                                  Bool
required'type'
                        Word64
48
                          -> 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
"w"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Word32 Word32
-> Word32 -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"w") Word32
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
56
                          -> 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
"dw"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Word32 Word32
-> Word32 -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"dw") Word32
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
64
                          -> 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
"pw"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Word32 Word32
-> Word32 -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pw") Word32
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
72
                          -> 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
"return_body"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Bool Bool
-> Bool -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"returnBody") Bool
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
80
                          -> 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
"timeout"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Word32 Word32
-> Word32 -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
88
                          -> 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
"sloppy_quorum"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Bool Bool
-> Bool -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"sloppyQuorum") Bool
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
96
                          -> 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
"n_val"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Word32 Word32
-> Word32 -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nVal") Word32
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
104
                          -> 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
"include_context"
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq Bool Bool
-> Bool -> DtUpdateReq -> DtUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "includeContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"includeContext") Bool
y DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                                  (Setter DtUpdateReq DtUpdateReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtUpdateReq -> DtUpdateReq
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 DtUpdateReq DtUpdateReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) DtUpdateReq
x)
                                  Bool
required'bucket
                                  Bool
required'op
                                  Bool
required'type'
      in
        Parser DtUpdateReq -> String -> Parser DtUpdateReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do DtUpdateReq -> Bool -> Bool -> Bool -> Parser DtUpdateReq
loop
                DtUpdateReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Bool
Prelude.True)
          String
"DtUpdateReq"
  buildMessage :: DtUpdateReq -> Builder
buildMessage
    = \ DtUpdateReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString DtUpdateReq DtUpdateReq ByteString ByteString
-> DtUpdateReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") DtUpdateReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  DtUpdateReq
  DtUpdateReq
  (Maybe ByteString)
  (Maybe ByteString)
-> DtUpdateReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key") DtUpdateReq
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                      ((\ 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))
                         (FoldLike ByteString DtUpdateReq DtUpdateReq ByteString ByteString
-> DtUpdateReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") DtUpdateReq
_x)))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe ByteString)
  DtUpdateReq
  DtUpdateReq
  (Maybe ByteString)
  (Maybe ByteString)
-> DtUpdateReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'context") DtUpdateReq
_x
                       of
                         Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just ByteString
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((\ 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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                            ((ByteString -> Builder) -> (DtOp -> ByteString) -> DtOp -> 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))
                               DtOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                               (FoldLike DtOp DtUpdateReq DtUpdateReq DtOp DtOp
-> DtUpdateReq -> DtOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "op" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"op") DtUpdateReq
_x)))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe Word32)
  DtUpdateReq
  DtUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> DtUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w") DtUpdateReq
_x
                             of
                               Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Word32
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      ((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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Word32)
  DtUpdateReq
  DtUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> DtUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw") DtUpdateReq
_x
                                of
                                  Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Word32
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe Word32)
  DtUpdateReq
  DtUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> DtUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw") DtUpdateReq
_x
                                   of
                                     Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Word32
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike
  (Maybe Bool) DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
-> DtUpdateReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnBody") DtUpdateReq
_x
                                      of
                                        Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just Bool
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
72)
                                               ((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))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe Word32)
  DtUpdateReq
  DtUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> DtUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") DtUpdateReq
_x
                                         of
                                           Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just Word32
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
80)
                                                  ((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))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike
  (Maybe Bool) DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
-> DtUpdateReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")
                                                  DtUpdateReq
_x
                                            of
                                              Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Bool
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                              (case
                                                   FoldLike
  (Maybe Word32)
  DtUpdateReq
  DtUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> DtUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                     (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal") DtUpdateReq
_x
                                               of
                                                 Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                 (Prelude.Just Word32
_v)
                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
96)
                                                        ((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))
                                              (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                 (case
                                                      FoldLike
  (Maybe Bool) DtUpdateReq DtUpdateReq (Maybe Bool) (Maybe Bool)
-> DtUpdateReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                        (forall s a (f :: * -> *).
(HasField s "maybe'includeContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                           @"maybe'includeContext")
                                                        DtUpdateReq
_x
                                                  of
                                                    Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                    (Prelude.Just Bool
_v)
                                                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                              Word64
104)
                                                           ((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))
                                                 (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                                                    (FoldLike FieldSet DtUpdateReq DtUpdateReq FieldSet FieldSet
-> DtUpdateReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                       FoldLike FieldSet DtUpdateReq DtUpdateReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields DtUpdateReq
_x))))))))))))))
instance Control.DeepSeq.NFData DtUpdateReq where
  rnf :: DtUpdateReq -> ()
rnf
    = \ DtUpdateReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (DtUpdateReq -> FieldSet
_DtUpdateReq'_unknownFields DtUpdateReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (DtUpdateReq -> ByteString
_DtUpdateReq'bucket DtUpdateReq
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (DtUpdateReq -> Maybe ByteString
_DtUpdateReq'key DtUpdateReq
x__)
                   (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (DtUpdateReq -> ByteString
_DtUpdateReq'type' DtUpdateReq
x__)
                      (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (DtUpdateReq -> Maybe ByteString
_DtUpdateReq'context DtUpdateReq
x__)
                         (DtOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (DtUpdateReq -> DtOp
_DtUpdateReq'op DtUpdateReq
x__)
                            (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (DtUpdateReq -> Maybe Word32
_DtUpdateReq'w DtUpdateReq
x__)
                               (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (DtUpdateReq -> Maybe Word32
_DtUpdateReq'dw DtUpdateReq
x__)
                                  (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (DtUpdateReq -> Maybe Word32
_DtUpdateReq'pw DtUpdateReq
x__)
                                     (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (DtUpdateReq -> Maybe Bool
_DtUpdateReq'returnBody DtUpdateReq
x__)
                                        (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (DtUpdateReq -> Maybe Word32
_DtUpdateReq'timeout DtUpdateReq
x__)
                                           (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (DtUpdateReq -> Maybe Bool
_DtUpdateReq'sloppyQuorum DtUpdateReq
x__)
                                              (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                 (DtUpdateReq -> Maybe Word32
_DtUpdateReq'nVal DtUpdateReq
x__)
                                                 (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                    (DtUpdateReq -> Maybe Bool
_DtUpdateReq'includeContext DtUpdateReq
x__)
                                                    ())))))))))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.key' @:: Lens' DtUpdateResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'key' @:: Lens' DtUpdateResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.context' @:: Lens' DtUpdateResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'context' @:: Lens' DtUpdateResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.counterValue' @:: Lens' DtUpdateResp Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'counterValue' @:: Lens' DtUpdateResp (Prelude.Maybe Data.Int.Int64)@
         * 'Proto.Riak_Fields.setValue' @:: Lens' DtUpdateResp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'setValue' @:: Lens' DtUpdateResp (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.mapValue' @:: Lens' DtUpdateResp [MapEntry]@
         * 'Proto.Riak_Fields.vec'mapValue' @:: Lens' DtUpdateResp (Data.Vector.Vector MapEntry)@
         * 'Proto.Riak_Fields.hllValue' @:: Lens' DtUpdateResp Data.Word.Word64@
         * 'Proto.Riak_Fields.maybe'hllValue' @:: Lens' DtUpdateResp (Prelude.Maybe Data.Word.Word64)@
         * 'Proto.Riak_Fields.gsetValue' @:: Lens' DtUpdateResp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'gsetValue' @:: Lens' DtUpdateResp (Data.Vector.Vector Data.ByteString.ByteString)@ -}
data DtUpdateResp
  = DtUpdateResp'_constructor {DtUpdateResp -> Maybe ByteString
_DtUpdateResp'key :: !(Prelude.Maybe Data.ByteString.ByteString),
                               DtUpdateResp -> Maybe ByteString
_DtUpdateResp'context :: !(Prelude.Maybe Data.ByteString.ByteString),
                               DtUpdateResp -> Maybe Int64
_DtUpdateResp'counterValue :: !(Prelude.Maybe Data.Int.Int64),
                               DtUpdateResp -> Vector ByteString
_DtUpdateResp'setValue :: !(Data.Vector.Vector Data.ByteString.ByteString),
                               DtUpdateResp -> Vector MapEntry
_DtUpdateResp'mapValue :: !(Data.Vector.Vector MapEntry),
                               DtUpdateResp -> Maybe Word64
_DtUpdateResp'hllValue :: !(Prelude.Maybe Data.Word.Word64),
                               DtUpdateResp -> Vector ByteString
_DtUpdateResp'gsetValue :: !(Data.Vector.Vector Data.ByteString.ByteString),
                               DtUpdateResp -> FieldSet
_DtUpdateResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (DtUpdateResp -> DtUpdateResp -> Bool
(DtUpdateResp -> DtUpdateResp -> Bool)
-> (DtUpdateResp -> DtUpdateResp -> Bool) -> Eq DtUpdateResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DtUpdateResp -> DtUpdateResp -> Bool
$c/= :: DtUpdateResp -> DtUpdateResp -> Bool
== :: DtUpdateResp -> DtUpdateResp -> Bool
$c== :: DtUpdateResp -> DtUpdateResp -> Bool
Prelude.Eq, Eq DtUpdateResp
Eq DtUpdateResp
-> (DtUpdateResp -> DtUpdateResp -> Ordering)
-> (DtUpdateResp -> DtUpdateResp -> Bool)
-> (DtUpdateResp -> DtUpdateResp -> Bool)
-> (DtUpdateResp -> DtUpdateResp -> Bool)
-> (DtUpdateResp -> DtUpdateResp -> Bool)
-> (DtUpdateResp -> DtUpdateResp -> DtUpdateResp)
-> (DtUpdateResp -> DtUpdateResp -> DtUpdateResp)
-> Ord DtUpdateResp
DtUpdateResp -> DtUpdateResp -> Bool
DtUpdateResp -> DtUpdateResp -> Ordering
DtUpdateResp -> DtUpdateResp -> DtUpdateResp
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 :: DtUpdateResp -> DtUpdateResp -> DtUpdateResp
$cmin :: DtUpdateResp -> DtUpdateResp -> DtUpdateResp
max :: DtUpdateResp -> DtUpdateResp -> DtUpdateResp
$cmax :: DtUpdateResp -> DtUpdateResp -> DtUpdateResp
>= :: DtUpdateResp -> DtUpdateResp -> Bool
$c>= :: DtUpdateResp -> DtUpdateResp -> Bool
> :: DtUpdateResp -> DtUpdateResp -> Bool
$c> :: DtUpdateResp -> DtUpdateResp -> Bool
<= :: DtUpdateResp -> DtUpdateResp -> Bool
$c<= :: DtUpdateResp -> DtUpdateResp -> Bool
< :: DtUpdateResp -> DtUpdateResp -> Bool
$c< :: DtUpdateResp -> DtUpdateResp -> Bool
compare :: DtUpdateResp -> DtUpdateResp -> Ordering
$ccompare :: DtUpdateResp -> DtUpdateResp -> Ordering
$cp1Ord :: Eq DtUpdateResp
Prelude.Ord)
instance Prelude.Show DtUpdateResp where
  showsPrec :: Int -> DtUpdateResp -> ShowS
showsPrec Int
_ DtUpdateResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (DtUpdateResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort DtUpdateResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField DtUpdateResp "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> DtUpdateResp -> f DtUpdateResp
fieldOf Proxy# "key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe ByteString)
-> (DtUpdateResp -> Maybe ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe ByteString
_DtUpdateResp'key (\ DtUpdateResp
x__ Maybe ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'key :: Maybe ByteString
_DtUpdateResp'key = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateResp "maybe'key" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'key"
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "maybe'key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe ByteString)
-> (DtUpdateResp -> Maybe ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe ByteString
_DtUpdateResp'key (\ DtUpdateResp
x__ Maybe ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'key :: Maybe ByteString
_DtUpdateResp'key = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateResp "context" Data.ByteString.ByteString where
  fieldOf :: Proxy# "context"
-> (ByteString -> f ByteString) -> DtUpdateResp -> f DtUpdateResp
fieldOf Proxy# "context"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe ByteString)
-> (DtUpdateResp -> Maybe ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe ByteString
_DtUpdateResp'context
           (\ DtUpdateResp
x__ Maybe ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'context :: Maybe ByteString
_DtUpdateResp'context = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateResp "maybe'context" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'context"
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "maybe'context"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe ByteString)
-> (DtUpdateResp -> Maybe ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe ByteString
_DtUpdateResp'context
           (\ DtUpdateResp
x__ Maybe ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'context :: Maybe ByteString
_DtUpdateResp'context = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateResp "counterValue" Data.Int.Int64 where
  fieldOf :: Proxy# "counterValue"
-> (Int64 -> f Int64) -> DtUpdateResp -> f DtUpdateResp
fieldOf Proxy# "counterValue"
_
    = ((Maybe Int64 -> f (Maybe Int64))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe Int64)
-> (DtUpdateResp -> Maybe Int64 -> DtUpdateResp)
-> Lens DtUpdateResp DtUpdateResp (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe Int64
_DtUpdateResp'counterValue
           (\ DtUpdateResp
x__ Maybe Int64
y__ -> DtUpdateResp
x__ {_DtUpdateResp'counterValue :: Maybe Int64
_DtUpdateResp'counterValue = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateResp "maybe'counterValue" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'counterValue"
-> (Maybe Int64 -> f (Maybe Int64))
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "maybe'counterValue"
_
    = ((Maybe Int64 -> f (Maybe Int64))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe Int64)
-> (DtUpdateResp -> Maybe Int64 -> DtUpdateResp)
-> Lens DtUpdateResp DtUpdateResp (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe Int64
_DtUpdateResp'counterValue
           (\ DtUpdateResp
x__ Maybe Int64
y__ -> DtUpdateResp
x__ {_DtUpdateResp'counterValue :: Maybe Int64
_DtUpdateResp'counterValue = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateResp "setValue" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "setValue"
-> ([ByteString] -> f [ByteString])
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "setValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Vector ByteString)
-> (DtUpdateResp -> Vector ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Vector ByteString
_DtUpdateResp'setValue
           (\ DtUpdateResp
x__ Vector ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'setValue :: Vector ByteString
_DtUpdateResp'setValue = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField DtUpdateResp "vec'setValue" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'setValue"
-> (Vector ByteString -> f (Vector ByteString))
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "vec'setValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Vector ByteString)
-> (DtUpdateResp -> Vector ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Vector ByteString
_DtUpdateResp'setValue
           (\ DtUpdateResp
x__ Vector ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'setValue :: Vector ByteString
_DtUpdateResp'setValue = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateResp "mapValue" [MapEntry] where
  fieldOf :: Proxy# "mapValue"
-> ([MapEntry] -> f [MapEntry]) -> DtUpdateResp -> f DtUpdateResp
fieldOf Proxy# "mapValue"
_
    = ((Vector MapEntry -> f (Vector MapEntry))
 -> DtUpdateResp -> f DtUpdateResp)
-> (([MapEntry] -> f [MapEntry])
    -> Vector MapEntry -> f (Vector MapEntry))
-> ([MapEntry] -> f [MapEntry])
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Vector MapEntry)
-> (DtUpdateResp -> Vector MapEntry -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Vector MapEntry) (Vector MapEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Vector MapEntry
_DtUpdateResp'mapValue
           (\ DtUpdateResp
x__ Vector MapEntry
y__ -> DtUpdateResp
x__ {_DtUpdateResp'mapValue :: Vector MapEntry
_DtUpdateResp'mapValue = Vector MapEntry
y__}))
        ((Vector MapEntry -> [MapEntry])
-> (Vector MapEntry -> [MapEntry] -> Vector MapEntry)
-> Lens (Vector MapEntry) (Vector MapEntry) [MapEntry] [MapEntry]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector MapEntry -> [MapEntry]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector MapEntry
_ [MapEntry]
y__ -> [MapEntry] -> Vector MapEntry
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [MapEntry]
y__))
instance Data.ProtoLens.Field.HasField DtUpdateResp "vec'mapValue" (Data.Vector.Vector MapEntry) where
  fieldOf :: Proxy# "vec'mapValue"
-> (Vector MapEntry -> f (Vector MapEntry))
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "vec'mapValue"
_
    = ((Vector MapEntry -> f (Vector MapEntry))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Vector MapEntry -> f (Vector MapEntry))
    -> Vector MapEntry -> f (Vector MapEntry))
-> (Vector MapEntry -> f (Vector MapEntry))
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Vector MapEntry)
-> (DtUpdateResp -> Vector MapEntry -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Vector MapEntry) (Vector MapEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Vector MapEntry
_DtUpdateResp'mapValue
           (\ DtUpdateResp
x__ Vector MapEntry
y__ -> DtUpdateResp
x__ {_DtUpdateResp'mapValue :: Vector MapEntry
_DtUpdateResp'mapValue = Vector MapEntry
y__}))
        (Vector MapEntry -> f (Vector MapEntry))
-> Vector MapEntry -> f (Vector MapEntry)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateResp "hllValue" Data.Word.Word64 where
  fieldOf :: Proxy# "hllValue"
-> (Word64 -> f Word64) -> DtUpdateResp -> f DtUpdateResp
fieldOf Proxy# "hllValue"
_
    = ((Maybe Word64 -> f (Maybe Word64))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Word64 -> f Word64) -> Maybe Word64 -> f (Maybe Word64))
-> (Word64 -> f Word64)
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe Word64)
-> (DtUpdateResp -> Maybe Word64 -> DtUpdateResp)
-> Lens DtUpdateResp DtUpdateResp (Maybe Word64) (Maybe Word64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe Word64
_DtUpdateResp'hllValue
           (\ DtUpdateResp
x__ Maybe Word64
y__ -> DtUpdateResp
x__ {_DtUpdateResp'hllValue :: Maybe Word64
_DtUpdateResp'hllValue = Maybe Word64
y__}))
        (Word64 -> Lens' (Maybe Word64) Word64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtUpdateResp "maybe'hllValue" (Prelude.Maybe Data.Word.Word64) where
  fieldOf :: Proxy# "maybe'hllValue"
-> (Maybe Word64 -> f (Maybe Word64))
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "maybe'hllValue"
_
    = ((Maybe Word64 -> f (Maybe Word64))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Maybe Word64 -> f (Maybe Word64))
    -> Maybe Word64 -> f (Maybe Word64))
-> (Maybe Word64 -> f (Maybe Word64))
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Maybe Word64)
-> (DtUpdateResp -> Maybe Word64 -> DtUpdateResp)
-> Lens DtUpdateResp DtUpdateResp (Maybe Word64) (Maybe Word64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Maybe Word64
_DtUpdateResp'hllValue
           (\ DtUpdateResp
x__ Maybe Word64
y__ -> DtUpdateResp
x__ {_DtUpdateResp'hllValue :: Maybe Word64
_DtUpdateResp'hllValue = Maybe Word64
y__}))
        (Maybe Word64 -> f (Maybe Word64))
-> Maybe Word64 -> f (Maybe Word64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtUpdateResp "gsetValue" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "gsetValue"
-> ([ByteString] -> f [ByteString])
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "gsetValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Vector ByteString)
-> (DtUpdateResp -> Vector ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Vector ByteString
_DtUpdateResp'gsetValue
           (\ DtUpdateResp
x__ Vector ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'gsetValue :: Vector ByteString
_DtUpdateResp'gsetValue = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField DtUpdateResp "vec'gsetValue" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'gsetValue"
-> (Vector ByteString -> f (Vector ByteString))
-> DtUpdateResp
-> f DtUpdateResp
fieldOf Proxy# "vec'gsetValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtUpdateResp -> f DtUpdateResp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> DtUpdateResp
-> f DtUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtUpdateResp -> Vector ByteString)
-> (DtUpdateResp -> Vector ByteString -> DtUpdateResp)
-> Lens
     DtUpdateResp DtUpdateResp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtUpdateResp -> Vector ByteString
_DtUpdateResp'gsetValue
           (\ DtUpdateResp
x__ Vector ByteString
y__ -> DtUpdateResp
x__ {_DtUpdateResp'gsetValue :: Vector ByteString
_DtUpdateResp'gsetValue = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message DtUpdateResp where
  messageName :: Proxy DtUpdateResp -> Text
messageName Proxy DtUpdateResp
_ = String -> Text
Data.Text.pack String
"DtUpdateResp"
  packedMessageDescriptor :: Proxy DtUpdateResp -> ByteString
packedMessageDescriptor Proxy DtUpdateResp
_
    = ByteString
"\n\
      \\fDtUpdateResp\DC2\DLE\n\
      \\ETXkey\CAN\SOH \SOH(\fR\ETXkey\DC2\CAN\n\
      \\acontext\CAN\STX \SOH(\fR\acontext\DC2#\n\
      \\rcounter_value\CAN\ETX \SOH(\DC2R\fcounterValue\DC2\ESC\n\
      \\tset_value\CAN\EOT \ETX(\fR\bsetValue\DC2&\n\
      \\tmap_value\CAN\ENQ \ETX(\v2\t.MapEntryR\bmapValue\DC2\ESC\n\
      \\thll_value\CAN\ACK \SOH(\EOTR\bhllValue\DC2\GS\n\
      \\n\
      \gset_value\CAN\a \ETX(\fR\tgsetValue"
  packedFileDescriptor :: Proxy DtUpdateResp -> ByteString
packedFileDescriptor Proxy DtUpdateResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor DtUpdateResp)
fieldsByTag
    = let
        key__field_descriptor :: FieldDescriptor DtUpdateResp
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateResp ByteString
-> FieldDescriptor DtUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  DtUpdateResp DtUpdateResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor DtUpdateResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateResp
        context__field_descriptor :: FieldDescriptor DtUpdateResp
context__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateResp ByteString
-> FieldDescriptor DtUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"context"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  DtUpdateResp DtUpdateResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor DtUpdateResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'context")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateResp
        counterValue__field_descriptor :: FieldDescriptor DtUpdateResp
counterValue__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor DtUpdateResp Int64
-> FieldDescriptor DtUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"counter_value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens DtUpdateResp DtUpdateResp (Maybe Int64) (Maybe Int64)
-> FieldAccessor DtUpdateResp Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterValue")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateResp
        setValue__field_descriptor :: FieldDescriptor DtUpdateResp
setValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateResp ByteString
-> FieldDescriptor DtUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"set_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' DtUpdateResp [ByteString]
-> FieldAccessor DtUpdateResp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"setValue")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateResp
        mapValue__field_descriptor :: FieldDescriptor DtUpdateResp
mapValue__field_descriptor
          = String
-> FieldTypeDescriptor MapEntry
-> FieldAccessor DtUpdateResp MapEntry
-> FieldDescriptor DtUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"map_value"
              (MessageOrGroup -> FieldTypeDescriptor MapEntry
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapEntry)
              (Packing
-> Lens' DtUpdateResp [MapEntry]
-> FieldAccessor DtUpdateResp MapEntry
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"mapValue")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateResp
        hllValue__field_descriptor :: FieldDescriptor DtUpdateResp
hllValue__field_descriptor
          = String
-> FieldTypeDescriptor Word64
-> FieldAccessor DtUpdateResp Word64
-> FieldDescriptor DtUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"hll_value"
              (ScalarField Word64 -> FieldTypeDescriptor Word64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word64
Data.ProtoLens.UInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64)
              (Lens DtUpdateResp DtUpdateResp (Maybe Word64) (Maybe Word64)
-> FieldAccessor DtUpdateResp Word64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'hllValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hllValue")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateResp
        gsetValue__field_descriptor :: FieldDescriptor DtUpdateResp
gsetValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtUpdateResp ByteString
-> FieldDescriptor DtUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"gset_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' DtUpdateResp [ByteString]
-> FieldAccessor DtUpdateResp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "gsetValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"gsetValue")) ::
              Data.ProtoLens.FieldDescriptor DtUpdateResp
      in
        [(Tag, FieldDescriptor DtUpdateResp)]
-> Map Tag (FieldDescriptor DtUpdateResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor DtUpdateResp
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor DtUpdateResp
context__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor DtUpdateResp
counterValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor DtUpdateResp
setValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor DtUpdateResp
mapValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor DtUpdateResp
hllValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor DtUpdateResp
gsetValue__field_descriptor)]
  unknownFields :: LensLike' f DtUpdateResp FieldSet
unknownFields
    = (DtUpdateResp -> FieldSet)
-> (DtUpdateResp -> FieldSet -> DtUpdateResp)
-> Lens' DtUpdateResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        DtUpdateResp -> FieldSet
_DtUpdateResp'_unknownFields
        (\ DtUpdateResp
x__ FieldSet
y__ -> DtUpdateResp
x__ {_DtUpdateResp'_unknownFields :: FieldSet
_DtUpdateResp'_unknownFields = FieldSet
y__})
  defMessage :: DtUpdateResp
defMessage
    = DtUpdateResp'_constructor :: Maybe ByteString
-> Maybe ByteString
-> Maybe Int64
-> Vector ByteString
-> Vector MapEntry
-> Maybe Word64
-> Vector ByteString
-> FieldSet
-> DtUpdateResp
DtUpdateResp'_constructor
        {_DtUpdateResp'key :: Maybe ByteString
_DtUpdateResp'key = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateResp'context :: Maybe ByteString
_DtUpdateResp'context = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateResp'counterValue :: Maybe Int64
_DtUpdateResp'counterValue = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateResp'setValue :: Vector ByteString
_DtUpdateResp'setValue = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _DtUpdateResp'mapValue :: Vector MapEntry
_DtUpdateResp'mapValue = Vector MapEntry
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _DtUpdateResp'hllValue :: Maybe Word64
_DtUpdateResp'hllValue = Maybe Word64
forall a. Maybe a
Prelude.Nothing,
         _DtUpdateResp'gsetValue :: Vector ByteString
_DtUpdateResp'gsetValue = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _DtUpdateResp'_unknownFields :: FieldSet
_DtUpdateResp'_unknownFields = []}
  parseMessage :: Parser DtUpdateResp
parseMessage
    = let
        loop ::
          DtUpdateResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld MapEntry
                -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
                   -> Data.ProtoLens.Encoding.Bytes.Parser DtUpdateResp
        loop :: DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop DtUpdateResp
x Growing Vector RealWorld ByteString
mutable'gsetValue Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
mutable'setValue
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'gsetValue <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                            (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'gsetValue)
                      Vector MapEntry
frozen'mapValue <- IO (Vector MapEntry) -> Parser (Vector MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) MapEntry -> IO (Vector MapEntry)
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 MapEntry
Growing Vector (PrimState IO) MapEntry
mutable'mapValue)
                      Vector ByteString
frozen'setValue <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'setValue)
                      (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]))))
                      DtUpdateResp -> Parser DtUpdateResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter DtUpdateResp DtUpdateResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtUpdateResp -> DtUpdateResp
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 DtUpdateResp DtUpdateResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  DtUpdateResp DtUpdateResp (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> DtUpdateResp -> DtUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'gsetValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'gsetValue")
                              Vector ByteString
frozen'gsetValue
                              (Setter
  DtUpdateResp DtUpdateResp (Vector MapEntry) (Vector MapEntry)
-> Vector MapEntry -> DtUpdateResp -> DtUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'mapValue")
                                 Vector MapEntry
frozen'mapValue
                                 (Setter
  DtUpdateResp DtUpdateResp (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> DtUpdateResp -> DtUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                    (forall s a (f :: * -> *).
(HasField s "vec'setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'setValue")
                                    Vector ByteString
frozen'setValue
                                    DtUpdateResp
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
"key"
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop
                                  (Setter DtUpdateResp DtUpdateResp ByteString ByteString
-> ByteString -> DtUpdateResp -> DtUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y DtUpdateResp
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
18
                          -> 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
"context"
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop
                                  (Setter DtUpdateResp DtUpdateResp ByteString ByteString
-> ByteString -> DtUpdateResp -> DtUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"context") ByteString
y DtUpdateResp
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
24
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"counter_value"
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop
                                  (Setter DtUpdateResp DtUpdateResp Int64 Int64
-> Int64 -> DtUpdateResp -> DtUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"counterValue") Int64
y DtUpdateResp
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
34
                          -> 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
"set_value"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'setValue ByteString
y)
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop DtUpdateResp
x Growing Vector RealWorld ByteString
mutable'gsetValue Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
v
                        Word64
42
                          -> do !MapEntry
y <- Parser MapEntry -> String -> Parser MapEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser MapEntry -> Parser MapEntry
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 MapEntry
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"map_value"
                                Growing Vector RealWorld MapEntry
v <- IO (Growing Vector RealWorld MapEntry)
-> Parser (Growing Vector RealWorld MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) MapEntry
-> MapEntry -> IO (Growing Vector (PrimState IO) MapEntry)
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 MapEntry
Growing Vector (PrimState IO) MapEntry
mutable'mapValue MapEntry
y)
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop DtUpdateResp
x Growing Vector RealWorld ByteString
mutable'gsetValue Growing Vector RealWorld MapEntry
v Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
48
                          -> 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
"hll_value"
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop
                                  (Setter DtUpdateResp DtUpdateResp Word64 Word64
-> Word64 -> DtUpdateResp -> DtUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "hllValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"hllValue") Word64
y DtUpdateResp
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
58
                          -> 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
"gset_value"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'gsetValue ByteString
y)
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop DtUpdateResp
x Growing Vector RealWorld ByteString
v Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop
                                  (Setter DtUpdateResp DtUpdateResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtUpdateResp -> DtUpdateResp
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 DtUpdateResp DtUpdateResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) DtUpdateResp
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
      in
        Parser DtUpdateResp -> String -> Parser DtUpdateResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'gsetValue <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                     IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld MapEntry
mutable'mapValue <- IO (Growing Vector RealWorld MapEntry)
-> Parser (Growing Vector RealWorld MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld MapEntry)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld ByteString
mutable'setValue <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              DtUpdateResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtUpdateResp
loop
                DtUpdateResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage
                Growing Vector RealWorld ByteString
mutable'gsetValue
                Growing Vector RealWorld MapEntry
mutable'mapValue
                Growing Vector RealWorld ByteString
mutable'setValue)
          String
"DtUpdateResp"
  buildMessage :: DtUpdateResp -> Builder
buildMessage
    = \ DtUpdateResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe ByteString)
  DtUpdateResp
  DtUpdateResp
  (Maybe ByteString)
  (Maybe ByteString)
-> DtUpdateResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key") DtUpdateResp
_x
              of
                Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just ByteString
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  DtUpdateResp
  DtUpdateResp
  (Maybe ByteString)
  (Maybe ByteString)
-> DtUpdateResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'context" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'context") DtUpdateResp
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Int64) DtUpdateResp DtUpdateResp (Maybe Int64) (Maybe Int64)
-> DtUpdateResp -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterValue") DtUpdateResp
_x
                    of
                      Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Int64
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                   Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                                Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                                Int64
_v))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                         (\ ByteString
_v
                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                 ((\ 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))
                         (FoldLike
  (Vector ByteString)
  DtUpdateResp
  DtUpdateResp
  (Vector ByteString)
  (Vector ByteString)
-> DtUpdateResp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                            (forall s a (f :: * -> *).
(HasField s "vec'setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'setValue") DtUpdateResp
_x))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         ((MapEntry -> Builder) -> Vector MapEntry -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                            (\ MapEntry
_v
                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                                    ((ByteString -> Builder)
-> (MapEntry -> ByteString) -> MapEntry -> 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))
                                       MapEntry -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                       MapEntry
_v))
                            (FoldLike
  (Vector MapEntry)
  DtUpdateResp
  DtUpdateResp
  (Vector MapEntry)
  (Vector MapEntry)
-> DtUpdateResp -> Vector MapEntry
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                               (forall s a (f :: * -> *).
(HasField s "vec'mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'mapValue") DtUpdateResp
_x))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe Word64)
  DtUpdateResp
  DtUpdateResp
  (Maybe Word64)
  (Maybe Word64)
-> DtUpdateResp -> Maybe Word64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'hllValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hllValue") DtUpdateResp
_x
                             of
                               Maybe Word64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Word64
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
_v))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                                  (\ ByteString
_v
                                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
58)
                                          ((\ 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))
                                  (FoldLike
  (Vector ByteString)
  DtUpdateResp
  DtUpdateResp
  (Vector ByteString)
  (Vector ByteString)
-> DtUpdateResp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                     (forall s a (f :: * -> *).
(HasField s "vec'gsetValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'gsetValue") DtUpdateResp
_x))
                               (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                                  (FoldLike FieldSet DtUpdateResp DtUpdateResp FieldSet FieldSet
-> DtUpdateResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet DtUpdateResp DtUpdateResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields DtUpdateResp
_x))))))))
instance Control.DeepSeq.NFData DtUpdateResp where
  rnf :: DtUpdateResp -> ()
rnf
    = \ DtUpdateResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (DtUpdateResp -> FieldSet
_DtUpdateResp'_unknownFields DtUpdateResp
x__)
             (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (DtUpdateResp -> Maybe ByteString
_DtUpdateResp'key DtUpdateResp
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (DtUpdateResp -> Maybe ByteString
_DtUpdateResp'context DtUpdateResp
x__)
                   (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (DtUpdateResp -> Maybe Int64
_DtUpdateResp'counterValue DtUpdateResp
x__)
                      (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (DtUpdateResp -> Vector ByteString
_DtUpdateResp'setValue DtUpdateResp
x__)
                         (Vector MapEntry -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (DtUpdateResp -> Vector MapEntry
_DtUpdateResp'mapValue DtUpdateResp
x__)
                            (Maybe Word64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (DtUpdateResp -> Maybe Word64
_DtUpdateResp'hllValue DtUpdateResp
x__)
                               (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (DtUpdateResp -> Vector ByteString
_DtUpdateResp'gsetValue DtUpdateResp
x__) ())))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.counterValue' @:: Lens' DtValue Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'counterValue' @:: Lens' DtValue (Prelude.Maybe Data.Int.Int64)@
         * 'Proto.Riak_Fields.setValue' @:: Lens' DtValue [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'setValue' @:: Lens' DtValue (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.mapValue' @:: Lens' DtValue [MapEntry]@
         * 'Proto.Riak_Fields.vec'mapValue' @:: Lens' DtValue (Data.Vector.Vector MapEntry)@
         * 'Proto.Riak_Fields.hllValue' @:: Lens' DtValue Data.Word.Word64@
         * 'Proto.Riak_Fields.maybe'hllValue' @:: Lens' DtValue (Prelude.Maybe Data.Word.Word64)@
         * 'Proto.Riak_Fields.gsetValue' @:: Lens' DtValue [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'gsetValue' @:: Lens' DtValue (Data.Vector.Vector Data.ByteString.ByteString)@ -}
data DtValue
  = DtValue'_constructor {DtValue -> Maybe Int64
_DtValue'counterValue :: !(Prelude.Maybe Data.Int.Int64),
                          DtValue -> Vector ByteString
_DtValue'setValue :: !(Data.Vector.Vector Data.ByteString.ByteString),
                          DtValue -> Vector MapEntry
_DtValue'mapValue :: !(Data.Vector.Vector MapEntry),
                          DtValue -> Maybe Word64
_DtValue'hllValue :: !(Prelude.Maybe Data.Word.Word64),
                          DtValue -> Vector ByteString
_DtValue'gsetValue :: !(Data.Vector.Vector Data.ByteString.ByteString),
                          DtValue -> FieldSet
_DtValue'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (DtValue -> DtValue -> Bool
(DtValue -> DtValue -> Bool)
-> (DtValue -> DtValue -> Bool) -> Eq DtValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DtValue -> DtValue -> Bool
$c/= :: DtValue -> DtValue -> Bool
== :: DtValue -> DtValue -> Bool
$c== :: DtValue -> DtValue -> Bool
Prelude.Eq, Eq DtValue
Eq DtValue
-> (DtValue -> DtValue -> Ordering)
-> (DtValue -> DtValue -> Bool)
-> (DtValue -> DtValue -> Bool)
-> (DtValue -> DtValue -> Bool)
-> (DtValue -> DtValue -> Bool)
-> (DtValue -> DtValue -> DtValue)
-> (DtValue -> DtValue -> DtValue)
-> Ord DtValue
DtValue -> DtValue -> Bool
DtValue -> DtValue -> Ordering
DtValue -> DtValue -> DtValue
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 :: DtValue -> DtValue -> DtValue
$cmin :: DtValue -> DtValue -> DtValue
max :: DtValue -> DtValue -> DtValue
$cmax :: DtValue -> DtValue -> DtValue
>= :: DtValue -> DtValue -> Bool
$c>= :: DtValue -> DtValue -> Bool
> :: DtValue -> DtValue -> Bool
$c> :: DtValue -> DtValue -> Bool
<= :: DtValue -> DtValue -> Bool
$c<= :: DtValue -> DtValue -> Bool
< :: DtValue -> DtValue -> Bool
$c< :: DtValue -> DtValue -> Bool
compare :: DtValue -> DtValue -> Ordering
$ccompare :: DtValue -> DtValue -> Ordering
$cp1Ord :: Eq DtValue
Prelude.Ord)
instance Prelude.Show DtValue where
  showsPrec :: Int -> DtValue -> ShowS
showsPrec Int
_ DtValue
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (DtValue -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort DtValue
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField DtValue "counterValue" Data.Int.Int64 where
  fieldOf :: Proxy# "counterValue" -> (Int64 -> f Int64) -> DtValue -> f DtValue
fieldOf Proxy# "counterValue"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> DtValue -> f DtValue)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Maybe Int64)
-> (DtValue -> Maybe Int64 -> DtValue)
-> Lens DtValue DtValue (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Maybe Int64
_DtValue'counterValue
           (\ DtValue
x__ Maybe Int64
y__ -> DtValue
x__ {_DtValue'counterValue :: Maybe Int64
_DtValue'counterValue = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtValue "maybe'counterValue" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'counterValue"
-> (Maybe Int64 -> f (Maybe Int64)) -> DtValue -> f DtValue
fieldOf Proxy# "maybe'counterValue"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> DtValue -> f DtValue)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Maybe Int64)
-> (DtValue -> Maybe Int64 -> DtValue)
-> Lens DtValue DtValue (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Maybe Int64
_DtValue'counterValue
           (\ DtValue
x__ Maybe Int64
y__ -> DtValue
x__ {_DtValue'counterValue :: Maybe Int64
_DtValue'counterValue = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtValue "setValue" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "setValue"
-> ([ByteString] -> f [ByteString]) -> DtValue -> f DtValue
fieldOf Proxy# "setValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtValue -> f DtValue)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Vector ByteString)
-> (DtValue -> Vector ByteString -> DtValue)
-> Lens DtValue DtValue (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Vector ByteString
_DtValue'setValue (\ DtValue
x__ Vector ByteString
y__ -> DtValue
x__ {_DtValue'setValue :: Vector ByteString
_DtValue'setValue = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField DtValue "vec'setValue" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'setValue"
-> (Vector ByteString -> f (Vector ByteString))
-> DtValue
-> f DtValue
fieldOf Proxy# "vec'setValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtValue -> f DtValue)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Vector ByteString)
-> (DtValue -> Vector ByteString -> DtValue)
-> Lens DtValue DtValue (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Vector ByteString
_DtValue'setValue (\ DtValue
x__ Vector ByteString
y__ -> DtValue
x__ {_DtValue'setValue :: Vector ByteString
_DtValue'setValue = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtValue "mapValue" [MapEntry] where
  fieldOf :: Proxy# "mapValue"
-> ([MapEntry] -> f [MapEntry]) -> DtValue -> f DtValue
fieldOf Proxy# "mapValue"
_
    = ((Vector MapEntry -> f (Vector MapEntry)) -> DtValue -> f DtValue)
-> (([MapEntry] -> f [MapEntry])
    -> Vector MapEntry -> f (Vector MapEntry))
-> ([MapEntry] -> f [MapEntry])
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Vector MapEntry)
-> (DtValue -> Vector MapEntry -> DtValue)
-> Lens DtValue DtValue (Vector MapEntry) (Vector MapEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Vector MapEntry
_DtValue'mapValue (\ DtValue
x__ Vector MapEntry
y__ -> DtValue
x__ {_DtValue'mapValue :: Vector MapEntry
_DtValue'mapValue = Vector MapEntry
y__}))
        ((Vector MapEntry -> [MapEntry])
-> (Vector MapEntry -> [MapEntry] -> Vector MapEntry)
-> Lens (Vector MapEntry) (Vector MapEntry) [MapEntry] [MapEntry]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector MapEntry -> [MapEntry]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector MapEntry
_ [MapEntry]
y__ -> [MapEntry] -> Vector MapEntry
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [MapEntry]
y__))
instance Data.ProtoLens.Field.HasField DtValue "vec'mapValue" (Data.Vector.Vector MapEntry) where
  fieldOf :: Proxy# "vec'mapValue"
-> (Vector MapEntry -> f (Vector MapEntry)) -> DtValue -> f DtValue
fieldOf Proxy# "vec'mapValue"
_
    = ((Vector MapEntry -> f (Vector MapEntry)) -> DtValue -> f DtValue)
-> ((Vector MapEntry -> f (Vector MapEntry))
    -> Vector MapEntry -> f (Vector MapEntry))
-> (Vector MapEntry -> f (Vector MapEntry))
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Vector MapEntry)
-> (DtValue -> Vector MapEntry -> DtValue)
-> Lens DtValue DtValue (Vector MapEntry) (Vector MapEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Vector MapEntry
_DtValue'mapValue (\ DtValue
x__ Vector MapEntry
y__ -> DtValue
x__ {_DtValue'mapValue :: Vector MapEntry
_DtValue'mapValue = Vector MapEntry
y__}))
        (Vector MapEntry -> f (Vector MapEntry))
-> Vector MapEntry -> f (Vector MapEntry)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtValue "hllValue" Data.Word.Word64 where
  fieldOf :: Proxy# "hllValue" -> (Word64 -> f Word64) -> DtValue -> f DtValue
fieldOf Proxy# "hllValue"
_
    = ((Maybe Word64 -> f (Maybe Word64)) -> DtValue -> f DtValue)
-> ((Word64 -> f Word64) -> Maybe Word64 -> f (Maybe Word64))
-> (Word64 -> f Word64)
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Maybe Word64)
-> (DtValue -> Maybe Word64 -> DtValue)
-> Lens DtValue DtValue (Maybe Word64) (Maybe Word64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Maybe Word64
_DtValue'hllValue (\ DtValue
x__ Maybe Word64
y__ -> DtValue
x__ {_DtValue'hllValue :: Maybe Word64
_DtValue'hllValue = Maybe Word64
y__}))
        (Word64 -> Lens' (Maybe Word64) Word64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField DtValue "maybe'hllValue" (Prelude.Maybe Data.Word.Word64) where
  fieldOf :: Proxy# "maybe'hllValue"
-> (Maybe Word64 -> f (Maybe Word64)) -> DtValue -> f DtValue
fieldOf Proxy# "maybe'hllValue"
_
    = ((Maybe Word64 -> f (Maybe Word64)) -> DtValue -> f DtValue)
-> ((Maybe Word64 -> f (Maybe Word64))
    -> Maybe Word64 -> f (Maybe Word64))
-> (Maybe Word64 -> f (Maybe Word64))
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Maybe Word64)
-> (DtValue -> Maybe Word64 -> DtValue)
-> Lens DtValue DtValue (Maybe Word64) (Maybe Word64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Maybe Word64
_DtValue'hllValue (\ DtValue
x__ Maybe Word64
y__ -> DtValue
x__ {_DtValue'hllValue :: Maybe Word64
_DtValue'hllValue = Maybe Word64
y__}))
        (Maybe Word64 -> f (Maybe Word64))
-> Maybe Word64 -> f (Maybe Word64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField DtValue "gsetValue" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "gsetValue"
-> ([ByteString] -> f [ByteString]) -> DtValue -> f DtValue
fieldOf Proxy# "gsetValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtValue -> f DtValue)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Vector ByteString)
-> (DtValue -> Vector ByteString -> DtValue)
-> Lens DtValue DtValue (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Vector ByteString
_DtValue'gsetValue (\ DtValue
x__ Vector ByteString
y__ -> DtValue
x__ {_DtValue'gsetValue :: Vector ByteString
_DtValue'gsetValue = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField DtValue "vec'gsetValue" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'gsetValue"
-> (Vector ByteString -> f (Vector ByteString))
-> DtValue
-> f DtValue
fieldOf Proxy# "vec'gsetValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> DtValue -> f DtValue)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> DtValue
-> f DtValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((DtValue -> Vector ByteString)
-> (DtValue -> Vector ByteString -> DtValue)
-> Lens DtValue DtValue (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           DtValue -> Vector ByteString
_DtValue'gsetValue (\ DtValue
x__ Vector ByteString
y__ -> DtValue
x__ {_DtValue'gsetValue :: Vector ByteString
_DtValue'gsetValue = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message DtValue where
  messageName :: Proxy DtValue -> Text
messageName Proxy DtValue
_ = String -> Text
Data.Text.pack String
"DtValue"
  packedMessageDescriptor :: Proxy DtValue -> ByteString
packedMessageDescriptor Proxy DtValue
_
    = ByteString
"\n\
      \\aDtValue\DC2#\n\
      \\rcounter_value\CAN\SOH \SOH(\DC2R\fcounterValue\DC2\ESC\n\
      \\tset_value\CAN\STX \ETX(\fR\bsetValue\DC2&\n\
      \\tmap_value\CAN\ETX \ETX(\v2\t.MapEntryR\bmapValue\DC2\ESC\n\
      \\thll_value\CAN\EOT \SOH(\EOTR\bhllValue\DC2\GS\n\
      \\n\
      \gset_value\CAN\ENQ \ETX(\fR\tgsetValue"
  packedFileDescriptor :: Proxy DtValue -> ByteString
packedFileDescriptor Proxy DtValue
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor DtValue)
fieldsByTag
    = let
        counterValue__field_descriptor :: FieldDescriptor DtValue
counterValue__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor DtValue Int64
-> FieldDescriptor DtValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"counter_value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens DtValue DtValue (Maybe Int64) (Maybe Int64)
-> FieldAccessor DtValue Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterValue")) ::
              Data.ProtoLens.FieldDescriptor DtValue
        setValue__field_descriptor :: FieldDescriptor DtValue
setValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtValue ByteString
-> FieldDescriptor DtValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"set_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' DtValue [ByteString] -> FieldAccessor DtValue ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"setValue")) ::
              Data.ProtoLens.FieldDescriptor DtValue
        mapValue__field_descriptor :: FieldDescriptor DtValue
mapValue__field_descriptor
          = String
-> FieldTypeDescriptor MapEntry
-> FieldAccessor DtValue MapEntry
-> FieldDescriptor DtValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"map_value"
              (MessageOrGroup -> FieldTypeDescriptor MapEntry
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapEntry)
              (Packing
-> Lens' DtValue [MapEntry] -> FieldAccessor DtValue MapEntry
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"mapValue")) ::
              Data.ProtoLens.FieldDescriptor DtValue
        hllValue__field_descriptor :: FieldDescriptor DtValue
hllValue__field_descriptor
          = String
-> FieldTypeDescriptor Word64
-> FieldAccessor DtValue Word64
-> FieldDescriptor DtValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"hll_value"
              (ScalarField Word64 -> FieldTypeDescriptor Word64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word64
Data.ProtoLens.UInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64)
              (Lens DtValue DtValue (Maybe Word64) (Maybe Word64)
-> FieldAccessor DtValue Word64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'hllValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hllValue")) ::
              Data.ProtoLens.FieldDescriptor DtValue
        gsetValue__field_descriptor :: FieldDescriptor DtValue
gsetValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor DtValue ByteString
-> FieldDescriptor DtValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"gset_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' DtValue [ByteString] -> FieldAccessor DtValue ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "gsetValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"gsetValue")) ::
              Data.ProtoLens.FieldDescriptor DtValue
      in
        [(Tag, FieldDescriptor DtValue)]
-> Map Tag (FieldDescriptor DtValue)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor DtValue
counterValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor DtValue
setValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor DtValue
mapValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor DtValue
hllValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor DtValue
gsetValue__field_descriptor)]
  unknownFields :: LensLike' f DtValue FieldSet
unknownFields
    = (DtValue -> FieldSet)
-> (DtValue -> FieldSet -> DtValue) -> Lens' DtValue FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        DtValue -> FieldSet
_DtValue'_unknownFields
        (\ DtValue
x__ FieldSet
y__ -> DtValue
x__ {_DtValue'_unknownFields :: FieldSet
_DtValue'_unknownFields = FieldSet
y__})
  defMessage :: DtValue
defMessage
    = DtValue'_constructor :: Maybe Int64
-> Vector ByteString
-> Vector MapEntry
-> Maybe Word64
-> Vector ByteString
-> FieldSet
-> DtValue
DtValue'_constructor
        {_DtValue'counterValue :: Maybe Int64
_DtValue'counterValue = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _DtValue'setValue :: Vector ByteString
_DtValue'setValue = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _DtValue'mapValue :: Vector MapEntry
_DtValue'mapValue = Vector MapEntry
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _DtValue'hllValue :: Maybe Word64
_DtValue'hllValue = Maybe Word64
forall a. Maybe a
Prelude.Nothing,
         _DtValue'gsetValue :: Vector ByteString
_DtValue'gsetValue = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _DtValue'_unknownFields :: FieldSet
_DtValue'_unknownFields = []}
  parseMessage :: Parser DtValue
parseMessage
    = let
        loop ::
          DtValue
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld MapEntry
                -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
                   -> Data.ProtoLens.Encoding.Bytes.Parser DtValue
        loop :: DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop DtValue
x Growing Vector RealWorld ByteString
mutable'gsetValue Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
mutable'setValue
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'gsetValue <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                            (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'gsetValue)
                      Vector MapEntry
frozen'mapValue <- IO (Vector MapEntry) -> Parser (Vector MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) MapEntry -> IO (Vector MapEntry)
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 MapEntry
Growing Vector (PrimState IO) MapEntry
mutable'mapValue)
                      Vector ByteString
frozen'setValue <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'setValue)
                      (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]))))
                      DtValue -> Parser DtValue
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter DtValue DtValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtValue -> DtValue
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 DtValue DtValue FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter DtValue DtValue (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> DtValue -> DtValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'gsetValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'gsetValue")
                              Vector ByteString
frozen'gsetValue
                              (Setter DtValue DtValue (Vector MapEntry) (Vector MapEntry)
-> Vector MapEntry -> DtValue -> DtValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'mapValue")
                                 Vector MapEntry
frozen'mapValue
                                 (Setter DtValue DtValue (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> DtValue -> DtValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                    (forall s a (f :: * -> *).
(HasField s "vec'setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'setValue")
                                    Vector ByteString
frozen'setValue
                                    DtValue
x))))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"counter_value"
                                DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop
                                  (Setter DtValue DtValue Int64 Int64 -> Int64 -> DtValue -> DtValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"counterValue") Int64
y DtValue
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
18
                          -> 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
"set_value"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'setValue ByteString
y)
                                DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop DtValue
x Growing Vector RealWorld ByteString
mutable'gsetValue Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
v
                        Word64
26
                          -> do !MapEntry
y <- Parser MapEntry -> String -> Parser MapEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser MapEntry -> Parser MapEntry
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 MapEntry
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"map_value"
                                Growing Vector RealWorld MapEntry
v <- IO (Growing Vector RealWorld MapEntry)
-> Parser (Growing Vector RealWorld MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) MapEntry
-> MapEntry -> IO (Growing Vector (PrimState IO) MapEntry)
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 MapEntry
Growing Vector (PrimState IO) MapEntry
mutable'mapValue MapEntry
y)
                                DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop DtValue
x Growing Vector RealWorld ByteString
mutable'gsetValue Growing Vector RealWorld MapEntry
v Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
32
                          -> 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
"hll_value"
                                DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop
                                  (Setter DtValue DtValue Word64 Word64
-> Word64 -> DtValue -> DtValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "hllValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"hllValue") Word64
y DtValue
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
42
                          -> 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
"gset_value"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'gsetValue ByteString
y)
                                DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop DtValue
x Growing Vector RealWorld ByteString
v Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop
                                  (Setter DtValue DtValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> DtValue -> DtValue
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 DtValue DtValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) DtValue
x)
                                  Growing Vector RealWorld ByteString
mutable'gsetValue
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
      in
        Parser DtValue -> String -> Parser DtValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'gsetValue <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                     IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld MapEntry
mutable'mapValue <- IO (Growing Vector RealWorld MapEntry)
-> Parser (Growing Vector RealWorld MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld MapEntry)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld ByteString
mutable'setValue <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              DtValue
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser DtValue
loop
                DtValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage
                Growing Vector RealWorld ByteString
mutable'gsetValue
                Growing Vector RealWorld MapEntry
mutable'mapValue
                Growing Vector RealWorld ByteString
mutable'setValue)
          String
"DtValue"
  buildMessage :: DtValue -> Builder
buildMessage
    = \ DtValue
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike (Maybe Int64) DtValue DtValue (Maybe Int64) (Maybe Int64)
-> DtValue -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                    (forall s a (f :: * -> *).
(HasField s "maybe'counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterValue") DtValue
_x
              of
                Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Int64
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                       ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                          Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                          Int64
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ ByteString
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((\ 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))
                   (FoldLike
  (Vector ByteString)
  DtValue
  DtValue
  (Vector ByteString)
  (Vector ByteString)
-> DtValue -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                      (forall s a (f :: * -> *).
(HasField s "vec'setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'setValue") DtValue
_x))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   ((MapEntry -> Builder) -> Vector MapEntry -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                      (\ MapEntry
_v
                         -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                              (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                              ((ByteString -> Builder)
-> (MapEntry -> ByteString) -> MapEntry -> 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))
                                 MapEntry -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                 MapEntry
_v))
                      (FoldLike
  (Vector MapEntry)
  DtValue
  DtValue
  (Vector MapEntry)
  (Vector MapEntry)
-> DtValue -> Vector MapEntry
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                         (forall s a (f :: * -> *).
(HasField s "vec'mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'mapValue") DtValue
_x))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Word64) DtValue DtValue (Maybe Word64) (Maybe Word64)
-> DtValue -> Maybe Word64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'hllValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hllValue") DtValue
_x
                       of
                         Maybe Word64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Word64
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
_v))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                            (\ ByteString
_v
                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                                    ((\ 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))
                            (FoldLike
  (Vector ByteString)
  DtValue
  DtValue
  (Vector ByteString)
  (Vector ByteString)
-> DtValue -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                               (forall s a (f :: * -> *).
(HasField s "vec'gsetValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'gsetValue") DtValue
_x))
                         (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                            (FoldLike FieldSet DtValue DtValue FieldSet FieldSet
-> DtValue -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet DtValue DtValue FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields DtValue
_x))))))
instance Control.DeepSeq.NFData DtValue where
  rnf :: DtValue -> ()
rnf
    = \ DtValue
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (DtValue -> FieldSet
_DtValue'_unknownFields DtValue
x__)
             (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (DtValue -> Maybe Int64
_DtValue'counterValue DtValue
x__)
                (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (DtValue -> Vector ByteString
_DtValue'setValue DtValue
x__)
                   (Vector MapEntry -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (DtValue -> Vector MapEntry
_DtValue'mapValue DtValue
x__)
                      (Maybe Word64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (DtValue -> Maybe Word64
_DtValue'hllValue DtValue
x__)
                         (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (DtValue -> Vector ByteString
_DtValue'gsetValue DtValue
x__) ())))))
{- | Fields :
     
         * 'Proto.Riak_Fields.adds' @:: Lens' GSetOp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'adds' @:: Lens' GSetOp (Data.Vector.Vector Data.ByteString.ByteString)@ -}
data GSetOp
  = GSetOp'_constructor {GSetOp -> Vector ByteString
_GSetOp'adds :: !(Data.Vector.Vector Data.ByteString.ByteString),
                         GSetOp -> FieldSet
_GSetOp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (GSetOp -> GSetOp -> Bool
(GSetOp -> GSetOp -> Bool)
-> (GSetOp -> GSetOp -> Bool) -> Eq GSetOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GSetOp -> GSetOp -> Bool
$c/= :: GSetOp -> GSetOp -> Bool
== :: GSetOp -> GSetOp -> Bool
$c== :: GSetOp -> GSetOp -> Bool
Prelude.Eq, Eq GSetOp
Eq GSetOp
-> (GSetOp -> GSetOp -> Ordering)
-> (GSetOp -> GSetOp -> Bool)
-> (GSetOp -> GSetOp -> Bool)
-> (GSetOp -> GSetOp -> Bool)
-> (GSetOp -> GSetOp -> Bool)
-> (GSetOp -> GSetOp -> GSetOp)
-> (GSetOp -> GSetOp -> GSetOp)
-> Ord GSetOp
GSetOp -> GSetOp -> Bool
GSetOp -> GSetOp -> Ordering
GSetOp -> GSetOp -> GSetOp
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 :: GSetOp -> GSetOp -> GSetOp
$cmin :: GSetOp -> GSetOp -> GSetOp
max :: GSetOp -> GSetOp -> GSetOp
$cmax :: GSetOp -> GSetOp -> GSetOp
>= :: GSetOp -> GSetOp -> Bool
$c>= :: GSetOp -> GSetOp -> Bool
> :: GSetOp -> GSetOp -> Bool
$c> :: GSetOp -> GSetOp -> Bool
<= :: GSetOp -> GSetOp -> Bool
$c<= :: GSetOp -> GSetOp -> Bool
< :: GSetOp -> GSetOp -> Bool
$c< :: GSetOp -> GSetOp -> Bool
compare :: GSetOp -> GSetOp -> Ordering
$ccompare :: GSetOp -> GSetOp -> Ordering
$cp1Ord :: Eq GSetOp
Prelude.Ord)
instance Prelude.Show GSetOp where
  showsPrec :: Int -> GSetOp -> ShowS
showsPrec Int
_ GSetOp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (GSetOp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort GSetOp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField GSetOp "adds" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "adds"
-> ([ByteString] -> f [ByteString]) -> GSetOp -> f GSetOp
fieldOf Proxy# "adds"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> GSetOp -> f GSetOp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> GSetOp
-> f GSetOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((GSetOp -> Vector ByteString)
-> (GSetOp -> Vector ByteString -> GSetOp)
-> Lens GSetOp GSetOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           GSetOp -> Vector ByteString
_GSetOp'adds (\ GSetOp
x__ Vector ByteString
y__ -> GSetOp
x__ {_GSetOp'adds :: Vector ByteString
_GSetOp'adds = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField GSetOp "vec'adds" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'adds"
-> (Vector ByteString -> f (Vector ByteString))
-> GSetOp
-> f GSetOp
fieldOf Proxy# "vec'adds"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> GSetOp -> f GSetOp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> GSetOp
-> f GSetOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((GSetOp -> Vector ByteString)
-> (GSetOp -> Vector ByteString -> GSetOp)
-> Lens GSetOp GSetOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           GSetOp -> Vector ByteString
_GSetOp'adds (\ GSetOp
x__ Vector ByteString
y__ -> GSetOp
x__ {_GSetOp'adds :: Vector ByteString
_GSetOp'adds = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message GSetOp where
  messageName :: Proxy GSetOp -> Text
messageName Proxy GSetOp
_ = String -> Text
Data.Text.pack String
"GSetOp"
  packedMessageDescriptor :: Proxy GSetOp -> ByteString
packedMessageDescriptor Proxy GSetOp
_
    = ByteString
"\n\
      \\ACKGSetOp\DC2\DC2\n\
      \\EOTadds\CAN\SOH \ETX(\fR\EOTadds"
  packedFileDescriptor :: Proxy GSetOp -> ByteString
packedFileDescriptor Proxy GSetOp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor GSetOp)
fieldsByTag
    = let
        adds__field_descriptor :: FieldDescriptor GSetOp
adds__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor GSetOp ByteString
-> FieldDescriptor GSetOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"adds"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' GSetOp [ByteString] -> FieldAccessor GSetOp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"adds")) ::
              Data.ProtoLens.FieldDescriptor GSetOp
      in
        [(Tag, FieldDescriptor GSetOp)] -> Map Tag (FieldDescriptor GSetOp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor GSetOp
adds__field_descriptor)]
  unknownFields :: LensLike' f GSetOp FieldSet
unknownFields
    = (GSetOp -> FieldSet)
-> (GSetOp -> FieldSet -> GSetOp) -> Lens' GSetOp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        GSetOp -> FieldSet
_GSetOp'_unknownFields
        (\ GSetOp
x__ FieldSet
y__ -> GSetOp
x__ {_GSetOp'_unknownFields :: FieldSet
_GSetOp'_unknownFields = FieldSet
y__})
  defMessage :: GSetOp
defMessage
    = GSetOp'_constructor :: Vector ByteString -> FieldSet -> GSetOp
GSetOp'_constructor
        {_GSetOp'adds :: Vector ByteString
_GSetOp'adds = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _GSetOp'_unknownFields :: FieldSet
_GSetOp'_unknownFields = []}
  parseMessage :: Parser GSetOp
parseMessage
    = let
        loop ::
          GSetOp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Bytes.Parser GSetOp
        loop :: GSetOp -> Growing Vector RealWorld ByteString -> Parser GSetOp
loop GSetOp
x Growing Vector RealWorld ByteString
mutable'adds
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'adds <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'adds)
                      (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]))))
                      GSetOp -> Parser GSetOp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter GSetOp GSetOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> GSetOp -> GSetOp
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 GSetOp GSetOp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter GSetOp GSetOp (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> GSetOp -> GSetOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'adds") Vector ByteString
frozen'adds GSetOp
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
"adds"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'adds ByteString
y)
                                GSetOp -> Growing Vector RealWorld ByteString -> Parser GSetOp
loop GSetOp
x Growing Vector RealWorld ByteString
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                GSetOp -> Growing Vector RealWorld ByteString -> Parser GSetOp
loop
                                  (Setter GSetOp GSetOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> GSetOp -> GSetOp
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 GSetOp GSetOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) GSetOp
x)
                                  Growing Vector RealWorld ByteString
mutable'adds
      in
        Parser GSetOp -> String -> Parser GSetOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'adds <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              GSetOp -> Growing Vector RealWorld ByteString -> Parser GSetOp
loop GSetOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld ByteString
mutable'adds)
          String
"GSetOp"
  buildMessage :: GSetOp -> Builder
buildMessage
    = \ GSetOp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ ByteString
_v
                   -> 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))
                (FoldLike
  (Vector ByteString)
  GSetOp
  GSetOp
  (Vector ByteString)
  (Vector ByteString)
-> GSetOp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'adds") GSetOp
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet GSetOp GSetOp FieldSet FieldSet
-> GSetOp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet GSetOp GSetOp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields GSetOp
_x))
instance Control.DeepSeq.NFData GSetOp where
  rnf :: GSetOp -> ()
rnf
    = \ GSetOp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (GSetOp -> FieldSet
_GSetOp'_unknownFields GSetOp
x__)
             (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (GSetOp -> Vector ByteString
_GSetOp'adds GSetOp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.adds' @:: Lens' HllOp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'adds' @:: Lens' HllOp (Data.Vector.Vector Data.ByteString.ByteString)@ -}
data HllOp
  = HllOp'_constructor {HllOp -> Vector ByteString
_HllOp'adds :: !(Data.Vector.Vector Data.ByteString.ByteString),
                        HllOp -> FieldSet
_HllOp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (HllOp -> HllOp -> Bool
(HllOp -> HllOp -> Bool) -> (HllOp -> HllOp -> Bool) -> Eq HllOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HllOp -> HllOp -> Bool
$c/= :: HllOp -> HllOp -> Bool
== :: HllOp -> HllOp -> Bool
$c== :: HllOp -> HllOp -> Bool
Prelude.Eq, Eq HllOp
Eq HllOp
-> (HllOp -> HllOp -> Ordering)
-> (HllOp -> HllOp -> Bool)
-> (HllOp -> HllOp -> Bool)
-> (HllOp -> HllOp -> Bool)
-> (HllOp -> HllOp -> Bool)
-> (HllOp -> HllOp -> HllOp)
-> (HllOp -> HllOp -> HllOp)
-> Ord HllOp
HllOp -> HllOp -> Bool
HllOp -> HllOp -> Ordering
HllOp -> HllOp -> HllOp
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 :: HllOp -> HllOp -> HllOp
$cmin :: HllOp -> HllOp -> HllOp
max :: HllOp -> HllOp -> HllOp
$cmax :: HllOp -> HllOp -> HllOp
>= :: HllOp -> HllOp -> Bool
$c>= :: HllOp -> HllOp -> Bool
> :: HllOp -> HllOp -> Bool
$c> :: HllOp -> HllOp -> Bool
<= :: HllOp -> HllOp -> Bool
$c<= :: HllOp -> HllOp -> Bool
< :: HllOp -> HllOp -> Bool
$c< :: HllOp -> HllOp -> Bool
compare :: HllOp -> HllOp -> Ordering
$ccompare :: HllOp -> HllOp -> Ordering
$cp1Ord :: Eq HllOp
Prelude.Ord)
instance Prelude.Show HllOp where
  showsPrec :: Int -> HllOp -> ShowS
showsPrec Int
_ HllOp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (HllOp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort HllOp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField HllOp "adds" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "adds"
-> ([ByteString] -> f [ByteString]) -> HllOp -> f HllOp
fieldOf Proxy# "adds"
_
    = ((Vector ByteString -> f (Vector ByteString)) -> HllOp -> f HllOp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> HllOp
-> f HllOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((HllOp -> Vector ByteString)
-> (HllOp -> Vector ByteString -> HllOp)
-> Lens HllOp HllOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           HllOp -> Vector ByteString
_HllOp'adds (\ HllOp
x__ Vector ByteString
y__ -> HllOp
x__ {_HllOp'adds :: Vector ByteString
_HllOp'adds = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField HllOp "vec'adds" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'adds"
-> (Vector ByteString -> f (Vector ByteString)) -> HllOp -> f HllOp
fieldOf Proxy# "vec'adds"
_
    = ((Vector ByteString -> f (Vector ByteString)) -> HllOp -> f HllOp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> HllOp
-> f HllOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((HllOp -> Vector ByteString)
-> (HllOp -> Vector ByteString -> HllOp)
-> Lens HllOp HllOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           HllOp -> Vector ByteString
_HllOp'adds (\ HllOp
x__ Vector ByteString
y__ -> HllOp
x__ {_HllOp'adds :: Vector ByteString
_HllOp'adds = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message HllOp where
  messageName :: Proxy HllOp -> Text
messageName Proxy HllOp
_ = String -> Text
Data.Text.pack String
"HllOp"
  packedMessageDescriptor :: Proxy HllOp -> ByteString
packedMessageDescriptor Proxy HllOp
_
    = ByteString
"\n\
      \\ENQHllOp\DC2\DC2\n\
      \\EOTadds\CAN\SOH \ETX(\fR\EOTadds"
  packedFileDescriptor :: Proxy HllOp -> ByteString
packedFileDescriptor Proxy HllOp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor HllOp)
fieldsByTag
    = let
        adds__field_descriptor :: FieldDescriptor HllOp
adds__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor HllOp ByteString
-> FieldDescriptor HllOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"adds"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' HllOp [ByteString] -> FieldAccessor HllOp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"adds")) ::
              Data.ProtoLens.FieldDescriptor HllOp
      in
        [(Tag, FieldDescriptor HllOp)] -> Map Tag (FieldDescriptor HllOp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor HllOp
adds__field_descriptor)]
  unknownFields :: LensLike' f HllOp FieldSet
unknownFields
    = (HllOp -> FieldSet)
-> (HllOp -> FieldSet -> HllOp) -> Lens' HllOp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        HllOp -> FieldSet
_HllOp'_unknownFields
        (\ HllOp
x__ FieldSet
y__ -> HllOp
x__ {_HllOp'_unknownFields :: FieldSet
_HllOp'_unknownFields = FieldSet
y__})
  defMessage :: HllOp
defMessage
    = HllOp'_constructor :: Vector ByteString -> FieldSet -> HllOp
HllOp'_constructor
        {_HllOp'adds :: Vector ByteString
_HllOp'adds = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _HllOp'_unknownFields :: FieldSet
_HllOp'_unknownFields = []}
  parseMessage :: Parser HllOp
parseMessage
    = let
        loop ::
          HllOp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Bytes.Parser HllOp
        loop :: HllOp -> Growing Vector RealWorld ByteString -> Parser HllOp
loop HllOp
x Growing Vector RealWorld ByteString
mutable'adds
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'adds <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'adds)
                      (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]))))
                      HllOp -> Parser HllOp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter HllOp HllOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> HllOp -> HllOp
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 HllOp HllOp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter HllOp HllOp (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> HllOp -> HllOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'adds") Vector ByteString
frozen'adds HllOp
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
"adds"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'adds ByteString
y)
                                HllOp -> Growing Vector RealWorld ByteString -> Parser HllOp
loop HllOp
x Growing Vector RealWorld ByteString
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                HllOp -> Growing Vector RealWorld ByteString -> Parser HllOp
loop
                                  (Setter HllOp HllOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> HllOp -> HllOp
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 HllOp HllOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) HllOp
x)
                                  Growing Vector RealWorld ByteString
mutable'adds
      in
        Parser HllOp -> String -> Parser HllOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'adds <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              HllOp -> Growing Vector RealWorld ByteString -> Parser HllOp
loop HllOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld ByteString
mutable'adds)
          String
"HllOp"
  buildMessage :: HllOp -> Builder
buildMessage
    = \ HllOp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ ByteString
_v
                   -> 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))
                (FoldLike
  (Vector ByteString)
  HllOp
  HllOp
  (Vector ByteString)
  (Vector ByteString)
-> HllOp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'adds") HllOp
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet HllOp HllOp FieldSet FieldSet
-> HllOp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet HllOp HllOp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields HllOp
_x))
instance Control.DeepSeq.NFData HllOp where
  rnf :: HllOp -> ()
rnf
    = \ HllOp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (HllOp -> FieldSet
_HllOp'_unknownFields HllOp
x__)
             (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (HllOp -> Vector ByteString
_HllOp'adds HllOp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.field' @:: Lens' MapEntry MapField@
         * 'Proto.Riak_Fields.counterValue' @:: Lens' MapEntry Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'counterValue' @:: Lens' MapEntry (Prelude.Maybe Data.Int.Int64)@
         * 'Proto.Riak_Fields.setValue' @:: Lens' MapEntry [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'setValue' @:: Lens' MapEntry (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.registerValue' @:: Lens' MapEntry Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'registerValue' @:: Lens' MapEntry (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.flagValue' @:: Lens' MapEntry Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'flagValue' @:: Lens' MapEntry (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.mapValue' @:: Lens' MapEntry [MapEntry]@
         * 'Proto.Riak_Fields.vec'mapValue' @:: Lens' MapEntry (Data.Vector.Vector MapEntry)@ -}
data MapEntry
  = MapEntry'_constructor {MapEntry -> MapField
_MapEntry'field :: !MapField,
                           MapEntry -> Maybe Int64
_MapEntry'counterValue :: !(Prelude.Maybe Data.Int.Int64),
                           MapEntry -> Vector ByteString
_MapEntry'setValue :: !(Data.Vector.Vector Data.ByteString.ByteString),
                           MapEntry -> Maybe ByteString
_MapEntry'registerValue :: !(Prelude.Maybe Data.ByteString.ByteString),
                           MapEntry -> Maybe Bool
_MapEntry'flagValue :: !(Prelude.Maybe Prelude.Bool),
                           MapEntry -> Vector MapEntry
_MapEntry'mapValue :: !(Data.Vector.Vector MapEntry),
                           MapEntry -> FieldSet
_MapEntry'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (MapEntry -> MapEntry -> Bool
(MapEntry -> MapEntry -> Bool)
-> (MapEntry -> MapEntry -> Bool) -> Eq MapEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapEntry -> MapEntry -> Bool
$c/= :: MapEntry -> MapEntry -> Bool
== :: MapEntry -> MapEntry -> Bool
$c== :: MapEntry -> MapEntry -> Bool
Prelude.Eq, Eq MapEntry
Eq MapEntry
-> (MapEntry -> MapEntry -> Ordering)
-> (MapEntry -> MapEntry -> Bool)
-> (MapEntry -> MapEntry -> Bool)
-> (MapEntry -> MapEntry -> Bool)
-> (MapEntry -> MapEntry -> Bool)
-> (MapEntry -> MapEntry -> MapEntry)
-> (MapEntry -> MapEntry -> MapEntry)
-> Ord MapEntry
MapEntry -> MapEntry -> Bool
MapEntry -> MapEntry -> Ordering
MapEntry -> MapEntry -> MapEntry
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 :: MapEntry -> MapEntry -> MapEntry
$cmin :: MapEntry -> MapEntry -> MapEntry
max :: MapEntry -> MapEntry -> MapEntry
$cmax :: MapEntry -> MapEntry -> MapEntry
>= :: MapEntry -> MapEntry -> Bool
$c>= :: MapEntry -> MapEntry -> Bool
> :: MapEntry -> MapEntry -> Bool
$c> :: MapEntry -> MapEntry -> Bool
<= :: MapEntry -> MapEntry -> Bool
$c<= :: MapEntry -> MapEntry -> Bool
< :: MapEntry -> MapEntry -> Bool
$c< :: MapEntry -> MapEntry -> Bool
compare :: MapEntry -> MapEntry -> Ordering
$ccompare :: MapEntry -> MapEntry -> Ordering
$cp1Ord :: Eq MapEntry
Prelude.Ord)
instance Prelude.Show MapEntry where
  showsPrec :: Int -> MapEntry -> ShowS
showsPrec Int
_ MapEntry
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (MapEntry -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort MapEntry
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField MapEntry "field" MapField where
  fieldOf :: Proxy# "field"
-> (MapField -> f MapField) -> MapEntry -> f MapEntry
fieldOf Proxy# "field"
_
    = ((MapField -> f MapField) -> MapEntry -> f MapEntry)
-> ((MapField -> f MapField) -> MapField -> f MapField)
-> (MapField -> f MapField)
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> MapField)
-> (MapEntry -> MapField -> MapEntry)
-> Lens MapEntry MapEntry MapField MapField
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> MapField
_MapEntry'field (\ MapEntry
x__ MapField
y__ -> MapEntry
x__ {_MapEntry'field :: MapField
_MapEntry'field = MapField
y__}))
        (MapField -> f MapField) -> MapField -> f MapField
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapEntry "counterValue" Data.Int.Int64 where
  fieldOf :: Proxy# "counterValue"
-> (Int64 -> f Int64) -> MapEntry -> f MapEntry
fieldOf Proxy# "counterValue"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> MapEntry -> f MapEntry)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Maybe Int64)
-> (MapEntry -> Maybe Int64 -> MapEntry)
-> Lens MapEntry MapEntry (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Maybe Int64
_MapEntry'counterValue
           (\ MapEntry
x__ Maybe Int64
y__ -> MapEntry
x__ {_MapEntry'counterValue :: Maybe Int64
_MapEntry'counterValue = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField MapEntry "maybe'counterValue" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'counterValue"
-> (Maybe Int64 -> f (Maybe Int64)) -> MapEntry -> f MapEntry
fieldOf Proxy# "maybe'counterValue"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> MapEntry -> f MapEntry)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Maybe Int64)
-> (MapEntry -> Maybe Int64 -> MapEntry)
-> Lens MapEntry MapEntry (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Maybe Int64
_MapEntry'counterValue
           (\ MapEntry
x__ Maybe Int64
y__ -> MapEntry
x__ {_MapEntry'counterValue :: Maybe Int64
_MapEntry'counterValue = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapEntry "setValue" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "setValue"
-> ([ByteString] -> f [ByteString]) -> MapEntry -> f MapEntry
fieldOf Proxy# "setValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> MapEntry -> f MapEntry)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Vector ByteString)
-> (MapEntry -> Vector ByteString -> MapEntry)
-> Lens MapEntry MapEntry (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Vector ByteString
_MapEntry'setValue (\ MapEntry
x__ Vector ByteString
y__ -> MapEntry
x__ {_MapEntry'setValue :: Vector ByteString
_MapEntry'setValue = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField MapEntry "vec'setValue" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'setValue"
-> (Vector ByteString -> f (Vector ByteString))
-> MapEntry
-> f MapEntry
fieldOf Proxy# "vec'setValue"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> MapEntry -> f MapEntry)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Vector ByteString)
-> (MapEntry -> Vector ByteString -> MapEntry)
-> Lens MapEntry MapEntry (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Vector ByteString
_MapEntry'setValue (\ MapEntry
x__ Vector ByteString
y__ -> MapEntry
x__ {_MapEntry'setValue :: Vector ByteString
_MapEntry'setValue = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapEntry "registerValue" Data.ByteString.ByteString where
  fieldOf :: Proxy# "registerValue"
-> (ByteString -> f ByteString) -> MapEntry -> f MapEntry
fieldOf Proxy# "registerValue"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> MapEntry -> f MapEntry)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Maybe ByteString)
-> (MapEntry -> Maybe ByteString -> MapEntry)
-> Lens MapEntry MapEntry (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Maybe ByteString
_MapEntry'registerValue
           (\ MapEntry
x__ Maybe ByteString
y__ -> MapEntry
x__ {_MapEntry'registerValue :: Maybe ByteString
_MapEntry'registerValue = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField MapEntry "maybe'registerValue" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'registerValue"
-> (Maybe ByteString -> f (Maybe ByteString))
-> MapEntry
-> f MapEntry
fieldOf Proxy# "maybe'registerValue"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> MapEntry -> f MapEntry)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Maybe ByteString)
-> (MapEntry -> Maybe ByteString -> MapEntry)
-> Lens MapEntry MapEntry (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Maybe ByteString
_MapEntry'registerValue
           (\ MapEntry
x__ Maybe ByteString
y__ -> MapEntry
x__ {_MapEntry'registerValue :: Maybe ByteString
_MapEntry'registerValue = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapEntry "flagValue" Prelude.Bool where
  fieldOf :: Proxy# "flagValue" -> (Bool -> f Bool) -> MapEntry -> f MapEntry
fieldOf Proxy# "flagValue"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> MapEntry -> f MapEntry)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Maybe Bool)
-> (MapEntry -> Maybe Bool -> MapEntry)
-> Lens MapEntry MapEntry (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Maybe Bool
_MapEntry'flagValue (\ MapEntry
x__ Maybe Bool
y__ -> MapEntry
x__ {_MapEntry'flagValue :: Maybe Bool
_MapEntry'flagValue = 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 MapEntry "maybe'flagValue" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'flagValue"
-> (Maybe Bool -> f (Maybe Bool)) -> MapEntry -> f MapEntry
fieldOf Proxy# "maybe'flagValue"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> MapEntry -> f MapEntry)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Maybe Bool)
-> (MapEntry -> Maybe Bool -> MapEntry)
-> Lens MapEntry MapEntry (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Maybe Bool
_MapEntry'flagValue (\ MapEntry
x__ Maybe Bool
y__ -> MapEntry
x__ {_MapEntry'flagValue :: Maybe Bool
_MapEntry'flagValue = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapEntry "mapValue" [MapEntry] where
  fieldOf :: Proxy# "mapValue"
-> ([MapEntry] -> f [MapEntry]) -> MapEntry -> f MapEntry
fieldOf Proxy# "mapValue"
_
    = ((Vector MapEntry -> f (Vector MapEntry))
 -> MapEntry -> f MapEntry)
-> (([MapEntry] -> f [MapEntry])
    -> Vector MapEntry -> f (Vector MapEntry))
-> ([MapEntry] -> f [MapEntry])
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Vector MapEntry)
-> (MapEntry -> Vector MapEntry -> MapEntry)
-> Lens MapEntry MapEntry (Vector MapEntry) (Vector MapEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Vector MapEntry
_MapEntry'mapValue (\ MapEntry
x__ Vector MapEntry
y__ -> MapEntry
x__ {_MapEntry'mapValue :: Vector MapEntry
_MapEntry'mapValue = Vector MapEntry
y__}))
        ((Vector MapEntry -> [MapEntry])
-> (Vector MapEntry -> [MapEntry] -> Vector MapEntry)
-> Lens (Vector MapEntry) (Vector MapEntry) [MapEntry] [MapEntry]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector MapEntry -> [MapEntry]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector MapEntry
_ [MapEntry]
y__ -> [MapEntry] -> Vector MapEntry
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [MapEntry]
y__))
instance Data.ProtoLens.Field.HasField MapEntry "vec'mapValue" (Data.Vector.Vector MapEntry) where
  fieldOf :: Proxy# "vec'mapValue"
-> (Vector MapEntry -> f (Vector MapEntry))
-> MapEntry
-> f MapEntry
fieldOf Proxy# "vec'mapValue"
_
    = ((Vector MapEntry -> f (Vector MapEntry))
 -> MapEntry -> f MapEntry)
-> ((Vector MapEntry -> f (Vector MapEntry))
    -> Vector MapEntry -> f (Vector MapEntry))
-> (Vector MapEntry -> f (Vector MapEntry))
-> MapEntry
-> f MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapEntry -> Vector MapEntry)
-> (MapEntry -> Vector MapEntry -> MapEntry)
-> Lens MapEntry MapEntry (Vector MapEntry) (Vector MapEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapEntry -> Vector MapEntry
_MapEntry'mapValue (\ MapEntry
x__ Vector MapEntry
y__ -> MapEntry
x__ {_MapEntry'mapValue :: Vector MapEntry
_MapEntry'mapValue = Vector MapEntry
y__}))
        (Vector MapEntry -> f (Vector MapEntry))
-> Vector MapEntry -> f (Vector MapEntry)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message MapEntry where
  messageName :: Proxy MapEntry -> Text
messageName Proxy MapEntry
_ = String -> Text
Data.Text.pack String
"MapEntry"
  packedMessageDescriptor :: Proxy MapEntry -> ByteString
packedMessageDescriptor Proxy MapEntry
_
    = ByteString
"\n\
      \\bMapEntry\DC2\US\n\
      \\ENQfield\CAN\SOH \STX(\v2\t.MapFieldR\ENQfield\DC2#\n\
      \\rcounter_value\CAN\STX \SOH(\DC2R\fcounterValue\DC2\ESC\n\
      \\tset_value\CAN\ETX \ETX(\fR\bsetValue\DC2%\n\
      \\SOregister_value\CAN\EOT \SOH(\fR\rregisterValue\DC2\GS\n\
      \\n\
      \flag_value\CAN\ENQ \SOH(\bR\tflagValue\DC2&\n\
      \\tmap_value\CAN\ACK \ETX(\v2\t.MapEntryR\bmapValue"
  packedFileDescriptor :: Proxy MapEntry -> ByteString
packedFileDescriptor Proxy MapEntry
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor MapEntry)
fieldsByTag
    = let
        field__field_descriptor :: FieldDescriptor MapEntry
field__field_descriptor
          = String
-> FieldTypeDescriptor MapField
-> FieldAccessor MapEntry MapField
-> FieldDescriptor MapEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"field"
              (MessageOrGroup -> FieldTypeDescriptor MapField
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapField)
              (WireDefault MapField
-> Lens MapEntry MapEntry MapField MapField
-> FieldAccessor MapEntry MapField
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault MapField
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "field" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"field")) ::
              Data.ProtoLens.FieldDescriptor MapEntry
        counterValue__field_descriptor :: FieldDescriptor MapEntry
counterValue__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor MapEntry Int64
-> FieldDescriptor MapEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"counter_value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens MapEntry MapEntry (Maybe Int64) (Maybe Int64)
-> FieldAccessor MapEntry Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterValue")) ::
              Data.ProtoLens.FieldDescriptor MapEntry
        setValue__field_descriptor :: FieldDescriptor MapEntry
setValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor MapEntry ByteString
-> FieldDescriptor MapEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"set_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' MapEntry [ByteString] -> FieldAccessor MapEntry ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"setValue")) ::
              Data.ProtoLens.FieldDescriptor MapEntry
        registerValue__field_descriptor :: FieldDescriptor MapEntry
registerValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor MapEntry ByteString
-> FieldDescriptor MapEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"register_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens MapEntry MapEntry (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor MapEntry ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'registerValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'registerValue")) ::
              Data.ProtoLens.FieldDescriptor MapEntry
        flagValue__field_descriptor :: FieldDescriptor MapEntry
flagValue__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor MapEntry Bool
-> FieldDescriptor MapEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"flag_value"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens MapEntry MapEntry (Maybe Bool) (Maybe Bool)
-> FieldAccessor MapEntry Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'flagValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'flagValue")) ::
              Data.ProtoLens.FieldDescriptor MapEntry
        mapValue__field_descriptor :: FieldDescriptor MapEntry
mapValue__field_descriptor
          = String
-> FieldTypeDescriptor MapEntry
-> FieldAccessor MapEntry MapEntry
-> FieldDescriptor MapEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"map_value"
              (MessageOrGroup -> FieldTypeDescriptor MapEntry
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapEntry)
              (Packing
-> Lens' MapEntry [MapEntry] -> FieldAccessor MapEntry MapEntry
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"mapValue")) ::
              Data.ProtoLens.FieldDescriptor MapEntry
      in
        [(Tag, FieldDescriptor MapEntry)]
-> Map Tag (FieldDescriptor MapEntry)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor MapEntry
field__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor MapEntry
counterValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor MapEntry
setValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor MapEntry
registerValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor MapEntry
flagValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor MapEntry
mapValue__field_descriptor)]
  unknownFields :: LensLike' f MapEntry FieldSet
unknownFields
    = (MapEntry -> FieldSet)
-> (MapEntry -> FieldSet -> MapEntry) -> Lens' MapEntry FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        MapEntry -> FieldSet
_MapEntry'_unknownFields
        (\ MapEntry
x__ FieldSet
y__ -> MapEntry
x__ {_MapEntry'_unknownFields :: FieldSet
_MapEntry'_unknownFields = FieldSet
y__})
  defMessage :: MapEntry
defMessage
    = MapEntry'_constructor :: MapField
-> Maybe Int64
-> Vector ByteString
-> Maybe ByteString
-> Maybe Bool
-> Vector MapEntry
-> FieldSet
-> MapEntry
MapEntry'_constructor
        {_MapEntry'field :: MapField
_MapEntry'field = MapField
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _MapEntry'counterValue :: Maybe Int64
_MapEntry'counterValue = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _MapEntry'setValue :: Vector ByteString
_MapEntry'setValue = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _MapEntry'registerValue :: Maybe ByteString
_MapEntry'registerValue = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _MapEntry'flagValue :: Maybe Bool
_MapEntry'flagValue = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _MapEntry'mapValue :: Vector MapEntry
_MapEntry'mapValue = Vector MapEntry
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _MapEntry'_unknownFields :: FieldSet
_MapEntry'_unknownFields = []}
  parseMessage :: Parser MapEntry
parseMessage
    = let
        loop ::
          MapEntry
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld MapEntry
                -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
                   -> Data.ProtoLens.Encoding.Bytes.Parser MapEntry
        loop :: MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop MapEntry
x Bool
required'field Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
mutable'setValue
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector MapEntry
frozen'mapValue <- IO (Vector MapEntry) -> Parser (Vector MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) MapEntry -> IO (Vector MapEntry)
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 MapEntry
Growing Vector (PrimState IO) MapEntry
mutable'mapValue)
                      Vector ByteString
frozen'setValue <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'setValue)
                      (let
                         missing :: [String]
missing = (if Bool
required'field then (:) String
"field" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      MapEntry -> Parser MapEntry
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter MapEntry MapEntry FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapEntry -> MapEntry
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 MapEntry MapEntry FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter MapEntry MapEntry (Vector MapEntry) (Vector MapEntry)
-> Vector MapEntry -> MapEntry -> MapEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'mapValue")
                              Vector MapEntry
frozen'mapValue
                              (Setter MapEntry MapEntry (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> MapEntry -> MapEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'setValue") Vector ByteString
frozen'setValue MapEntry
x)))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do MapField
y <- Parser MapField -> String -> Parser MapField
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser MapField -> Parser MapField
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 MapField
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"field"
                                MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop
                                  (Setter MapEntry MapEntry MapField MapField
-> MapField -> MapEntry -> MapEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "field" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"field") MapField
y MapEntry
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
16
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"counter_value"
                                MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop
                                  (Setter MapEntry MapEntry Int64 Int64
-> Int64 -> MapEntry -> MapEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"counterValue") Int64
y MapEntry
x)
                                  Bool
required'field
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
26
                          -> 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
"set_value"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'setValue ByteString
y)
                                MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop MapEntry
x Bool
required'field Growing Vector RealWorld MapEntry
mutable'mapValue Growing Vector RealWorld ByteString
v
                        Word64
34
                          -> 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
"register_value"
                                MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop
                                  (Setter MapEntry MapEntry ByteString ByteString
-> ByteString -> MapEntry -> MapEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "registerValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"registerValue") ByteString
y MapEntry
x)
                                  Bool
required'field
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
40
                          -> 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
"flag_value"
                                MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop
                                  (Setter MapEntry MapEntry Bool Bool -> Bool -> MapEntry -> MapEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "flagValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"flagValue") Bool
y MapEntry
x)
                                  Bool
required'field
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
50
                          -> do !MapEntry
y <- Parser MapEntry -> String -> Parser MapEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser MapEntry -> Parser MapEntry
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 MapEntry
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"map_value"
                                Growing Vector RealWorld MapEntry
v <- IO (Growing Vector RealWorld MapEntry)
-> Parser (Growing Vector RealWorld MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) MapEntry
-> MapEntry -> IO (Growing Vector (PrimState IO) MapEntry)
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 MapEntry
Growing Vector (PrimState IO) MapEntry
mutable'mapValue MapEntry
y)
                                MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop MapEntry
x Bool
required'field Growing Vector RealWorld MapEntry
v Growing Vector RealWorld ByteString
mutable'setValue
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop
                                  (Setter MapEntry MapEntry FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapEntry -> MapEntry
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 MapEntry MapEntry FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) MapEntry
x)
                                  Bool
required'field
                                  Growing Vector RealWorld MapEntry
mutable'mapValue
                                  Growing Vector RealWorld ByteString
mutable'setValue
      in
        Parser MapEntry -> String -> Parser MapEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld MapEntry
mutable'mapValue <- IO (Growing Vector RealWorld MapEntry)
-> Parser (Growing Vector RealWorld MapEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld MapEntry)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld ByteString
mutable'setValue <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              MapEntry
-> Bool
-> Growing Vector RealWorld MapEntry
-> Growing Vector RealWorld ByteString
-> Parser MapEntry
loop
                MapEntry
forall msg. Message msg => msg
Data.ProtoLens.defMessage
                Bool
Prelude.True
                Growing Vector RealWorld MapEntry
mutable'mapValue
                Growing Vector RealWorld ByteString
mutable'setValue)
          String
"MapEntry"
  buildMessage :: MapEntry -> Builder
buildMessage
    = \ MapEntry
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                ((ByteString -> Builder)
-> (MapField -> ByteString) -> MapField -> 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))
                   MapField -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                   (FoldLike MapField MapEntry MapEntry MapField MapField
-> MapEntry -> MapField
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "field" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"field") MapEntry
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Int64) MapEntry MapEntry (Maybe Int64) (Maybe Int64)
-> MapEntry -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'counterValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterValue") MapEntry
_x
                 of
                   Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Int64
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                             Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                             Int64
_v))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                      (\ ByteString
_v
                         -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                              (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                              ((\ 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))
                      (FoldLike
  (Vector ByteString)
  MapEntry
  MapEntry
  (Vector ByteString)
  (Vector ByteString)
-> MapEntry -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                         (forall s a (f :: * -> *).
(HasField s "vec'setValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'setValue") MapEntry
_x))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe ByteString)
  MapEntry
  MapEntry
  (Maybe ByteString)
  (Maybe ByteString)
-> MapEntry -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                             (forall s a (f :: * -> *).
(HasField s "maybe'registerValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'registerValue") MapEntry
_x
                       of
                         Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just ByteString
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((\ 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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike (Maybe Bool) MapEntry MapEntry (Maybe Bool) (Maybe Bool)
-> MapEntry -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                (forall s a (f :: * -> *).
(HasField s "maybe'flagValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'flagValue") MapEntry
_x
                          of
                            Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Bool
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            ((MapEntry -> Builder) -> Vector MapEntry -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                               (\ MapEntry
_v
                                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                                       ((ByteString -> Builder)
-> (MapEntry -> ByteString) -> MapEntry -> 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))
                                          MapEntry -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                          MapEntry
_v))
                               (FoldLike
  (Vector MapEntry)
  MapEntry
  MapEntry
  (Vector MapEntry)
  (Vector MapEntry)
-> MapEntry -> Vector MapEntry
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                  (forall s a (f :: * -> *).
(HasField s "vec'mapValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'mapValue") MapEntry
_x))
                            (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                               (FoldLike FieldSet MapEntry MapEntry FieldSet FieldSet
-> MapEntry -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet MapEntry MapEntry FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields MapEntry
_x)))))))
instance Control.DeepSeq.NFData MapEntry where
  rnf :: MapEntry -> ()
rnf
    = \ MapEntry
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (MapEntry -> FieldSet
_MapEntry'_unknownFields MapEntry
x__)
             (MapField -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (MapEntry -> MapField
_MapEntry'field MapEntry
x__)
                (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (MapEntry -> Maybe Int64
_MapEntry'counterValue MapEntry
x__)
                   (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (MapEntry -> Vector ByteString
_MapEntry'setValue MapEntry
x__)
                      (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (MapEntry -> Maybe ByteString
_MapEntry'registerValue MapEntry
x__)
                         (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (MapEntry -> Maybe Bool
_MapEntry'flagValue MapEntry
x__)
                            (Vector MapEntry -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (MapEntry -> Vector MapEntry
_MapEntry'mapValue MapEntry
x__) ()))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.name' @:: Lens' MapField Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.type'' @:: Lens' MapField MapField'MapFieldType@ -}
data MapField
  = MapField'_constructor {MapField -> ByteString
_MapField'name :: !Data.ByteString.ByteString,
                           MapField -> MapField'MapFieldType
_MapField'type' :: !MapField'MapFieldType,
                           MapField -> FieldSet
_MapField'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (MapField -> MapField -> Bool
(MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool) -> Eq MapField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapField -> MapField -> Bool
$c/= :: MapField -> MapField -> Bool
== :: MapField -> MapField -> Bool
$c== :: MapField -> MapField -> Bool
Prelude.Eq, Eq MapField
Eq MapField
-> (MapField -> MapField -> Ordering)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> MapField)
-> (MapField -> MapField -> MapField)
-> Ord MapField
MapField -> MapField -> Bool
MapField -> MapField -> Ordering
MapField -> MapField -> MapField
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 :: MapField -> MapField -> MapField
$cmin :: MapField -> MapField -> MapField
max :: MapField -> MapField -> MapField
$cmax :: MapField -> MapField -> MapField
>= :: MapField -> MapField -> Bool
$c>= :: MapField -> MapField -> Bool
> :: MapField -> MapField -> Bool
$c> :: MapField -> MapField -> Bool
<= :: MapField -> MapField -> Bool
$c<= :: MapField -> MapField -> Bool
< :: MapField -> MapField -> Bool
$c< :: MapField -> MapField -> Bool
compare :: MapField -> MapField -> Ordering
$ccompare :: MapField -> MapField -> Ordering
$cp1Ord :: Eq MapField
Prelude.Ord)
instance Prelude.Show MapField where
  showsPrec :: Int -> MapField -> ShowS
showsPrec Int
_ MapField
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (MapField -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort MapField
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField MapField "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString) -> MapField -> f MapField
fieldOf Proxy# "name"
_
    = ((ByteString -> f ByteString) -> MapField -> f MapField)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> MapField
-> f MapField
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapField -> ByteString)
-> (MapField -> ByteString -> MapField)
-> Lens MapField MapField ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapField -> ByteString
_MapField'name (\ MapField
x__ ByteString
y__ -> MapField
x__ {_MapField'name :: ByteString
_MapField'name = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapField "type'" MapField'MapFieldType where
  fieldOf :: Proxy# "type'"
-> (MapField'MapFieldType -> f MapField'MapFieldType)
-> MapField
-> f MapField
fieldOf Proxy# "type'"
_
    = ((MapField'MapFieldType -> f MapField'MapFieldType)
 -> MapField -> f MapField)
-> ((MapField'MapFieldType -> f MapField'MapFieldType)
    -> MapField'MapFieldType -> f MapField'MapFieldType)
-> (MapField'MapFieldType -> f MapField'MapFieldType)
-> MapField
-> f MapField
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapField -> MapField'MapFieldType)
-> (MapField -> MapField'MapFieldType -> MapField)
-> Lens
     MapField MapField MapField'MapFieldType MapField'MapFieldType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapField -> MapField'MapFieldType
_MapField'type' (\ MapField
x__ MapField'MapFieldType
y__ -> MapField
x__ {_MapField'type' :: MapField'MapFieldType
_MapField'type' = MapField'MapFieldType
y__}))
        (MapField'MapFieldType -> f MapField'MapFieldType)
-> MapField'MapFieldType -> f MapField'MapFieldType
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message MapField where
  messageName :: Proxy MapField -> Text
messageName Proxy MapField
_ = String -> Text
Data.Text.pack String
"MapField"
  packedMessageDescriptor :: Proxy MapField -> ByteString
packedMessageDescriptor Proxy MapField
_
    = ByteString
"\n\
      \\bMapField\DC2\DC2\n\
      \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2*\n\
      \\EOTtype\CAN\STX \STX(\SO2\SYN.MapField.MapFieldTypeR\EOTtype\"E\n\
      \\fMapFieldType\DC2\v\n\
      \\aCOUNTER\DLE\SOH\DC2\a\n\
      \\ETXSET\DLE\STX\DC2\f\n\
      \\bREGISTER\DLE\ETX\DC2\b\n\
      \\EOTFLAG\DLE\EOT\DC2\a\n\
      \\ETXMAP\DLE\ENQ"
  packedFileDescriptor :: Proxy MapField -> ByteString
packedFileDescriptor Proxy MapField
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor MapField)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor MapField
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor MapField ByteString
-> FieldDescriptor MapField
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (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 MapField MapField ByteString ByteString
-> FieldAccessor MapField ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name")) ::
              Data.ProtoLens.FieldDescriptor MapField
        type'__field_descriptor :: FieldDescriptor MapField
type'__field_descriptor
          = String
-> FieldTypeDescriptor MapField'MapFieldType
-> FieldAccessor MapField MapField'MapFieldType
-> FieldDescriptor MapField
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField MapField'MapFieldType
-> FieldTypeDescriptor MapField'MapFieldType
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField MapField'MapFieldType
forall t. MessageEnum t => ScalarField t
Data.ProtoLens.EnumField ::
                 Data.ProtoLens.FieldTypeDescriptor MapField'MapFieldType)
              (WireDefault MapField'MapFieldType
-> Lens
     MapField MapField MapField'MapFieldType MapField'MapFieldType
-> FieldAccessor MapField MapField'MapFieldType
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault MapField'MapFieldType
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'")) ::
              Data.ProtoLens.FieldDescriptor MapField
      in
        [(Tag, FieldDescriptor MapField)]
-> Map Tag (FieldDescriptor MapField)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor MapField
name__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor MapField
type'__field_descriptor)]
  unknownFields :: LensLike' f MapField FieldSet
unknownFields
    = (MapField -> FieldSet)
-> (MapField -> FieldSet -> MapField) -> Lens' MapField FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        MapField -> FieldSet
_MapField'_unknownFields
        (\ MapField
x__ FieldSet
y__ -> MapField
x__ {_MapField'_unknownFields :: FieldSet
_MapField'_unknownFields = FieldSet
y__})
  defMessage :: MapField
defMessage
    = MapField'_constructor :: ByteString -> MapField'MapFieldType -> FieldSet -> MapField
MapField'_constructor
        {_MapField'name :: ByteString
_MapField'name = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _MapField'type' :: MapField'MapFieldType
_MapField'type' = MapField'MapFieldType
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _MapField'_unknownFields :: FieldSet
_MapField'_unknownFields = []}
  parseMessage :: Parser MapField
parseMessage
    = let
        loop ::
          MapField
          -> Prelude.Bool
             -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser MapField
        loop :: MapField -> Bool -> Bool -> Parser MapField
loop MapField
x Bool
required'name Bool
required'type'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'name then (:) String
"name" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'type' then (:) String
"type" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      MapField -> Parser MapField
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter MapField MapField FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapField -> MapField
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 MapField MapField FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) MapField
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
"name"
                                MapField -> Bool -> Bool -> Parser MapField
loop
                                  (Setter MapField MapField ByteString ByteString
-> ByteString -> MapField -> MapField
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y MapField
x)
                                  Bool
Prelude.False
                                  Bool
required'type'
                        Word64
16
                          -> do MapField'MapFieldType
y <- Parser MapField'MapFieldType
-> String -> Parser MapField'MapFieldType
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Int -> MapField'MapFieldType)
-> Parser Int -> Parser MapField'MapFieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Int -> MapField'MapFieldType
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
"type"
                                MapField -> Bool -> Bool -> Parser MapField
loop
                                  (Setter
  MapField MapField MapField'MapFieldType MapField'MapFieldType
-> MapField'MapFieldType -> MapField -> MapField
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") MapField'MapFieldType
y MapField
x)
                                  Bool
required'name
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                MapField -> Bool -> Bool -> Parser MapField
loop
                                  (Setter MapField MapField FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapField -> MapField
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 MapField MapField FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) MapField
x)
                                  Bool
required'name
                                  Bool
required'type'
      in
        Parser MapField -> String -> Parser MapField
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do MapField -> Bool -> Bool -> Parser MapField
loop MapField
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"MapField"
  buildMessage :: MapField -> Builder
buildMessage
    = \ MapField
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString MapField MapField ByteString ByteString
-> MapField -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") MapField
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                   ((Int -> Builder)
-> (MapField'MapFieldType -> Int)
-> MapField'MapFieldType
-> 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)
                      MapField'MapFieldType -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum
                      (FoldLike
  MapField'MapFieldType
  MapField
  MapField
  MapField'MapFieldType
  MapField'MapFieldType
-> MapField -> MapField'MapFieldType
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") MapField
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet MapField MapField FieldSet FieldSet
-> MapField -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet MapField MapField FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields MapField
_x)))
instance Control.DeepSeq.NFData MapField where
  rnf :: MapField -> ()
rnf
    = \ MapField
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (MapField -> FieldSet
_MapField'_unknownFields MapField
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (MapField -> ByteString
_MapField'name MapField
x__)
                (MapField'MapFieldType -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (MapField -> MapField'MapFieldType
_MapField'type' MapField
x__) ()))
data MapField'MapFieldType
  = MapField'COUNTER |
    MapField'SET |
    MapField'REGISTER |
    MapField'FLAG |
    MapField'MAP
  deriving stock (Int -> MapField'MapFieldType -> ShowS
[MapField'MapFieldType] -> ShowS
MapField'MapFieldType -> String
(Int -> MapField'MapFieldType -> ShowS)
-> (MapField'MapFieldType -> String)
-> ([MapField'MapFieldType] -> ShowS)
-> Show MapField'MapFieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapField'MapFieldType] -> ShowS
$cshowList :: [MapField'MapFieldType] -> ShowS
show :: MapField'MapFieldType -> String
$cshow :: MapField'MapFieldType -> String
showsPrec :: Int -> MapField'MapFieldType -> ShowS
$cshowsPrec :: Int -> MapField'MapFieldType -> ShowS
Prelude.Show, MapField'MapFieldType -> MapField'MapFieldType -> Bool
(MapField'MapFieldType -> MapField'MapFieldType -> Bool)
-> (MapField'MapFieldType -> MapField'MapFieldType -> Bool)
-> Eq MapField'MapFieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
$c/= :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
== :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
$c== :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
Prelude.Eq, Eq MapField'MapFieldType
Eq MapField'MapFieldType
-> (MapField'MapFieldType -> MapField'MapFieldType -> Ordering)
-> (MapField'MapFieldType -> MapField'MapFieldType -> Bool)
-> (MapField'MapFieldType -> MapField'MapFieldType -> Bool)
-> (MapField'MapFieldType -> MapField'MapFieldType -> Bool)
-> (MapField'MapFieldType -> MapField'MapFieldType -> Bool)
-> (MapField'MapFieldType
    -> MapField'MapFieldType -> MapField'MapFieldType)
-> (MapField'MapFieldType
    -> MapField'MapFieldType -> MapField'MapFieldType)
-> Ord MapField'MapFieldType
MapField'MapFieldType -> MapField'MapFieldType -> Bool
MapField'MapFieldType -> MapField'MapFieldType -> Ordering
MapField'MapFieldType
-> MapField'MapFieldType -> MapField'MapFieldType
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 :: MapField'MapFieldType
-> MapField'MapFieldType -> MapField'MapFieldType
$cmin :: MapField'MapFieldType
-> MapField'MapFieldType -> MapField'MapFieldType
max :: MapField'MapFieldType
-> MapField'MapFieldType -> MapField'MapFieldType
$cmax :: MapField'MapFieldType
-> MapField'MapFieldType -> MapField'MapFieldType
>= :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
$c>= :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
> :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
$c> :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
<= :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
$c<= :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
< :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
$c< :: MapField'MapFieldType -> MapField'MapFieldType -> Bool
compare :: MapField'MapFieldType -> MapField'MapFieldType -> Ordering
$ccompare :: MapField'MapFieldType -> MapField'MapFieldType -> Ordering
$cp1Ord :: Eq MapField'MapFieldType
Prelude.Ord)
instance Data.ProtoLens.MessageEnum MapField'MapFieldType where
  maybeToEnum :: Int -> Maybe MapField'MapFieldType
maybeToEnum Int
1 = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'COUNTER
  maybeToEnum Int
2 = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'SET
  maybeToEnum Int
3 = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'REGISTER
  maybeToEnum Int
4 = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'FLAG
  maybeToEnum Int
5 = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'MAP
  maybeToEnum Int
_ = Maybe MapField'MapFieldType
forall a. Maybe a
Prelude.Nothing
  showEnum :: MapField'MapFieldType -> String
showEnum MapField'MapFieldType
MapField'COUNTER = String
"COUNTER"
  showEnum MapField'MapFieldType
MapField'SET = String
"SET"
  showEnum MapField'MapFieldType
MapField'REGISTER = String
"REGISTER"
  showEnum MapField'MapFieldType
MapField'FLAG = String
"FLAG"
  showEnum MapField'MapFieldType
MapField'MAP = String
"MAP"
  readEnum :: String -> Maybe MapField'MapFieldType
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"COUNTER" = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'COUNTER
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"SET" = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'SET
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"REGISTER" = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'REGISTER
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"FLAG" = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'FLAG
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"MAP" = MapField'MapFieldType -> Maybe MapField'MapFieldType
forall a. a -> Maybe a
Prelude.Just MapField'MapFieldType
MapField'MAP
    | Bool
Prelude.otherwise
    = Maybe Int
-> (Int -> Maybe MapField'MapFieldType)
-> Maybe MapField'MapFieldType
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 MapField'MapFieldType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded MapField'MapFieldType where
  minBound :: MapField'MapFieldType
minBound = MapField'MapFieldType
MapField'COUNTER
  maxBound :: MapField'MapFieldType
maxBound = MapField'MapFieldType
MapField'MAP
instance Prelude.Enum MapField'MapFieldType where
  toEnum :: Int -> MapField'MapFieldType
toEnum Int
k__
    = MapField'MapFieldType
-> (MapField'MapFieldType -> MapField'MapFieldType)
-> Maybe MapField'MapFieldType
-> MapField'MapFieldType
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> MapField'MapFieldType
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum MapFieldType: "
              (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        MapField'MapFieldType -> MapField'MapFieldType
forall a. a -> a
Prelude.id
        (Int -> Maybe MapField'MapFieldType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: MapField'MapFieldType -> Int
fromEnum MapField'MapFieldType
MapField'COUNTER = Int
1
  fromEnum MapField'MapFieldType
MapField'SET = Int
2
  fromEnum MapField'MapFieldType
MapField'REGISTER = Int
3
  fromEnum MapField'MapFieldType
MapField'FLAG = Int
4
  fromEnum MapField'MapFieldType
MapField'MAP = Int
5
  succ :: MapField'MapFieldType -> MapField'MapFieldType
succ MapField'MapFieldType
MapField'MAP
    = String -> MapField'MapFieldType
forall a. HasCallStack => String -> a
Prelude.error
        String
"MapField'MapFieldType.succ: bad argument MapField'MAP. This value would be out of bounds."
  succ MapField'MapFieldType
MapField'COUNTER = MapField'MapFieldType
MapField'SET
  succ MapField'MapFieldType
MapField'SET = MapField'MapFieldType
MapField'REGISTER
  succ MapField'MapFieldType
MapField'REGISTER = MapField'MapFieldType
MapField'FLAG
  succ MapField'MapFieldType
MapField'FLAG = MapField'MapFieldType
MapField'MAP
  pred :: MapField'MapFieldType -> MapField'MapFieldType
pred MapField'MapFieldType
MapField'COUNTER
    = String -> MapField'MapFieldType
forall a. HasCallStack => String -> a
Prelude.error
        String
"MapField'MapFieldType.pred: bad argument MapField'COUNTER. This value would be out of bounds."
  pred MapField'MapFieldType
MapField'SET = MapField'MapFieldType
MapField'COUNTER
  pred MapField'MapFieldType
MapField'REGISTER = MapField'MapFieldType
MapField'SET
  pred MapField'MapFieldType
MapField'FLAG = MapField'MapFieldType
MapField'REGISTER
  pred MapField'MapFieldType
MapField'MAP = MapField'MapFieldType
MapField'FLAG
  enumFrom :: MapField'MapFieldType -> [MapField'MapFieldType]
enumFrom = MapField'MapFieldType -> [MapField'MapFieldType]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: MapField'MapFieldType
-> MapField'MapFieldType -> [MapField'MapFieldType]
enumFromTo = MapField'MapFieldType
-> MapField'MapFieldType -> [MapField'MapFieldType]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: MapField'MapFieldType
-> MapField'MapFieldType -> [MapField'MapFieldType]
enumFromThen = MapField'MapFieldType
-> MapField'MapFieldType -> [MapField'MapFieldType]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: MapField'MapFieldType
-> MapField'MapFieldType
-> MapField'MapFieldType
-> [MapField'MapFieldType]
enumFromThenTo = MapField'MapFieldType
-> MapField'MapFieldType
-> MapField'MapFieldType
-> [MapField'MapFieldType]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault MapField'MapFieldType where
  fieldDefault :: MapField'MapFieldType
fieldDefault = MapField'MapFieldType
MapField'COUNTER
instance Control.DeepSeq.NFData MapField'MapFieldType where
  rnf :: MapField'MapFieldType -> ()
rnf MapField'MapFieldType
x__ = MapField'MapFieldType -> () -> ()
Prelude.seq MapField'MapFieldType
x__ ()
{- | Fields :
     
         * 'Proto.Riak_Fields.removes' @:: Lens' MapOp [MapField]@
         * 'Proto.Riak_Fields.vec'removes' @:: Lens' MapOp (Data.Vector.Vector MapField)@
         * 'Proto.Riak_Fields.updates' @:: Lens' MapOp [MapUpdate]@
         * 'Proto.Riak_Fields.vec'updates' @:: Lens' MapOp (Data.Vector.Vector MapUpdate)@ -}
data MapOp
  = MapOp'_constructor {MapOp -> Vector MapField
_MapOp'removes :: !(Data.Vector.Vector MapField),
                        MapOp -> Vector MapUpdate
_MapOp'updates :: !(Data.Vector.Vector MapUpdate),
                        MapOp -> FieldSet
_MapOp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (MapOp -> MapOp -> Bool
(MapOp -> MapOp -> Bool) -> (MapOp -> MapOp -> Bool) -> Eq MapOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapOp -> MapOp -> Bool
$c/= :: MapOp -> MapOp -> Bool
== :: MapOp -> MapOp -> Bool
$c== :: MapOp -> MapOp -> Bool
Prelude.Eq, Eq MapOp
Eq MapOp
-> (MapOp -> MapOp -> Ordering)
-> (MapOp -> MapOp -> Bool)
-> (MapOp -> MapOp -> Bool)
-> (MapOp -> MapOp -> Bool)
-> (MapOp -> MapOp -> Bool)
-> (MapOp -> MapOp -> MapOp)
-> (MapOp -> MapOp -> MapOp)
-> Ord MapOp
MapOp -> MapOp -> Bool
MapOp -> MapOp -> Ordering
MapOp -> MapOp -> MapOp
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 :: MapOp -> MapOp -> MapOp
$cmin :: MapOp -> MapOp -> MapOp
max :: MapOp -> MapOp -> MapOp
$cmax :: MapOp -> MapOp -> MapOp
>= :: MapOp -> MapOp -> Bool
$c>= :: MapOp -> MapOp -> Bool
> :: MapOp -> MapOp -> Bool
$c> :: MapOp -> MapOp -> Bool
<= :: MapOp -> MapOp -> Bool
$c<= :: MapOp -> MapOp -> Bool
< :: MapOp -> MapOp -> Bool
$c< :: MapOp -> MapOp -> Bool
compare :: MapOp -> MapOp -> Ordering
$ccompare :: MapOp -> MapOp -> Ordering
$cp1Ord :: Eq MapOp
Prelude.Ord)
instance Prelude.Show MapOp where
  showsPrec :: Int -> MapOp -> ShowS
showsPrec Int
_ MapOp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (MapOp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort MapOp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField MapOp "removes" [MapField] where
  fieldOf :: Proxy# "removes"
-> ([MapField] -> f [MapField]) -> MapOp -> f MapOp
fieldOf Proxy# "removes"
_
    = ((Vector MapField -> f (Vector MapField)) -> MapOp -> f MapOp)
-> (([MapField] -> f [MapField])
    -> Vector MapField -> f (Vector MapField))
-> ([MapField] -> f [MapField])
-> MapOp
-> f MapOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapOp -> Vector MapField)
-> (MapOp -> Vector MapField -> MapOp)
-> Lens MapOp MapOp (Vector MapField) (Vector MapField)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapOp -> Vector MapField
_MapOp'removes (\ MapOp
x__ Vector MapField
y__ -> MapOp
x__ {_MapOp'removes :: Vector MapField
_MapOp'removes = Vector MapField
y__}))
        ((Vector MapField -> [MapField])
-> (Vector MapField -> [MapField] -> Vector MapField)
-> Lens (Vector MapField) (Vector MapField) [MapField] [MapField]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector MapField -> [MapField]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector MapField
_ [MapField]
y__ -> [MapField] -> Vector MapField
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [MapField]
y__))
instance Data.ProtoLens.Field.HasField MapOp "vec'removes" (Data.Vector.Vector MapField) where
  fieldOf :: Proxy# "vec'removes"
-> (Vector MapField -> f (Vector MapField)) -> MapOp -> f MapOp
fieldOf Proxy# "vec'removes"
_
    = ((Vector MapField -> f (Vector MapField)) -> MapOp -> f MapOp)
-> ((Vector MapField -> f (Vector MapField))
    -> Vector MapField -> f (Vector MapField))
-> (Vector MapField -> f (Vector MapField))
-> MapOp
-> f MapOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapOp -> Vector MapField)
-> (MapOp -> Vector MapField -> MapOp)
-> Lens MapOp MapOp (Vector MapField) (Vector MapField)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapOp -> Vector MapField
_MapOp'removes (\ MapOp
x__ Vector MapField
y__ -> MapOp
x__ {_MapOp'removes :: Vector MapField
_MapOp'removes = Vector MapField
y__}))
        (Vector MapField -> f (Vector MapField))
-> Vector MapField -> f (Vector MapField)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapOp "updates" [MapUpdate] where
  fieldOf :: Proxy# "updates"
-> ([MapUpdate] -> f [MapUpdate]) -> MapOp -> f MapOp
fieldOf Proxy# "updates"
_
    = ((Vector MapUpdate -> f (Vector MapUpdate)) -> MapOp -> f MapOp)
-> (([MapUpdate] -> f [MapUpdate])
    -> Vector MapUpdate -> f (Vector MapUpdate))
-> ([MapUpdate] -> f [MapUpdate])
-> MapOp
-> f MapOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapOp -> Vector MapUpdate)
-> (MapOp -> Vector MapUpdate -> MapOp)
-> Lens MapOp MapOp (Vector MapUpdate) (Vector MapUpdate)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapOp -> Vector MapUpdate
_MapOp'updates (\ MapOp
x__ Vector MapUpdate
y__ -> MapOp
x__ {_MapOp'updates :: Vector MapUpdate
_MapOp'updates = Vector MapUpdate
y__}))
        ((Vector MapUpdate -> [MapUpdate])
-> (Vector MapUpdate -> [MapUpdate] -> Vector MapUpdate)
-> Lens
     (Vector MapUpdate) (Vector MapUpdate) [MapUpdate] [MapUpdate]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector MapUpdate -> [MapUpdate]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector MapUpdate
_ [MapUpdate]
y__ -> [MapUpdate] -> Vector MapUpdate
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [MapUpdate]
y__))
instance Data.ProtoLens.Field.HasField MapOp "vec'updates" (Data.Vector.Vector MapUpdate) where
  fieldOf :: Proxy# "vec'updates"
-> (Vector MapUpdate -> f (Vector MapUpdate)) -> MapOp -> f MapOp
fieldOf Proxy# "vec'updates"
_
    = ((Vector MapUpdate -> f (Vector MapUpdate)) -> MapOp -> f MapOp)
-> ((Vector MapUpdate -> f (Vector MapUpdate))
    -> Vector MapUpdate -> f (Vector MapUpdate))
-> (Vector MapUpdate -> f (Vector MapUpdate))
-> MapOp
-> f MapOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapOp -> Vector MapUpdate)
-> (MapOp -> Vector MapUpdate -> MapOp)
-> Lens MapOp MapOp (Vector MapUpdate) (Vector MapUpdate)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapOp -> Vector MapUpdate
_MapOp'updates (\ MapOp
x__ Vector MapUpdate
y__ -> MapOp
x__ {_MapOp'updates :: Vector MapUpdate
_MapOp'updates = Vector MapUpdate
y__}))
        (Vector MapUpdate -> f (Vector MapUpdate))
-> Vector MapUpdate -> f (Vector MapUpdate)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message MapOp where
  messageName :: Proxy MapOp -> Text
messageName Proxy MapOp
_ = String -> Text
Data.Text.pack String
"MapOp"
  packedMessageDescriptor :: Proxy MapOp -> ByteString
packedMessageDescriptor Proxy MapOp
_
    = ByteString
"\n\
      \\ENQMapOp\DC2#\n\
      \\aremoves\CAN\SOH \ETX(\v2\t.MapFieldR\aremoves\DC2$\n\
      \\aupdates\CAN\STX \ETX(\v2\n\
      \.MapUpdateR\aupdates"
  packedFileDescriptor :: Proxy MapOp -> ByteString
packedFileDescriptor Proxy MapOp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor MapOp)
fieldsByTag
    = let
        removes__field_descriptor :: FieldDescriptor MapOp
removes__field_descriptor
          = String
-> FieldTypeDescriptor MapField
-> FieldAccessor MapOp MapField
-> FieldDescriptor MapOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"removes"
              (MessageOrGroup -> FieldTypeDescriptor MapField
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapField)
              (Packing -> Lens' MapOp [MapField] -> FieldAccessor MapOp MapField
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "removes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"removes")) ::
              Data.ProtoLens.FieldDescriptor MapOp
        updates__field_descriptor :: FieldDescriptor MapOp
updates__field_descriptor
          = String
-> FieldTypeDescriptor MapUpdate
-> FieldAccessor MapOp MapUpdate
-> FieldDescriptor MapOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"updates"
              (MessageOrGroup -> FieldTypeDescriptor MapUpdate
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapUpdate)
              (Packing -> Lens' MapOp [MapUpdate] -> FieldAccessor MapOp MapUpdate
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "updates" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"updates")) ::
              Data.ProtoLens.FieldDescriptor MapOp
      in
        [(Tag, FieldDescriptor MapOp)] -> Map Tag (FieldDescriptor MapOp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor MapOp
removes__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor MapOp
updates__field_descriptor)]
  unknownFields :: LensLike' f MapOp FieldSet
unknownFields
    = (MapOp -> FieldSet)
-> (MapOp -> FieldSet -> MapOp) -> Lens' MapOp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        MapOp -> FieldSet
_MapOp'_unknownFields
        (\ MapOp
x__ FieldSet
y__ -> MapOp
x__ {_MapOp'_unknownFields :: FieldSet
_MapOp'_unknownFields = FieldSet
y__})
  defMessage :: MapOp
defMessage
    = MapOp'_constructor :: Vector MapField -> Vector MapUpdate -> FieldSet -> MapOp
MapOp'_constructor
        {_MapOp'removes :: Vector MapField
_MapOp'removes = Vector MapField
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _MapOp'updates :: Vector MapUpdate
_MapOp'updates = Vector MapUpdate
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _MapOp'_unknownFields :: FieldSet
_MapOp'_unknownFields = []}
  parseMessage :: Parser MapOp
parseMessage
    = let
        loop ::
          MapOp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld MapField
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld MapUpdate
                -> Data.ProtoLens.Encoding.Bytes.Parser MapOp
        loop :: MapOp
-> Growing Vector RealWorld MapField
-> Growing Vector RealWorld MapUpdate
-> Parser MapOp
loop MapOp
x Growing Vector RealWorld MapField
mutable'removes Growing Vector RealWorld MapUpdate
mutable'updates
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector MapField
frozen'removes <- IO (Vector MapField) -> Parser (Vector MapField)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) MapField -> IO (Vector MapField)
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 MapField
Growing Vector (PrimState IO) MapField
mutable'removes)
                      Vector MapUpdate
frozen'updates <- IO (Vector MapUpdate) -> Parser (Vector MapUpdate)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) MapUpdate -> IO (Vector MapUpdate)
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 MapUpdate
Growing Vector (PrimState IO) MapUpdate
mutable'updates)
                      (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]))))
                      MapOp -> Parser MapOp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter MapOp MapOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapOp -> MapOp
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 MapOp MapOp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter MapOp MapOp (Vector MapField) (Vector MapField)
-> Vector MapField -> MapOp -> MapOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'removes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'removes")
                              Vector MapField
frozen'removes
                              (Setter MapOp MapOp (Vector MapUpdate) (Vector MapUpdate)
-> Vector MapUpdate -> MapOp -> MapOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'updates" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'updates") Vector MapUpdate
frozen'updates MapOp
x)))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !MapField
y <- Parser MapField -> String -> Parser MapField
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser MapField -> Parser MapField
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 MapField
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"removes"
                                Growing Vector RealWorld MapField
v <- IO (Growing Vector RealWorld MapField)
-> Parser (Growing Vector RealWorld MapField)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) MapField
-> MapField -> IO (Growing Vector (PrimState IO) MapField)
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 MapField
Growing Vector (PrimState IO) MapField
mutable'removes MapField
y)
                                MapOp
-> Growing Vector RealWorld MapField
-> Growing Vector RealWorld MapUpdate
-> Parser MapOp
loop MapOp
x Growing Vector RealWorld MapField
v Growing Vector RealWorld MapUpdate
mutable'updates
                        Word64
18
                          -> do !MapUpdate
y <- Parser MapUpdate -> String -> Parser MapUpdate
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser MapUpdate -> Parser MapUpdate
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 MapUpdate
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"updates"
                                Growing Vector RealWorld MapUpdate
v <- IO (Growing Vector RealWorld MapUpdate)
-> Parser (Growing Vector RealWorld MapUpdate)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) MapUpdate
-> MapUpdate -> IO (Growing Vector (PrimState IO) MapUpdate)
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 MapUpdate
Growing Vector (PrimState IO) MapUpdate
mutable'updates MapUpdate
y)
                                MapOp
-> Growing Vector RealWorld MapField
-> Growing Vector RealWorld MapUpdate
-> Parser MapOp
loop MapOp
x Growing Vector RealWorld MapField
mutable'removes Growing Vector RealWorld MapUpdate
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                MapOp
-> Growing Vector RealWorld MapField
-> Growing Vector RealWorld MapUpdate
-> Parser MapOp
loop
                                  (Setter MapOp MapOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapOp -> MapOp
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 MapOp MapOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) MapOp
x)
                                  Growing Vector RealWorld MapField
mutable'removes
                                  Growing Vector RealWorld MapUpdate
mutable'updates
      in
        Parser MapOp -> String -> Parser MapOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld MapField
mutable'removes <- IO (Growing Vector RealWorld MapField)
-> Parser (Growing Vector RealWorld MapField)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld MapField)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld MapUpdate
mutable'updates <- IO (Growing Vector RealWorld MapUpdate)
-> Parser (Growing Vector RealWorld MapUpdate)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld MapUpdate)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              MapOp
-> Growing Vector RealWorld MapField
-> Growing Vector RealWorld MapUpdate
-> Parser MapOp
loop MapOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld MapField
mutable'removes Growing Vector RealWorld MapUpdate
mutable'updates)
          String
"MapOp"
  buildMessage :: MapOp -> Builder
buildMessage
    = \ MapOp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((MapField -> Builder) -> Vector MapField -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ MapField
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (MapField -> ByteString) -> MapField -> 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))
                           MapField -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           MapField
_v))
                (FoldLike
  (Vector MapField) MapOp MapOp (Vector MapField) (Vector MapField)
-> MapOp -> Vector MapField
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'removes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'removes") MapOp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((MapUpdate -> Builder) -> Vector MapUpdate -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ MapUpdate
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (MapUpdate -> ByteString) -> MapUpdate -> 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))
                              MapUpdate -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              MapUpdate
_v))
                   (FoldLike
  (Vector MapUpdate)
  MapOp
  MapOp
  (Vector MapUpdate)
  (Vector MapUpdate)
-> MapOp -> Vector MapUpdate
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'updates" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'updates") MapOp
_x))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet MapOp MapOp FieldSet FieldSet
-> MapOp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet MapOp MapOp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields MapOp
_x)))
instance Control.DeepSeq.NFData MapOp where
  rnf :: MapOp -> ()
rnf
    = \ MapOp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (MapOp -> FieldSet
_MapOp'_unknownFields MapOp
x__)
             (Vector MapField -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (MapOp -> Vector MapField
_MapOp'removes MapOp
x__)
                (Vector MapUpdate -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (MapOp -> Vector MapUpdate
_MapOp'updates MapOp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.field' @:: Lens' MapUpdate MapField@
         * 'Proto.Riak_Fields.counterOp' @:: Lens' MapUpdate CounterOp@
         * 'Proto.Riak_Fields.maybe'counterOp' @:: Lens' MapUpdate (Prelude.Maybe CounterOp)@
         * 'Proto.Riak_Fields.setOp' @:: Lens' MapUpdate SetOp@
         * 'Proto.Riak_Fields.maybe'setOp' @:: Lens' MapUpdate (Prelude.Maybe SetOp)@
         * 'Proto.Riak_Fields.registerOp' @:: Lens' MapUpdate Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'registerOp' @:: Lens' MapUpdate (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.flagOp' @:: Lens' MapUpdate MapUpdate'FlagOp@
         * 'Proto.Riak_Fields.maybe'flagOp' @:: Lens' MapUpdate (Prelude.Maybe MapUpdate'FlagOp)@
         * 'Proto.Riak_Fields.mapOp' @:: Lens' MapUpdate MapOp@
         * 'Proto.Riak_Fields.maybe'mapOp' @:: Lens' MapUpdate (Prelude.Maybe MapOp)@ -}
data MapUpdate
  = MapUpdate'_constructor {MapUpdate -> MapField
_MapUpdate'field :: !MapField,
                            MapUpdate -> Maybe CounterOp
_MapUpdate'counterOp :: !(Prelude.Maybe CounterOp),
                            MapUpdate -> Maybe SetOp
_MapUpdate'setOp :: !(Prelude.Maybe SetOp),
                            MapUpdate -> Maybe ByteString
_MapUpdate'registerOp :: !(Prelude.Maybe Data.ByteString.ByteString),
                            MapUpdate -> Maybe MapUpdate'FlagOp
_MapUpdate'flagOp :: !(Prelude.Maybe MapUpdate'FlagOp),
                            MapUpdate -> Maybe MapOp
_MapUpdate'mapOp :: !(Prelude.Maybe MapOp),
                            MapUpdate -> FieldSet
_MapUpdate'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (MapUpdate -> MapUpdate -> Bool
(MapUpdate -> MapUpdate -> Bool)
-> (MapUpdate -> MapUpdate -> Bool) -> Eq MapUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapUpdate -> MapUpdate -> Bool
$c/= :: MapUpdate -> MapUpdate -> Bool
== :: MapUpdate -> MapUpdate -> Bool
$c== :: MapUpdate -> MapUpdate -> Bool
Prelude.Eq, Eq MapUpdate
Eq MapUpdate
-> (MapUpdate -> MapUpdate -> Ordering)
-> (MapUpdate -> MapUpdate -> Bool)
-> (MapUpdate -> MapUpdate -> Bool)
-> (MapUpdate -> MapUpdate -> Bool)
-> (MapUpdate -> MapUpdate -> Bool)
-> (MapUpdate -> MapUpdate -> MapUpdate)
-> (MapUpdate -> MapUpdate -> MapUpdate)
-> Ord MapUpdate
MapUpdate -> MapUpdate -> Bool
MapUpdate -> MapUpdate -> Ordering
MapUpdate -> MapUpdate -> MapUpdate
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 :: MapUpdate -> MapUpdate -> MapUpdate
$cmin :: MapUpdate -> MapUpdate -> MapUpdate
max :: MapUpdate -> MapUpdate -> MapUpdate
$cmax :: MapUpdate -> MapUpdate -> MapUpdate
>= :: MapUpdate -> MapUpdate -> Bool
$c>= :: MapUpdate -> MapUpdate -> Bool
> :: MapUpdate -> MapUpdate -> Bool
$c> :: MapUpdate -> MapUpdate -> Bool
<= :: MapUpdate -> MapUpdate -> Bool
$c<= :: MapUpdate -> MapUpdate -> Bool
< :: MapUpdate -> MapUpdate -> Bool
$c< :: MapUpdate -> MapUpdate -> Bool
compare :: MapUpdate -> MapUpdate -> Ordering
$ccompare :: MapUpdate -> MapUpdate -> Ordering
$cp1Ord :: Eq MapUpdate
Prelude.Ord)
instance Prelude.Show MapUpdate where
  showsPrec :: Int -> MapUpdate -> ShowS
showsPrec Int
_ MapUpdate
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (MapUpdate -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort MapUpdate
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField MapUpdate "field" MapField where
  fieldOf :: Proxy# "field"
-> (MapField -> f MapField) -> MapUpdate -> f MapUpdate
fieldOf Proxy# "field"
_
    = ((MapField -> f MapField) -> MapUpdate -> f MapUpdate)
-> ((MapField -> f MapField) -> MapField -> f MapField)
-> (MapField -> f MapField)
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> MapField)
-> (MapUpdate -> MapField -> MapUpdate)
-> Lens MapUpdate MapUpdate MapField MapField
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> MapField
_MapUpdate'field (\ MapUpdate
x__ MapField
y__ -> MapUpdate
x__ {_MapUpdate'field :: MapField
_MapUpdate'field = MapField
y__}))
        (MapField -> f MapField) -> MapField -> f MapField
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapUpdate "counterOp" CounterOp where
  fieldOf :: Proxy# "counterOp"
-> (CounterOp -> f CounterOp) -> MapUpdate -> f MapUpdate
fieldOf Proxy# "counterOp"
_
    = ((Maybe CounterOp -> f (Maybe CounterOp))
 -> MapUpdate -> f MapUpdate)
-> ((CounterOp -> f CounterOp)
    -> Maybe CounterOp -> f (Maybe CounterOp))
-> (CounterOp -> f CounterOp)
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe CounterOp)
-> (MapUpdate -> Maybe CounterOp -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe CounterOp) (Maybe CounterOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe CounterOp
_MapUpdate'counterOp
           (\ MapUpdate
x__ Maybe CounterOp
y__ -> MapUpdate
x__ {_MapUpdate'counterOp :: Maybe CounterOp
_MapUpdate'counterOp = Maybe CounterOp
y__}))
        (CounterOp -> Lens' (Maybe CounterOp) CounterOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens CounterOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField MapUpdate "maybe'counterOp" (Prelude.Maybe CounterOp) where
  fieldOf :: Proxy# "maybe'counterOp"
-> (Maybe CounterOp -> f (Maybe CounterOp))
-> MapUpdate
-> f MapUpdate
fieldOf Proxy# "maybe'counterOp"
_
    = ((Maybe CounterOp -> f (Maybe CounterOp))
 -> MapUpdate -> f MapUpdate)
-> ((Maybe CounterOp -> f (Maybe CounterOp))
    -> Maybe CounterOp -> f (Maybe CounterOp))
-> (Maybe CounterOp -> f (Maybe CounterOp))
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe CounterOp)
-> (MapUpdate -> Maybe CounterOp -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe CounterOp) (Maybe CounterOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe CounterOp
_MapUpdate'counterOp
           (\ MapUpdate
x__ Maybe CounterOp
y__ -> MapUpdate
x__ {_MapUpdate'counterOp :: Maybe CounterOp
_MapUpdate'counterOp = Maybe CounterOp
y__}))
        (Maybe CounterOp -> f (Maybe CounterOp))
-> Maybe CounterOp -> f (Maybe CounterOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapUpdate "setOp" SetOp where
  fieldOf :: Proxy# "setOp" -> (SetOp -> f SetOp) -> MapUpdate -> f MapUpdate
fieldOf Proxy# "setOp"
_
    = ((Maybe SetOp -> f (Maybe SetOp)) -> MapUpdate -> f MapUpdate)
-> ((SetOp -> f SetOp) -> Maybe SetOp -> f (Maybe SetOp))
-> (SetOp -> f SetOp)
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe SetOp)
-> (MapUpdate -> Maybe SetOp -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe SetOp) (Maybe SetOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe SetOp
_MapUpdate'setOp (\ MapUpdate
x__ Maybe SetOp
y__ -> MapUpdate
x__ {_MapUpdate'setOp :: Maybe SetOp
_MapUpdate'setOp = Maybe SetOp
y__}))
        (SetOp -> Lens' (Maybe SetOp) SetOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens SetOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField MapUpdate "maybe'setOp" (Prelude.Maybe SetOp) where
  fieldOf :: Proxy# "maybe'setOp"
-> (Maybe SetOp -> f (Maybe SetOp)) -> MapUpdate -> f MapUpdate
fieldOf Proxy# "maybe'setOp"
_
    = ((Maybe SetOp -> f (Maybe SetOp)) -> MapUpdate -> f MapUpdate)
-> ((Maybe SetOp -> f (Maybe SetOp))
    -> Maybe SetOp -> f (Maybe SetOp))
-> (Maybe SetOp -> f (Maybe SetOp))
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe SetOp)
-> (MapUpdate -> Maybe SetOp -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe SetOp) (Maybe SetOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe SetOp
_MapUpdate'setOp (\ MapUpdate
x__ Maybe SetOp
y__ -> MapUpdate
x__ {_MapUpdate'setOp :: Maybe SetOp
_MapUpdate'setOp = Maybe SetOp
y__}))
        (Maybe SetOp -> f (Maybe SetOp)) -> Maybe SetOp -> f (Maybe SetOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapUpdate "registerOp" Data.ByteString.ByteString where
  fieldOf :: Proxy# "registerOp"
-> (ByteString -> f ByteString) -> MapUpdate -> f MapUpdate
fieldOf Proxy# "registerOp"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> MapUpdate -> f MapUpdate)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe ByteString)
-> (MapUpdate -> Maybe ByteString -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe ByteString
_MapUpdate'registerOp
           (\ MapUpdate
x__ Maybe ByteString
y__ -> MapUpdate
x__ {_MapUpdate'registerOp :: Maybe ByteString
_MapUpdate'registerOp = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField MapUpdate "maybe'registerOp" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'registerOp"
-> (Maybe ByteString -> f (Maybe ByteString))
-> MapUpdate
-> f MapUpdate
fieldOf Proxy# "maybe'registerOp"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> MapUpdate -> f MapUpdate)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe ByteString)
-> (MapUpdate -> Maybe ByteString -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe ByteString
_MapUpdate'registerOp
           (\ MapUpdate
x__ Maybe ByteString
y__ -> MapUpdate
x__ {_MapUpdate'registerOp :: Maybe ByteString
_MapUpdate'registerOp = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapUpdate "flagOp" MapUpdate'FlagOp where
  fieldOf :: Proxy# "flagOp"
-> (MapUpdate'FlagOp -> f MapUpdate'FlagOp)
-> MapUpdate
-> f MapUpdate
fieldOf Proxy# "flagOp"
_
    = ((Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
 -> MapUpdate -> f MapUpdate)
-> ((MapUpdate'FlagOp -> f MapUpdate'FlagOp)
    -> Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
-> (MapUpdate'FlagOp -> f MapUpdate'FlagOp)
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe MapUpdate'FlagOp)
-> (MapUpdate -> Maybe MapUpdate'FlagOp -> MapUpdate)
-> Lens
     MapUpdate
     MapUpdate
     (Maybe MapUpdate'FlagOp)
     (Maybe MapUpdate'FlagOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe MapUpdate'FlagOp
_MapUpdate'flagOp (\ MapUpdate
x__ Maybe MapUpdate'FlagOp
y__ -> MapUpdate
x__ {_MapUpdate'flagOp :: Maybe MapUpdate'FlagOp
_MapUpdate'flagOp = Maybe MapUpdate'FlagOp
y__}))
        (MapUpdate'FlagOp -> Lens' (Maybe MapUpdate'FlagOp) MapUpdate'FlagOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens MapUpdate'FlagOp
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField MapUpdate "maybe'flagOp" (Prelude.Maybe MapUpdate'FlagOp) where
  fieldOf :: Proxy# "maybe'flagOp"
-> (Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
-> MapUpdate
-> f MapUpdate
fieldOf Proxy# "maybe'flagOp"
_
    = ((Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
 -> MapUpdate -> f MapUpdate)
-> ((Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
    -> Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
-> (Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe MapUpdate'FlagOp)
-> (MapUpdate -> Maybe MapUpdate'FlagOp -> MapUpdate)
-> Lens
     MapUpdate
     MapUpdate
     (Maybe MapUpdate'FlagOp)
     (Maybe MapUpdate'FlagOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe MapUpdate'FlagOp
_MapUpdate'flagOp (\ MapUpdate
x__ Maybe MapUpdate'FlagOp
y__ -> MapUpdate
x__ {_MapUpdate'flagOp :: Maybe MapUpdate'FlagOp
_MapUpdate'flagOp = Maybe MapUpdate'FlagOp
y__}))
        (Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp))
-> Maybe MapUpdate'FlagOp -> f (Maybe MapUpdate'FlagOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField MapUpdate "mapOp" MapOp where
  fieldOf :: Proxy# "mapOp" -> (MapOp -> f MapOp) -> MapUpdate -> f MapUpdate
fieldOf Proxy# "mapOp"
_
    = ((Maybe MapOp -> f (Maybe MapOp)) -> MapUpdate -> f MapUpdate)
-> ((MapOp -> f MapOp) -> Maybe MapOp -> f (Maybe MapOp))
-> (MapOp -> f MapOp)
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe MapOp)
-> (MapUpdate -> Maybe MapOp -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe MapOp) (Maybe MapOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe MapOp
_MapUpdate'mapOp (\ MapUpdate
x__ Maybe MapOp
y__ -> MapUpdate
x__ {_MapUpdate'mapOp :: Maybe MapOp
_MapUpdate'mapOp = Maybe MapOp
y__}))
        (MapOp -> Lens' (Maybe MapOp) MapOp
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens MapOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField MapUpdate "maybe'mapOp" (Prelude.Maybe MapOp) where
  fieldOf :: Proxy# "maybe'mapOp"
-> (Maybe MapOp -> f (Maybe MapOp)) -> MapUpdate -> f MapUpdate
fieldOf Proxy# "maybe'mapOp"
_
    = ((Maybe MapOp -> f (Maybe MapOp)) -> MapUpdate -> f MapUpdate)
-> ((Maybe MapOp -> f (Maybe MapOp))
    -> Maybe MapOp -> f (Maybe MapOp))
-> (Maybe MapOp -> f (Maybe MapOp))
-> MapUpdate
-> f MapUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((MapUpdate -> Maybe MapOp)
-> (MapUpdate -> Maybe MapOp -> MapUpdate)
-> Lens MapUpdate MapUpdate (Maybe MapOp) (Maybe MapOp)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           MapUpdate -> Maybe MapOp
_MapUpdate'mapOp (\ MapUpdate
x__ Maybe MapOp
y__ -> MapUpdate
x__ {_MapUpdate'mapOp :: Maybe MapOp
_MapUpdate'mapOp = Maybe MapOp
y__}))
        (Maybe MapOp -> f (Maybe MapOp)) -> Maybe MapOp -> f (Maybe MapOp)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message MapUpdate where
  messageName :: Proxy MapUpdate -> Text
messageName Proxy MapUpdate
_ = String -> Text
Data.Text.pack String
"MapUpdate"
  packedMessageDescriptor :: Proxy MapUpdate -> ByteString
packedMessageDescriptor Proxy MapUpdate
_
    = ByteString
"\n\
      \\tMapUpdate\DC2\US\n\
      \\ENQfield\CAN\SOH \STX(\v2\t.MapFieldR\ENQfield\DC2)\n\
      \\n\
      \counter_op\CAN\STX \SOH(\v2\n\
      \.CounterOpR\tcounterOp\DC2\GS\n\
      \\ACKset_op\CAN\ETX \SOH(\v2\ACK.SetOpR\ENQsetOp\DC2\US\n\
      \\vregister_op\CAN\EOT \SOH(\fR\n\
      \registerOp\DC2*\n\
      \\aflag_op\CAN\ENQ \SOH(\SO2\DC1.MapUpdate.FlagOpR\ACKflagOp\DC2\GS\n\
      \\ACKmap_op\CAN\ACK \SOH(\v2\ACK.MapOpR\ENQmapOp\"!\n\
      \\ACKFlagOp\DC2\n\
      \\n\
      \\ACKENABLE\DLE\SOH\DC2\v\n\
      \\aDISABLE\DLE\STX"
  packedFileDescriptor :: Proxy MapUpdate -> ByteString
packedFileDescriptor Proxy MapUpdate
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor MapUpdate)
fieldsByTag
    = let
        field__field_descriptor :: FieldDescriptor MapUpdate
field__field_descriptor
          = String
-> FieldTypeDescriptor MapField
-> FieldAccessor MapUpdate MapField
-> FieldDescriptor MapUpdate
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"field"
              (MessageOrGroup -> FieldTypeDescriptor MapField
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapField)
              (WireDefault MapField
-> Lens MapUpdate MapUpdate MapField MapField
-> FieldAccessor MapUpdate MapField
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault MapField
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "field" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"field")) ::
              Data.ProtoLens.FieldDescriptor MapUpdate
        counterOp__field_descriptor :: FieldDescriptor MapUpdate
counterOp__field_descriptor
          = String
-> FieldTypeDescriptor CounterOp
-> FieldAccessor MapUpdate CounterOp
-> FieldDescriptor MapUpdate
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"counter_op"
              (MessageOrGroup -> FieldTypeDescriptor CounterOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor CounterOp)
              (Lens MapUpdate MapUpdate (Maybe CounterOp) (Maybe CounterOp)
-> FieldAccessor MapUpdate CounterOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'counterOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterOp")) ::
              Data.ProtoLens.FieldDescriptor MapUpdate
        setOp__field_descriptor :: FieldDescriptor MapUpdate
setOp__field_descriptor
          = String
-> FieldTypeDescriptor SetOp
-> FieldAccessor MapUpdate SetOp
-> FieldDescriptor MapUpdate
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"set_op"
              (MessageOrGroup -> FieldTypeDescriptor SetOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor SetOp)
              (Lens MapUpdate MapUpdate (Maybe SetOp) (Maybe SetOp)
-> FieldAccessor MapUpdate SetOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'setOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'setOp")) ::
              Data.ProtoLens.FieldDescriptor MapUpdate
        registerOp__field_descriptor :: FieldDescriptor MapUpdate
registerOp__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor MapUpdate ByteString
-> FieldDescriptor MapUpdate
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"register_op"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens MapUpdate MapUpdate (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor MapUpdate ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'registerOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'registerOp")) ::
              Data.ProtoLens.FieldDescriptor MapUpdate
        flagOp__field_descriptor :: FieldDescriptor MapUpdate
flagOp__field_descriptor
          = String
-> FieldTypeDescriptor MapUpdate'FlagOp
-> FieldAccessor MapUpdate MapUpdate'FlagOp
-> FieldDescriptor MapUpdate
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"flag_op"
              (ScalarField MapUpdate'FlagOp
-> FieldTypeDescriptor MapUpdate'FlagOp
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField MapUpdate'FlagOp
forall t. MessageEnum t => ScalarField t
Data.ProtoLens.EnumField ::
                 Data.ProtoLens.FieldTypeDescriptor MapUpdate'FlagOp)
              (Lens
  MapUpdate
  MapUpdate
  (Maybe MapUpdate'FlagOp)
  (Maybe MapUpdate'FlagOp)
-> FieldAccessor MapUpdate MapUpdate'FlagOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'flagOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'flagOp")) ::
              Data.ProtoLens.FieldDescriptor MapUpdate
        mapOp__field_descriptor :: FieldDescriptor MapUpdate
mapOp__field_descriptor
          = String
-> FieldTypeDescriptor MapOp
-> FieldAccessor MapUpdate MapOp
-> FieldDescriptor MapUpdate
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"map_op"
              (MessageOrGroup -> FieldTypeDescriptor MapOp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor MapOp)
              (Lens MapUpdate MapUpdate (Maybe MapOp) (Maybe MapOp)
-> FieldAccessor MapUpdate MapOp
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'mapOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'mapOp")) ::
              Data.ProtoLens.FieldDescriptor MapUpdate
      in
        [(Tag, FieldDescriptor MapUpdate)]
-> Map Tag (FieldDescriptor MapUpdate)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor MapUpdate
field__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor MapUpdate
counterOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor MapUpdate
setOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor MapUpdate
registerOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor MapUpdate
flagOp__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor MapUpdate
mapOp__field_descriptor)]
  unknownFields :: LensLike' f MapUpdate FieldSet
unknownFields
    = (MapUpdate -> FieldSet)
-> (MapUpdate -> FieldSet -> MapUpdate) -> Lens' MapUpdate FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        MapUpdate -> FieldSet
_MapUpdate'_unknownFields
        (\ MapUpdate
x__ FieldSet
y__ -> MapUpdate
x__ {_MapUpdate'_unknownFields :: FieldSet
_MapUpdate'_unknownFields = FieldSet
y__})
  defMessage :: MapUpdate
defMessage
    = MapUpdate'_constructor :: MapField
-> Maybe CounterOp
-> Maybe SetOp
-> Maybe ByteString
-> Maybe MapUpdate'FlagOp
-> Maybe MapOp
-> FieldSet
-> MapUpdate
MapUpdate'_constructor
        {_MapUpdate'field :: MapField
_MapUpdate'field = MapField
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _MapUpdate'counterOp :: Maybe CounterOp
_MapUpdate'counterOp = Maybe CounterOp
forall a. Maybe a
Prelude.Nothing,
         _MapUpdate'setOp :: Maybe SetOp
_MapUpdate'setOp = Maybe SetOp
forall a. Maybe a
Prelude.Nothing,
         _MapUpdate'registerOp :: Maybe ByteString
_MapUpdate'registerOp = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _MapUpdate'flagOp :: Maybe MapUpdate'FlagOp
_MapUpdate'flagOp = Maybe MapUpdate'FlagOp
forall a. Maybe a
Prelude.Nothing,
         _MapUpdate'mapOp :: Maybe MapOp
_MapUpdate'mapOp = Maybe MapOp
forall a. Maybe a
Prelude.Nothing, _MapUpdate'_unknownFields :: FieldSet
_MapUpdate'_unknownFields = []}
  parseMessage :: Parser MapUpdate
parseMessage
    = let
        loop ::
          MapUpdate
          -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser MapUpdate
        loop :: MapUpdate -> Bool -> Parser MapUpdate
loop MapUpdate
x Bool
required'field
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'field then (:) String
"field" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      MapUpdate -> Parser MapUpdate
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter MapUpdate MapUpdate FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapUpdate -> MapUpdate
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 MapUpdate MapUpdate FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) MapUpdate
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do MapField
y <- Parser MapField -> String -> Parser MapField
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser MapField -> Parser MapField
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 MapField
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"field"
                                MapUpdate -> Bool -> Parser MapUpdate
loop
                                  (Setter MapUpdate MapUpdate MapField MapField
-> MapField -> MapUpdate -> MapUpdate
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "field" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"field") MapField
y MapUpdate
x)
                                  Bool
Prelude.False
                        Word64
18
                          -> do CounterOp
y <- Parser CounterOp -> String -> Parser CounterOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser CounterOp -> Parser CounterOp
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 CounterOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"counter_op"
                                MapUpdate -> Bool -> Parser MapUpdate
loop
                                  (Setter MapUpdate MapUpdate CounterOp CounterOp
-> CounterOp -> MapUpdate -> MapUpdate
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "counterOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"counterOp") CounterOp
y MapUpdate
x)
                                  Bool
required'field
                        Word64
26
                          -> do SetOp
y <- Parser SetOp -> String -> Parser SetOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser SetOp -> Parser SetOp
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 SetOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"set_op"
                                MapUpdate -> Bool -> Parser MapUpdate
loop
                                  (Setter MapUpdate MapUpdate SetOp SetOp
-> SetOp -> MapUpdate -> MapUpdate
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "setOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"setOp") SetOp
y MapUpdate
x)
                                  Bool
required'field
                        Word64
34
                          -> 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
"register_op"
                                MapUpdate -> Bool -> Parser MapUpdate
loop
                                  (Setter MapUpdate MapUpdate ByteString ByteString
-> ByteString -> MapUpdate -> MapUpdate
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "registerOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"registerOp") ByteString
y MapUpdate
x)
                                  Bool
required'field
                        Word64
40
                          -> do MapUpdate'FlagOp
y <- Parser MapUpdate'FlagOp -> String -> Parser MapUpdate'FlagOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Int -> MapUpdate'FlagOp) -> Parser Int -> Parser MapUpdate'FlagOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Int -> MapUpdate'FlagOp
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
"flag_op"
                                MapUpdate -> Bool -> Parser MapUpdate
loop
                                  (Setter MapUpdate MapUpdate MapUpdate'FlagOp MapUpdate'FlagOp
-> MapUpdate'FlagOp -> MapUpdate -> MapUpdate
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "flagOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"flagOp") MapUpdate'FlagOp
y MapUpdate
x)
                                  Bool
required'field
                        Word64
50
                          -> do MapOp
y <- Parser MapOp -> String -> Parser MapOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser MapOp -> Parser MapOp
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 MapOp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"map_op"
                                MapUpdate -> Bool -> Parser MapUpdate
loop
                                  (Setter MapUpdate MapUpdate MapOp MapOp
-> MapOp -> MapUpdate -> MapUpdate
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "mapOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"mapOp") MapOp
y MapUpdate
x)
                                  Bool
required'field
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                MapUpdate -> Bool -> Parser MapUpdate
loop
                                  (Setter MapUpdate MapUpdate FieldSet FieldSet
-> (FieldSet -> FieldSet) -> MapUpdate -> MapUpdate
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 MapUpdate MapUpdate FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) MapUpdate
x)
                                  Bool
required'field
      in
        Parser MapUpdate -> String -> Parser MapUpdate
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do MapUpdate -> Bool -> Parser MapUpdate
loop MapUpdate
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"MapUpdate"
  buildMessage :: MapUpdate -> Builder
buildMessage
    = \ MapUpdate
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                ((ByteString -> Builder)
-> (MapField -> ByteString) -> MapField -> 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))
                   MapField -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                   (FoldLike MapField MapUpdate MapUpdate MapField MapField
-> MapUpdate -> MapField
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "field" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"field") MapUpdate
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe CounterOp)
  MapUpdate
  MapUpdate
  (Maybe CounterOp)
  (Maybe CounterOp)
-> MapUpdate -> Maybe CounterOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'counterOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'counterOp") MapUpdate
_x
                 of
                   Maybe CounterOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just CounterOp
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((ByteString -> Builder)
-> (CounterOp -> ByteString) -> CounterOp -> 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))
                             CounterOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                             CounterOp
_v))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe SetOp) MapUpdate MapUpdate (Maybe SetOp) (Maybe SetOp)
-> MapUpdate -> Maybe SetOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'setOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'setOp") MapUpdate
_x
                    of
                      Maybe SetOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just SetOp
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((ByteString -> Builder)
-> (SetOp -> ByteString) -> SetOp -> 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))
                                SetOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                SetOp
_v))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe ByteString)
  MapUpdate
  MapUpdate
  (Maybe ByteString)
  (Maybe ByteString)
-> MapUpdate -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                             (forall s a (f :: * -> *).
(HasField s "maybe'registerOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'registerOp") MapUpdate
_x
                       of
                         Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just ByteString
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((\ 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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe MapUpdate'FlagOp)
  MapUpdate
  MapUpdate
  (Maybe MapUpdate'FlagOp)
  (Maybe MapUpdate'FlagOp)
-> MapUpdate -> Maybe MapUpdate'FlagOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'flagOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'flagOp") MapUpdate
_x
                          of
                            Maybe MapUpdate'FlagOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just MapUpdate'FlagOp
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((Int -> Builder)
-> (MapUpdate'FlagOp -> Int) -> MapUpdate'FlagOp -> 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)
                                      MapUpdate'FlagOp -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum
                                      MapUpdate'FlagOp
_v))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe MapOp) MapUpdate MapUpdate (Maybe MapOp) (Maybe MapOp)
-> MapUpdate -> Maybe MapOp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'mapOp" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'mapOp") MapUpdate
_x
                             of
                               Maybe MapOp
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just MapOp
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                                      ((ByteString -> Builder)
-> (MapOp -> ByteString) -> MapOp -> 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))
                                         MapOp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                         MapOp
_v))
                            (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                               (FoldLike FieldSet MapUpdate MapUpdate FieldSet FieldSet
-> MapUpdate -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet MapUpdate MapUpdate FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields MapUpdate
_x)))))))
instance Control.DeepSeq.NFData MapUpdate where
  rnf :: MapUpdate -> ()
rnf
    = \ MapUpdate
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (MapUpdate -> FieldSet
_MapUpdate'_unknownFields MapUpdate
x__)
             (MapField -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (MapUpdate -> MapField
_MapUpdate'field MapUpdate
x__)
                (Maybe CounterOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (MapUpdate -> Maybe CounterOp
_MapUpdate'counterOp MapUpdate
x__)
                   (Maybe SetOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (MapUpdate -> Maybe SetOp
_MapUpdate'setOp MapUpdate
x__)
                      (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (MapUpdate -> Maybe ByteString
_MapUpdate'registerOp MapUpdate
x__)
                         (Maybe MapUpdate'FlagOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (MapUpdate -> Maybe MapUpdate'FlagOp
_MapUpdate'flagOp MapUpdate
x__)
                            (Maybe MapOp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (MapUpdate -> Maybe MapOp
_MapUpdate'mapOp MapUpdate
x__) ()))))))
data MapUpdate'FlagOp
  = MapUpdate'ENABLE | MapUpdate'DISABLE
  deriving stock (Int -> MapUpdate'FlagOp -> ShowS
[MapUpdate'FlagOp] -> ShowS
MapUpdate'FlagOp -> String
(Int -> MapUpdate'FlagOp -> ShowS)
-> (MapUpdate'FlagOp -> String)
-> ([MapUpdate'FlagOp] -> ShowS)
-> Show MapUpdate'FlagOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapUpdate'FlagOp] -> ShowS
$cshowList :: [MapUpdate'FlagOp] -> ShowS
show :: MapUpdate'FlagOp -> String
$cshow :: MapUpdate'FlagOp -> String
showsPrec :: Int -> MapUpdate'FlagOp -> ShowS
$cshowsPrec :: Int -> MapUpdate'FlagOp -> ShowS
Prelude.Show, MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
(MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool)
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool)
-> Eq MapUpdate'FlagOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
$c/= :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
== :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
$c== :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
Prelude.Eq, Eq MapUpdate'FlagOp
Eq MapUpdate'FlagOp
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> Ordering)
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool)
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool)
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool)
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool)
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> MapUpdate'FlagOp)
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp -> MapUpdate'FlagOp)
-> Ord MapUpdate'FlagOp
MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
MapUpdate'FlagOp -> MapUpdate'FlagOp -> Ordering
MapUpdate'FlagOp -> MapUpdate'FlagOp -> MapUpdate'FlagOp
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 :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> MapUpdate'FlagOp
$cmin :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> MapUpdate'FlagOp
max :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> MapUpdate'FlagOp
$cmax :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> MapUpdate'FlagOp
>= :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
$c>= :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
> :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
$c> :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
<= :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
$c<= :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
< :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
$c< :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Bool
compare :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Ordering
$ccompare :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> Ordering
$cp1Ord :: Eq MapUpdate'FlagOp
Prelude.Ord)
instance Data.ProtoLens.MessageEnum MapUpdate'FlagOp where
  maybeToEnum :: Int -> Maybe MapUpdate'FlagOp
maybeToEnum Int
1 = MapUpdate'FlagOp -> Maybe MapUpdate'FlagOp
forall a. a -> Maybe a
Prelude.Just MapUpdate'FlagOp
MapUpdate'ENABLE
  maybeToEnum Int
2 = MapUpdate'FlagOp -> Maybe MapUpdate'FlagOp
forall a. a -> Maybe a
Prelude.Just MapUpdate'FlagOp
MapUpdate'DISABLE
  maybeToEnum Int
_ = Maybe MapUpdate'FlagOp
forall a. Maybe a
Prelude.Nothing
  showEnum :: MapUpdate'FlagOp -> String
showEnum MapUpdate'FlagOp
MapUpdate'ENABLE = String
"ENABLE"
  showEnum MapUpdate'FlagOp
MapUpdate'DISABLE = String
"DISABLE"
  readEnum :: String -> Maybe MapUpdate'FlagOp
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"ENABLE" = MapUpdate'FlagOp -> Maybe MapUpdate'FlagOp
forall a. a -> Maybe a
Prelude.Just MapUpdate'FlagOp
MapUpdate'ENABLE
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"DISABLE" = MapUpdate'FlagOp -> Maybe MapUpdate'FlagOp
forall a. a -> Maybe a
Prelude.Just MapUpdate'FlagOp
MapUpdate'DISABLE
    | Bool
Prelude.otherwise
    = Maybe Int
-> (Int -> Maybe MapUpdate'FlagOp) -> Maybe MapUpdate'FlagOp
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 MapUpdate'FlagOp
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded MapUpdate'FlagOp where
  minBound :: MapUpdate'FlagOp
minBound = MapUpdate'FlagOp
MapUpdate'ENABLE
  maxBound :: MapUpdate'FlagOp
maxBound = MapUpdate'FlagOp
MapUpdate'DISABLE
instance Prelude.Enum MapUpdate'FlagOp where
  toEnum :: Int -> MapUpdate'FlagOp
toEnum Int
k__
    = MapUpdate'FlagOp
-> (MapUpdate'FlagOp -> MapUpdate'FlagOp)
-> Maybe MapUpdate'FlagOp
-> MapUpdate'FlagOp
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> MapUpdate'FlagOp
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum FlagOp: " (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        MapUpdate'FlagOp -> MapUpdate'FlagOp
forall a. a -> a
Prelude.id
        (Int -> Maybe MapUpdate'FlagOp
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: MapUpdate'FlagOp -> Int
fromEnum MapUpdate'FlagOp
MapUpdate'ENABLE = Int
1
  fromEnum MapUpdate'FlagOp
MapUpdate'DISABLE = Int
2
  succ :: MapUpdate'FlagOp -> MapUpdate'FlagOp
succ MapUpdate'FlagOp
MapUpdate'DISABLE
    = String -> MapUpdate'FlagOp
forall a. HasCallStack => String -> a
Prelude.error
        String
"MapUpdate'FlagOp.succ: bad argument MapUpdate'DISABLE. This value would be out of bounds."
  succ MapUpdate'FlagOp
MapUpdate'ENABLE = MapUpdate'FlagOp
MapUpdate'DISABLE
  pred :: MapUpdate'FlagOp -> MapUpdate'FlagOp
pred MapUpdate'FlagOp
MapUpdate'ENABLE
    = String -> MapUpdate'FlagOp
forall a. HasCallStack => String -> a
Prelude.error
        String
"MapUpdate'FlagOp.pred: bad argument MapUpdate'ENABLE. This value would be out of bounds."
  pred MapUpdate'FlagOp
MapUpdate'DISABLE = MapUpdate'FlagOp
MapUpdate'ENABLE
  enumFrom :: MapUpdate'FlagOp -> [MapUpdate'FlagOp]
enumFrom = MapUpdate'FlagOp -> [MapUpdate'FlagOp]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> [MapUpdate'FlagOp]
enumFromTo = MapUpdate'FlagOp -> MapUpdate'FlagOp -> [MapUpdate'FlagOp]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: MapUpdate'FlagOp -> MapUpdate'FlagOp -> [MapUpdate'FlagOp]
enumFromThen = MapUpdate'FlagOp -> MapUpdate'FlagOp -> [MapUpdate'FlagOp]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: MapUpdate'FlagOp
-> MapUpdate'FlagOp -> MapUpdate'FlagOp -> [MapUpdate'FlagOp]
enumFromThenTo = MapUpdate'FlagOp
-> MapUpdate'FlagOp -> MapUpdate'FlagOp -> [MapUpdate'FlagOp]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault MapUpdate'FlagOp where
  fieldDefault :: MapUpdate'FlagOp
fieldDefault = MapUpdate'FlagOp
MapUpdate'ENABLE
instance Control.DeepSeq.NFData MapUpdate'FlagOp where
  rnf :: MapUpdate'FlagOp -> ()
rnf MapUpdate'FlagOp
x__ = MapUpdate'FlagOp -> () -> ()
Prelude.seq MapUpdate'FlagOp
x__ ()
{- | Fields :
     
         * 'Proto.Riak_Fields.user' @:: Lens' RpbAuthReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.password' @:: Lens' RpbAuthReq Data.ByteString.ByteString@ -}
data RpbAuthReq
  = RpbAuthReq'_constructor {RpbAuthReq -> ByteString
_RpbAuthReq'user :: !Data.ByteString.ByteString,
                             RpbAuthReq -> ByteString
_RpbAuthReq'password :: !Data.ByteString.ByteString,
                             RpbAuthReq -> FieldSet
_RpbAuthReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbAuthReq -> RpbAuthReq -> Bool
(RpbAuthReq -> RpbAuthReq -> Bool)
-> (RpbAuthReq -> RpbAuthReq -> Bool) -> Eq RpbAuthReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbAuthReq -> RpbAuthReq -> Bool
$c/= :: RpbAuthReq -> RpbAuthReq -> Bool
== :: RpbAuthReq -> RpbAuthReq -> Bool
$c== :: RpbAuthReq -> RpbAuthReq -> Bool
Prelude.Eq, Eq RpbAuthReq
Eq RpbAuthReq
-> (RpbAuthReq -> RpbAuthReq -> Ordering)
-> (RpbAuthReq -> RpbAuthReq -> Bool)
-> (RpbAuthReq -> RpbAuthReq -> Bool)
-> (RpbAuthReq -> RpbAuthReq -> Bool)
-> (RpbAuthReq -> RpbAuthReq -> Bool)
-> (RpbAuthReq -> RpbAuthReq -> RpbAuthReq)
-> (RpbAuthReq -> RpbAuthReq -> RpbAuthReq)
-> Ord RpbAuthReq
RpbAuthReq -> RpbAuthReq -> Bool
RpbAuthReq -> RpbAuthReq -> Ordering
RpbAuthReq -> RpbAuthReq -> RpbAuthReq
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 :: RpbAuthReq -> RpbAuthReq -> RpbAuthReq
$cmin :: RpbAuthReq -> RpbAuthReq -> RpbAuthReq
max :: RpbAuthReq -> RpbAuthReq -> RpbAuthReq
$cmax :: RpbAuthReq -> RpbAuthReq -> RpbAuthReq
>= :: RpbAuthReq -> RpbAuthReq -> Bool
$c>= :: RpbAuthReq -> RpbAuthReq -> Bool
> :: RpbAuthReq -> RpbAuthReq -> Bool
$c> :: RpbAuthReq -> RpbAuthReq -> Bool
<= :: RpbAuthReq -> RpbAuthReq -> Bool
$c<= :: RpbAuthReq -> RpbAuthReq -> Bool
< :: RpbAuthReq -> RpbAuthReq -> Bool
$c< :: RpbAuthReq -> RpbAuthReq -> Bool
compare :: RpbAuthReq -> RpbAuthReq -> Ordering
$ccompare :: RpbAuthReq -> RpbAuthReq -> Ordering
$cp1Ord :: Eq RpbAuthReq
Prelude.Ord)
instance Prelude.Show RpbAuthReq where
  showsPrec :: Int -> RpbAuthReq -> ShowS
showsPrec Int
_ RpbAuthReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbAuthReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbAuthReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbAuthReq "user" Data.ByteString.ByteString where
  fieldOf :: Proxy# "user"
-> (ByteString -> f ByteString) -> RpbAuthReq -> f RpbAuthReq
fieldOf Proxy# "user"
_
    = ((ByteString -> f ByteString) -> RpbAuthReq -> f RpbAuthReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbAuthReq
-> f RpbAuthReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbAuthReq -> ByteString)
-> (RpbAuthReq -> ByteString -> RpbAuthReq)
-> Lens RpbAuthReq RpbAuthReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbAuthReq -> ByteString
_RpbAuthReq'user (\ RpbAuthReq
x__ ByteString
y__ -> RpbAuthReq
x__ {_RpbAuthReq'user :: ByteString
_RpbAuthReq'user = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbAuthReq "password" Data.ByteString.ByteString where
  fieldOf :: Proxy# "password"
-> (ByteString -> f ByteString) -> RpbAuthReq -> f RpbAuthReq
fieldOf Proxy# "password"
_
    = ((ByteString -> f ByteString) -> RpbAuthReq -> f RpbAuthReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbAuthReq
-> f RpbAuthReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbAuthReq -> ByteString)
-> (RpbAuthReq -> ByteString -> RpbAuthReq)
-> Lens RpbAuthReq RpbAuthReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbAuthReq -> ByteString
_RpbAuthReq'password
           (\ RpbAuthReq
x__ ByteString
y__ -> RpbAuthReq
x__ {_RpbAuthReq'password :: ByteString
_RpbAuthReq'password = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbAuthReq where
  messageName :: Proxy RpbAuthReq -> Text
messageName Proxy RpbAuthReq
_ = String -> Text
Data.Text.pack String
"RpbAuthReq"
  packedMessageDescriptor :: Proxy RpbAuthReq -> ByteString
packedMessageDescriptor Proxy RpbAuthReq
_
    = ByteString
"\n\
      \\n\
      \RpbAuthReq\DC2\DC2\n\
      \\EOTuser\CAN\SOH \STX(\fR\EOTuser\DC2\SUB\n\
      \\bpassword\CAN\STX \STX(\fR\bpassword"
  packedFileDescriptor :: Proxy RpbAuthReq -> ByteString
packedFileDescriptor Proxy RpbAuthReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbAuthReq)
fieldsByTag
    = let
        user__field_descriptor :: FieldDescriptor RpbAuthReq
user__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbAuthReq ByteString
-> FieldDescriptor RpbAuthReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"user"
              (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 RpbAuthReq RpbAuthReq ByteString ByteString
-> FieldAccessor RpbAuthReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "user" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"user")) ::
              Data.ProtoLens.FieldDescriptor RpbAuthReq
        password__field_descriptor :: FieldDescriptor RpbAuthReq
password__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbAuthReq ByteString
-> FieldDescriptor RpbAuthReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"password"
              (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 RpbAuthReq RpbAuthReq ByteString ByteString
-> FieldAccessor RpbAuthReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "password" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"password")) ::
              Data.ProtoLens.FieldDescriptor RpbAuthReq
      in
        [(Tag, FieldDescriptor RpbAuthReq)]
-> Map Tag (FieldDescriptor RpbAuthReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbAuthReq
user__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbAuthReq
password__field_descriptor)]
  unknownFields :: LensLike' f RpbAuthReq FieldSet
unknownFields
    = (RpbAuthReq -> FieldSet)
-> (RpbAuthReq -> FieldSet -> RpbAuthReq)
-> Lens' RpbAuthReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbAuthReq -> FieldSet
_RpbAuthReq'_unknownFields
        (\ RpbAuthReq
x__ FieldSet
y__ -> RpbAuthReq
x__ {_RpbAuthReq'_unknownFields :: FieldSet
_RpbAuthReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbAuthReq
defMessage
    = RpbAuthReq'_constructor :: ByteString -> ByteString -> FieldSet -> RpbAuthReq
RpbAuthReq'_constructor
        {_RpbAuthReq'user :: ByteString
_RpbAuthReq'user = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbAuthReq'password :: ByteString
_RpbAuthReq'password = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbAuthReq'_unknownFields :: FieldSet
_RpbAuthReq'_unknownFields = []}
  parseMessage :: Parser RpbAuthReq
parseMessage
    = let
        loop ::
          RpbAuthReq
          -> Prelude.Bool
             -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser RpbAuthReq
        loop :: RpbAuthReq -> Bool -> Bool -> Parser RpbAuthReq
loop RpbAuthReq
x Bool
required'password Bool
required'user
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'password then (:) String
"password" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'user then (:) String
"user" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbAuthReq -> Parser RpbAuthReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbAuthReq RpbAuthReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbAuthReq -> RpbAuthReq
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 RpbAuthReq RpbAuthReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbAuthReq
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
"user"
                                RpbAuthReq -> Bool -> Bool -> Parser RpbAuthReq
loop
                                  (Setter RpbAuthReq RpbAuthReq ByteString ByteString
-> ByteString -> RpbAuthReq -> RpbAuthReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "user" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"user") ByteString
y RpbAuthReq
x)
                                  Bool
required'password
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"password"
                                RpbAuthReq -> Bool -> Bool -> Parser RpbAuthReq
loop
                                  (Setter RpbAuthReq RpbAuthReq ByteString ByteString
-> ByteString -> RpbAuthReq -> RpbAuthReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "password" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"password") ByteString
y RpbAuthReq
x)
                                  Bool
Prelude.False
                                  Bool
required'user
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbAuthReq -> Bool -> Bool -> Parser RpbAuthReq
loop
                                  (Setter RpbAuthReq RpbAuthReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbAuthReq -> RpbAuthReq
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 RpbAuthReq RpbAuthReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbAuthReq
x)
                                  Bool
required'password
                                  Bool
required'user
      in
        Parser RpbAuthReq -> String -> Parser RpbAuthReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbAuthReq -> Bool -> Bool -> Parser RpbAuthReq
loop RpbAuthReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbAuthReq"
  buildMessage :: RpbAuthReq -> Builder
buildMessage
    = \ RpbAuthReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbAuthReq RpbAuthReq ByteString ByteString
-> RpbAuthReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "user" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"user") RpbAuthReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike ByteString RpbAuthReq RpbAuthReq ByteString ByteString
-> RpbAuthReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "password" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"password") RpbAuthReq
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet RpbAuthReq RpbAuthReq FieldSet FieldSet
-> RpbAuthReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbAuthReq RpbAuthReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbAuthReq
_x)))
instance Control.DeepSeq.NFData RpbAuthReq where
  rnf :: RpbAuthReq -> ()
rnf
    = \ RpbAuthReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbAuthReq -> FieldSet
_RpbAuthReq'_unknownFields RpbAuthReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbAuthReq -> ByteString
_RpbAuthReq'user RpbAuthReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbAuthReq -> ByteString
_RpbAuthReq'password RpbAuthReq
x__) ()))
{- | Fields :
      -}
data RpbAuthResp
  = RpbAuthResp'_constructor {RpbAuthResp -> FieldSet
_RpbAuthResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbAuthResp -> RpbAuthResp -> Bool
(RpbAuthResp -> RpbAuthResp -> Bool)
-> (RpbAuthResp -> RpbAuthResp -> Bool) -> Eq RpbAuthResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbAuthResp -> RpbAuthResp -> Bool
$c/= :: RpbAuthResp -> RpbAuthResp -> Bool
== :: RpbAuthResp -> RpbAuthResp -> Bool
$c== :: RpbAuthResp -> RpbAuthResp -> Bool
Prelude.Eq, Eq RpbAuthResp
Eq RpbAuthResp
-> (RpbAuthResp -> RpbAuthResp -> Ordering)
-> (RpbAuthResp -> RpbAuthResp -> Bool)
-> (RpbAuthResp -> RpbAuthResp -> Bool)
-> (RpbAuthResp -> RpbAuthResp -> Bool)
-> (RpbAuthResp -> RpbAuthResp -> Bool)
-> (RpbAuthResp -> RpbAuthResp -> RpbAuthResp)
-> (RpbAuthResp -> RpbAuthResp -> RpbAuthResp)
-> Ord RpbAuthResp
RpbAuthResp -> RpbAuthResp -> Bool
RpbAuthResp -> RpbAuthResp -> Ordering
RpbAuthResp -> RpbAuthResp -> RpbAuthResp
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 :: RpbAuthResp -> RpbAuthResp -> RpbAuthResp
$cmin :: RpbAuthResp -> RpbAuthResp -> RpbAuthResp
max :: RpbAuthResp -> RpbAuthResp -> RpbAuthResp
$cmax :: RpbAuthResp -> RpbAuthResp -> RpbAuthResp
>= :: RpbAuthResp -> RpbAuthResp -> Bool
$c>= :: RpbAuthResp -> RpbAuthResp -> Bool
> :: RpbAuthResp -> RpbAuthResp -> Bool
$c> :: RpbAuthResp -> RpbAuthResp -> Bool
<= :: RpbAuthResp -> RpbAuthResp -> Bool
$c<= :: RpbAuthResp -> RpbAuthResp -> Bool
< :: RpbAuthResp -> RpbAuthResp -> Bool
$c< :: RpbAuthResp -> RpbAuthResp -> Bool
compare :: RpbAuthResp -> RpbAuthResp -> Ordering
$ccompare :: RpbAuthResp -> RpbAuthResp -> Ordering
$cp1Ord :: Eq RpbAuthResp
Prelude.Ord)
instance Prelude.Show RpbAuthResp where
  showsPrec :: Int -> RpbAuthResp -> ShowS
showsPrec Int
_ RpbAuthResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbAuthResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbAuthResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbAuthResp where
  messageName :: Proxy RpbAuthResp -> Text
messageName Proxy RpbAuthResp
_ = String -> Text
Data.Text.pack String
"RpbAuthResp"
  packedMessageDescriptor :: Proxy RpbAuthResp -> ByteString
packedMessageDescriptor Proxy RpbAuthResp
_
    = ByteString
"\n\
      \\vRpbAuthResp"
  packedFileDescriptor :: Proxy RpbAuthResp -> ByteString
packedFileDescriptor Proxy RpbAuthResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbAuthResp)
fieldsByTag = let in [(Tag, FieldDescriptor RpbAuthResp)]
-> Map Tag (FieldDescriptor RpbAuthResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbAuthResp FieldSet
unknownFields
    = (RpbAuthResp -> FieldSet)
-> (RpbAuthResp -> FieldSet -> RpbAuthResp)
-> Lens' RpbAuthResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbAuthResp -> FieldSet
_RpbAuthResp'_unknownFields
        (\ RpbAuthResp
x__ FieldSet
y__ -> RpbAuthResp
x__ {_RpbAuthResp'_unknownFields :: FieldSet
_RpbAuthResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbAuthResp
defMessage
    = RpbAuthResp'_constructor :: FieldSet -> RpbAuthResp
RpbAuthResp'_constructor {_RpbAuthResp'_unknownFields :: FieldSet
_RpbAuthResp'_unknownFields = []}
  parseMessage :: Parser RpbAuthResp
parseMessage
    = let
        loop ::
          RpbAuthResp -> Data.ProtoLens.Encoding.Bytes.Parser RpbAuthResp
        loop :: RpbAuthResp -> Parser RpbAuthResp
loop RpbAuthResp
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]))))
                      RpbAuthResp -> Parser RpbAuthResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbAuthResp RpbAuthResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbAuthResp -> RpbAuthResp
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 RpbAuthResp RpbAuthResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbAuthResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbAuthResp -> Parser RpbAuthResp
loop
                                  (Setter RpbAuthResp RpbAuthResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbAuthResp -> RpbAuthResp
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 RpbAuthResp RpbAuthResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbAuthResp
x) }
      in
        Parser RpbAuthResp -> String -> Parser RpbAuthResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbAuthResp -> Parser RpbAuthResp
loop RpbAuthResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbAuthResp"
  buildMessage :: RpbAuthResp -> Builder
buildMessage
    = \ RpbAuthResp
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike FieldSet RpbAuthResp RpbAuthResp FieldSet FieldSet
-> RpbAuthResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbAuthResp RpbAuthResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbAuthResp
_x)
instance Control.DeepSeq.NFData RpbAuthResp where
  rnf :: RpbAuthResp -> ()
rnf
    = \ RpbAuthResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbAuthResp -> FieldSet
_RpbAuthResp'_unknownFields RpbAuthResp
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.partition' @:: Lens' RpbBucketKeyPreflistItem Data.Int.Int64@
         * 'Proto.Riak_Fields.node' @:: Lens' RpbBucketKeyPreflistItem Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.primary' @:: Lens' RpbBucketKeyPreflistItem Prelude.Bool@ -}
data RpbBucketKeyPreflistItem
  = RpbBucketKeyPreflistItem'_constructor {RpbBucketKeyPreflistItem -> Int64
_RpbBucketKeyPreflistItem'partition :: !Data.Int.Int64,
                                           RpbBucketKeyPreflistItem -> ByteString
_RpbBucketKeyPreflistItem'node :: !Data.ByteString.ByteString,
                                           RpbBucketKeyPreflistItem -> Bool
_RpbBucketKeyPreflistItem'primary :: !Prelude.Bool,
                                           RpbBucketKeyPreflistItem -> FieldSet
_RpbBucketKeyPreflistItem'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
(RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool)
-> (RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool)
-> Eq RpbBucketKeyPreflistItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
$c/= :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
== :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
$c== :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
Prelude.Eq, Eq RpbBucketKeyPreflistItem
Eq RpbBucketKeyPreflistItem
-> (RpbBucketKeyPreflistItem
    -> RpbBucketKeyPreflistItem -> Ordering)
-> (RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool)
-> (RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool)
-> (RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool)
-> (RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool)
-> (RpbBucketKeyPreflistItem
    -> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem)
-> (RpbBucketKeyPreflistItem
    -> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem)
-> Ord RpbBucketKeyPreflistItem
RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Ordering
RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem
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 :: RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem
$cmin :: RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem
max :: RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem
$cmax :: RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem
>= :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
$c>= :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
> :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
$c> :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
<= :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
$c<= :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
< :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
$c< :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Bool
compare :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Ordering
$ccompare :: RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem -> Ordering
$cp1Ord :: Eq RpbBucketKeyPreflistItem
Prelude.Ord)
instance Prelude.Show RpbBucketKeyPreflistItem where
  showsPrec :: Int -> RpbBucketKeyPreflistItem -> ShowS
showsPrec Int
_ RpbBucketKeyPreflistItem
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbBucketKeyPreflistItem -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbBucketKeyPreflistItem
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbBucketKeyPreflistItem "partition" Data.Int.Int64 where
  fieldOf :: Proxy# "partition"
-> (Int64 -> f Int64)
-> RpbBucketKeyPreflistItem
-> f RpbBucketKeyPreflistItem
fieldOf Proxy# "partition"
_
    = ((Int64 -> f Int64)
 -> RpbBucketKeyPreflistItem -> f RpbBucketKeyPreflistItem)
-> ((Int64 -> f Int64) -> Int64 -> f Int64)
-> (Int64 -> f Int64)
-> RpbBucketKeyPreflistItem
-> f RpbBucketKeyPreflistItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketKeyPreflistItem -> Int64)
-> (RpbBucketKeyPreflistItem -> Int64 -> RpbBucketKeyPreflistItem)
-> Lens
     RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Int64 Int64
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketKeyPreflistItem -> Int64
_RpbBucketKeyPreflistItem'partition
           (\ RpbBucketKeyPreflistItem
x__ Int64
y__ -> RpbBucketKeyPreflistItem
x__ {_RpbBucketKeyPreflistItem'partition :: Int64
_RpbBucketKeyPreflistItem'partition = Int64
y__}))
        (Int64 -> f Int64) -> Int64 -> f Int64
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketKeyPreflistItem "node" Data.ByteString.ByteString where
  fieldOf :: Proxy# "node"
-> (ByteString -> f ByteString)
-> RpbBucketKeyPreflistItem
-> f RpbBucketKeyPreflistItem
fieldOf Proxy# "node"
_
    = ((ByteString -> f ByteString)
 -> RpbBucketKeyPreflistItem -> f RpbBucketKeyPreflistItem)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbBucketKeyPreflistItem
-> f RpbBucketKeyPreflistItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketKeyPreflistItem -> ByteString)
-> (RpbBucketKeyPreflistItem
    -> ByteString -> RpbBucketKeyPreflistItem)
-> Lens
     RpbBucketKeyPreflistItem
     RpbBucketKeyPreflistItem
     ByteString
     ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketKeyPreflistItem -> ByteString
_RpbBucketKeyPreflistItem'node
           (\ RpbBucketKeyPreflistItem
x__ ByteString
y__ -> RpbBucketKeyPreflistItem
x__ {_RpbBucketKeyPreflistItem'node :: ByteString
_RpbBucketKeyPreflistItem'node = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketKeyPreflistItem "primary" Prelude.Bool where
  fieldOf :: Proxy# "primary"
-> (Bool -> f Bool)
-> RpbBucketKeyPreflistItem
-> f RpbBucketKeyPreflistItem
fieldOf Proxy# "primary"
_
    = ((Bool -> f Bool)
 -> RpbBucketKeyPreflistItem -> f RpbBucketKeyPreflistItem)
-> ((Bool -> f Bool) -> Bool -> f Bool)
-> (Bool -> f Bool)
-> RpbBucketKeyPreflistItem
-> f RpbBucketKeyPreflistItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketKeyPreflistItem -> Bool)
-> (RpbBucketKeyPreflistItem -> Bool -> RpbBucketKeyPreflistItem)
-> Lens RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketKeyPreflistItem -> Bool
_RpbBucketKeyPreflistItem'primary
           (\ RpbBucketKeyPreflistItem
x__ Bool
y__ -> RpbBucketKeyPreflistItem
x__ {_RpbBucketKeyPreflistItem'primary :: Bool
_RpbBucketKeyPreflistItem'primary = Bool
y__}))
        (Bool -> f Bool) -> Bool -> f Bool
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbBucketKeyPreflistItem where
  messageName :: Proxy RpbBucketKeyPreflistItem -> Text
messageName Proxy RpbBucketKeyPreflistItem
_ = String -> Text
Data.Text.pack String
"RpbBucketKeyPreflistItem"
  packedMessageDescriptor :: Proxy RpbBucketKeyPreflistItem -> ByteString
packedMessageDescriptor Proxy RpbBucketKeyPreflistItem
_
    = ByteString
"\n\
      \\CANRpbBucketKeyPreflistItem\DC2\FS\n\
      \\tpartition\CAN\SOH \STX(\ETXR\tpartition\DC2\DC2\n\
      \\EOTnode\CAN\STX \STX(\fR\EOTnode\DC2\CAN\n\
      \\aprimary\CAN\ETX \STX(\bR\aprimary"
  packedFileDescriptor :: Proxy RpbBucketKeyPreflistItem -> ByteString
packedFileDescriptor Proxy RpbBucketKeyPreflistItem
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbBucketKeyPreflistItem)
fieldsByTag
    = let
        partition__field_descriptor :: FieldDescriptor RpbBucketKeyPreflistItem
partition__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor RpbBucketKeyPreflistItem Int64
-> FieldDescriptor RpbBucketKeyPreflistItem
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"partition"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.Int64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (WireDefault Int64
-> Lens
     RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Int64 Int64
-> FieldAccessor RpbBucketKeyPreflistItem Int64
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Int64
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "partition" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"partition")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketKeyPreflistItem
        node__field_descriptor :: FieldDescriptor RpbBucketKeyPreflistItem
node__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbBucketKeyPreflistItem ByteString
-> FieldDescriptor RpbBucketKeyPreflistItem
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"node"
              (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
     RpbBucketKeyPreflistItem
     RpbBucketKeyPreflistItem
     ByteString
     ByteString
-> FieldAccessor RpbBucketKeyPreflistItem ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "node" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"node")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketKeyPreflistItem
        primary__field_descriptor :: FieldDescriptor RpbBucketKeyPreflistItem
primary__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketKeyPreflistItem Bool
-> FieldDescriptor RpbBucketKeyPreflistItem
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"primary"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (WireDefault Bool
-> Lens RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Bool Bool
-> FieldAccessor RpbBucketKeyPreflistItem Bool
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Bool
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "primary" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"primary")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketKeyPreflistItem
      in
        [(Tag, FieldDescriptor RpbBucketKeyPreflistItem)]
-> Map Tag (FieldDescriptor RpbBucketKeyPreflistItem)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbBucketKeyPreflistItem
partition__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbBucketKeyPreflistItem
node__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbBucketKeyPreflistItem
primary__field_descriptor)]
  unknownFields :: LensLike' f RpbBucketKeyPreflistItem FieldSet
unknownFields
    = (RpbBucketKeyPreflistItem -> FieldSet)
-> (RpbBucketKeyPreflistItem
    -> FieldSet -> RpbBucketKeyPreflistItem)
-> Lens' RpbBucketKeyPreflistItem FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbBucketKeyPreflistItem -> FieldSet
_RpbBucketKeyPreflistItem'_unknownFields
        (\ RpbBucketKeyPreflistItem
x__ FieldSet
y__ -> RpbBucketKeyPreflistItem
x__ {_RpbBucketKeyPreflistItem'_unknownFields :: FieldSet
_RpbBucketKeyPreflistItem'_unknownFields = FieldSet
y__})
  defMessage :: RpbBucketKeyPreflistItem
defMessage
    = RpbBucketKeyPreflistItem'_constructor :: Int64 -> ByteString -> Bool -> FieldSet -> RpbBucketKeyPreflistItem
RpbBucketKeyPreflistItem'_constructor
        {_RpbBucketKeyPreflistItem'partition :: Int64
_RpbBucketKeyPreflistItem'partition = Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbBucketKeyPreflistItem'node :: ByteString
_RpbBucketKeyPreflistItem'node = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbBucketKeyPreflistItem'primary :: Bool
_RpbBucketKeyPreflistItem'primary = Bool
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbBucketKeyPreflistItem'_unknownFields :: FieldSet
_RpbBucketKeyPreflistItem'_unknownFields = []}
  parseMessage :: Parser RpbBucketKeyPreflistItem
parseMessage
    = let
        loop ::
          RpbBucketKeyPreflistItem
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool
                   -> Data.ProtoLens.Encoding.Bytes.Parser RpbBucketKeyPreflistItem
        loop :: RpbBucketKeyPreflistItem
-> Bool -> Bool -> Bool -> Parser RpbBucketKeyPreflistItem
loop RpbBucketKeyPreflistItem
x Bool
required'node Bool
required'partition Bool
required'primary
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'node then (:) String
"node" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'partition then (:) String
"partition" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'primary then (:) String
"primary" else [String] -> [String]
forall a. a -> a
Prelude.id) []))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbBucketKeyPreflistItem -> Parser RpbBucketKeyPreflistItem
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem
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
  RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbBucketKeyPreflistItem
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                          Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt)
                                       String
"partition"
                                RpbBucketKeyPreflistItem
-> Bool -> Bool -> Bool -> Parser RpbBucketKeyPreflistItem
loop
                                  (Setter
  RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Int64 Int64
-> Int64 -> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "partition" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"partition") Int64
y RpbBucketKeyPreflistItem
x)
                                  Bool
required'node
                                  Bool
Prelude.False
                                  Bool
required'primary
                        Word64
18
                          -> 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
"node"
                                RpbBucketKeyPreflistItem
-> Bool -> Bool -> Bool -> Parser RpbBucketKeyPreflistItem
loop
                                  (Setter
  RpbBucketKeyPreflistItem
  RpbBucketKeyPreflistItem
  ByteString
  ByteString
-> ByteString
-> RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "node" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"node") ByteString
y RpbBucketKeyPreflistItem
x)
                                  Bool
Prelude.False
                                  Bool
required'partition
                                  Bool
required'primary
                        Word64
24
                          -> 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
"primary"
                                RpbBucketKeyPreflistItem
-> Bool -> Bool -> Bool -> Parser RpbBucketKeyPreflistItem
loop
                                  (Setter RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Bool Bool
-> Bool -> RpbBucketKeyPreflistItem -> RpbBucketKeyPreflistItem
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "primary" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"primary") Bool
y RpbBucketKeyPreflistItem
x)
                                  Bool
required'node
                                  Bool
required'partition
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbBucketKeyPreflistItem
-> Bool -> Bool -> Bool -> Parser RpbBucketKeyPreflistItem
loop
                                  (Setter
  RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem
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
  RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbBucketKeyPreflistItem
x)
                                  Bool
required'node
                                  Bool
required'partition
                                  Bool
required'primary
      in
        Parser RpbBucketKeyPreflistItem
-> String -> Parser RpbBucketKeyPreflistItem
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbBucketKeyPreflistItem
-> Bool -> Bool -> Bool -> Parser RpbBucketKeyPreflistItem
loop
                RpbBucketKeyPreflistItem
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Bool
Prelude.True)
          String
"RpbBucketKeyPreflistItem"
  buildMessage :: RpbBucketKeyPreflistItem -> Builder
buildMessage
    = \ RpbBucketKeyPreflistItem
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                   Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                   Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                   (FoldLike
  Int64 RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Int64 Int64
-> RpbBucketKeyPreflistItem -> Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "partition" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"partition") RpbBucketKeyPreflistItem
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString
  RpbBucketKeyPreflistItem
  RpbBucketKeyPreflistItem
  ByteString
  ByteString
-> RpbBucketKeyPreflistItem -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "node" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"node") RpbBucketKeyPreflistItem
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                      ((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)
                         (FoldLike
  Bool RpbBucketKeyPreflistItem RpbBucketKeyPreflistItem Bool Bool
-> RpbBucketKeyPreflistItem -> Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "primary" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"primary") RpbBucketKeyPreflistItem
_x)))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike
  FieldSet
  RpbBucketKeyPreflistItem
  RpbBucketKeyPreflistItem
  FieldSet
  FieldSet
-> RpbBucketKeyPreflistItem -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbBucketKeyPreflistItem
  RpbBucketKeyPreflistItem
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbBucketKeyPreflistItem
_x))))
instance Control.DeepSeq.NFData RpbBucketKeyPreflistItem where
  rnf :: RpbBucketKeyPreflistItem -> ()
rnf
    = \ RpbBucketKeyPreflistItem
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbBucketKeyPreflistItem -> FieldSet
_RpbBucketKeyPreflistItem'_unknownFields RpbBucketKeyPreflistItem
x__)
             (Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbBucketKeyPreflistItem -> Int64
_RpbBucketKeyPreflistItem'partition RpbBucketKeyPreflistItem
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbBucketKeyPreflistItem -> ByteString
_RpbBucketKeyPreflistItem'node RpbBucketKeyPreflistItem
x__)
                   (Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbBucketKeyPreflistItem -> Bool
_RpbBucketKeyPreflistItem'primary RpbBucketKeyPreflistItem
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.nVal' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'nVal' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.allowMult' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'allowMult' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.lastWriteWins' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'lastWriteWins' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.precommit' @:: Lens' RpbBucketProps [RpbCommitHook]@
         * 'Proto.Riak_Fields.vec'precommit' @:: Lens' RpbBucketProps (Data.Vector.Vector RpbCommitHook)@
         * 'Proto.Riak_Fields.hasPrecommit' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'hasPrecommit' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.postcommit' @:: Lens' RpbBucketProps [RpbCommitHook]@
         * 'Proto.Riak_Fields.vec'postcommit' @:: Lens' RpbBucketProps (Data.Vector.Vector RpbCommitHook)@
         * 'Proto.Riak_Fields.hasPostcommit' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'hasPostcommit' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.chashKeyfun' @:: Lens' RpbBucketProps RpbModFun@
         * 'Proto.Riak_Fields.maybe'chashKeyfun' @:: Lens' RpbBucketProps (Prelude.Maybe RpbModFun)@
         * 'Proto.Riak_Fields.linkfun' @:: Lens' RpbBucketProps RpbModFun@
         * 'Proto.Riak_Fields.maybe'linkfun' @:: Lens' RpbBucketProps (Prelude.Maybe RpbModFun)@
         * 'Proto.Riak_Fields.oldVclock' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'oldVclock' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.youngVclock' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'youngVclock' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.bigVclock' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'bigVclock' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.smallVclock' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'smallVclock' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pr' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pr' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.r' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'r' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.w' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'w' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pw' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pw' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.dw' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'dw' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.rw' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'rw' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.basicQuorum' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'basicQuorum' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.notfoundOk' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'notfoundOk' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.backend' @:: Lens' RpbBucketProps Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'backend' @:: Lens' RpbBucketProps (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.search' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'search' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.repl' @:: Lens' RpbBucketProps RpbBucketProps'RpbReplMode@
         * 'Proto.Riak_Fields.maybe'repl' @:: Lens' RpbBucketProps (Prelude.Maybe RpbBucketProps'RpbReplMode)@
         * 'Proto.Riak_Fields.searchIndex' @:: Lens' RpbBucketProps Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'searchIndex' @:: Lens' RpbBucketProps (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.datatype' @:: Lens' RpbBucketProps Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'datatype' @:: Lens' RpbBucketProps (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.consistent' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'consistent' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.writeOnce' @:: Lens' RpbBucketProps Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'writeOnce' @:: Lens' RpbBucketProps (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.hllPrecision' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'hllPrecision' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.ttl' @:: Lens' RpbBucketProps Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'ttl' @:: Lens' RpbBucketProps (Prelude.Maybe Data.Word.Word32)@ -}
data RpbBucketProps
  = RpbBucketProps'_constructor {RpbBucketProps -> Maybe Word32
_RpbBucketProps'nVal :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'allowMult :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'lastWriteWins :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'precommit :: !(Data.Vector.Vector RpbCommitHook),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPrecommit :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'postcommit :: !(Data.Vector.Vector RpbCommitHook),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPostcommit :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'chashKeyfun :: !(Prelude.Maybe RpbModFun),
                                 RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'linkfun :: !(Prelude.Maybe RpbModFun),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'oldVclock :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'youngVclock :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'bigVclock :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'smallVclock :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'pr :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'r :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'w :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'pw :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'dw :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'rw :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'basicQuorum :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'notfoundOk :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Maybe ByteString
_RpbBucketProps'backend :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'search :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Maybe RpbBucketProps'RpbReplMode
_RpbBucketProps'repl :: !(Prelude.Maybe RpbBucketProps'RpbReplMode),
                                 RpbBucketProps -> Maybe ByteString
_RpbBucketProps'searchIndex :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbBucketProps -> Maybe ByteString
_RpbBucketProps'datatype :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'consistent :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Maybe Bool
_RpbBucketProps'writeOnce :: !(Prelude.Maybe Prelude.Bool),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'hllPrecision :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> Maybe Word32
_RpbBucketProps'ttl :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbBucketProps -> FieldSet
_RpbBucketProps'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbBucketProps -> RpbBucketProps -> Bool
(RpbBucketProps -> RpbBucketProps -> Bool)
-> (RpbBucketProps -> RpbBucketProps -> Bool) -> Eq RpbBucketProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbBucketProps -> RpbBucketProps -> Bool
$c/= :: RpbBucketProps -> RpbBucketProps -> Bool
== :: RpbBucketProps -> RpbBucketProps -> Bool
$c== :: RpbBucketProps -> RpbBucketProps -> Bool
Prelude.Eq, Eq RpbBucketProps
Eq RpbBucketProps
-> (RpbBucketProps -> RpbBucketProps -> Ordering)
-> (RpbBucketProps -> RpbBucketProps -> Bool)
-> (RpbBucketProps -> RpbBucketProps -> Bool)
-> (RpbBucketProps -> RpbBucketProps -> Bool)
-> (RpbBucketProps -> RpbBucketProps -> Bool)
-> (RpbBucketProps -> RpbBucketProps -> RpbBucketProps)
-> (RpbBucketProps -> RpbBucketProps -> RpbBucketProps)
-> Ord RpbBucketProps
RpbBucketProps -> RpbBucketProps -> Bool
RpbBucketProps -> RpbBucketProps -> Ordering
RpbBucketProps -> RpbBucketProps -> RpbBucketProps
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 :: RpbBucketProps -> RpbBucketProps -> RpbBucketProps
$cmin :: RpbBucketProps -> RpbBucketProps -> RpbBucketProps
max :: RpbBucketProps -> RpbBucketProps -> RpbBucketProps
$cmax :: RpbBucketProps -> RpbBucketProps -> RpbBucketProps
>= :: RpbBucketProps -> RpbBucketProps -> Bool
$c>= :: RpbBucketProps -> RpbBucketProps -> Bool
> :: RpbBucketProps -> RpbBucketProps -> Bool
$c> :: RpbBucketProps -> RpbBucketProps -> Bool
<= :: RpbBucketProps -> RpbBucketProps -> Bool
$c<= :: RpbBucketProps -> RpbBucketProps -> Bool
< :: RpbBucketProps -> RpbBucketProps -> Bool
$c< :: RpbBucketProps -> RpbBucketProps -> Bool
compare :: RpbBucketProps -> RpbBucketProps -> Ordering
$ccompare :: RpbBucketProps -> RpbBucketProps -> Ordering
$cp1Ord :: Eq RpbBucketProps
Prelude.Ord)
instance Prelude.Show RpbBucketProps where
  showsPrec :: Int -> RpbBucketProps -> ShowS
showsPrec Int
_ RpbBucketProps
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbBucketProps -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbBucketProps
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbBucketProps "nVal" Data.Word.Word32 where
  fieldOf :: Proxy# "nVal"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'nVal
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'nVal :: Maybe Word32
_RpbBucketProps'nVal = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'nVal" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'nVal"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'nVal
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'nVal :: Maybe Word32
_RpbBucketProps'nVal = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "allowMult" Prelude.Bool where
  fieldOf :: Proxy# "allowMult"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "allowMult"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'allowMult
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'allowMult :: Maybe Bool
_RpbBucketProps'allowMult = 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 RpbBucketProps "maybe'allowMult" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'allowMult"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'allowMult"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'allowMult
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'allowMult :: Maybe Bool
_RpbBucketProps'allowMult = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "lastWriteWins" Prelude.Bool where
  fieldOf :: Proxy# "lastWriteWins"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "lastWriteWins"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'lastWriteWins
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'lastWriteWins :: Maybe Bool
_RpbBucketProps'lastWriteWins = 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 RpbBucketProps "maybe'lastWriteWins" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'lastWriteWins"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'lastWriteWins"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'lastWriteWins
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'lastWriteWins :: Maybe Bool
_RpbBucketProps'lastWriteWins = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "precommit" [RpbCommitHook] where
  fieldOf :: Proxy# "precommit"
-> ([RpbCommitHook] -> f [RpbCommitHook])
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "precommit"
_
    = ((Vector RpbCommitHook -> f (Vector RpbCommitHook))
 -> RpbBucketProps -> f RpbBucketProps)
-> (([RpbCommitHook] -> f [RpbCommitHook])
    -> Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> ([RpbCommitHook] -> f [RpbCommitHook])
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Vector RpbCommitHook)
-> (RpbBucketProps -> Vector RpbCommitHook -> RpbBucketProps)
-> Lens
     RpbBucketProps
     RpbBucketProps
     (Vector RpbCommitHook)
     (Vector RpbCommitHook)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'precommit
           (\ RpbBucketProps
x__ Vector RpbCommitHook
y__ -> RpbBucketProps
x__ {_RpbBucketProps'precommit :: Vector RpbCommitHook
_RpbBucketProps'precommit = Vector RpbCommitHook
y__}))
        ((Vector RpbCommitHook -> [RpbCommitHook])
-> (Vector RpbCommitHook
    -> [RpbCommitHook] -> Vector RpbCommitHook)
-> Lens
     (Vector RpbCommitHook)
     (Vector RpbCommitHook)
     [RpbCommitHook]
     [RpbCommitHook]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbCommitHook -> [RpbCommitHook]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbCommitHook
_ [RpbCommitHook]
y__ -> [RpbCommitHook] -> Vector RpbCommitHook
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbCommitHook]
y__))
instance Data.ProtoLens.Field.HasField RpbBucketProps "vec'precommit" (Data.Vector.Vector RpbCommitHook) where
  fieldOf :: Proxy# "vec'precommit"
-> (Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "vec'precommit"
_
    = ((Vector RpbCommitHook -> f (Vector RpbCommitHook))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Vector RpbCommitHook -> f (Vector RpbCommitHook))
    -> Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> (Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Vector RpbCommitHook)
-> (RpbBucketProps -> Vector RpbCommitHook -> RpbBucketProps)
-> Lens
     RpbBucketProps
     RpbBucketProps
     (Vector RpbCommitHook)
     (Vector RpbCommitHook)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'precommit
           (\ RpbBucketProps
x__ Vector RpbCommitHook
y__ -> RpbBucketProps
x__ {_RpbBucketProps'precommit :: Vector RpbCommitHook
_RpbBucketProps'precommit = Vector RpbCommitHook
y__}))
        (Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> Vector RpbCommitHook -> f (Vector RpbCommitHook)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "hasPrecommit" Prelude.Bool where
  fieldOf :: Proxy# "hasPrecommit"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "hasPrecommit"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPrecommit
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'hasPrecommit :: Maybe Bool
_RpbBucketProps'hasPrecommit = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.False)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'hasPrecommit" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'hasPrecommit"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'hasPrecommit"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPrecommit
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'hasPrecommit :: Maybe Bool
_RpbBucketProps'hasPrecommit = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "postcommit" [RpbCommitHook] where
  fieldOf :: Proxy# "postcommit"
-> ([RpbCommitHook] -> f [RpbCommitHook])
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "postcommit"
_
    = ((Vector RpbCommitHook -> f (Vector RpbCommitHook))
 -> RpbBucketProps -> f RpbBucketProps)
-> (([RpbCommitHook] -> f [RpbCommitHook])
    -> Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> ([RpbCommitHook] -> f [RpbCommitHook])
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Vector RpbCommitHook)
-> (RpbBucketProps -> Vector RpbCommitHook -> RpbBucketProps)
-> Lens
     RpbBucketProps
     RpbBucketProps
     (Vector RpbCommitHook)
     (Vector RpbCommitHook)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'postcommit
           (\ RpbBucketProps
x__ Vector RpbCommitHook
y__ -> RpbBucketProps
x__ {_RpbBucketProps'postcommit :: Vector RpbCommitHook
_RpbBucketProps'postcommit = Vector RpbCommitHook
y__}))
        ((Vector RpbCommitHook -> [RpbCommitHook])
-> (Vector RpbCommitHook
    -> [RpbCommitHook] -> Vector RpbCommitHook)
-> Lens
     (Vector RpbCommitHook)
     (Vector RpbCommitHook)
     [RpbCommitHook]
     [RpbCommitHook]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbCommitHook -> [RpbCommitHook]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbCommitHook
_ [RpbCommitHook]
y__ -> [RpbCommitHook] -> Vector RpbCommitHook
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbCommitHook]
y__))
instance Data.ProtoLens.Field.HasField RpbBucketProps "vec'postcommit" (Data.Vector.Vector RpbCommitHook) where
  fieldOf :: Proxy# "vec'postcommit"
-> (Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "vec'postcommit"
_
    = ((Vector RpbCommitHook -> f (Vector RpbCommitHook))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Vector RpbCommitHook -> f (Vector RpbCommitHook))
    -> Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> (Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Vector RpbCommitHook)
-> (RpbBucketProps -> Vector RpbCommitHook -> RpbBucketProps)
-> Lens
     RpbBucketProps
     RpbBucketProps
     (Vector RpbCommitHook)
     (Vector RpbCommitHook)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'postcommit
           (\ RpbBucketProps
x__ Vector RpbCommitHook
y__ -> RpbBucketProps
x__ {_RpbBucketProps'postcommit :: Vector RpbCommitHook
_RpbBucketProps'postcommit = Vector RpbCommitHook
y__}))
        (Vector RpbCommitHook -> f (Vector RpbCommitHook))
-> Vector RpbCommitHook -> f (Vector RpbCommitHook)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "hasPostcommit" Prelude.Bool where
  fieldOf :: Proxy# "hasPostcommit"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "hasPostcommit"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPostcommit
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'hasPostcommit :: Maybe Bool
_RpbBucketProps'hasPostcommit = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.False)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'hasPostcommit" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'hasPostcommit"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'hasPostcommit"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPostcommit
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'hasPostcommit :: Maybe Bool
_RpbBucketProps'hasPostcommit = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "chashKeyfun" RpbModFun where
  fieldOf :: Proxy# "chashKeyfun"
-> (RpbModFun -> f RpbModFun) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "chashKeyfun"
_
    = ((Maybe RpbModFun -> f (Maybe RpbModFun))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((RpbModFun -> f RpbModFun)
    -> Maybe RpbModFun -> f (Maybe RpbModFun))
-> (RpbModFun -> f RpbModFun)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe RpbModFun)
-> (RpbBucketProps -> Maybe RpbModFun -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe RpbModFun) (Maybe RpbModFun)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'chashKeyfun
           (\ RpbBucketProps
x__ Maybe RpbModFun
y__ -> RpbBucketProps
x__ {_RpbBucketProps'chashKeyfun :: Maybe RpbModFun
_RpbBucketProps'chashKeyfun = Maybe RpbModFun
y__}))
        (RpbModFun -> Lens' (Maybe RpbModFun) RpbModFun
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens RpbModFun
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'chashKeyfun" (Prelude.Maybe RpbModFun) where
  fieldOf :: Proxy# "maybe'chashKeyfun"
-> (Maybe RpbModFun -> f (Maybe RpbModFun))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'chashKeyfun"
_
    = ((Maybe RpbModFun -> f (Maybe RpbModFun))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe RpbModFun -> f (Maybe RpbModFun))
    -> Maybe RpbModFun -> f (Maybe RpbModFun))
-> (Maybe RpbModFun -> f (Maybe RpbModFun))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe RpbModFun)
-> (RpbBucketProps -> Maybe RpbModFun -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe RpbModFun) (Maybe RpbModFun)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'chashKeyfun
           (\ RpbBucketProps
x__ Maybe RpbModFun
y__ -> RpbBucketProps
x__ {_RpbBucketProps'chashKeyfun :: Maybe RpbModFun
_RpbBucketProps'chashKeyfun = Maybe RpbModFun
y__}))
        (Maybe RpbModFun -> f (Maybe RpbModFun))
-> Maybe RpbModFun -> f (Maybe RpbModFun)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "linkfun" RpbModFun where
  fieldOf :: Proxy# "linkfun"
-> (RpbModFun -> f RpbModFun) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "linkfun"
_
    = ((Maybe RpbModFun -> f (Maybe RpbModFun))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((RpbModFun -> f RpbModFun)
    -> Maybe RpbModFun -> f (Maybe RpbModFun))
-> (RpbModFun -> f RpbModFun)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe RpbModFun)
-> (RpbBucketProps -> Maybe RpbModFun -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe RpbModFun) (Maybe RpbModFun)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'linkfun
           (\ RpbBucketProps
x__ Maybe RpbModFun
y__ -> RpbBucketProps
x__ {_RpbBucketProps'linkfun :: Maybe RpbModFun
_RpbBucketProps'linkfun = Maybe RpbModFun
y__}))
        (RpbModFun -> Lens' (Maybe RpbModFun) RpbModFun
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens RpbModFun
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'linkfun" (Prelude.Maybe RpbModFun) where
  fieldOf :: Proxy# "maybe'linkfun"
-> (Maybe RpbModFun -> f (Maybe RpbModFun))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'linkfun"
_
    = ((Maybe RpbModFun -> f (Maybe RpbModFun))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe RpbModFun -> f (Maybe RpbModFun))
    -> Maybe RpbModFun -> f (Maybe RpbModFun))
-> (Maybe RpbModFun -> f (Maybe RpbModFun))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe RpbModFun)
-> (RpbBucketProps -> Maybe RpbModFun -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe RpbModFun) (Maybe RpbModFun)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'linkfun
           (\ RpbBucketProps
x__ Maybe RpbModFun
y__ -> RpbBucketProps
x__ {_RpbBucketProps'linkfun :: Maybe RpbModFun
_RpbBucketProps'linkfun = Maybe RpbModFun
y__}))
        (Maybe RpbModFun -> f (Maybe RpbModFun))
-> Maybe RpbModFun -> f (Maybe RpbModFun)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "oldVclock" Data.Word.Word32 where
  fieldOf :: Proxy# "oldVclock"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "oldVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'oldVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'oldVclock :: Maybe Word32
_RpbBucketProps'oldVclock = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'oldVclock" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'oldVclock"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'oldVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'oldVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'oldVclock :: Maybe Word32
_RpbBucketProps'oldVclock = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "youngVclock" Data.Word.Word32 where
  fieldOf :: Proxy# "youngVclock"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "youngVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'youngVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'youngVclock :: Maybe Word32
_RpbBucketProps'youngVclock = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'youngVclock" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'youngVclock"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'youngVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'youngVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'youngVclock :: Maybe Word32
_RpbBucketProps'youngVclock = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "bigVclock" Data.Word.Word32 where
  fieldOf :: Proxy# "bigVclock"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "bigVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'bigVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'bigVclock :: Maybe Word32
_RpbBucketProps'bigVclock = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'bigVclock" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'bigVclock"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'bigVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'bigVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'bigVclock :: Maybe Word32
_RpbBucketProps'bigVclock = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "smallVclock" Data.Word.Word32 where
  fieldOf :: Proxy# "smallVclock"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "smallVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'smallVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'smallVclock :: Maybe Word32
_RpbBucketProps'smallVclock = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'smallVclock" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'smallVclock"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'smallVclock"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'smallVclock
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'smallVclock :: Maybe Word32
_RpbBucketProps'smallVclock = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "pr" Data.Word.Word32 where
  fieldOf :: Proxy# "pr"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "pr"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'pr (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'pr :: Maybe Word32
_RpbBucketProps'pr = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'pr" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pr"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'pr"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'pr (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'pr :: Maybe Word32
_RpbBucketProps'pr = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "r" Data.Word.Word32 where
  fieldOf :: Proxy# "r"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "r"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'r (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'r :: Maybe Word32
_RpbBucketProps'r = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'r" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'r"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'r"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'r (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'r :: Maybe Word32
_RpbBucketProps'r = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "w" Data.Word.Word32 where
  fieldOf :: Proxy# "w"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "w"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'w (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'w :: Maybe Word32
_RpbBucketProps'w = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'w" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'w"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'w"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'w (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'w :: Maybe Word32
_RpbBucketProps'w = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "pw" Data.Word.Word32 where
  fieldOf :: Proxy# "pw"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "pw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'pw (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'pw :: Maybe Word32
_RpbBucketProps'pw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'pw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pw"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'pw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'pw (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'pw :: Maybe Word32
_RpbBucketProps'pw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "dw" Data.Word.Word32 where
  fieldOf :: Proxy# "dw"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "dw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'dw (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'dw :: Maybe Word32
_RpbBucketProps'dw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'dw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'dw"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'dw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'dw (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'dw :: Maybe Word32
_RpbBucketProps'dw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "rw" Data.Word.Word32 where
  fieldOf :: Proxy# "rw"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "rw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'rw (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'rw :: Maybe Word32
_RpbBucketProps'rw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'rw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'rw"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'rw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'rw (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'rw :: Maybe Word32
_RpbBucketProps'rw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "basicQuorum" Prelude.Bool where
  fieldOf :: Proxy# "basicQuorum"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'basicQuorum
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'basicQuorum :: Maybe Bool
_RpbBucketProps'basicQuorum = 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 RpbBucketProps "maybe'basicQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'basicQuorum"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'basicQuorum
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'basicQuorum :: Maybe Bool
_RpbBucketProps'basicQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "notfoundOk" Prelude.Bool where
  fieldOf :: Proxy# "notfoundOk"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'notfoundOk
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'notfoundOk :: Maybe Bool
_RpbBucketProps'notfoundOk = 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 RpbBucketProps "maybe'notfoundOk" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'notfoundOk"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'notfoundOk
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'notfoundOk :: Maybe Bool
_RpbBucketProps'notfoundOk = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "backend" Data.ByteString.ByteString where
  fieldOf :: Proxy# "backend"
-> (ByteString -> f ByteString)
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "backend"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe ByteString)
-> (RpbBucketProps -> Maybe ByteString -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe ByteString
_RpbBucketProps'backend
           (\ RpbBucketProps
x__ Maybe ByteString
y__ -> RpbBucketProps
x__ {_RpbBucketProps'backend :: Maybe ByteString
_RpbBucketProps'backend = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'backend" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'backend"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'backend"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe ByteString)
-> (RpbBucketProps -> Maybe ByteString -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe ByteString
_RpbBucketProps'backend
           (\ RpbBucketProps
x__ Maybe ByteString
y__ -> RpbBucketProps
x__ {_RpbBucketProps'backend :: Maybe ByteString
_RpbBucketProps'backend = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "search" Prelude.Bool where
  fieldOf :: Proxy# "search"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "search"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'search
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'search :: Maybe Bool
_RpbBucketProps'search = 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 RpbBucketProps "maybe'search" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'search"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'search"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'search
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'search :: Maybe Bool
_RpbBucketProps'search = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "repl" RpbBucketProps'RpbReplMode where
  fieldOf :: Proxy# "repl"
-> (RpbBucketProps'RpbReplMode -> f RpbBucketProps'RpbReplMode)
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "repl"
_
    = ((Maybe RpbBucketProps'RpbReplMode
  -> f (Maybe RpbBucketProps'RpbReplMode))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((RpbBucketProps'RpbReplMode -> f RpbBucketProps'RpbReplMode)
    -> Maybe RpbBucketProps'RpbReplMode
    -> f (Maybe RpbBucketProps'RpbReplMode))
-> (RpbBucketProps'RpbReplMode -> f RpbBucketProps'RpbReplMode)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe RpbBucketProps'RpbReplMode)
-> (RpbBucketProps
    -> Maybe RpbBucketProps'RpbReplMode -> RpbBucketProps)
-> Lens
     RpbBucketProps
     RpbBucketProps
     (Maybe RpbBucketProps'RpbReplMode)
     (Maybe RpbBucketProps'RpbReplMode)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe RpbBucketProps'RpbReplMode
_RpbBucketProps'repl
           (\ RpbBucketProps
x__ Maybe RpbBucketProps'RpbReplMode
y__ -> RpbBucketProps
x__ {_RpbBucketProps'repl :: Maybe RpbBucketProps'RpbReplMode
_RpbBucketProps'repl = Maybe RpbBucketProps'RpbReplMode
y__}))
        (RpbBucketProps'RpbReplMode
-> Lens'
     (Maybe RpbBucketProps'RpbReplMode) RpbBucketProps'RpbReplMode
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens RpbBucketProps'RpbReplMode
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'repl" (Prelude.Maybe RpbBucketProps'RpbReplMode) where
  fieldOf :: Proxy# "maybe'repl"
-> (Maybe RpbBucketProps'RpbReplMode
    -> f (Maybe RpbBucketProps'RpbReplMode))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'repl"
_
    = ((Maybe RpbBucketProps'RpbReplMode
  -> f (Maybe RpbBucketProps'RpbReplMode))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe RpbBucketProps'RpbReplMode
     -> f (Maybe RpbBucketProps'RpbReplMode))
    -> Maybe RpbBucketProps'RpbReplMode
    -> f (Maybe RpbBucketProps'RpbReplMode))
-> (Maybe RpbBucketProps'RpbReplMode
    -> f (Maybe RpbBucketProps'RpbReplMode))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe RpbBucketProps'RpbReplMode)
-> (RpbBucketProps
    -> Maybe RpbBucketProps'RpbReplMode -> RpbBucketProps)
-> Lens
     RpbBucketProps
     RpbBucketProps
     (Maybe RpbBucketProps'RpbReplMode)
     (Maybe RpbBucketProps'RpbReplMode)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe RpbBucketProps'RpbReplMode
_RpbBucketProps'repl
           (\ RpbBucketProps
x__ Maybe RpbBucketProps'RpbReplMode
y__ -> RpbBucketProps
x__ {_RpbBucketProps'repl :: Maybe RpbBucketProps'RpbReplMode
_RpbBucketProps'repl = Maybe RpbBucketProps'RpbReplMode
y__}))
        (Maybe RpbBucketProps'RpbReplMode
 -> f (Maybe RpbBucketProps'RpbReplMode))
-> Maybe RpbBucketProps'RpbReplMode
-> f (Maybe RpbBucketProps'RpbReplMode)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "searchIndex" Data.ByteString.ByteString where
  fieldOf :: Proxy# "searchIndex"
-> (ByteString -> f ByteString)
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "searchIndex"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe ByteString)
-> (RpbBucketProps -> Maybe ByteString -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe ByteString
_RpbBucketProps'searchIndex
           (\ RpbBucketProps
x__ Maybe ByteString
y__ -> RpbBucketProps
x__ {_RpbBucketProps'searchIndex :: Maybe ByteString
_RpbBucketProps'searchIndex = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'searchIndex" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'searchIndex"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'searchIndex"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe ByteString)
-> (RpbBucketProps -> Maybe ByteString -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe ByteString
_RpbBucketProps'searchIndex
           (\ RpbBucketProps
x__ Maybe ByteString
y__ -> RpbBucketProps
x__ {_RpbBucketProps'searchIndex :: Maybe ByteString
_RpbBucketProps'searchIndex = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "datatype" Data.ByteString.ByteString where
  fieldOf :: Proxy# "datatype"
-> (ByteString -> f ByteString)
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "datatype"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe ByteString)
-> (RpbBucketProps -> Maybe ByteString -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe ByteString
_RpbBucketProps'datatype
           (\ RpbBucketProps
x__ Maybe ByteString
y__ -> RpbBucketProps
x__ {_RpbBucketProps'datatype :: Maybe ByteString
_RpbBucketProps'datatype = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'datatype" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'datatype"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'datatype"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe ByteString)
-> (RpbBucketProps -> Maybe ByteString -> RpbBucketProps)
-> Lens
     RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe ByteString
_RpbBucketProps'datatype
           (\ RpbBucketProps
x__ Maybe ByteString
y__ -> RpbBucketProps
x__ {_RpbBucketProps'datatype :: Maybe ByteString
_RpbBucketProps'datatype = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "consistent" Prelude.Bool where
  fieldOf :: Proxy# "consistent"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "consistent"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'consistent
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'consistent :: Maybe Bool
_RpbBucketProps'consistent = 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 RpbBucketProps "maybe'consistent" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'consistent"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'consistent"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'consistent
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'consistent :: Maybe Bool
_RpbBucketProps'consistent = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "writeOnce" Prelude.Bool where
  fieldOf :: Proxy# "writeOnce"
-> (Bool -> f Bool) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "writeOnce"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'writeOnce
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'writeOnce :: Maybe Bool
_RpbBucketProps'writeOnce = 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 RpbBucketProps "maybe'writeOnce" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'writeOnce"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'writeOnce"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Bool)
-> (RpbBucketProps -> Maybe Bool -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Bool
_RpbBucketProps'writeOnce
           (\ RpbBucketProps
x__ Maybe Bool
y__ -> RpbBucketProps
x__ {_RpbBucketProps'writeOnce :: Maybe Bool
_RpbBucketProps'writeOnce = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "hllPrecision" Data.Word.Word32 where
  fieldOf :: Proxy# "hllPrecision"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "hllPrecision"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'hllPrecision
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'hllPrecision :: Maybe Word32
_RpbBucketProps'hllPrecision = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'hllPrecision" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'hllPrecision"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'hllPrecision"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'hllPrecision
           (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'hllPrecision :: Maybe Word32
_RpbBucketProps'hllPrecision = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbBucketProps "ttl" Data.Word.Word32 where
  fieldOf :: Proxy# "ttl"
-> (Word32 -> f Word32) -> RpbBucketProps -> f RpbBucketProps
fieldOf Proxy# "ttl"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'ttl (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'ttl :: Maybe Word32
_RpbBucketProps'ttl = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbBucketProps "maybe'ttl" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'ttl"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
fieldOf Proxy# "maybe'ttl"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbBucketProps -> f RpbBucketProps)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbBucketProps
-> f RpbBucketProps
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbBucketProps -> Maybe Word32)
-> (RpbBucketProps -> Maybe Word32 -> RpbBucketProps)
-> Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbBucketProps -> Maybe Word32
_RpbBucketProps'ttl (\ RpbBucketProps
x__ Maybe Word32
y__ -> RpbBucketProps
x__ {_RpbBucketProps'ttl :: Maybe Word32
_RpbBucketProps'ttl = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbBucketProps where
  messageName :: Proxy RpbBucketProps -> Text
messageName Proxy RpbBucketProps
_ = String -> Text
Data.Text.pack String
"RpbBucketProps"
  packedMessageDescriptor :: Proxy RpbBucketProps -> ByteString
packedMessageDescriptor Proxy RpbBucketProps
_
    = ByteString
"\n\
      \\SORpbBucketProps\DC2\DC3\n\
      \\ENQn_val\CAN\SOH \SOH(\rR\EOTnVal\DC2\GS\n\
      \\n\
      \allow_mult\CAN\STX \SOH(\bR\tallowMult\DC2&\n\
      \\SIlast_write_wins\CAN\ETX \SOH(\bR\rlastWriteWins\DC2,\n\
      \\tprecommit\CAN\EOT \ETX(\v2\SO.RpbCommitHookR\tprecommit\DC2*\n\
      \\rhas_precommit\CAN\ENQ \SOH(\b:\ENQfalseR\fhasPrecommit\DC2.\n\
      \\n\
      \postcommit\CAN\ACK \ETX(\v2\SO.RpbCommitHookR\n\
      \postcommit\DC2,\n\
      \\SOhas_postcommit\CAN\a \SOH(\b:\ENQfalseR\rhasPostcommit\DC2-\n\
      \\fchash_keyfun\CAN\b \SOH(\v2\n\
      \.RpbModFunR\vchashKeyfun\DC2$\n\
      \\alinkfun\CAN\t \SOH(\v2\n\
      \.RpbModFunR\alinkfun\DC2\GS\n\
      \\n\
      \old_vclock\CAN\n\
      \ \SOH(\rR\toldVclock\DC2!\n\
      \\fyoung_vclock\CAN\v \SOH(\rR\vyoungVclock\DC2\GS\n\
      \\n\
      \big_vclock\CAN\f \SOH(\rR\tbigVclock\DC2!\n\
      \\fsmall_vclock\CAN\r \SOH(\rR\vsmallVclock\DC2\SO\n\
      \\STXpr\CAN\SO \SOH(\rR\STXpr\DC2\f\n\
      \\SOHr\CAN\SI \SOH(\rR\SOHr\DC2\f\n\
      \\SOHw\CAN\DLE \SOH(\rR\SOHw\DC2\SO\n\
      \\STXpw\CAN\DC1 \SOH(\rR\STXpw\DC2\SO\n\
      \\STXdw\CAN\DC2 \SOH(\rR\STXdw\DC2\SO\n\
      \\STXrw\CAN\DC3 \SOH(\rR\STXrw\DC2!\n\
      \\fbasic_quorum\CAN\DC4 \SOH(\bR\vbasicQuorum\DC2\US\n\
      \\vnotfound_ok\CAN\NAK \SOH(\bR\n\
      \notfoundOk\DC2\CAN\n\
      \\abackend\CAN\SYN \SOH(\fR\abackend\DC2\SYN\n\
      \\ACKsearch\CAN\ETB \SOH(\bR\ACKsearch\DC2/\n\
      \\EOTrepl\CAN\CAN \SOH(\SO2\ESC.RpbBucketProps.RpbReplModeR\EOTrepl\DC2!\n\
      \\fsearch_index\CAN\EM \SOH(\fR\vsearchIndex\DC2\SUB\n\
      \\bdatatype\CAN\SUB \SOH(\fR\bdatatype\DC2\RS\n\
      \\n\
      \consistent\CAN\ESC \SOH(\bR\n\
      \consistent\DC2\GS\n\
      \\n\
      \write_once\CAN\FS \SOH(\bR\twriteOnce\DC2#\n\
      \\rhll_precision\CAN\GS \SOH(\rR\fhllPrecision\DC2\DLE\n\
      \\ETXttl\CAN\RS \SOH(\rR\ETXttl\">\n\
      \\vRpbReplMode\DC2\t\n\
      \\ENQFALSE\DLE\NUL\DC2\f\n\
      \\bREALTIME\DLE\SOH\DC2\f\n\
      \\bFULLSYNC\DLE\STX\DC2\b\n\
      \\EOTTRUE\DLE\ETX"
  packedFileDescriptor :: Proxy RpbBucketProps -> ByteString
packedFileDescriptor Proxy RpbBucketProps
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbBucketProps)
fieldsByTag
    = let
        nVal__field_descriptor :: FieldDescriptor RpbBucketProps
nVal__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"n_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)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        allowMult__field_descriptor :: FieldDescriptor RpbBucketProps
allowMult__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"allow_mult"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'allowMult" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'allowMult")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        lastWriteWins__field_descriptor :: FieldDescriptor RpbBucketProps
lastWriteWins__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"last_write_wins"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'lastWriteWins" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lastWriteWins")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        precommit__field_descriptor :: FieldDescriptor RpbBucketProps
precommit__field_descriptor
          = String
-> FieldTypeDescriptor RpbCommitHook
-> FieldAccessor RpbBucketProps RpbCommitHook
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"precommit"
              (MessageOrGroup -> FieldTypeDescriptor RpbCommitHook
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbCommitHook)
              (Packing
-> Lens' RpbBucketProps [RpbCommitHook]
-> FieldAccessor RpbBucketProps RpbCommitHook
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "precommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"precommit")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        hasPrecommit__field_descriptor :: FieldDescriptor RpbBucketProps
hasPrecommit__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"has_precommit"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'hasPrecommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hasPrecommit")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        postcommit__field_descriptor :: FieldDescriptor RpbBucketProps
postcommit__field_descriptor
          = String
-> FieldTypeDescriptor RpbCommitHook
-> FieldAccessor RpbBucketProps RpbCommitHook
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"postcommit"
              (MessageOrGroup -> FieldTypeDescriptor RpbCommitHook
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbCommitHook)
              (Packing
-> Lens' RpbBucketProps [RpbCommitHook]
-> FieldAccessor RpbBucketProps RpbCommitHook
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "postcommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"postcommit")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        hasPostcommit__field_descriptor :: FieldDescriptor RpbBucketProps
hasPostcommit__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"has_postcommit"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'hasPostcommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hasPostcommit")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        chashKeyfun__field_descriptor :: FieldDescriptor RpbBucketProps
chashKeyfun__field_descriptor
          = String
-> FieldTypeDescriptor RpbModFun
-> FieldAccessor RpbBucketProps RpbModFun
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"chash_keyfun"
              (MessageOrGroup -> FieldTypeDescriptor RpbModFun
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbModFun)
              (Lens
  RpbBucketProps RpbBucketProps (Maybe RpbModFun) (Maybe RpbModFun)
-> FieldAccessor RpbBucketProps RpbModFun
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'chashKeyfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'chashKeyfun")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        linkfun__field_descriptor :: FieldDescriptor RpbBucketProps
linkfun__field_descriptor
          = String
-> FieldTypeDescriptor RpbModFun
-> FieldAccessor RpbBucketProps RpbModFun
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"linkfun"
              (MessageOrGroup -> FieldTypeDescriptor RpbModFun
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbModFun)
              (Lens
  RpbBucketProps RpbBucketProps (Maybe RpbModFun) (Maybe RpbModFun)
-> FieldAccessor RpbBucketProps RpbModFun
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'linkfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'linkfun")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        oldVclock__field_descriptor :: FieldDescriptor RpbBucketProps
oldVclock__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"old_vclock"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'oldVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'oldVclock")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        youngVclock__field_descriptor :: FieldDescriptor RpbBucketProps
youngVclock__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"young_vclock"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'youngVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'youngVclock")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        bigVclock__field_descriptor :: FieldDescriptor RpbBucketProps
bigVclock__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"big_vclock"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'bigVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'bigVclock")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        smallVclock__field_descriptor :: FieldDescriptor RpbBucketProps
smallVclock__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"small_vclock"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'smallVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'smallVclock")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        pr__field_descriptor :: FieldDescriptor RpbBucketProps
pr__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pr"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        r__field_descriptor :: FieldDescriptor RpbBucketProps
r__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"r"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        w__field_descriptor :: FieldDescriptor RpbBucketProps
w__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"w"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        pw__field_descriptor :: FieldDescriptor RpbBucketProps
pw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        dw__field_descriptor :: FieldDescriptor RpbBucketProps
dw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"dw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        rw__field_descriptor :: FieldDescriptor RpbBucketProps
rw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"rw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'rw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rw")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        basicQuorum__field_descriptor :: FieldDescriptor RpbBucketProps
basicQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"basic_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'basicQuorum")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        notfoundOk__field_descriptor :: FieldDescriptor RpbBucketProps
notfoundOk__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"notfound_ok"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'notfoundOk")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        backend__field_descriptor :: FieldDescriptor RpbBucketProps
backend__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbBucketProps ByteString
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"backend"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbBucketProps ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'backend" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'backend")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        search__field_descriptor :: FieldDescriptor RpbBucketProps
search__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"search"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'search" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'search")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        repl__field_descriptor :: FieldDescriptor RpbBucketProps
repl__field_descriptor
          = String
-> FieldTypeDescriptor RpbBucketProps'RpbReplMode
-> FieldAccessor RpbBucketProps RpbBucketProps'RpbReplMode
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"repl"
              (ScalarField RpbBucketProps'RpbReplMode
-> FieldTypeDescriptor RpbBucketProps'RpbReplMode
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField RpbBucketProps'RpbReplMode
forall t. MessageEnum t => ScalarField t
Data.ProtoLens.EnumField ::
                 Data.ProtoLens.FieldTypeDescriptor RpbBucketProps'RpbReplMode)
              (Lens
  RpbBucketProps
  RpbBucketProps
  (Maybe RpbBucketProps'RpbReplMode)
  (Maybe RpbBucketProps'RpbReplMode)
-> FieldAccessor RpbBucketProps RpbBucketProps'RpbReplMode
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'repl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'repl")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        searchIndex__field_descriptor :: FieldDescriptor RpbBucketProps
searchIndex__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbBucketProps ByteString
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"search_index"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbBucketProps ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'searchIndex" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'searchIndex")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        datatype__field_descriptor :: FieldDescriptor RpbBucketProps
datatype__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbBucketProps ByteString
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"datatype"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbBucketProps RpbBucketProps (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbBucketProps ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'datatype" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'datatype")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        consistent__field_descriptor :: FieldDescriptor RpbBucketProps
consistent__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"consistent"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'consistent" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'consistent")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        writeOnce__field_descriptor :: FieldDescriptor RpbBucketProps
writeOnce__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbBucketProps Bool
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"write_once"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbBucketProps RpbBucketProps (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbBucketProps Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'writeOnce" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'writeOnce")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        hllPrecision__field_descriptor :: FieldDescriptor RpbBucketProps
hllPrecision__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"hll_precision"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'hllPrecision" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hllPrecision")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
        ttl__field_descriptor :: FieldDescriptor RpbBucketProps
ttl__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbBucketProps Word32
-> FieldDescriptor RpbBucketProps
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"ttl"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbBucketProps RpbBucketProps (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbBucketProps Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'ttl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ttl")) ::
              Data.ProtoLens.FieldDescriptor RpbBucketProps
      in
        [(Tag, FieldDescriptor RpbBucketProps)]
-> Map Tag (FieldDescriptor RpbBucketProps)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbBucketProps
nVal__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbBucketProps
allowMult__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbBucketProps
lastWriteWins__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbBucketProps
precommit__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbBucketProps
hasPrecommit__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbBucketProps
postcommit__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbBucketProps
hasPostcommit__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbBucketProps
chashKeyfun__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbBucketProps
linkfun__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbBucketProps
oldVclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor RpbBucketProps
youngVclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
12, FieldDescriptor RpbBucketProps
bigVclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
13, FieldDescriptor RpbBucketProps
smallVclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
14, FieldDescriptor RpbBucketProps
pr__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
15, FieldDescriptor RpbBucketProps
r__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
16, FieldDescriptor RpbBucketProps
w__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
17, FieldDescriptor RpbBucketProps
pw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
18, FieldDescriptor RpbBucketProps
dw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
19, FieldDescriptor RpbBucketProps
rw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
20, FieldDescriptor RpbBucketProps
basicQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
21, FieldDescriptor RpbBucketProps
notfoundOk__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
22, FieldDescriptor RpbBucketProps
backend__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
23, FieldDescriptor RpbBucketProps
search__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
24, FieldDescriptor RpbBucketProps
repl__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
25, FieldDescriptor RpbBucketProps
searchIndex__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
26, FieldDescriptor RpbBucketProps
datatype__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
27, FieldDescriptor RpbBucketProps
consistent__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
28, FieldDescriptor RpbBucketProps
writeOnce__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
29, FieldDescriptor RpbBucketProps
hllPrecision__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
30, FieldDescriptor RpbBucketProps
ttl__field_descriptor)]
  unknownFields :: LensLike' f RpbBucketProps FieldSet
unknownFields
    = (RpbBucketProps -> FieldSet)
-> (RpbBucketProps -> FieldSet -> RpbBucketProps)
-> Lens' RpbBucketProps FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbBucketProps -> FieldSet
_RpbBucketProps'_unknownFields
        (\ RpbBucketProps
x__ FieldSet
y__ -> RpbBucketProps
x__ {_RpbBucketProps'_unknownFields :: FieldSet
_RpbBucketProps'_unknownFields = FieldSet
y__})
  defMessage :: RpbBucketProps
defMessage
    = RpbBucketProps'_constructor :: Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Vector RpbCommitHook
-> Maybe Bool
-> Vector RpbCommitHook
-> Maybe Bool
-> Maybe RpbModFun
-> Maybe RpbModFun
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Maybe ByteString
-> Maybe Bool
-> Maybe RpbBucketProps'RpbReplMode
-> Maybe ByteString
-> Maybe ByteString
-> Maybe Bool
-> Maybe Bool
-> Maybe Word32
-> Maybe Word32
-> FieldSet
-> RpbBucketProps
RpbBucketProps'_constructor
        {_RpbBucketProps'nVal :: Maybe Word32
_RpbBucketProps'nVal = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'allowMult :: Maybe Bool
_RpbBucketProps'allowMult = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'lastWriteWins :: Maybe Bool
_RpbBucketProps'lastWriteWins = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'precommit :: Vector RpbCommitHook
_RpbBucketProps'precommit = Vector RpbCommitHook
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbBucketProps'hasPrecommit :: Maybe Bool
_RpbBucketProps'hasPrecommit = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'postcommit :: Vector RpbCommitHook
_RpbBucketProps'postcommit = Vector RpbCommitHook
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbBucketProps'hasPostcommit :: Maybe Bool
_RpbBucketProps'hasPostcommit = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'chashKeyfun :: Maybe RpbModFun
_RpbBucketProps'chashKeyfun = Maybe RpbModFun
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'linkfun :: Maybe RpbModFun
_RpbBucketProps'linkfun = Maybe RpbModFun
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'oldVclock :: Maybe Word32
_RpbBucketProps'oldVclock = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'youngVclock :: Maybe Word32
_RpbBucketProps'youngVclock = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'bigVclock :: Maybe Word32
_RpbBucketProps'bigVclock = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'smallVclock :: Maybe Word32
_RpbBucketProps'smallVclock = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'pr :: Maybe Word32
_RpbBucketProps'pr = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'r :: Maybe Word32
_RpbBucketProps'r = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'w :: Maybe Word32
_RpbBucketProps'w = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'pw :: Maybe Word32
_RpbBucketProps'pw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'dw :: Maybe Word32
_RpbBucketProps'dw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'rw :: Maybe Word32
_RpbBucketProps'rw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'basicQuorum :: Maybe Bool
_RpbBucketProps'basicQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'notfoundOk :: Maybe Bool
_RpbBucketProps'notfoundOk = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'backend :: Maybe ByteString
_RpbBucketProps'backend = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'search :: Maybe Bool
_RpbBucketProps'search = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'repl :: Maybe RpbBucketProps'RpbReplMode
_RpbBucketProps'repl = Maybe RpbBucketProps'RpbReplMode
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'searchIndex :: Maybe ByteString
_RpbBucketProps'searchIndex = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'datatype :: Maybe ByteString
_RpbBucketProps'datatype = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'consistent :: Maybe Bool
_RpbBucketProps'consistent = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'writeOnce :: Maybe Bool
_RpbBucketProps'writeOnce = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'hllPrecision :: Maybe Word32
_RpbBucketProps'hllPrecision = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'ttl :: Maybe Word32
_RpbBucketProps'ttl = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbBucketProps'_unknownFields :: FieldSet
_RpbBucketProps'_unknownFields = []}
  parseMessage :: Parser RpbBucketProps
parseMessage
    = let
        loop ::
          RpbBucketProps
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbCommitHook
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbCommitHook
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbBucketProps
        loop :: RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop RpbBucketProps
x Growing Vector RealWorld RpbCommitHook
mutable'postcommit Growing Vector RealWorld RpbCommitHook
mutable'precommit
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbCommitHook
frozen'postcommit <- IO (Vector RpbCommitHook) -> Parser (Vector RpbCommitHook)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                             (Growing Vector (PrimState IO) RpbCommitHook
-> IO (Vector RpbCommitHook)
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 RpbCommitHook
Growing Vector (PrimState IO) RpbCommitHook
mutable'postcommit)
                      Vector RpbCommitHook
frozen'precommit <- IO (Vector RpbCommitHook) -> Parser (Vector RpbCommitHook)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                            (Growing Vector (PrimState IO) RpbCommitHook
-> IO (Vector RpbCommitHook)
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 RpbCommitHook
Growing Vector (PrimState IO) RpbCommitHook
mutable'precommit)
                      (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]))))
                      RpbBucketProps -> Parser RpbBucketProps
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbBucketProps RpbBucketProps FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbBucketProps -> RpbBucketProps
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 RpbBucketProps RpbBucketProps FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbBucketProps
  RpbBucketProps
  (Vector RpbCommitHook)
  (Vector RpbCommitHook)
-> Vector RpbCommitHook -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'postcommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'postcommit")
                              Vector RpbCommitHook
frozen'postcommit
                              (Setter
  RpbBucketProps
  RpbBucketProps
  (Vector RpbCommitHook)
  (Vector RpbCommitHook)
-> Vector RpbCommitHook -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'precommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'precommit") Vector RpbCommitHook
frozen'precommit RpbBucketProps
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
"n_val"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nVal") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
16
                          -> 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
"allow_mult"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "allowMult" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"allowMult") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
24
                          -> 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
"last_write_wins"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "lastWriteWins" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lastWriteWins") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
34
                          -> do !RpbCommitHook
y <- Parser RpbCommitHook -> String -> Parser RpbCommitHook
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbCommitHook -> Parser RpbCommitHook
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 RpbCommitHook
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"precommit"
                                Growing Vector RealWorld RpbCommitHook
v <- IO (Growing Vector RealWorld RpbCommitHook)
-> Parser (Growing Vector RealWorld RpbCommitHook)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbCommitHook
-> RpbCommitHook
-> IO (Growing Vector (PrimState IO) RpbCommitHook)
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 RpbCommitHook
Growing Vector (PrimState IO) RpbCommitHook
mutable'precommit RpbCommitHook
y)
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop RpbBucketProps
x Growing Vector RealWorld RpbCommitHook
mutable'postcommit Growing Vector RealWorld RpbCommitHook
v
                        Word64
40
                          -> 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
"has_precommit"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "hasPrecommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"hasPrecommit") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
50
                          -> do !RpbCommitHook
y <- Parser RpbCommitHook -> String -> Parser RpbCommitHook
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbCommitHook -> Parser RpbCommitHook
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 RpbCommitHook
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"postcommit"
                                Growing Vector RealWorld RpbCommitHook
v <- IO (Growing Vector RealWorld RpbCommitHook)
-> Parser (Growing Vector RealWorld RpbCommitHook)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbCommitHook
-> RpbCommitHook
-> IO (Growing Vector (PrimState IO) RpbCommitHook)
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 RpbCommitHook
Growing Vector (PrimState IO) RpbCommitHook
mutable'postcommit RpbCommitHook
y)
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop RpbBucketProps
x Growing Vector RealWorld RpbCommitHook
v Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
56
                          -> 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
"has_postcommit"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "hasPostcommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"hasPostcommit") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
66
                          -> do RpbModFun
y <- Parser RpbModFun -> String -> Parser RpbModFun
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbModFun -> Parser RpbModFun
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 RpbModFun
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"chash_keyfun"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps RpbModFun RpbModFun
-> RpbModFun -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "chashKeyfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"chashKeyfun") RpbModFun
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
74
                          -> do RpbModFun
y <- Parser RpbModFun -> String -> Parser RpbModFun
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbModFun -> Parser RpbModFun
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 RpbModFun
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"linkfun"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps RpbModFun RpbModFun
-> RpbModFun -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "linkfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"linkfun") RpbModFun
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
80
                          -> 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
"old_vclock"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "oldVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"oldVclock") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
88
                          -> 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
"young_vclock"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "youngVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"youngVclock") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
96
                          -> 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
"big_vclock"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bigVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bigVclock") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
104
                          -> 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
"small_vclock"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "smallVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"smallVclock") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
112
                          -> 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
"pr"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pr") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
120
                          -> 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
"r"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"r") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
128
                          -> 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
"w"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"w") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
136
                          -> 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
"pw"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pw") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
144
                          -> 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
"dw"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"dw") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
152
                          -> 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
"rw"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "rw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rw") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
160
                          -> 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
"basic_quorum"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"basicQuorum") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
168
                          -> 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
"notfound_ok"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"notfoundOk") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
178
                          -> 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
"backend"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps ByteString ByteString
-> ByteString -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "backend" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"backend") ByteString
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
184
                          -> 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
"search"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "search" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"search") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
192
                          -> do RpbBucketProps'RpbReplMode
y <- Parser RpbBucketProps'RpbReplMode
-> String -> Parser RpbBucketProps'RpbReplMode
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Int -> RpbBucketProps'RpbReplMode)
-> Parser Int -> Parser RpbBucketProps'RpbReplMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Int -> RpbBucketProps'RpbReplMode
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
"repl"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter
  RpbBucketProps
  RpbBucketProps
  RpbBucketProps'RpbReplMode
  RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "repl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"repl") RpbBucketProps'RpbReplMode
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
202
                          -> 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
"search_index"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps ByteString ByteString
-> ByteString -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "searchIndex" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"searchIndex") ByteString
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
210
                          -> 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
"datatype"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps ByteString ByteString
-> ByteString -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "datatype" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"datatype") ByteString
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
216
                          -> 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
"consistent"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "consistent" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"consistent") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
224
                          -> 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
"write_once"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Bool Bool
-> Bool -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "writeOnce" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"writeOnce") Bool
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
232
                          -> 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
"hll_precision"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "hllPrecision" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"hllPrecision") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
240
                          -> 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
"ttl"
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps Word32 Word32
-> Word32 -> RpbBucketProps -> RpbBucketProps
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "ttl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ttl") Word32
y RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                                  (Setter RpbBucketProps RpbBucketProps FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbBucketProps -> RpbBucketProps
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 RpbBucketProps RpbBucketProps FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbBucketProps
x)
                                  Growing Vector RealWorld RpbCommitHook
mutable'postcommit
                                  Growing Vector RealWorld RpbCommitHook
mutable'precommit
      in
        Parser RpbBucketProps -> String -> Parser RpbBucketProps
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbCommitHook
mutable'postcommit <- IO (Growing Vector RealWorld RpbCommitHook)
-> Parser (Growing Vector RealWorld RpbCommitHook)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                      IO (Growing Vector RealWorld RpbCommitHook)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld RpbCommitHook
mutable'precommit <- IO (Growing Vector RealWorld RpbCommitHook)
-> Parser (Growing Vector RealWorld RpbCommitHook)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                     IO (Growing Vector RealWorld RpbCommitHook)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbBucketProps
-> Growing Vector RealWorld RpbCommitHook
-> Growing Vector RealWorld RpbCommitHook
-> Parser RpbBucketProps
loop
                RpbBucketProps
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbCommitHook
mutable'postcommit Growing Vector RealWorld RpbCommitHook
mutable'precommit)
          String
"RpbBucketProps"
  buildMessage :: RpbBucketProps -> Builder
buildMessage
    = \ RpbBucketProps
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal") RpbBucketProps
_x
              of
                Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Word32
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'allowMult" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'allowMult") RpbBucketProps
_x
                 of
                   Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Bool
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'lastWriteWins" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lastWriteWins") RpbBucketProps
_x
                    of
                      Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Bool
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      ((RpbCommitHook -> Builder) -> Vector RpbCommitHook -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                         (\ RpbCommitHook
_v
                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                 ((ByteString -> Builder)
-> (RpbCommitHook -> ByteString) -> RpbCommitHook -> 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))
                                    RpbCommitHook -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                    RpbCommitHook
_v))
                         (FoldLike
  (Vector RpbCommitHook)
  RpbBucketProps
  RpbBucketProps
  (Vector RpbCommitHook)
  (Vector RpbCommitHook)
-> RpbBucketProps -> Vector RpbCommitHook
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                            (forall s a (f :: * -> *).
(HasField s "vec'precommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'precommit") RpbBucketProps
_x))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                (forall s a (f :: * -> *).
(HasField s "maybe'hasPrecommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hasPrecommit") RpbBucketProps
_x
                          of
                            Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Bool
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            ((RpbCommitHook -> Builder) -> Vector RpbCommitHook -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                               (\ RpbCommitHook
_v
                                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                                       ((ByteString -> Builder)
-> (RpbCommitHook -> ByteString) -> RpbCommitHook -> 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))
                                          RpbCommitHook -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                          RpbCommitHook
_v))
                               (FoldLike
  (Vector RpbCommitHook)
  RpbBucketProps
  RpbBucketProps
  (Vector RpbCommitHook)
  (Vector RpbCommitHook)
-> RpbBucketProps -> Vector RpbCommitHook
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                  (forall s a (f :: * -> *).
(HasField s "vec'postcommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'postcommit") RpbBucketProps
_x))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'hasPostcommit" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'hasPostcommit") RpbBucketProps
_x
                                of
                                  Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Bool
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe RpbModFun)
  RpbBucketProps
  RpbBucketProps
  (Maybe RpbModFun)
  (Maybe RpbModFun)
-> RpbBucketProps -> Maybe RpbModFun
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                         (forall s a (f :: * -> *).
(HasField s "maybe'chashKeyfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'chashKeyfun") RpbBucketProps
_x
                                   of
                                     Maybe RpbModFun
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just RpbModFun
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
66)
                                            ((ByteString -> Builder)
-> (RpbModFun -> ByteString) -> RpbModFun -> 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))
                                               RpbModFun -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                               RpbModFun
_v))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike
  (Maybe RpbModFun)
  RpbBucketProps
  RpbBucketProps
  (Maybe RpbModFun)
  (Maybe RpbModFun)
-> RpbBucketProps -> Maybe RpbModFun
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'linkfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'linkfun") RpbBucketProps
_x
                                      of
                                        Maybe RpbModFun
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just RpbModFun
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
74)
                                               ((ByteString -> Builder)
-> (RpbModFun -> ByteString) -> RpbModFun -> 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))
                                                  RpbModFun -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                                  RpbModFun
_v))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'oldVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'oldVclock") RpbBucketProps
_x
                                         of
                                           Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just Word32
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
80)
                                                  ((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))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'youngVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'youngVclock")
                                                  RpbBucketProps
_x
                                            of
                                              Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Word32
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                              (case
                                                   FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                     (forall s a (f :: * -> *).
(HasField s "maybe'bigVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'bigVclock")
                                                     RpbBucketProps
_x
                                               of
                                                 Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                 (Prelude.Just Word32
_v)
                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
96)
                                                        ((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))
                                              (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                 (case
                                                      FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                        (forall s a (f :: * -> *).
(HasField s "maybe'smallVclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                           @"maybe'smallVclock")
                                                        RpbBucketProps
_x
                                                  of
                                                    Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                    (Prelude.Just Word32
_v)
                                                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                              Word64
104)
                                                           ((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))
                                                 (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                    (case
                                                         FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                           (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr")
                                                           RpbBucketProps
_x
                                                     of
                                                       Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                       (Prelude.Just Word32
_v)
                                                         -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                              (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                 Word64
112)
                                                              ((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))
                                                    (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                       (case
                                                            FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                              (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                 @"maybe'r")
                                                              RpbBucketProps
_x
                                                        of
                                                          Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                          (Prelude.Just Word32
_v)
                                                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                    Word64
120)
                                                                 ((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))
                                                       (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                          (case
                                                               FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                 (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                    @"maybe'w")
                                                                 RpbBucketProps
_x
                                                           of
                                                             Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                             (Prelude.Just Word32
_v)
                                                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                       Word64
128)
                                                                    ((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))
                                                          (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                             (case
                                                                  FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                    (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                       @"maybe'pw")
                                                                    RpbBucketProps
_x
                                                              of
                                                                Maybe Word32
Prelude.Nothing
                                                                  -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                (Prelude.Just Word32
_v)
                                                                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                          Word64
136)
                                                                       ((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))
                                                             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                (case
                                                                     FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                       (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                          @"maybe'dw")
                                                                       RpbBucketProps
_x
                                                                 of
                                                                   Maybe Word32
Prelude.Nothing
                                                                     -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                   (Prelude.Just Word32
_v)
                                                                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                             Word64
144)
                                                                          ((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))
                                                                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                   (case
                                                                        FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                          (forall s a (f :: * -> *).
(HasField s "maybe'rw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                             @"maybe'rw")
                                                                          RpbBucketProps
_x
                                                                    of
                                                                      Maybe Word32
Prelude.Nothing
                                                                        -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                      (Prelude.Just Word32
_v)
                                                                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                Word64
152)
                                                                             ((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))
                                                                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                      (case
                                                                           FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                             (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                @"maybe'basicQuorum")
                                                                             RpbBucketProps
_x
                                                                       of
                                                                         Maybe Bool
Prelude.Nothing
                                                                           -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                         (Prelude.Just Bool
_v)
                                                                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                   Word64
160)
                                                                                ((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))
                                                                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                         (case
                                                                              FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                   @"maybe'notfoundOk")
                                                                                RpbBucketProps
_x
                                                                          of
                                                                            Maybe Bool
Prelude.Nothing
                                                                              -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                            (Prelude.Just Bool
_v)
                                                                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                      Word64
168)
                                                                                   ((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))
                                                                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                            (case
                                                                                 FoldLike
  (Maybe ByteString)
  RpbBucketProps
  RpbBucketProps
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbBucketProps -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                   (forall s a (f :: * -> *).
(HasField s "maybe'backend" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                      @"maybe'backend")
                                                                                   RpbBucketProps
_x
                                                                             of
                                                                               Maybe ByteString
Prelude.Nothing
                                                                                 -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                               (Prelude.Just ByteString
_v)
                                                                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                         Word64
178)
                                                                                      ((\ 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))
                                                                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                               (case
                                                                                    FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                      (forall s a (f :: * -> *).
(HasField s "maybe'search" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                         @"maybe'search")
                                                                                      RpbBucketProps
_x
                                                                                of
                                                                                  Maybe Bool
Prelude.Nothing
                                                                                    -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                  (Prelude.Just Bool
_v)
                                                                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                            Word64
184)
                                                                                         ((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))
                                                                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                  (case
                                                                                       FoldLike
  (Maybe RpbBucketProps'RpbReplMode)
  RpbBucketProps
  RpbBucketProps
  (Maybe RpbBucketProps'RpbReplMode)
  (Maybe RpbBucketProps'RpbReplMode)
-> RpbBucketProps -> Maybe RpbBucketProps'RpbReplMode
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                         (forall s a (f :: * -> *).
(HasField s "maybe'repl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                            @"maybe'repl")
                                                                                         RpbBucketProps
_x
                                                                                   of
                                                                                     Maybe RpbBucketProps'RpbReplMode
Prelude.Nothing
                                                                                       -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                     (Prelude.Just RpbBucketProps'RpbReplMode
_v)
                                                                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                               Word64
192)
                                                                                            ((Int -> Builder)
-> (RpbBucketProps'RpbReplMode -> Int)
-> RpbBucketProps'RpbReplMode
-> 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)
                                                                                               RpbBucketProps'RpbReplMode -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum
                                                                                               RpbBucketProps'RpbReplMode
_v))
                                                                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                     (case
                                                                                          FoldLike
  (Maybe ByteString)
  RpbBucketProps
  RpbBucketProps
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbBucketProps -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                            (forall s a (f :: * -> *).
(HasField s "maybe'searchIndex" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                               @"maybe'searchIndex")
                                                                                            RpbBucketProps
_x
                                                                                      of
                                                                                        Maybe ByteString
Prelude.Nothing
                                                                                          -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                        (Prelude.Just ByteString
_v)
                                                                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                                  Word64
202)
                                                                                               ((\ 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))
                                                                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                        (case
                                                                                             FoldLike
  (Maybe ByteString)
  RpbBucketProps
  RpbBucketProps
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbBucketProps -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                               (forall s a (f :: * -> *).
(HasField s "maybe'datatype" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                                  @"maybe'datatype")
                                                                                               RpbBucketProps
_x
                                                                                         of
                                                                                           Maybe ByteString
Prelude.Nothing
                                                                                             -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                           (Prelude.Just ByteString
_v)
                                                                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                                     Word64
210)
                                                                                                  ((\ 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))
                                                                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                           (case
                                                                                                FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                                  (forall s a (f :: * -> *).
(HasField s "maybe'consistent" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                                     @"maybe'consistent")
                                                                                                  RpbBucketProps
_x
                                                                                            of
                                                                                              Maybe Bool
Prelude.Nothing
                                                                                                -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                              (Prelude.Just Bool
_v)
                                                                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                                        Word64
216)
                                                                                                     ((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))
                                                                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                              (case
                                                                                                   FoldLike
  (Maybe Bool)
  RpbBucketProps
  RpbBucketProps
  (Maybe Bool)
  (Maybe Bool)
-> RpbBucketProps -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                                     (forall s a (f :: * -> *).
(HasField s "maybe'writeOnce" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                                        @"maybe'writeOnce")
                                                                                                     RpbBucketProps
_x
                                                                                               of
                                                                                                 Maybe Bool
Prelude.Nothing
                                                                                                   -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                                 (Prelude.Just Bool
_v)
                                                                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                                           Word64
224)
                                                                                                        ((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))
                                                                                              (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                                 (case
                                                                                                      FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                                        (forall s a (f :: * -> *).
(HasField s "maybe'hllPrecision" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                                           @"maybe'hllPrecision")
                                                                                                        RpbBucketProps
_x
                                                                                                  of
                                                                                                    Maybe Word32
Prelude.Nothing
                                                                                                      -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                                    (Prelude.Just Word32
_v)
                                                                                                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                                              Word64
232)
                                                                                                           ((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))
                                                                                                 (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                                    (case
                                                                                                         FoldLike
  (Maybe Word32)
  RpbBucketProps
  RpbBucketProps
  (Maybe Word32)
  (Maybe Word32)
-> RpbBucketProps -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                                           (forall s a (f :: * -> *).
(HasField s "maybe'ttl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                                                              @"maybe'ttl")
                                                                                                           RpbBucketProps
_x
                                                                                                     of
                                                                                                       Maybe Word32
Prelude.Nothing
                                                                                                         -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                                                                       (Prelude.Just Word32
_v)
                                                                                                         -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                                                              (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                                                                 Word64
240)
                                                                                                              ((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 RpbBucketProps RpbBucketProps FieldSet FieldSet
-> RpbBucketProps -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                                                          FoldLike FieldSet RpbBucketProps RpbBucketProps FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields
                                                                                                          RpbBucketProps
_x)))))))))))))))))))))))))))))))
instance Control.DeepSeq.NFData RpbBucketProps where
  rnf :: RpbBucketProps -> ()
rnf
    = \ RpbBucketProps
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbBucketProps -> FieldSet
_RpbBucketProps'_unknownFields RpbBucketProps
x__)
             (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbBucketProps -> Maybe Word32
_RpbBucketProps'nVal RpbBucketProps
x__)
                (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbBucketProps -> Maybe Bool
_RpbBucketProps'allowMult RpbBucketProps
x__)
                   (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbBucketProps -> Maybe Bool
_RpbBucketProps'lastWriteWins RpbBucketProps
x__)
                      (Vector RpbCommitHook -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'precommit RpbBucketProps
x__)
                         (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPrecommit RpbBucketProps
x__)
                            (Vector RpbCommitHook -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbBucketProps -> Vector RpbCommitHook
_RpbBucketProps'postcommit RpbBucketProps
x__)
                               (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbBucketProps -> Maybe Bool
_RpbBucketProps'hasPostcommit RpbBucketProps
x__)
                                  (Maybe RpbModFun -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'chashKeyfun RpbBucketProps
x__)
                                     (Maybe RpbModFun -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbBucketProps -> Maybe RpbModFun
_RpbBucketProps'linkfun RpbBucketProps
x__)
                                        (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbBucketProps -> Maybe Word32
_RpbBucketProps'oldVclock RpbBucketProps
x__)
                                           (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (RpbBucketProps -> Maybe Word32
_RpbBucketProps'youngVclock RpbBucketProps
x__)
                                              (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                 (RpbBucketProps -> Maybe Word32
_RpbBucketProps'bigVclock RpbBucketProps
x__)
                                                 (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                    (RpbBucketProps -> Maybe Word32
_RpbBucketProps'smallVclock RpbBucketProps
x__)
                                                    (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                       (RpbBucketProps -> Maybe Word32
_RpbBucketProps'pr RpbBucketProps
x__)
                                                       (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                          (RpbBucketProps -> Maybe Word32
_RpbBucketProps'r RpbBucketProps
x__)
                                                          (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                             (RpbBucketProps -> Maybe Word32
_RpbBucketProps'w RpbBucketProps
x__)
                                                             (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                (RpbBucketProps -> Maybe Word32
_RpbBucketProps'pw RpbBucketProps
x__)
                                                                (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                   (RpbBucketProps -> Maybe Word32
_RpbBucketProps'dw RpbBucketProps
x__)
                                                                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                      (RpbBucketProps -> Maybe Word32
_RpbBucketProps'rw RpbBucketProps
x__)
                                                                      (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                         (RpbBucketProps -> Maybe Bool
_RpbBucketProps'basicQuorum
                                                                            RpbBucketProps
x__)
                                                                         (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                            (RpbBucketProps -> Maybe Bool
_RpbBucketProps'notfoundOk
                                                                               RpbBucketProps
x__)
                                                                            (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                               (RpbBucketProps -> Maybe ByteString
_RpbBucketProps'backend
                                                                                  RpbBucketProps
x__)
                                                                               (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                  (RpbBucketProps -> Maybe Bool
_RpbBucketProps'search
                                                                                     RpbBucketProps
x__)
                                                                                  (Maybe RpbBucketProps'RpbReplMode -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                     (RpbBucketProps -> Maybe RpbBucketProps'RpbReplMode
_RpbBucketProps'repl
                                                                                        RpbBucketProps
x__)
                                                                                     (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                        (RpbBucketProps -> Maybe ByteString
_RpbBucketProps'searchIndex
                                                                                           RpbBucketProps
x__)
                                                                                        (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                           (RpbBucketProps -> Maybe ByteString
_RpbBucketProps'datatype
                                                                                              RpbBucketProps
x__)
                                                                                           (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                              (RpbBucketProps -> Maybe Bool
_RpbBucketProps'consistent
                                                                                                 RpbBucketProps
x__)
                                                                                              (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                                 (RpbBucketProps -> Maybe Bool
_RpbBucketProps'writeOnce
                                                                                                    RpbBucketProps
x__)
                                                                                                 (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                                    (RpbBucketProps -> Maybe Word32
_RpbBucketProps'hllPrecision
                                                                                                       RpbBucketProps
x__)
                                                                                                    (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                                                                       (RpbBucketProps -> Maybe Word32
_RpbBucketProps'ttl
                                                                                                          RpbBucketProps
x__)
                                                                                                       ()))))))))))))))))))))))))))))))
data RpbBucketProps'RpbReplMode
  = RpbBucketProps'FALSE |
    RpbBucketProps'REALTIME |
    RpbBucketProps'FULLSYNC |
    RpbBucketProps'TRUE
  deriving stock (Int -> RpbBucketProps'RpbReplMode -> ShowS
[RpbBucketProps'RpbReplMode] -> ShowS
RpbBucketProps'RpbReplMode -> String
(Int -> RpbBucketProps'RpbReplMode -> ShowS)
-> (RpbBucketProps'RpbReplMode -> String)
-> ([RpbBucketProps'RpbReplMode] -> ShowS)
-> Show RpbBucketProps'RpbReplMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpbBucketProps'RpbReplMode] -> ShowS
$cshowList :: [RpbBucketProps'RpbReplMode] -> ShowS
show :: RpbBucketProps'RpbReplMode -> String
$cshow :: RpbBucketProps'RpbReplMode -> String
showsPrec :: Int -> RpbBucketProps'RpbReplMode -> ShowS
$cshowsPrec :: Int -> RpbBucketProps'RpbReplMode -> ShowS
Prelude.Show, RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
(RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool)
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> Bool)
-> Eq RpbBucketProps'RpbReplMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
$c/= :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
== :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
$c== :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
Prelude.Eq, Eq RpbBucketProps'RpbReplMode
Eq RpbBucketProps'RpbReplMode
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> Ordering)
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> Bool)
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> Bool)
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> Bool)
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> Bool)
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode)
-> (RpbBucketProps'RpbReplMode
    -> RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode)
-> Ord RpbBucketProps'RpbReplMode
RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> Ordering
RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
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 :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
$cmin :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
max :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
$cmax :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
>= :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
$c>= :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
> :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
$c> :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
<= :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
$c<= :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
< :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
$c< :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode -> Bool
compare :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> Ordering
$ccompare :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> Ordering
$cp1Ord :: Eq RpbBucketProps'RpbReplMode
Prelude.Ord)
instance Data.ProtoLens.MessageEnum RpbBucketProps'RpbReplMode where
  maybeToEnum :: Int -> Maybe RpbBucketProps'RpbReplMode
maybeToEnum Int
0 = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE
  maybeToEnum Int
1 = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME
  maybeToEnum Int
2 = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC
  maybeToEnum Int
3 = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE
  maybeToEnum Int
_ = Maybe RpbBucketProps'RpbReplMode
forall a. Maybe a
Prelude.Nothing
  showEnum :: RpbBucketProps'RpbReplMode -> String
showEnum RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE = String
"FALSE"
  showEnum RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME = String
"REALTIME"
  showEnum RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC = String
"FULLSYNC"
  showEnum RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE = String
"TRUE"
  readEnum :: String -> Maybe RpbBucketProps'RpbReplMode
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"FALSE" = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"REALTIME" = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"FULLSYNC" = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"TRUE" = RpbBucketProps'RpbReplMode -> Maybe RpbBucketProps'RpbReplMode
forall a. a -> Maybe a
Prelude.Just RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE
    | Bool
Prelude.otherwise
    = Maybe Int
-> (Int -> Maybe RpbBucketProps'RpbReplMode)
-> Maybe RpbBucketProps'RpbReplMode
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 RpbBucketProps'RpbReplMode
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded RpbBucketProps'RpbReplMode where
  minBound :: RpbBucketProps'RpbReplMode
minBound = RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE
  maxBound :: RpbBucketProps'RpbReplMode
maxBound = RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE
instance Prelude.Enum RpbBucketProps'RpbReplMode where
  toEnum :: Int -> RpbBucketProps'RpbReplMode
toEnum Int
k__
    = RpbBucketProps'RpbReplMode
-> (RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode)
-> Maybe RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> RpbBucketProps'RpbReplMode
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum RpbReplMode: " (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
forall a. a -> a
Prelude.id
        (Int -> Maybe RpbBucketProps'RpbReplMode
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: RpbBucketProps'RpbReplMode -> Int
fromEnum RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE = Int
0
  fromEnum RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME = Int
1
  fromEnum RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC = Int
2
  fromEnum RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE = Int
3
  succ :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
succ RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE
    = String -> RpbBucketProps'RpbReplMode
forall a. HasCallStack => String -> a
Prelude.error
        String
"RpbBucketProps'RpbReplMode.succ: bad argument RpbBucketProps'TRUE. This value would be out of bounds."
  succ RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE = RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME
  succ RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME = RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC
  succ RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC = RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE
  pred :: RpbBucketProps'RpbReplMode -> RpbBucketProps'RpbReplMode
pred RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE
    = String -> RpbBucketProps'RpbReplMode
forall a. HasCallStack => String -> a
Prelude.error
        String
"RpbBucketProps'RpbReplMode.pred: bad argument RpbBucketProps'FALSE. This value would be out of bounds."
  pred RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME = RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE
  pred RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC = RpbBucketProps'RpbReplMode
RpbBucketProps'REALTIME
  pred RpbBucketProps'RpbReplMode
RpbBucketProps'TRUE = RpbBucketProps'RpbReplMode
RpbBucketProps'FULLSYNC
  enumFrom :: RpbBucketProps'RpbReplMode -> [RpbBucketProps'RpbReplMode]
enumFrom = RpbBucketProps'RpbReplMode -> [RpbBucketProps'RpbReplMode]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> [RpbBucketProps'RpbReplMode]
enumFromTo = RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> [RpbBucketProps'RpbReplMode]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> [RpbBucketProps'RpbReplMode]
enumFromThen = RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode -> [RpbBucketProps'RpbReplMode]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode
-> [RpbBucketProps'RpbReplMode]
enumFromThenTo = RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode
-> RpbBucketProps'RpbReplMode
-> [RpbBucketProps'RpbReplMode]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault RpbBucketProps'RpbReplMode where
  fieldDefault :: RpbBucketProps'RpbReplMode
fieldDefault = RpbBucketProps'RpbReplMode
RpbBucketProps'FALSE
instance Control.DeepSeq.NFData RpbBucketProps'RpbReplMode where
  rnf :: RpbBucketProps'RpbReplMode -> ()
rnf RpbBucketProps'RpbReplMode
x__ = RpbBucketProps'RpbReplMode -> () -> ()
Prelude.seq RpbBucketProps'RpbReplMode
x__ ()
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbCSBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.startKey' @:: Lens' RpbCSBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.endKey' @:: Lens' RpbCSBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'endKey' @:: Lens' RpbCSBucketReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.startIncl' @:: Lens' RpbCSBucketReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'startIncl' @:: Lens' RpbCSBucketReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.endIncl' @:: Lens' RpbCSBucketReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'endIncl' @:: Lens' RpbCSBucketReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.continuation' @:: Lens' RpbCSBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'continuation' @:: Lens' RpbCSBucketReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.maxResults' @:: Lens' RpbCSBucketReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'maxResults' @:: Lens' RpbCSBucketReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbCSBucketReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbCSBucketReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbCSBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbCSBucketReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.coverContext' @:: Lens' RpbCSBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'coverContext' @:: Lens' RpbCSBucketReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbCSBucketReq
  = RpbCSBucketReq'_constructor {RpbCSBucketReq -> ByteString
_RpbCSBucketReq'bucket :: !Data.ByteString.ByteString,
                                 RpbCSBucketReq -> ByteString
_RpbCSBucketReq'startKey :: !Data.ByteString.ByteString,
                                 RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'endKey :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'startIncl :: !(Prelude.Maybe Prelude.Bool),
                                 RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'endIncl :: !(Prelude.Maybe Prelude.Bool),
                                 RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'continuation :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'maxResults :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'coverContext :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbCSBucketReq -> FieldSet
_RpbCSBucketReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCSBucketReq -> RpbCSBucketReq -> Bool
(RpbCSBucketReq -> RpbCSBucketReq -> Bool)
-> (RpbCSBucketReq -> RpbCSBucketReq -> Bool) -> Eq RpbCSBucketReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
$c/= :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
== :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
$c== :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
Prelude.Eq, Eq RpbCSBucketReq
Eq RpbCSBucketReq
-> (RpbCSBucketReq -> RpbCSBucketReq -> Ordering)
-> (RpbCSBucketReq -> RpbCSBucketReq -> Bool)
-> (RpbCSBucketReq -> RpbCSBucketReq -> Bool)
-> (RpbCSBucketReq -> RpbCSBucketReq -> Bool)
-> (RpbCSBucketReq -> RpbCSBucketReq -> Bool)
-> (RpbCSBucketReq -> RpbCSBucketReq -> RpbCSBucketReq)
-> (RpbCSBucketReq -> RpbCSBucketReq -> RpbCSBucketReq)
-> Ord RpbCSBucketReq
RpbCSBucketReq -> RpbCSBucketReq -> Bool
RpbCSBucketReq -> RpbCSBucketReq -> Ordering
RpbCSBucketReq -> RpbCSBucketReq -> RpbCSBucketReq
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 :: RpbCSBucketReq -> RpbCSBucketReq -> RpbCSBucketReq
$cmin :: RpbCSBucketReq -> RpbCSBucketReq -> RpbCSBucketReq
max :: RpbCSBucketReq -> RpbCSBucketReq -> RpbCSBucketReq
$cmax :: RpbCSBucketReq -> RpbCSBucketReq -> RpbCSBucketReq
>= :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
$c>= :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
> :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
$c> :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
<= :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
$c<= :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
< :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
$c< :: RpbCSBucketReq -> RpbCSBucketReq -> Bool
compare :: RpbCSBucketReq -> RpbCSBucketReq -> Ordering
$ccompare :: RpbCSBucketReq -> RpbCSBucketReq -> Ordering
$cp1Ord :: Eq RpbCSBucketReq
Prelude.Ord)
instance Prelude.Show RpbCSBucketReq where
  showsPrec :: Int -> RpbCSBucketReq -> ShowS
showsPrec Int
_ RpbCSBucketReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCSBucketReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCSBucketReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> ByteString)
-> (RpbCSBucketReq -> ByteString -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> ByteString
_RpbCSBucketReq'bucket
           (\ RpbCSBucketReq
x__ ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'bucket :: ByteString
_RpbCSBucketReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "startKey" Data.ByteString.ByteString where
  fieldOf :: Proxy# "startKey"
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "startKey"
_
    = ((ByteString -> f ByteString)
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> ByteString)
-> (RpbCSBucketReq -> ByteString -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> ByteString
_RpbCSBucketReq'startKey
           (\ RpbCSBucketReq
x__ ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'startKey :: ByteString
_RpbCSBucketReq'startKey = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "endKey" Data.ByteString.ByteString where
  fieldOf :: Proxy# "endKey"
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "endKey"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'endKey
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'endKey :: Maybe ByteString
_RpbCSBucketReq'endKey = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'endKey" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'endKey"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'endKey"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'endKey
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'endKey :: Maybe ByteString
_RpbCSBucketReq'endKey = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "startIncl" Prelude.Bool where
  fieldOf :: Proxy# "startIncl"
-> (Bool -> f Bool) -> RpbCSBucketReq -> f RpbCSBucketReq
fieldOf Proxy# "startIncl"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Bool)
-> (RpbCSBucketReq -> Maybe Bool -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'startIncl
           (\ RpbCSBucketReq
x__ Maybe Bool
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'startIncl :: Maybe Bool
_RpbCSBucketReq'startIncl = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.True)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'startIncl" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'startIncl"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'startIncl"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Bool)
-> (RpbCSBucketReq -> Maybe Bool -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'startIncl
           (\ RpbCSBucketReq
x__ Maybe Bool
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'startIncl :: Maybe Bool
_RpbCSBucketReq'startIncl = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "endIncl" Prelude.Bool where
  fieldOf :: Proxy# "endIncl"
-> (Bool -> f Bool) -> RpbCSBucketReq -> f RpbCSBucketReq
fieldOf Proxy# "endIncl"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Bool)
-> (RpbCSBucketReq -> Maybe Bool -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'endIncl
           (\ RpbCSBucketReq
x__ Maybe Bool
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'endIncl :: Maybe Bool
_RpbCSBucketReq'endIncl = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.False)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'endIncl" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'endIncl"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'endIncl"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Bool)
-> (RpbCSBucketReq -> Maybe Bool -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'endIncl
           (\ RpbCSBucketReq
x__ Maybe Bool
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'endIncl :: Maybe Bool
_RpbCSBucketReq'endIncl = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "continuation" Data.ByteString.ByteString where
  fieldOf :: Proxy# "continuation"
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'continuation
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'continuation :: Maybe ByteString
_RpbCSBucketReq'continuation = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'continuation" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'continuation"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'continuation
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'continuation :: Maybe ByteString
_RpbCSBucketReq'continuation = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maxResults" Data.Word.Word32 where
  fieldOf :: Proxy# "maxResults"
-> (Word32 -> f Word32) -> RpbCSBucketReq -> f RpbCSBucketReq
fieldOf Proxy# "maxResults"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Word32)
-> (RpbCSBucketReq -> Maybe Word32 -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'maxResults
           (\ RpbCSBucketReq
x__ Maybe Word32
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'maxResults :: Maybe Word32
_RpbCSBucketReq'maxResults = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'maxResults" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'maxResults"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'maxResults"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Word32)
-> (RpbCSBucketReq -> Maybe Word32 -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'maxResults
           (\ RpbCSBucketReq
x__ Maybe Word32
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'maxResults :: Maybe Word32
_RpbCSBucketReq'maxResults = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> RpbCSBucketReq -> f RpbCSBucketReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Word32)
-> (RpbCSBucketReq -> Maybe Word32 -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'timeout
           (\ RpbCSBucketReq
x__ Maybe Word32
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'timeout :: Maybe Word32
_RpbCSBucketReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe Word32)
-> (RpbCSBucketReq -> Maybe Word32 -> RpbCSBucketReq)
-> Lens RpbCSBucketReq RpbCSBucketReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'timeout
           (\ RpbCSBucketReq
x__ Maybe Word32
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'timeout :: Maybe Word32
_RpbCSBucketReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'type'
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'type' :: Maybe ByteString
_RpbCSBucketReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'type'
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'type' :: Maybe ByteString
_RpbCSBucketReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "coverContext" Data.ByteString.ByteString where
  fieldOf :: Proxy# "coverContext"
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "coverContext"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'coverContext
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'coverContext :: Maybe ByteString
_RpbCSBucketReq'coverContext = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCSBucketReq "maybe'coverContext" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'coverContext"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
fieldOf Proxy# "maybe'coverContext"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketReq -> f RpbCSBucketReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketReq
-> f RpbCSBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketReq -> Maybe ByteString)
-> (RpbCSBucketReq -> Maybe ByteString -> RpbCSBucketReq)
-> Lens
     RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'coverContext
           (\ RpbCSBucketReq
x__ Maybe ByteString
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'coverContext :: Maybe ByteString
_RpbCSBucketReq'coverContext = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCSBucketReq where
  messageName :: Proxy RpbCSBucketReq -> Text
messageName Proxy RpbCSBucketReq
_ = String -> Text
Data.Text.pack String
"RpbCSBucketReq"
  packedMessageDescriptor :: Proxy RpbCSBucketReq -> ByteString
packedMessageDescriptor Proxy RpbCSBucketReq
_
    = ByteString
"\n\
      \\SORpbCSBucketReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\ESC\n\
      \\tstart_key\CAN\STX \STX(\fR\bstartKey\DC2\ETB\n\
      \\aend_key\CAN\ETX \SOH(\fR\ACKendKey\DC2#\n\
      \\n\
      \start_incl\CAN\EOT \SOH(\b:\EOTtrueR\tstartIncl\DC2 \n\
      \\bend_incl\CAN\ENQ \SOH(\b:\ENQfalseR\aendIncl\DC2\"\n\
      \\fcontinuation\CAN\ACK \SOH(\fR\fcontinuation\DC2\US\n\
      \\vmax_results\CAN\a \SOH(\rR\n\
      \maxResults\DC2\CAN\n\
      \\atimeout\CAN\b \SOH(\rR\atimeout\DC2\DC2\n\
      \\EOTtype\CAN\t \SOH(\fR\EOTtype\DC2#\n\
      \\rcover_context\CAN\n\
      \ \SOH(\fR\fcoverContext"
  packedFileDescriptor :: Proxy RpbCSBucketReq -> ByteString
packedFileDescriptor Proxy RpbCSBucketReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCSBucketReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbCSBucketReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCSBucketReq ByteString
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> FieldAccessor RpbCSBucketReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        startKey__field_descriptor :: FieldDescriptor RpbCSBucketReq
startKey__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCSBucketReq ByteString
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"start_key"
              (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 RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> FieldAccessor RpbCSBucketReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "startKey" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"startKey")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        endKey__field_descriptor :: FieldDescriptor RpbCSBucketReq
endKey__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCSBucketReq ByteString
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"end_key"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbCSBucketReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'endKey" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'endKey")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        startIncl__field_descriptor :: FieldDescriptor RpbCSBucketReq
startIncl__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbCSBucketReq Bool
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"start_incl"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbCSBucketReq RpbCSBucketReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbCSBucketReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'startIncl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'startIncl")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        endIncl__field_descriptor :: FieldDescriptor RpbCSBucketReq
endIncl__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbCSBucketReq Bool
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"end_incl"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbCSBucketReq RpbCSBucketReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbCSBucketReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'endIncl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'endIncl")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        continuation__field_descriptor :: FieldDescriptor RpbCSBucketReq
continuation__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCSBucketReq ByteString
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"continuation"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbCSBucketReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        maxResults__field_descriptor :: FieldDescriptor RpbCSBucketReq
maxResults__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCSBucketReq Word32
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"max_results"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbCSBucketReq RpbCSBucketReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbCSBucketReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'maxResults" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'maxResults")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        timeout__field_descriptor :: FieldDescriptor RpbCSBucketReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCSBucketReq Word32
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbCSBucketReq RpbCSBucketReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbCSBucketReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        type'__field_descriptor :: FieldDescriptor RpbCSBucketReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCSBucketReq ByteString
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbCSBucketReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
        coverContext__field_descriptor :: FieldDescriptor RpbCSBucketReq
coverContext__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCSBucketReq ByteString
-> FieldDescriptor RpbCSBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"cover_context"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCSBucketReq RpbCSBucketReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbCSBucketReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'coverContext")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketReq
      in
        [(Tag, FieldDescriptor RpbCSBucketReq)]
-> Map Tag (FieldDescriptor RpbCSBucketReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCSBucketReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbCSBucketReq
startKey__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbCSBucketReq
endKey__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbCSBucketReq
startIncl__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbCSBucketReq
endIncl__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbCSBucketReq
continuation__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbCSBucketReq
maxResults__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbCSBucketReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbCSBucketReq
type'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbCSBucketReq
coverContext__field_descriptor)]
  unknownFields :: LensLike' f RpbCSBucketReq FieldSet
unknownFields
    = (RpbCSBucketReq -> FieldSet)
-> (RpbCSBucketReq -> FieldSet -> RpbCSBucketReq)
-> Lens' RpbCSBucketReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCSBucketReq -> FieldSet
_RpbCSBucketReq'_unknownFields
        (\ RpbCSBucketReq
x__ FieldSet
y__ -> RpbCSBucketReq
x__ {_RpbCSBucketReq'_unknownFields :: FieldSet
_RpbCSBucketReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbCSBucketReq
defMessage
    = RpbCSBucketReq'_constructor :: ByteString
-> ByteString
-> Maybe ByteString
-> Maybe Bool
-> Maybe Bool
-> Maybe ByteString
-> Maybe Word32
-> Maybe Word32
-> Maybe ByteString
-> Maybe ByteString
-> FieldSet
-> RpbCSBucketReq
RpbCSBucketReq'_constructor
        {_RpbCSBucketReq'bucket :: ByteString
_RpbCSBucketReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCSBucketReq'startKey :: ByteString
_RpbCSBucketReq'startKey = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCSBucketReq'endKey :: Maybe ByteString
_RpbCSBucketReq'endKey = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'startIncl :: Maybe Bool
_RpbCSBucketReq'startIncl = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'endIncl :: Maybe Bool
_RpbCSBucketReq'endIncl = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'continuation :: Maybe ByteString
_RpbCSBucketReq'continuation = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'maxResults :: Maybe Word32
_RpbCSBucketReq'maxResults = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'timeout :: Maybe Word32
_RpbCSBucketReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'type' :: Maybe ByteString
_RpbCSBucketReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'coverContext :: Maybe ByteString
_RpbCSBucketReq'coverContext = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketReq'_unknownFields :: FieldSet
_RpbCSBucketReq'_unknownFields = []}
  parseMessage :: Parser RpbCSBucketReq
parseMessage
    = let
        loop ::
          RpbCSBucketReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbCSBucketReq
        loop :: RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop RpbCSBucketReq
x Bool
required'bucket Bool
required'startKey
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'startKey then (:) String
"start_key" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbCSBucketReq -> Parser RpbCSBucketReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCSBucketReq RpbCSBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCSBucketReq -> RpbCSBucketReq
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 RpbCSBucketReq RpbCSBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbCSBucketReq
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
"bucket"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> ByteString -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbCSBucketReq
x)
                                  Bool
Prelude.False
                                  Bool
required'startKey
                        Word64
18
                          -> 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
"start_key"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> ByteString -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "startKey" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"startKey") ByteString
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
26
                          -> 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
"end_key"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> ByteString -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "endKey" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"endKey") ByteString
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
32
                          -> 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
"start_incl"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq Bool Bool
-> Bool -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "startIncl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"startIncl") Bool
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
40
                          -> 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
"end_incl"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq Bool Bool
-> Bool -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "endIncl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"endIncl") Bool
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
50
                          -> 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
"continuation"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> ByteString -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"continuation") ByteString
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
56
                          -> 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
"max_results"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq Word32 Word32
-> Word32 -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "maxResults" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maxResults") Word32
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
64
                          -> 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
"timeout"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq Word32 Word32
-> Word32 -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
74
                          -> 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
"type"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> ByteString -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
82
                          -> 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
"cover_context"
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> ByteString -> RpbCSBucketReq -> RpbCSBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext") ByteString
y RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop
                                  (Setter RpbCSBucketReq RpbCSBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCSBucketReq -> RpbCSBucketReq
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 RpbCSBucketReq RpbCSBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCSBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'startKey
      in
        Parser RpbCSBucketReq -> String -> Parser RpbCSBucketReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbCSBucketReq -> Bool -> Bool -> Parser RpbCSBucketReq
loop RpbCSBucketReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbCSBucketReq"
  buildMessage :: RpbCSBucketReq -> Builder
buildMessage
    = \ RpbCSBucketReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> RpbCSBucketReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbCSBucketReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString RpbCSBucketReq RpbCSBucketReq ByteString ByteString
-> RpbCSBucketReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "startKey" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"startKey") RpbCSBucketReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCSBucketReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'endKey" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'endKey") RpbCSBucketReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Bool)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe Bool)
  (Maybe Bool)
-> RpbCSBucketReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                             (forall s a (f :: * -> *).
(HasField s "maybe'startIncl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'startIncl") RpbCSBucketReq
_x
                       of
                         Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Bool
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe Bool)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe Bool)
  (Maybe Bool)
-> RpbCSBucketReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'endIncl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'endIncl") RpbCSBucketReq
_x
                          of
                            Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Bool
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe ByteString)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCSBucketReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                   (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation") RpbCSBucketReq
_x
                             of
                               Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just ByteString
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                                      ((\ 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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Word32)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCSBucketReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'maxResults" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'maxResults") RpbCSBucketReq
_x
                                of
                                  Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Word32
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe Word32)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCSBucketReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                         (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") RpbCSBucketReq
_x
                                   of
                                     Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Word32
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike
  (Maybe ByteString)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCSBucketReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbCSBucketReq
_x
                                      of
                                        Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just ByteString
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
74)
                                               ((\ 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))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe ByteString)
  RpbCSBucketReq
  RpbCSBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCSBucketReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'coverContext") RpbCSBucketReq
_x
                                         of
                                           Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just ByteString
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
82)
                                                  ((\ 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 RpbCSBucketReq RpbCSBucketReq FieldSet FieldSet
-> RpbCSBucketReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                              FoldLike FieldSet RpbCSBucketReq RpbCSBucketReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCSBucketReq
_x)))))))))))
instance Control.DeepSeq.NFData RpbCSBucketReq where
  rnf :: RpbCSBucketReq -> ()
rnf
    = \ RpbCSBucketReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCSBucketReq -> FieldSet
_RpbCSBucketReq'_unknownFields RpbCSBucketReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbCSBucketReq -> ByteString
_RpbCSBucketReq'bucket RpbCSBucketReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbCSBucketReq -> ByteString
_RpbCSBucketReq'startKey RpbCSBucketReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'endKey RpbCSBucketReq
x__)
                      (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'startIncl RpbCSBucketReq
x__)
                         (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbCSBucketReq -> Maybe Bool
_RpbCSBucketReq'endIncl RpbCSBucketReq
x__)
                            (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'continuation RpbCSBucketReq
x__)
                               (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'maxResults RpbCSBucketReq
x__)
                                  (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbCSBucketReq -> Maybe Word32
_RpbCSBucketReq'timeout RpbCSBucketReq
x__)
                                     (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'type' RpbCSBucketReq
x__)
                                        (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbCSBucketReq -> Maybe ByteString
_RpbCSBucketReq'coverContext RpbCSBucketReq
x__) ()))))))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.objects' @:: Lens' RpbCSBucketResp [RpbIndexObject]@
         * 'Proto.Riak_Fields.vec'objects' @:: Lens' RpbCSBucketResp (Data.Vector.Vector RpbIndexObject)@
         * 'Proto.Riak_Fields.continuation' @:: Lens' RpbCSBucketResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'continuation' @:: Lens' RpbCSBucketResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.done' @:: Lens' RpbCSBucketResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' RpbCSBucketResp (Prelude.Maybe Prelude.Bool)@ -}
data RpbCSBucketResp
  = RpbCSBucketResp'_constructor {RpbCSBucketResp -> Vector RpbIndexObject
_RpbCSBucketResp'objects :: !(Data.Vector.Vector RpbIndexObject),
                                  RpbCSBucketResp -> Maybe ByteString
_RpbCSBucketResp'continuation :: !(Prelude.Maybe Data.ByteString.ByteString),
                                  RpbCSBucketResp -> Maybe Bool
_RpbCSBucketResp'done :: !(Prelude.Maybe Prelude.Bool),
                                  RpbCSBucketResp -> FieldSet
_RpbCSBucketResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCSBucketResp -> RpbCSBucketResp -> Bool
(RpbCSBucketResp -> RpbCSBucketResp -> Bool)
-> (RpbCSBucketResp -> RpbCSBucketResp -> Bool)
-> Eq RpbCSBucketResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
$c/= :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
== :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
$c== :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
Prelude.Eq, Eq RpbCSBucketResp
Eq RpbCSBucketResp
-> (RpbCSBucketResp -> RpbCSBucketResp -> Ordering)
-> (RpbCSBucketResp -> RpbCSBucketResp -> Bool)
-> (RpbCSBucketResp -> RpbCSBucketResp -> Bool)
-> (RpbCSBucketResp -> RpbCSBucketResp -> Bool)
-> (RpbCSBucketResp -> RpbCSBucketResp -> Bool)
-> (RpbCSBucketResp -> RpbCSBucketResp -> RpbCSBucketResp)
-> (RpbCSBucketResp -> RpbCSBucketResp -> RpbCSBucketResp)
-> Ord RpbCSBucketResp
RpbCSBucketResp -> RpbCSBucketResp -> Bool
RpbCSBucketResp -> RpbCSBucketResp -> Ordering
RpbCSBucketResp -> RpbCSBucketResp -> RpbCSBucketResp
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 :: RpbCSBucketResp -> RpbCSBucketResp -> RpbCSBucketResp
$cmin :: RpbCSBucketResp -> RpbCSBucketResp -> RpbCSBucketResp
max :: RpbCSBucketResp -> RpbCSBucketResp -> RpbCSBucketResp
$cmax :: RpbCSBucketResp -> RpbCSBucketResp -> RpbCSBucketResp
>= :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
$c>= :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
> :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
$c> :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
<= :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
$c<= :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
< :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
$c< :: RpbCSBucketResp -> RpbCSBucketResp -> Bool
compare :: RpbCSBucketResp -> RpbCSBucketResp -> Ordering
$ccompare :: RpbCSBucketResp -> RpbCSBucketResp -> Ordering
$cp1Ord :: Eq RpbCSBucketResp
Prelude.Ord)
instance Prelude.Show RpbCSBucketResp where
  showsPrec :: Int -> RpbCSBucketResp -> ShowS
showsPrec Int
_ RpbCSBucketResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCSBucketResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCSBucketResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCSBucketResp "objects" [RpbIndexObject] where
  fieldOf :: Proxy# "objects"
-> ([RpbIndexObject] -> f [RpbIndexObject])
-> RpbCSBucketResp
-> f RpbCSBucketResp
fieldOf Proxy# "objects"
_
    = ((Vector RpbIndexObject -> f (Vector RpbIndexObject))
 -> RpbCSBucketResp -> f RpbCSBucketResp)
-> (([RpbIndexObject] -> f [RpbIndexObject])
    -> Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> ([RpbIndexObject] -> f [RpbIndexObject])
-> RpbCSBucketResp
-> f RpbCSBucketResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketResp -> Vector RpbIndexObject)
-> (RpbCSBucketResp -> Vector RpbIndexObject -> RpbCSBucketResp)
-> Lens
     RpbCSBucketResp
     RpbCSBucketResp
     (Vector RpbIndexObject)
     (Vector RpbIndexObject)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketResp -> Vector RpbIndexObject
_RpbCSBucketResp'objects
           (\ RpbCSBucketResp
x__ Vector RpbIndexObject
y__ -> RpbCSBucketResp
x__ {_RpbCSBucketResp'objects :: Vector RpbIndexObject
_RpbCSBucketResp'objects = Vector RpbIndexObject
y__}))
        ((Vector RpbIndexObject -> [RpbIndexObject])
-> (Vector RpbIndexObject
    -> [RpbIndexObject] -> Vector RpbIndexObject)
-> Lens
     (Vector RpbIndexObject)
     (Vector RpbIndexObject)
     [RpbIndexObject]
     [RpbIndexObject]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbIndexObject -> [RpbIndexObject]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbIndexObject
_ [RpbIndexObject]
y__ -> [RpbIndexObject] -> Vector RpbIndexObject
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbIndexObject]
y__))
instance Data.ProtoLens.Field.HasField RpbCSBucketResp "vec'objects" (Data.Vector.Vector RpbIndexObject) where
  fieldOf :: Proxy# "vec'objects"
-> (Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> RpbCSBucketResp
-> f RpbCSBucketResp
fieldOf Proxy# "vec'objects"
_
    = ((Vector RpbIndexObject -> f (Vector RpbIndexObject))
 -> RpbCSBucketResp -> f RpbCSBucketResp)
-> ((Vector RpbIndexObject -> f (Vector RpbIndexObject))
    -> Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> (Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> RpbCSBucketResp
-> f RpbCSBucketResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketResp -> Vector RpbIndexObject)
-> (RpbCSBucketResp -> Vector RpbIndexObject -> RpbCSBucketResp)
-> Lens
     RpbCSBucketResp
     RpbCSBucketResp
     (Vector RpbIndexObject)
     (Vector RpbIndexObject)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketResp -> Vector RpbIndexObject
_RpbCSBucketResp'objects
           (\ RpbCSBucketResp
x__ Vector RpbIndexObject
y__ -> RpbCSBucketResp
x__ {_RpbCSBucketResp'objects :: Vector RpbIndexObject
_RpbCSBucketResp'objects = Vector RpbIndexObject
y__}))
        (Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> Vector RpbIndexObject -> f (Vector RpbIndexObject)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketResp "continuation" Data.ByteString.ByteString where
  fieldOf :: Proxy# "continuation"
-> (ByteString -> f ByteString)
-> RpbCSBucketResp
-> f RpbCSBucketResp
fieldOf Proxy# "continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketResp -> f RpbCSBucketResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCSBucketResp
-> f RpbCSBucketResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketResp -> Maybe ByteString)
-> (RpbCSBucketResp -> Maybe ByteString -> RpbCSBucketResp)
-> Lens
     RpbCSBucketResp
     RpbCSBucketResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketResp -> Maybe ByteString
_RpbCSBucketResp'continuation
           (\ RpbCSBucketResp
x__ Maybe ByteString
y__ -> RpbCSBucketResp
x__ {_RpbCSBucketResp'continuation :: Maybe ByteString
_RpbCSBucketResp'continuation = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCSBucketResp "maybe'continuation" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'continuation"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketResp
-> f RpbCSBucketResp
fieldOf Proxy# "maybe'continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCSBucketResp -> f RpbCSBucketResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCSBucketResp
-> f RpbCSBucketResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketResp -> Maybe ByteString)
-> (RpbCSBucketResp -> Maybe ByteString -> RpbCSBucketResp)
-> Lens
     RpbCSBucketResp
     RpbCSBucketResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketResp -> Maybe ByteString
_RpbCSBucketResp'continuation
           (\ RpbCSBucketResp
x__ Maybe ByteString
y__ -> RpbCSBucketResp
x__ {_RpbCSBucketResp'continuation :: Maybe ByteString
_RpbCSBucketResp'continuation = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCSBucketResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done"
-> (Bool -> f Bool) -> RpbCSBucketResp -> f RpbCSBucketResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCSBucketResp -> f RpbCSBucketResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbCSBucketResp
-> f RpbCSBucketResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketResp -> Maybe Bool)
-> (RpbCSBucketResp -> Maybe Bool -> RpbCSBucketResp)
-> Lens RpbCSBucketResp RpbCSBucketResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketResp -> Maybe Bool
_RpbCSBucketResp'done
           (\ RpbCSBucketResp
x__ Maybe Bool
y__ -> RpbCSBucketResp
x__ {_RpbCSBucketResp'done :: Maybe Bool
_RpbCSBucketResp'done = 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 RpbCSBucketResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCSBucketResp
-> f RpbCSBucketResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCSBucketResp -> f RpbCSBucketResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCSBucketResp
-> f RpbCSBucketResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCSBucketResp -> Maybe Bool)
-> (RpbCSBucketResp -> Maybe Bool -> RpbCSBucketResp)
-> Lens RpbCSBucketResp RpbCSBucketResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCSBucketResp -> Maybe Bool
_RpbCSBucketResp'done
           (\ RpbCSBucketResp
x__ Maybe Bool
y__ -> RpbCSBucketResp
x__ {_RpbCSBucketResp'done :: Maybe Bool
_RpbCSBucketResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCSBucketResp where
  messageName :: Proxy RpbCSBucketResp -> Text
messageName Proxy RpbCSBucketResp
_ = String -> Text
Data.Text.pack String
"RpbCSBucketResp"
  packedMessageDescriptor :: Proxy RpbCSBucketResp -> ByteString
packedMessageDescriptor Proxy RpbCSBucketResp
_
    = ByteString
"\n\
      \\SIRpbCSBucketResp\DC2)\n\
      \\aobjects\CAN\SOH \ETX(\v2\SI.RpbIndexObjectR\aobjects\DC2\"\n\
      \\fcontinuation\CAN\STX \SOH(\fR\fcontinuation\DC2\DC2\n\
      \\EOTdone\CAN\ETX \SOH(\bR\EOTdone"
  packedFileDescriptor :: Proxy RpbCSBucketResp -> ByteString
packedFileDescriptor Proxy RpbCSBucketResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCSBucketResp)
fieldsByTag
    = let
        objects__field_descriptor :: FieldDescriptor RpbCSBucketResp
objects__field_descriptor
          = String
-> FieldTypeDescriptor RpbIndexObject
-> FieldAccessor RpbCSBucketResp RpbIndexObject
-> FieldDescriptor RpbCSBucketResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"objects"
              (MessageOrGroup -> FieldTypeDescriptor RpbIndexObject
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbIndexObject)
              (Packing
-> Lens' RpbCSBucketResp [RpbIndexObject]
-> FieldAccessor RpbCSBucketResp RpbIndexObject
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "objects" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"objects")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketResp
        continuation__field_descriptor :: FieldDescriptor RpbCSBucketResp
continuation__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCSBucketResp ByteString
-> FieldDescriptor RpbCSBucketResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"continuation"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCSBucketResp
  RpbCSBucketResp
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbCSBucketResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketResp
        done__field_descriptor :: FieldDescriptor RpbCSBucketResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbCSBucketResp Bool
-> FieldDescriptor RpbCSBucketResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbCSBucketResp RpbCSBucketResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbCSBucketResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor RpbCSBucketResp
      in
        [(Tag, FieldDescriptor RpbCSBucketResp)]
-> Map Tag (FieldDescriptor RpbCSBucketResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCSBucketResp
objects__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbCSBucketResp
continuation__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbCSBucketResp
done__field_descriptor)]
  unknownFields :: LensLike' f RpbCSBucketResp FieldSet
unknownFields
    = (RpbCSBucketResp -> FieldSet)
-> (RpbCSBucketResp -> FieldSet -> RpbCSBucketResp)
-> Lens' RpbCSBucketResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCSBucketResp -> FieldSet
_RpbCSBucketResp'_unknownFields
        (\ RpbCSBucketResp
x__ FieldSet
y__ -> RpbCSBucketResp
x__ {_RpbCSBucketResp'_unknownFields :: FieldSet
_RpbCSBucketResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbCSBucketResp
defMessage
    = RpbCSBucketResp'_constructor :: Vector RpbIndexObject
-> Maybe ByteString -> Maybe Bool -> FieldSet -> RpbCSBucketResp
RpbCSBucketResp'_constructor
        {_RpbCSBucketResp'objects :: Vector RpbIndexObject
_RpbCSBucketResp'objects = Vector RpbIndexObject
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbCSBucketResp'continuation :: Maybe ByteString
_RpbCSBucketResp'continuation = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketResp'done :: Maybe Bool
_RpbCSBucketResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbCSBucketResp'_unknownFields :: FieldSet
_RpbCSBucketResp'_unknownFields = []}
  parseMessage :: Parser RpbCSBucketResp
parseMessage
    = let
        loop ::
          RpbCSBucketResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbIndexObject
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbCSBucketResp
        loop :: RpbCSBucketResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbCSBucketResp
loop RpbCSBucketResp
x Growing Vector RealWorld RpbIndexObject
mutable'objects
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbIndexObject
frozen'objects <- IO (Vector RpbIndexObject) -> Parser (Vector RpbIndexObject)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) RpbIndexObject
-> IO (Vector RpbIndexObject)
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 RpbIndexObject
Growing Vector (PrimState IO) RpbIndexObject
mutable'objects)
                      (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]))))
                      RpbCSBucketResp -> Parser RpbCSBucketResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCSBucketResp RpbCSBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCSBucketResp -> RpbCSBucketResp
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 RpbCSBucketResp RpbCSBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbCSBucketResp
  RpbCSBucketResp
  (Vector RpbIndexObject)
  (Vector RpbIndexObject)
-> Vector RpbIndexObject -> RpbCSBucketResp -> RpbCSBucketResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'objects" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'objects") Vector RpbIndexObject
frozen'objects RpbCSBucketResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbIndexObject
y <- Parser RpbIndexObject -> String -> Parser RpbIndexObject
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbIndexObject -> Parser RpbIndexObject
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 RpbIndexObject
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"objects"
                                Growing Vector RealWorld RpbIndexObject
v <- IO (Growing Vector RealWorld RpbIndexObject)
-> Parser (Growing Vector RealWorld RpbIndexObject)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbIndexObject
-> RpbIndexObject
-> IO (Growing Vector (PrimState IO) RpbIndexObject)
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 RpbIndexObject
Growing Vector (PrimState IO) RpbIndexObject
mutable'objects RpbIndexObject
y)
                                RpbCSBucketResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbCSBucketResp
loop RpbCSBucketResp
x Growing Vector RealWorld RpbIndexObject
v
                        Word64
18
                          -> 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
"continuation"
                                RpbCSBucketResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbCSBucketResp
loop
                                  (Setter RpbCSBucketResp RpbCSBucketResp ByteString ByteString
-> ByteString -> RpbCSBucketResp -> RpbCSBucketResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"continuation") ByteString
y RpbCSBucketResp
x)
                                  Growing Vector RealWorld RpbIndexObject
mutable'objects
                        Word64
24
                          -> 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
"done"
                                RpbCSBucketResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbCSBucketResp
loop
                                  (Setter RpbCSBucketResp RpbCSBucketResp Bool Bool
-> Bool -> RpbCSBucketResp -> RpbCSBucketResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y RpbCSBucketResp
x)
                                  Growing Vector RealWorld RpbIndexObject
mutable'objects
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCSBucketResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbCSBucketResp
loop
                                  (Setter RpbCSBucketResp RpbCSBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCSBucketResp -> RpbCSBucketResp
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 RpbCSBucketResp RpbCSBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCSBucketResp
x)
                                  Growing Vector RealWorld RpbIndexObject
mutable'objects
      in
        Parser RpbCSBucketResp -> String -> Parser RpbCSBucketResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbIndexObject
mutable'objects <- IO (Growing Vector RealWorld RpbIndexObject)
-> Parser (Growing Vector RealWorld RpbIndexObject)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld RpbIndexObject)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbCSBucketResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbCSBucketResp
loop RpbCSBucketResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbIndexObject
mutable'objects)
          String
"RpbCSBucketResp"
  buildMessage :: RpbCSBucketResp -> Builder
buildMessage
    = \ RpbCSBucketResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbIndexObject -> Builder) -> Vector RpbIndexObject -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbIndexObject
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbIndexObject -> ByteString) -> RpbIndexObject -> 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))
                           RpbIndexObject -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbIndexObject
_v))
                (FoldLike
  (Vector RpbIndexObject)
  RpbCSBucketResp
  RpbCSBucketResp
  (Vector RpbIndexObject)
  (Vector RpbIndexObject)
-> RpbCSBucketResp -> Vector RpbIndexObject
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'objects" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'objects") RpbCSBucketResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbCSBucketResp
  RpbCSBucketResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCSBucketResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation") RpbCSBucketResp
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Bool)
  RpbCSBucketResp
  RpbCSBucketResp
  (Maybe Bool)
  (Maybe Bool)
-> RpbCSBucketResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") RpbCSBucketResp
_x
                    of
                      Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Bool
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike FieldSet RpbCSBucketResp RpbCSBucketResp FieldSet FieldSet
-> RpbCSBucketResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbCSBucketResp RpbCSBucketResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCSBucketResp
_x))))
instance Control.DeepSeq.NFData RpbCSBucketResp where
  rnf :: RpbCSBucketResp -> ()
rnf
    = \ RpbCSBucketResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCSBucketResp -> FieldSet
_RpbCSBucketResp'_unknownFields RpbCSBucketResp
x__)
             (Vector RpbIndexObject -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbCSBucketResp -> Vector RpbIndexObject
_RpbCSBucketResp'objects RpbCSBucketResp
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbCSBucketResp -> Maybe ByteString
_RpbCSBucketResp'continuation RpbCSBucketResp
x__)
                   (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbCSBucketResp -> Maybe Bool
_RpbCSBucketResp'done RpbCSBucketResp
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.modfun' @:: Lens' RpbCommitHook RpbModFun@
         * 'Proto.Riak_Fields.maybe'modfun' @:: Lens' RpbCommitHook (Prelude.Maybe RpbModFun)@
         * 'Proto.Riak_Fields.name' @:: Lens' RpbCommitHook Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'name' @:: Lens' RpbCommitHook (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbCommitHook
  = RpbCommitHook'_constructor {RpbCommitHook -> Maybe RpbModFun
_RpbCommitHook'modfun :: !(Prelude.Maybe RpbModFun),
                                RpbCommitHook -> Maybe ByteString
_RpbCommitHook'name :: !(Prelude.Maybe Data.ByteString.ByteString),
                                RpbCommitHook -> FieldSet
_RpbCommitHook'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCommitHook -> RpbCommitHook -> Bool
(RpbCommitHook -> RpbCommitHook -> Bool)
-> (RpbCommitHook -> RpbCommitHook -> Bool) -> Eq RpbCommitHook
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCommitHook -> RpbCommitHook -> Bool
$c/= :: RpbCommitHook -> RpbCommitHook -> Bool
== :: RpbCommitHook -> RpbCommitHook -> Bool
$c== :: RpbCommitHook -> RpbCommitHook -> Bool
Prelude.Eq, Eq RpbCommitHook
Eq RpbCommitHook
-> (RpbCommitHook -> RpbCommitHook -> Ordering)
-> (RpbCommitHook -> RpbCommitHook -> Bool)
-> (RpbCommitHook -> RpbCommitHook -> Bool)
-> (RpbCommitHook -> RpbCommitHook -> Bool)
-> (RpbCommitHook -> RpbCommitHook -> Bool)
-> (RpbCommitHook -> RpbCommitHook -> RpbCommitHook)
-> (RpbCommitHook -> RpbCommitHook -> RpbCommitHook)
-> Ord RpbCommitHook
RpbCommitHook -> RpbCommitHook -> Bool
RpbCommitHook -> RpbCommitHook -> Ordering
RpbCommitHook -> RpbCommitHook -> RpbCommitHook
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 :: RpbCommitHook -> RpbCommitHook -> RpbCommitHook
$cmin :: RpbCommitHook -> RpbCommitHook -> RpbCommitHook
max :: RpbCommitHook -> RpbCommitHook -> RpbCommitHook
$cmax :: RpbCommitHook -> RpbCommitHook -> RpbCommitHook
>= :: RpbCommitHook -> RpbCommitHook -> Bool
$c>= :: RpbCommitHook -> RpbCommitHook -> Bool
> :: RpbCommitHook -> RpbCommitHook -> Bool
$c> :: RpbCommitHook -> RpbCommitHook -> Bool
<= :: RpbCommitHook -> RpbCommitHook -> Bool
$c<= :: RpbCommitHook -> RpbCommitHook -> Bool
< :: RpbCommitHook -> RpbCommitHook -> Bool
$c< :: RpbCommitHook -> RpbCommitHook -> Bool
compare :: RpbCommitHook -> RpbCommitHook -> Ordering
$ccompare :: RpbCommitHook -> RpbCommitHook -> Ordering
$cp1Ord :: Eq RpbCommitHook
Prelude.Ord)
instance Prelude.Show RpbCommitHook where
  showsPrec :: Int -> RpbCommitHook -> ShowS
showsPrec Int
_ RpbCommitHook
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCommitHook -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCommitHook
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCommitHook "modfun" RpbModFun where
  fieldOf :: Proxy# "modfun"
-> (RpbModFun -> f RpbModFun) -> RpbCommitHook -> f RpbCommitHook
fieldOf Proxy# "modfun"
_
    = ((Maybe RpbModFun -> f (Maybe RpbModFun))
 -> RpbCommitHook -> f RpbCommitHook)
-> ((RpbModFun -> f RpbModFun)
    -> Maybe RpbModFun -> f (Maybe RpbModFun))
-> (RpbModFun -> f RpbModFun)
-> RpbCommitHook
-> f RpbCommitHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCommitHook -> Maybe RpbModFun)
-> (RpbCommitHook -> Maybe RpbModFun -> RpbCommitHook)
-> Lens
     RpbCommitHook RpbCommitHook (Maybe RpbModFun) (Maybe RpbModFun)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCommitHook -> Maybe RpbModFun
_RpbCommitHook'modfun
           (\ RpbCommitHook
x__ Maybe RpbModFun
y__ -> RpbCommitHook
x__ {_RpbCommitHook'modfun :: Maybe RpbModFun
_RpbCommitHook'modfun = Maybe RpbModFun
y__}))
        (RpbModFun -> Lens' (Maybe RpbModFun) RpbModFun
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens RpbModFun
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField RpbCommitHook "maybe'modfun" (Prelude.Maybe RpbModFun) where
  fieldOf :: Proxy# "maybe'modfun"
-> (Maybe RpbModFun -> f (Maybe RpbModFun))
-> RpbCommitHook
-> f RpbCommitHook
fieldOf Proxy# "maybe'modfun"
_
    = ((Maybe RpbModFun -> f (Maybe RpbModFun))
 -> RpbCommitHook -> f RpbCommitHook)
-> ((Maybe RpbModFun -> f (Maybe RpbModFun))
    -> Maybe RpbModFun -> f (Maybe RpbModFun))
-> (Maybe RpbModFun -> f (Maybe RpbModFun))
-> RpbCommitHook
-> f RpbCommitHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCommitHook -> Maybe RpbModFun)
-> (RpbCommitHook -> Maybe RpbModFun -> RpbCommitHook)
-> Lens
     RpbCommitHook RpbCommitHook (Maybe RpbModFun) (Maybe RpbModFun)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCommitHook -> Maybe RpbModFun
_RpbCommitHook'modfun
           (\ RpbCommitHook
x__ Maybe RpbModFun
y__ -> RpbCommitHook
x__ {_RpbCommitHook'modfun :: Maybe RpbModFun
_RpbCommitHook'modfun = Maybe RpbModFun
y__}))
        (Maybe RpbModFun -> f (Maybe RpbModFun))
-> Maybe RpbModFun -> f (Maybe RpbModFun)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCommitHook "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString) -> RpbCommitHook -> f RpbCommitHook
fieldOf Proxy# "name"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCommitHook -> f RpbCommitHook)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCommitHook
-> f RpbCommitHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCommitHook -> Maybe ByteString)
-> (RpbCommitHook -> Maybe ByteString -> RpbCommitHook)
-> Lens
     RpbCommitHook RpbCommitHook (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCommitHook -> Maybe ByteString
_RpbCommitHook'name (\ RpbCommitHook
x__ Maybe ByteString
y__ -> RpbCommitHook
x__ {_RpbCommitHook'name :: Maybe ByteString
_RpbCommitHook'name = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCommitHook "maybe'name" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'name"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCommitHook
-> f RpbCommitHook
fieldOf Proxy# "maybe'name"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCommitHook -> f RpbCommitHook)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCommitHook
-> f RpbCommitHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCommitHook -> Maybe ByteString)
-> (RpbCommitHook -> Maybe ByteString -> RpbCommitHook)
-> Lens
     RpbCommitHook RpbCommitHook (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCommitHook -> Maybe ByteString
_RpbCommitHook'name (\ RpbCommitHook
x__ Maybe ByteString
y__ -> RpbCommitHook
x__ {_RpbCommitHook'name :: Maybe ByteString
_RpbCommitHook'name = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCommitHook where
  messageName :: Proxy RpbCommitHook -> Text
messageName Proxy RpbCommitHook
_ = String -> Text
Data.Text.pack String
"RpbCommitHook"
  packedMessageDescriptor :: Proxy RpbCommitHook -> ByteString
packedMessageDescriptor Proxy RpbCommitHook
_
    = ByteString
"\n\
      \\rRpbCommitHook\DC2\"\n\
      \\ACKmodfun\CAN\SOH \SOH(\v2\n\
      \.RpbModFunR\ACKmodfun\DC2\DC2\n\
      \\EOTname\CAN\STX \SOH(\fR\EOTname"
  packedFileDescriptor :: Proxy RpbCommitHook -> ByteString
packedFileDescriptor Proxy RpbCommitHook
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCommitHook)
fieldsByTag
    = let
        modfun__field_descriptor :: FieldDescriptor RpbCommitHook
modfun__field_descriptor
          = String
-> FieldTypeDescriptor RpbModFun
-> FieldAccessor RpbCommitHook RpbModFun
-> FieldDescriptor RpbCommitHook
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"modfun"
              (MessageOrGroup -> FieldTypeDescriptor RpbModFun
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbModFun)
              (Lens
  RpbCommitHook RpbCommitHook (Maybe RpbModFun) (Maybe RpbModFun)
-> FieldAccessor RpbCommitHook RpbModFun
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'modfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'modfun")) ::
              Data.ProtoLens.FieldDescriptor RpbCommitHook
        name__field_descriptor :: FieldDescriptor RpbCommitHook
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCommitHook ByteString
-> FieldDescriptor RpbCommitHook
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCommitHook RpbCommitHook (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbCommitHook ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'name")) ::
              Data.ProtoLens.FieldDescriptor RpbCommitHook
      in
        [(Tag, FieldDescriptor RpbCommitHook)]
-> Map Tag (FieldDescriptor RpbCommitHook)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCommitHook
modfun__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbCommitHook
name__field_descriptor)]
  unknownFields :: LensLike' f RpbCommitHook FieldSet
unknownFields
    = (RpbCommitHook -> FieldSet)
-> (RpbCommitHook -> FieldSet -> RpbCommitHook)
-> Lens' RpbCommitHook FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCommitHook -> FieldSet
_RpbCommitHook'_unknownFields
        (\ RpbCommitHook
x__ FieldSet
y__ -> RpbCommitHook
x__ {_RpbCommitHook'_unknownFields :: FieldSet
_RpbCommitHook'_unknownFields = FieldSet
y__})
  defMessage :: RpbCommitHook
defMessage
    = RpbCommitHook'_constructor :: Maybe RpbModFun -> Maybe ByteString -> FieldSet -> RpbCommitHook
RpbCommitHook'_constructor
        {_RpbCommitHook'modfun :: Maybe RpbModFun
_RpbCommitHook'modfun = Maybe RpbModFun
forall a. Maybe a
Prelude.Nothing,
         _RpbCommitHook'name :: Maybe ByteString
_RpbCommitHook'name = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCommitHook'_unknownFields :: FieldSet
_RpbCommitHook'_unknownFields = []}
  parseMessage :: Parser RpbCommitHook
parseMessage
    = let
        loop ::
          RpbCommitHook -> Data.ProtoLens.Encoding.Bytes.Parser RpbCommitHook
        loop :: RpbCommitHook -> Parser RpbCommitHook
loop RpbCommitHook
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]))))
                      RpbCommitHook -> Parser RpbCommitHook
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCommitHook RpbCommitHook FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCommitHook -> RpbCommitHook
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 RpbCommitHook RpbCommitHook FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbCommitHook
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do RpbModFun
y <- Parser RpbModFun -> String -> Parser RpbModFun
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbModFun -> Parser RpbModFun
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 RpbModFun
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"modfun"
                                RpbCommitHook -> Parser RpbCommitHook
loop (Setter RpbCommitHook RpbCommitHook RpbModFun RpbModFun
-> RpbModFun -> RpbCommitHook -> RpbCommitHook
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "modfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"modfun") RpbModFun
y RpbCommitHook
x)
                        Word64
18
                          -> 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
"name"
                                RpbCommitHook -> Parser RpbCommitHook
loop (Setter RpbCommitHook RpbCommitHook ByteString ByteString
-> ByteString -> RpbCommitHook -> RpbCommitHook
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y RpbCommitHook
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCommitHook -> Parser RpbCommitHook
loop
                                  (Setter RpbCommitHook RpbCommitHook FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCommitHook -> RpbCommitHook
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 RpbCommitHook RpbCommitHook FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCommitHook
x)
      in
        Parser RpbCommitHook -> String -> Parser RpbCommitHook
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbCommitHook -> Parser RpbCommitHook
loop RpbCommitHook
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbCommitHook"
  buildMessage :: RpbCommitHook -> Builder
buildMessage
    = \ RpbCommitHook
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe RpbModFun)
  RpbCommitHook
  RpbCommitHook
  (Maybe RpbModFun)
  (Maybe RpbModFun)
-> RpbCommitHook -> Maybe RpbModFun
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'modfun" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'modfun") RpbCommitHook
_x
              of
                Maybe RpbModFun
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just RpbModFun
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (RpbModFun -> ByteString) -> RpbModFun -> 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))
                          RpbModFun -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                          RpbModFun
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbCommitHook
  RpbCommitHook
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCommitHook -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'name") RpbCommitHook
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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 RpbCommitHook RpbCommitHook FieldSet FieldSet
-> RpbCommitHook -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbCommitHook RpbCommitHook FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCommitHook
_x)))
instance Control.DeepSeq.NFData RpbCommitHook where
  rnf :: RpbCommitHook -> ()
rnf
    = \ RpbCommitHook
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCommitHook -> FieldSet
_RpbCommitHook'_unknownFields RpbCommitHook
x__)
             (Maybe RpbModFun -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbCommitHook -> Maybe RpbModFun
_RpbCommitHook'modfun RpbCommitHook
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbCommitHook -> Maybe ByteString
_RpbCommitHook'name RpbCommitHook
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.value' @:: Lens' RpbContent Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.contentType' @:: Lens' RpbContent Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'contentType' @:: Lens' RpbContent (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.charset' @:: Lens' RpbContent Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'charset' @:: Lens' RpbContent (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.contentEncoding' @:: Lens' RpbContent Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'contentEncoding' @:: Lens' RpbContent (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.vtag' @:: Lens' RpbContent Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'vtag' @:: Lens' RpbContent (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.links' @:: Lens' RpbContent [RpbLink]@
         * 'Proto.Riak_Fields.vec'links' @:: Lens' RpbContent (Data.Vector.Vector RpbLink)@
         * 'Proto.Riak_Fields.lastMod' @:: Lens' RpbContent Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'lastMod' @:: Lens' RpbContent (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.lastModUsecs' @:: Lens' RpbContent Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'lastModUsecs' @:: Lens' RpbContent (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.usermeta' @:: Lens' RpbContent [RpbPair]@
         * 'Proto.Riak_Fields.vec'usermeta' @:: Lens' RpbContent (Data.Vector.Vector RpbPair)@
         * 'Proto.Riak_Fields.indexes' @:: Lens' RpbContent [RpbPair]@
         * 'Proto.Riak_Fields.vec'indexes' @:: Lens' RpbContent (Data.Vector.Vector RpbPair)@
         * 'Proto.Riak_Fields.deleted' @:: Lens' RpbContent Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'deleted' @:: Lens' RpbContent (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.ttl' @:: Lens' RpbContent Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'ttl' @:: Lens' RpbContent (Prelude.Maybe Data.Word.Word32)@ -}
data RpbContent
  = RpbContent'_constructor {RpbContent -> ByteString
_RpbContent'value :: !Data.ByteString.ByteString,
                             RpbContent -> Maybe ByteString
_RpbContent'contentType :: !(Prelude.Maybe Data.ByteString.ByteString),
                             RpbContent -> Maybe ByteString
_RpbContent'charset :: !(Prelude.Maybe Data.ByteString.ByteString),
                             RpbContent -> Maybe ByteString
_RpbContent'contentEncoding :: !(Prelude.Maybe Data.ByteString.ByteString),
                             RpbContent -> Maybe ByteString
_RpbContent'vtag :: !(Prelude.Maybe Data.ByteString.ByteString),
                             RpbContent -> Vector RpbLink
_RpbContent'links :: !(Data.Vector.Vector RpbLink),
                             RpbContent -> Maybe Word32
_RpbContent'lastMod :: !(Prelude.Maybe Data.Word.Word32),
                             RpbContent -> Maybe Word32
_RpbContent'lastModUsecs :: !(Prelude.Maybe Data.Word.Word32),
                             RpbContent -> Vector RpbPair
_RpbContent'usermeta :: !(Data.Vector.Vector RpbPair),
                             RpbContent -> Vector RpbPair
_RpbContent'indexes :: !(Data.Vector.Vector RpbPair),
                             RpbContent -> Maybe Bool
_RpbContent'deleted :: !(Prelude.Maybe Prelude.Bool),
                             RpbContent -> Maybe Word32
_RpbContent'ttl :: !(Prelude.Maybe Data.Word.Word32),
                             RpbContent -> FieldSet
_RpbContent'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbContent -> RpbContent -> Bool
(RpbContent -> RpbContent -> Bool)
-> (RpbContent -> RpbContent -> Bool) -> Eq RpbContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbContent -> RpbContent -> Bool
$c/= :: RpbContent -> RpbContent -> Bool
== :: RpbContent -> RpbContent -> Bool
$c== :: RpbContent -> RpbContent -> Bool
Prelude.Eq, Eq RpbContent
Eq RpbContent
-> (RpbContent -> RpbContent -> Ordering)
-> (RpbContent -> RpbContent -> Bool)
-> (RpbContent -> RpbContent -> Bool)
-> (RpbContent -> RpbContent -> Bool)
-> (RpbContent -> RpbContent -> Bool)
-> (RpbContent -> RpbContent -> RpbContent)
-> (RpbContent -> RpbContent -> RpbContent)
-> Ord RpbContent
RpbContent -> RpbContent -> Bool
RpbContent -> RpbContent -> Ordering
RpbContent -> RpbContent -> RpbContent
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 :: RpbContent -> RpbContent -> RpbContent
$cmin :: RpbContent -> RpbContent -> RpbContent
max :: RpbContent -> RpbContent -> RpbContent
$cmax :: RpbContent -> RpbContent -> RpbContent
>= :: RpbContent -> RpbContent -> Bool
$c>= :: RpbContent -> RpbContent -> Bool
> :: RpbContent -> RpbContent -> Bool
$c> :: RpbContent -> RpbContent -> Bool
<= :: RpbContent -> RpbContent -> Bool
$c<= :: RpbContent -> RpbContent -> Bool
< :: RpbContent -> RpbContent -> Bool
$c< :: RpbContent -> RpbContent -> Bool
compare :: RpbContent -> RpbContent -> Ordering
$ccompare :: RpbContent -> RpbContent -> Ordering
$cp1Ord :: Eq RpbContent
Prelude.Ord)
instance Prelude.Show RpbContent where
  showsPrec :: Int -> RpbContent -> ShowS
showsPrec Int
_ RpbContent
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbContent -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbContent
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbContent "value" Data.ByteString.ByteString where
  fieldOf :: Proxy# "value"
-> (ByteString -> f ByteString) -> RpbContent -> f RpbContent
fieldOf Proxy# "value"
_
    = ((ByteString -> f ByteString) -> RpbContent -> f RpbContent)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> ByteString)
-> (RpbContent -> ByteString -> RpbContent)
-> Lens RpbContent RpbContent ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> ByteString
_RpbContent'value (\ RpbContent
x__ ByteString
y__ -> RpbContent
x__ {_RpbContent'value :: ByteString
_RpbContent'value = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "contentType" Data.ByteString.ByteString where
  fieldOf :: Proxy# "contentType"
-> (ByteString -> f ByteString) -> RpbContent -> f RpbContent
fieldOf Proxy# "contentType"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'contentType
           (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'contentType :: Maybe ByteString
_RpbContent'contentType = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbContent "maybe'contentType" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'contentType"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
fieldOf Proxy# "maybe'contentType"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'contentType
           (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'contentType :: Maybe ByteString
_RpbContent'contentType = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "charset" Data.ByteString.ByteString where
  fieldOf :: Proxy# "charset"
-> (ByteString -> f ByteString) -> RpbContent -> f RpbContent
fieldOf Proxy# "charset"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'charset (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'charset :: Maybe ByteString
_RpbContent'charset = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbContent "maybe'charset" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'charset"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
fieldOf Proxy# "maybe'charset"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'charset (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'charset :: Maybe ByteString
_RpbContent'charset = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "contentEncoding" Data.ByteString.ByteString where
  fieldOf :: Proxy# "contentEncoding"
-> (ByteString -> f ByteString) -> RpbContent -> f RpbContent
fieldOf Proxy# "contentEncoding"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'contentEncoding
           (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'contentEncoding :: Maybe ByteString
_RpbContent'contentEncoding = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbContent "maybe'contentEncoding" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'contentEncoding"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
fieldOf Proxy# "maybe'contentEncoding"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'contentEncoding
           (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'contentEncoding :: Maybe ByteString
_RpbContent'contentEncoding = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "vtag" Data.ByteString.ByteString where
  fieldOf :: Proxy# "vtag"
-> (ByteString -> f ByteString) -> RpbContent -> f RpbContent
fieldOf Proxy# "vtag"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'vtag (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'vtag :: Maybe ByteString
_RpbContent'vtag = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbContent "maybe'vtag" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'vtag"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
fieldOf Proxy# "maybe'vtag"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbContent -> f RpbContent)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe ByteString)
-> (RpbContent -> Maybe ByteString -> RpbContent)
-> Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe ByteString
_RpbContent'vtag (\ RpbContent
x__ Maybe ByteString
y__ -> RpbContent
x__ {_RpbContent'vtag :: Maybe ByteString
_RpbContent'vtag = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "links" [RpbLink] where
  fieldOf :: Proxy# "links"
-> ([RpbLink] -> f [RpbLink]) -> RpbContent -> f RpbContent
fieldOf Proxy# "links"
_
    = ((Vector RpbLink -> f (Vector RpbLink))
 -> RpbContent -> f RpbContent)
-> (([RpbLink] -> f [RpbLink])
    -> Vector RpbLink -> f (Vector RpbLink))
-> ([RpbLink] -> f [RpbLink])
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Vector RpbLink)
-> (RpbContent -> Vector RpbLink -> RpbContent)
-> Lens RpbContent RpbContent (Vector RpbLink) (Vector RpbLink)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Vector RpbLink
_RpbContent'links (\ RpbContent
x__ Vector RpbLink
y__ -> RpbContent
x__ {_RpbContent'links :: Vector RpbLink
_RpbContent'links = Vector RpbLink
y__}))
        ((Vector RpbLink -> [RpbLink])
-> (Vector RpbLink -> [RpbLink] -> Vector RpbLink)
-> Lens (Vector RpbLink) (Vector RpbLink) [RpbLink] [RpbLink]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbLink -> [RpbLink]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbLink
_ [RpbLink]
y__ -> [RpbLink] -> Vector RpbLink
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbLink]
y__))
instance Data.ProtoLens.Field.HasField RpbContent "vec'links" (Data.Vector.Vector RpbLink) where
  fieldOf :: Proxy# "vec'links"
-> (Vector RpbLink -> f (Vector RpbLink))
-> RpbContent
-> f RpbContent
fieldOf Proxy# "vec'links"
_
    = ((Vector RpbLink -> f (Vector RpbLink))
 -> RpbContent -> f RpbContent)
-> ((Vector RpbLink -> f (Vector RpbLink))
    -> Vector RpbLink -> f (Vector RpbLink))
-> (Vector RpbLink -> f (Vector RpbLink))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Vector RpbLink)
-> (RpbContent -> Vector RpbLink -> RpbContent)
-> Lens RpbContent RpbContent (Vector RpbLink) (Vector RpbLink)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Vector RpbLink
_RpbContent'links (\ RpbContent
x__ Vector RpbLink
y__ -> RpbContent
x__ {_RpbContent'links :: Vector RpbLink
_RpbContent'links = Vector RpbLink
y__}))
        (Vector RpbLink -> f (Vector RpbLink))
-> Vector RpbLink -> f (Vector RpbLink)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "lastMod" Data.Word.Word32 where
  fieldOf :: Proxy# "lastMod"
-> (Word32 -> f Word32) -> RpbContent -> f RpbContent
fieldOf Proxy# "lastMod"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Word32)
-> (RpbContent -> Maybe Word32 -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Word32
_RpbContent'lastMod (\ RpbContent
x__ Maybe Word32
y__ -> RpbContent
x__ {_RpbContent'lastMod :: Maybe Word32
_RpbContent'lastMod = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbContent "maybe'lastMod" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'lastMod"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent
fieldOf Proxy# "maybe'lastMod"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Word32)
-> (RpbContent -> Maybe Word32 -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Word32
_RpbContent'lastMod (\ RpbContent
x__ Maybe Word32
y__ -> RpbContent
x__ {_RpbContent'lastMod :: Maybe Word32
_RpbContent'lastMod = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "lastModUsecs" Data.Word.Word32 where
  fieldOf :: Proxy# "lastModUsecs"
-> (Word32 -> f Word32) -> RpbContent -> f RpbContent
fieldOf Proxy# "lastModUsecs"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Word32)
-> (RpbContent -> Maybe Word32 -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Word32
_RpbContent'lastModUsecs
           (\ RpbContent
x__ Maybe Word32
y__ -> RpbContent
x__ {_RpbContent'lastModUsecs :: Maybe Word32
_RpbContent'lastModUsecs = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbContent "maybe'lastModUsecs" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'lastModUsecs"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent
fieldOf Proxy# "maybe'lastModUsecs"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Word32)
-> (RpbContent -> Maybe Word32 -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Word32
_RpbContent'lastModUsecs
           (\ RpbContent
x__ Maybe Word32
y__ -> RpbContent
x__ {_RpbContent'lastModUsecs :: Maybe Word32
_RpbContent'lastModUsecs = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "usermeta" [RpbPair] where
  fieldOf :: Proxy# "usermeta"
-> ([RpbPair] -> f [RpbPair]) -> RpbContent -> f RpbContent
fieldOf Proxy# "usermeta"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbContent -> f RpbContent)
-> (([RpbPair] -> f [RpbPair])
    -> Vector RpbPair -> f (Vector RpbPair))
-> ([RpbPair] -> f [RpbPair])
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Vector RpbPair)
-> (RpbContent -> Vector RpbPair -> RpbContent)
-> Lens RpbContent RpbContent (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Vector RpbPair
_RpbContent'usermeta
           (\ RpbContent
x__ Vector RpbPair
y__ -> RpbContent
x__ {_RpbContent'usermeta :: Vector RpbPair
_RpbContent'usermeta = Vector RpbPair
y__}))
        ((Vector RpbPair -> [RpbPair])
-> (Vector RpbPair -> [RpbPair] -> Vector RpbPair)
-> Lens (Vector RpbPair) (Vector RpbPair) [RpbPair] [RpbPair]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbPair -> [RpbPair]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbPair
_ [RpbPair]
y__ -> [RpbPair] -> Vector RpbPair
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbPair]
y__))
instance Data.ProtoLens.Field.HasField RpbContent "vec'usermeta" (Data.Vector.Vector RpbPair) where
  fieldOf :: Proxy# "vec'usermeta"
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbContent
-> f RpbContent
fieldOf Proxy# "vec'usermeta"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbContent -> f RpbContent)
-> ((Vector RpbPair -> f (Vector RpbPair))
    -> Vector RpbPair -> f (Vector RpbPair))
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Vector RpbPair)
-> (RpbContent -> Vector RpbPair -> RpbContent)
-> Lens RpbContent RpbContent (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Vector RpbPair
_RpbContent'usermeta
           (\ RpbContent
x__ Vector RpbPair
y__ -> RpbContent
x__ {_RpbContent'usermeta :: Vector RpbPair
_RpbContent'usermeta = Vector RpbPair
y__}))
        (Vector RpbPair -> f (Vector RpbPair))
-> Vector RpbPair -> f (Vector RpbPair)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "indexes" [RpbPair] where
  fieldOf :: Proxy# "indexes"
-> ([RpbPair] -> f [RpbPair]) -> RpbContent -> f RpbContent
fieldOf Proxy# "indexes"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbContent -> f RpbContent)
-> (([RpbPair] -> f [RpbPair])
    -> Vector RpbPair -> f (Vector RpbPair))
-> ([RpbPair] -> f [RpbPair])
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Vector RpbPair)
-> (RpbContent -> Vector RpbPair -> RpbContent)
-> Lens RpbContent RpbContent (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Vector RpbPair
_RpbContent'indexes (\ RpbContent
x__ Vector RpbPair
y__ -> RpbContent
x__ {_RpbContent'indexes :: Vector RpbPair
_RpbContent'indexes = Vector RpbPair
y__}))
        ((Vector RpbPair -> [RpbPair])
-> (Vector RpbPair -> [RpbPair] -> Vector RpbPair)
-> Lens (Vector RpbPair) (Vector RpbPair) [RpbPair] [RpbPair]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbPair -> [RpbPair]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbPair
_ [RpbPair]
y__ -> [RpbPair] -> Vector RpbPair
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbPair]
y__))
instance Data.ProtoLens.Field.HasField RpbContent "vec'indexes" (Data.Vector.Vector RpbPair) where
  fieldOf :: Proxy# "vec'indexes"
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbContent
-> f RpbContent
fieldOf Proxy# "vec'indexes"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbContent -> f RpbContent)
-> ((Vector RpbPair -> f (Vector RpbPair))
    -> Vector RpbPair -> f (Vector RpbPair))
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Vector RpbPair)
-> (RpbContent -> Vector RpbPair -> RpbContent)
-> Lens RpbContent RpbContent (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Vector RpbPair
_RpbContent'indexes (\ RpbContent
x__ Vector RpbPair
y__ -> RpbContent
x__ {_RpbContent'indexes :: Vector RpbPair
_RpbContent'indexes = Vector RpbPair
y__}))
        (Vector RpbPair -> f (Vector RpbPair))
-> Vector RpbPair -> f (Vector RpbPair)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "deleted" Prelude.Bool where
  fieldOf :: Proxy# "deleted" -> (Bool -> f Bool) -> RpbContent -> f RpbContent
fieldOf Proxy# "deleted"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbContent -> f RpbContent)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Bool)
-> (RpbContent -> Maybe Bool -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Bool
_RpbContent'deleted (\ RpbContent
x__ Maybe Bool
y__ -> RpbContent
x__ {_RpbContent'deleted :: Maybe Bool
_RpbContent'deleted = 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 RpbContent "maybe'deleted" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'deleted"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbContent -> f RpbContent
fieldOf Proxy# "maybe'deleted"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbContent -> f RpbContent)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Bool)
-> (RpbContent -> Maybe Bool -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Bool
_RpbContent'deleted (\ RpbContent
x__ Maybe Bool
y__ -> RpbContent
x__ {_RpbContent'deleted :: Maybe Bool
_RpbContent'deleted = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbContent "ttl" Data.Word.Word32 where
  fieldOf :: Proxy# "ttl" -> (Word32 -> f Word32) -> RpbContent -> f RpbContent
fieldOf Proxy# "ttl"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Word32)
-> (RpbContent -> Maybe Word32 -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Word32
_RpbContent'ttl (\ RpbContent
x__ Maybe Word32
y__ -> RpbContent
x__ {_RpbContent'ttl :: Maybe Word32
_RpbContent'ttl = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbContent "maybe'ttl" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'ttl"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent
fieldOf Proxy# "maybe'ttl"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbContent -> f RpbContent)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbContent
-> f RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbContent -> Maybe Word32)
-> (RpbContent -> Maybe Word32 -> RpbContent)
-> Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbContent -> Maybe Word32
_RpbContent'ttl (\ RpbContent
x__ Maybe Word32
y__ -> RpbContent
x__ {_RpbContent'ttl :: Maybe Word32
_RpbContent'ttl = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbContent where
  messageName :: Proxy RpbContent -> Text
messageName Proxy RpbContent
_ = String -> Text
Data.Text.pack String
"RpbContent"
  packedMessageDescriptor :: Proxy RpbContent -> ByteString
packedMessageDescriptor Proxy RpbContent
_
    = ByteString
"\n\
      \\n\
      \RpbContent\DC2\DC4\n\
      \\ENQvalue\CAN\SOH \STX(\fR\ENQvalue\DC2!\n\
      \\fcontent_type\CAN\STX \SOH(\fR\vcontentType\DC2\CAN\n\
      \\acharset\CAN\ETX \SOH(\fR\acharset\DC2)\n\
      \\DLEcontent_encoding\CAN\EOT \SOH(\fR\SIcontentEncoding\DC2\DC2\n\
      \\EOTvtag\CAN\ENQ \SOH(\fR\EOTvtag\DC2\RS\n\
      \\ENQlinks\CAN\ACK \ETX(\v2\b.RpbLinkR\ENQlinks\DC2\EM\n\
      \\blast_mod\CAN\a \SOH(\rR\alastMod\DC2$\n\
      \\SOlast_mod_usecs\CAN\b \SOH(\rR\flastModUsecs\DC2$\n\
      \\busermeta\CAN\t \ETX(\v2\b.RpbPairR\busermeta\DC2\"\n\
      \\aindexes\CAN\n\
      \ \ETX(\v2\b.RpbPairR\aindexes\DC2\CAN\n\
      \\adeleted\CAN\v \SOH(\bR\adeleted\DC2\DLE\n\
      \\ETXttl\CAN\f \SOH(\rR\ETXttl"
  packedFileDescriptor :: Proxy RpbContent -> ByteString
packedFileDescriptor Proxy RpbContent
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbContent)
fieldsByTag
    = let
        value__field_descriptor :: FieldDescriptor RpbContent
value__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbContent ByteString
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"value"
              (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 RpbContent RpbContent ByteString ByteString
-> FieldAccessor RpbContent ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        contentType__field_descriptor :: FieldDescriptor RpbContent
contentType__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbContent ByteString
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"content_type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbContent ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'contentType" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'contentType")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        charset__field_descriptor :: FieldDescriptor RpbContent
charset__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbContent ByteString
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"charset"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbContent ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'charset" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'charset")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        contentEncoding__field_descriptor :: FieldDescriptor RpbContent
contentEncoding__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbContent ByteString
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"content_encoding"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbContent ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'contentEncoding" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'contentEncoding")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        vtag__field_descriptor :: FieldDescriptor RpbContent
vtag__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbContent ByteString
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"vtag"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbContent RpbContent (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbContent ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'vtag" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vtag")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        links__field_descriptor :: FieldDescriptor RpbContent
links__field_descriptor
          = String
-> FieldTypeDescriptor RpbLink
-> FieldAccessor RpbContent RpbLink
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"links"
              (MessageOrGroup -> FieldTypeDescriptor RpbLink
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbLink)
              (Packing
-> Lens' RpbContent [RpbLink] -> FieldAccessor RpbContent RpbLink
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "links" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"links")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        lastMod__field_descriptor :: FieldDescriptor RpbContent
lastMod__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbContent Word32
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"last_mod"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbContent Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'lastMod" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lastMod")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        lastModUsecs__field_descriptor :: FieldDescriptor RpbContent
lastModUsecs__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbContent Word32
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"last_mod_usecs"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbContent Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'lastModUsecs" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lastModUsecs")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        usermeta__field_descriptor :: FieldDescriptor RpbContent
usermeta__field_descriptor
          = String
-> FieldTypeDescriptor RpbPair
-> FieldAccessor RpbContent RpbPair
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"usermeta"
              (MessageOrGroup -> FieldTypeDescriptor RpbPair
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbPair)
              (Packing
-> Lens' RpbContent [RpbPair] -> FieldAccessor RpbContent RpbPair
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "usermeta" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"usermeta")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        indexes__field_descriptor :: FieldDescriptor RpbContent
indexes__field_descriptor
          = String
-> FieldTypeDescriptor RpbPair
-> FieldAccessor RpbContent RpbPair
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"indexes"
              (MessageOrGroup -> FieldTypeDescriptor RpbPair
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbPair)
              (Packing
-> Lens' RpbContent [RpbPair] -> FieldAccessor RpbContent RpbPair
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "indexes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"indexes")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        deleted__field_descriptor :: FieldDescriptor RpbContent
deleted__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbContent Bool
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"deleted"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbContent RpbContent (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbContent Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'deleted" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'deleted")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
        ttl__field_descriptor :: FieldDescriptor RpbContent
ttl__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbContent Word32
-> FieldDescriptor RpbContent
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"ttl"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbContent RpbContent (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbContent Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'ttl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ttl")) ::
              Data.ProtoLens.FieldDescriptor RpbContent
      in
        [(Tag, FieldDescriptor RpbContent)]
-> Map Tag (FieldDescriptor RpbContent)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbContent
value__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbContent
contentType__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbContent
charset__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbContent
contentEncoding__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbContent
vtag__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbContent
links__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbContent
lastMod__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbContent
lastModUsecs__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbContent
usermeta__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbContent
indexes__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor RpbContent
deleted__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
12, FieldDescriptor RpbContent
ttl__field_descriptor)]
  unknownFields :: LensLike' f RpbContent FieldSet
unknownFields
    = (RpbContent -> FieldSet)
-> (RpbContent -> FieldSet -> RpbContent)
-> Lens' RpbContent FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbContent -> FieldSet
_RpbContent'_unknownFields
        (\ RpbContent
x__ FieldSet
y__ -> RpbContent
x__ {_RpbContent'_unknownFields :: FieldSet
_RpbContent'_unknownFields = FieldSet
y__})
  defMessage :: RpbContent
defMessage
    = RpbContent'_constructor :: ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Vector RpbLink
-> Maybe Word32
-> Maybe Word32
-> Vector RpbPair
-> Vector RpbPair
-> Maybe Bool
-> Maybe Word32
-> FieldSet
-> RpbContent
RpbContent'_constructor
        {_RpbContent'value :: ByteString
_RpbContent'value = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbContent'contentType :: Maybe ByteString
_RpbContent'contentType = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbContent'charset :: Maybe ByteString
_RpbContent'charset = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbContent'contentEncoding :: Maybe ByteString
_RpbContent'contentEncoding = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbContent'vtag :: Maybe ByteString
_RpbContent'vtag = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbContent'links :: Vector RpbLink
_RpbContent'links = Vector RpbLink
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbContent'lastMod :: Maybe Word32
_RpbContent'lastMod = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbContent'lastModUsecs :: Maybe Word32
_RpbContent'lastModUsecs = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbContent'usermeta :: Vector RpbPair
_RpbContent'usermeta = Vector RpbPair
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbContent'indexes :: Vector RpbPair
_RpbContent'indexes = Vector RpbPair
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbContent'deleted :: Maybe Bool
_RpbContent'deleted = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbContent'ttl :: Maybe Word32
_RpbContent'ttl = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _RpbContent'_unknownFields :: FieldSet
_RpbContent'_unknownFields = []}
  parseMessage :: Parser RpbContent
parseMessage
    = let
        loop ::
          RpbContent
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbPair
                -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbLink
                   -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbPair
                      -> Data.ProtoLens.Encoding.Bytes.Parser RpbContent
        loop :: RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
          RpbContent
x
          Bool
required'value
          Growing Vector RealWorld RpbPair
mutable'indexes
          Growing Vector RealWorld RpbLink
mutable'links
          Growing Vector RealWorld RpbPair
mutable'usermeta
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbPair
frozen'indexes <- IO (Vector RpbPair) -> Parser (Vector RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) RpbPair -> IO (Vector RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'indexes)
                      Vector RpbLink
frozen'links <- IO (Vector RpbLink) -> Parser (Vector RpbLink)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                        (Growing Vector (PrimState IO) RpbLink -> IO (Vector RpbLink)
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 RpbLink
Growing Vector (PrimState IO) RpbLink
mutable'links)
                      Vector RpbPair
frozen'usermeta <- IO (Vector RpbPair) -> Parser (Vector RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) RpbPair -> IO (Vector RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'usermeta)
                      (let
                         missing :: [String]
missing = (if Bool
required'value then (:) String
"value" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbContent -> Parser RpbContent
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbContent RpbContent FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbContent -> RpbContent
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 RpbContent RpbContent FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter RpbContent RpbContent (Vector RpbPair) (Vector RpbPair)
-> Vector RpbPair -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'indexes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'indexes")
                              Vector RpbPair
frozen'indexes
                              (Setter RpbContent RpbContent (Vector RpbLink) (Vector RpbLink)
-> Vector RpbLink -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'links" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'links")
                                 Vector RpbLink
frozen'links
                                 (Setter RpbContent RpbContent (Vector RpbPair) (Vector RpbPair)
-> Vector RpbPair -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                    (forall s a (f :: * -> *).
(HasField s "vec'usermeta" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'usermeta")
                                    Vector RpbPair
frozen'usermeta
                                    RpbContent
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
"value"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent ByteString ByteString
-> ByteString -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") ByteString
y RpbContent
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
18
                          -> 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
"content_type"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent ByteString ByteString
-> ByteString -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "contentType" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"contentType") ByteString
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
26
                          -> 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
"charset"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent ByteString ByteString
-> ByteString -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "charset" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"charset") ByteString
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
34
                          -> 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
"content_encoding"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent ByteString ByteString
-> ByteString -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "contentEncoding" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"contentEncoding") ByteString
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
42
                          -> 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
"vtag"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent ByteString ByteString
-> ByteString -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "vtag" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vtag") ByteString
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
50
                          -> do !RpbLink
y <- Parser RpbLink -> String -> Parser RpbLink
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbLink -> Parser RpbLink
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 RpbLink
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"links"
                                Growing Vector RealWorld RpbLink
v <- IO (Growing Vector RealWorld RpbLink)
-> Parser (Growing Vector RealWorld RpbLink)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbLink
-> RpbLink -> IO (Growing Vector (PrimState IO) RpbLink)
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 RpbLink
Growing Vector (PrimState IO) RpbLink
mutable'links RpbLink
y)
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop RpbContent
x Bool
required'value Growing Vector RealWorld RpbPair
mutable'indexes Growing Vector RealWorld RpbLink
v Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
56
                          -> 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
"last_mod"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent Word32 Word32
-> Word32 -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "lastMod" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lastMod") Word32
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
64
                          -> 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
"last_mod_usecs"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent Word32 Word32
-> Word32 -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "lastModUsecs" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lastModUsecs") Word32
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
74
                          -> do !RpbPair
y <- Parser RpbPair -> String -> Parser RpbPair
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbPair -> Parser RpbPair
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 RpbPair
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"usermeta"
                                Growing Vector RealWorld RpbPair
v <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbPair
-> RpbPair -> IO (Growing Vector (PrimState IO) RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'usermeta RpbPair
y)
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop RpbContent
x Bool
required'value Growing Vector RealWorld RpbPair
mutable'indexes Growing Vector RealWorld RpbLink
mutable'links Growing Vector RealWorld RpbPair
v
                        Word64
82
                          -> do !RpbPair
y <- Parser RpbPair -> String -> Parser RpbPair
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbPair -> Parser RpbPair
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 RpbPair
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"indexes"
                                Growing Vector RealWorld RpbPair
v <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbPair
-> RpbPair -> IO (Growing Vector (PrimState IO) RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'indexes RpbPair
y)
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop RpbContent
x Bool
required'value Growing Vector RealWorld RpbPair
v Growing Vector RealWorld RpbLink
mutable'links Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
88
                          -> 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
"deleted"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent Bool Bool
-> Bool -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "deleted" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"deleted") Bool
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
96
                          -> 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
"ttl"
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent Word32 Word32
-> Word32 -> RpbContent -> RpbContent
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "ttl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ttl") Word32
y RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                                  (Setter RpbContent RpbContent FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbContent -> RpbContent
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 RpbContent RpbContent FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbContent
x)
                                  Bool
required'value
                                  Growing Vector RealWorld RpbPair
mutable'indexes
                                  Growing Vector RealWorld RpbLink
mutable'links
                                  Growing Vector RealWorld RpbPair
mutable'usermeta
      in
        Parser RpbContent -> String -> Parser RpbContent
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbPair
mutable'indexes <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld RpbPair)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld RpbLink
mutable'links <- IO (Growing Vector RealWorld RpbLink)
-> Parser (Growing Vector RealWorld RpbLink)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                 IO (Growing Vector RealWorld RpbLink)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld RpbPair
mutable'usermeta <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld RpbPair)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbContent
-> Bool
-> Growing Vector RealWorld RpbPair
-> Growing Vector RealWorld RpbLink
-> Growing Vector RealWorld RpbPair
-> Parser RpbContent
loop
                RpbContent
forall msg. Message msg => msg
Data.ProtoLens.defMessage
                Bool
Prelude.True
                Growing Vector RealWorld RpbPair
mutable'indexes
                Growing Vector RealWorld RpbLink
mutable'links
                Growing Vector RealWorld RpbPair
mutable'usermeta)
          String
"RpbContent"
  buildMessage :: RpbContent -> Builder
buildMessage
    = \ RpbContent
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbContent RpbContent ByteString ByteString
-> RpbContent -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") RpbContent
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbContent
  RpbContent
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbContent -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'contentType" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'contentType") RpbContent
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbContent
  RpbContent
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbContent -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'charset" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'charset") RpbContent
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe ByteString)
  RpbContent
  RpbContent
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbContent -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                             (forall s a (f :: * -> *).
(HasField s "maybe'contentEncoding" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'contentEncoding") RpbContent
_x
                       of
                         Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just ByteString
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((\ 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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe ByteString)
  RpbContent
  RpbContent
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbContent -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'vtag" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vtag") RpbContent
_x
                          of
                            Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just ByteString
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                                   ((\ 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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            ((RpbLink -> Builder) -> Vector RpbLink -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                               (\ RpbLink
_v
                                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                                       ((ByteString -> Builder)
-> (RpbLink -> ByteString) -> RpbLink -> 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))
                                          RpbLink -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                          RpbLink
_v))
                               (FoldLike
  (Vector RpbLink)
  RpbContent
  RpbContent
  (Vector RpbLink)
  (Vector RpbLink)
-> RpbContent -> Vector RpbLink
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'links" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'links") RpbContent
_x))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Word32) RpbContent RpbContent (Maybe Word32) (Maybe Word32)
-> RpbContent -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'lastMod" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lastMod") RpbContent
_x
                                of
                                  Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Word32
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe Word32) RpbContent RpbContent (Maybe Word32) (Maybe Word32)
-> RpbContent -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                         (forall s a (f :: * -> *).
(HasField s "maybe'lastModUsecs" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'lastModUsecs") RpbContent
_x
                                   of
                                     Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Word32
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     ((RpbPair -> Builder) -> Vector RpbPair -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                                        (\ RpbPair
_v
                                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
74)
                                                ((ByteString -> Builder)
-> (RpbPair -> ByteString) -> RpbPair -> 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))
                                                   RpbPair -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                                   RpbPair
_v))
                                        (FoldLike
  (Vector RpbPair)
  RpbContent
  RpbContent
  (Vector RpbPair)
  (Vector RpbPair)
-> RpbContent -> Vector RpbPair
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                           (forall s a (f :: * -> *).
(HasField s "vec'usermeta" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'usermeta") RpbContent
_x))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        ((RpbPair -> Builder) -> Vector RpbPair -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                                           (\ RpbPair
_v
                                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
82)
                                                   ((ByteString -> Builder)
-> (RpbPair -> ByteString) -> RpbPair -> 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))
                                                      RpbPair -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                                      RpbPair
_v))
                                           (FoldLike
  (Vector RpbPair)
  RpbContent
  RpbContent
  (Vector RpbPair)
  (Vector RpbPair)
-> RpbContent -> Vector RpbPair
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                              (forall s a (f :: * -> *).
(HasField s "vec'indexes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'indexes") RpbContent
_x))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike
  (Maybe Bool) RpbContent RpbContent (Maybe Bool) (Maybe Bool)
-> RpbContent -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'deleted" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'deleted") RpbContent
_x
                                            of
                                              Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Bool
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                              (case
                                                   FoldLike
  (Maybe Word32) RpbContent RpbContent (Maybe Word32) (Maybe Word32)
-> RpbContent -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                     (forall s a (f :: * -> *).
(HasField s "maybe'ttl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ttl") RpbContent
_x
                                               of
                                                 Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                 (Prelude.Just Word32
_v)
                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
96)
                                                        ((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 RpbContent RpbContent FieldSet FieldSet
-> RpbContent -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                    FoldLike FieldSet RpbContent RpbContent FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbContent
_x)))))))))))))
instance Control.DeepSeq.NFData RpbContent where
  rnf :: RpbContent -> ()
rnf
    = \ RpbContent
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbContent -> FieldSet
_RpbContent'_unknownFields RpbContent
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbContent -> ByteString
_RpbContent'value RpbContent
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbContent -> Maybe ByteString
_RpbContent'contentType RpbContent
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbContent -> Maybe ByteString
_RpbContent'charset RpbContent
x__)
                      (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbContent -> Maybe ByteString
_RpbContent'contentEncoding RpbContent
x__)
                         (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbContent -> Maybe ByteString
_RpbContent'vtag RpbContent
x__)
                            (Vector RpbLink -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbContent -> Vector RpbLink
_RpbContent'links RpbContent
x__)
                               (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbContent -> Maybe Word32
_RpbContent'lastMod RpbContent
x__)
                                  (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbContent -> Maybe Word32
_RpbContent'lastModUsecs RpbContent
x__)
                                     (Vector RpbPair -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbContent -> Vector RpbPair
_RpbContent'usermeta RpbContent
x__)
                                        (Vector RpbPair -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbContent -> Vector RpbPair
_RpbContent'indexes RpbContent
x__)
                                           (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (RpbContent -> Maybe Bool
_RpbContent'deleted RpbContent
x__)
                                              (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                 (RpbContent -> Maybe Word32
_RpbContent'ttl RpbContent
x__) ()))))))))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbCounterGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbCounterGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.r' @:: Lens' RpbCounterGetReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'r' @:: Lens' RpbCounterGetReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pr' @:: Lens' RpbCounterGetReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pr' @:: Lens' RpbCounterGetReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.basicQuorum' @:: Lens' RpbCounterGetReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'basicQuorum' @:: Lens' RpbCounterGetReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.notfoundOk' @:: Lens' RpbCounterGetReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'notfoundOk' @:: Lens' RpbCounterGetReq (Prelude.Maybe Prelude.Bool)@ -}
data RpbCounterGetReq
  = RpbCounterGetReq'_constructor {RpbCounterGetReq -> ByteString
_RpbCounterGetReq'bucket :: !Data.ByteString.ByteString,
                                   RpbCounterGetReq -> ByteString
_RpbCounterGetReq'key :: !Data.ByteString.ByteString,
                                   RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'r :: !(Prelude.Maybe Data.Word.Word32),
                                   RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'pr :: !(Prelude.Maybe Data.Word.Word32),
                                   RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'basicQuorum :: !(Prelude.Maybe Prelude.Bool),
                                   RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'notfoundOk :: !(Prelude.Maybe Prelude.Bool),
                                   RpbCounterGetReq -> FieldSet
_RpbCounterGetReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCounterGetReq -> RpbCounterGetReq -> Bool
(RpbCounterGetReq -> RpbCounterGetReq -> Bool)
-> (RpbCounterGetReq -> RpbCounterGetReq -> Bool)
-> Eq RpbCounterGetReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
$c/= :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
== :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
$c== :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
Prelude.Eq, Eq RpbCounterGetReq
Eq RpbCounterGetReq
-> (RpbCounterGetReq -> RpbCounterGetReq -> Ordering)
-> (RpbCounterGetReq -> RpbCounterGetReq -> Bool)
-> (RpbCounterGetReq -> RpbCounterGetReq -> Bool)
-> (RpbCounterGetReq -> RpbCounterGetReq -> Bool)
-> (RpbCounterGetReq -> RpbCounterGetReq -> Bool)
-> (RpbCounterGetReq -> RpbCounterGetReq -> RpbCounterGetReq)
-> (RpbCounterGetReq -> RpbCounterGetReq -> RpbCounterGetReq)
-> Ord RpbCounterGetReq
RpbCounterGetReq -> RpbCounterGetReq -> Bool
RpbCounterGetReq -> RpbCounterGetReq -> Ordering
RpbCounterGetReq -> RpbCounterGetReq -> RpbCounterGetReq
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 :: RpbCounterGetReq -> RpbCounterGetReq -> RpbCounterGetReq
$cmin :: RpbCounterGetReq -> RpbCounterGetReq -> RpbCounterGetReq
max :: RpbCounterGetReq -> RpbCounterGetReq -> RpbCounterGetReq
$cmax :: RpbCounterGetReq -> RpbCounterGetReq -> RpbCounterGetReq
>= :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
$c>= :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
> :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
$c> :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
<= :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
$c<= :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
< :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
$c< :: RpbCounterGetReq -> RpbCounterGetReq -> Bool
compare :: RpbCounterGetReq -> RpbCounterGetReq -> Ordering
$ccompare :: RpbCounterGetReq -> RpbCounterGetReq -> Ordering
$cp1Ord :: Eq RpbCounterGetReq
Prelude.Ord)
instance Prelude.Show RpbCounterGetReq where
  showsPrec :: Int -> RpbCounterGetReq -> ShowS
showsPrec Int
_ RpbCounterGetReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCounterGetReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCounterGetReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbCounterGetReq
-> f RpbCounterGetReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> ByteString)
-> (RpbCounterGetReq -> ByteString -> RpbCounterGetReq)
-> Lens RpbCounterGetReq RpbCounterGetReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> ByteString
_RpbCounterGetReq'bucket
           (\ RpbCounterGetReq
x__ ByteString
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'bucket :: ByteString
_RpbCounterGetReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString)
-> RpbCounterGetReq
-> f RpbCounterGetReq
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString)
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> ByteString)
-> (RpbCounterGetReq -> ByteString -> RpbCounterGetReq)
-> Lens RpbCounterGetReq RpbCounterGetReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> ByteString
_RpbCounterGetReq'key
           (\ RpbCounterGetReq
x__ ByteString
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'key :: ByteString
_RpbCounterGetReq'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "r" Data.Word.Word32 where
  fieldOf :: Proxy# "r"
-> (Word32 -> f Word32) -> RpbCounterGetReq -> f RpbCounterGetReq
fieldOf Proxy# "r"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Word32)
-> (RpbCounterGetReq -> Maybe Word32 -> RpbCounterGetReq)
-> Lens
     RpbCounterGetReq RpbCounterGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'r (\ RpbCounterGetReq
x__ Maybe Word32
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'r :: Maybe Word32
_RpbCounterGetReq'r = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "maybe'r" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'r"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterGetReq
-> f RpbCounterGetReq
fieldOf Proxy# "maybe'r"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Word32)
-> (RpbCounterGetReq -> Maybe Word32 -> RpbCounterGetReq)
-> Lens
     RpbCounterGetReq RpbCounterGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'r (\ RpbCounterGetReq
x__ Maybe Word32
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'r :: Maybe Word32
_RpbCounterGetReq'r = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "pr" Data.Word.Word32 where
  fieldOf :: Proxy# "pr"
-> (Word32 -> f Word32) -> RpbCounterGetReq -> f RpbCounterGetReq
fieldOf Proxy# "pr"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Word32)
-> (RpbCounterGetReq -> Maybe Word32 -> RpbCounterGetReq)
-> Lens
     RpbCounterGetReq RpbCounterGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'pr
           (\ RpbCounterGetReq
x__ Maybe Word32
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'pr :: Maybe Word32
_RpbCounterGetReq'pr = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "maybe'pr" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pr"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterGetReq
-> f RpbCounterGetReq
fieldOf Proxy# "maybe'pr"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Word32)
-> (RpbCounterGetReq -> Maybe Word32 -> RpbCounterGetReq)
-> Lens
     RpbCounterGetReq RpbCounterGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'pr
           (\ RpbCounterGetReq
x__ Maybe Word32
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'pr :: Maybe Word32
_RpbCounterGetReq'pr = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "basicQuorum" Prelude.Bool where
  fieldOf :: Proxy# "basicQuorum"
-> (Bool -> f Bool) -> RpbCounterGetReq -> f RpbCounterGetReq
fieldOf Proxy# "basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Bool)
-> (RpbCounterGetReq -> Maybe Bool -> RpbCounterGetReq)
-> Lens RpbCounterGetReq RpbCounterGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'basicQuorum
           (\ RpbCounterGetReq
x__ Maybe Bool
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'basicQuorum :: Maybe Bool
_RpbCounterGetReq'basicQuorum = 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 RpbCounterGetReq "maybe'basicQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'basicQuorum"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCounterGetReq
-> f RpbCounterGetReq
fieldOf Proxy# "maybe'basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Bool)
-> (RpbCounterGetReq -> Maybe Bool -> RpbCounterGetReq)
-> Lens RpbCounterGetReq RpbCounterGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'basicQuorum
           (\ RpbCounterGetReq
x__ Maybe Bool
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'basicQuorum :: Maybe Bool
_RpbCounterGetReq'basicQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterGetReq "notfoundOk" Prelude.Bool where
  fieldOf :: Proxy# "notfoundOk"
-> (Bool -> f Bool) -> RpbCounterGetReq -> f RpbCounterGetReq
fieldOf Proxy# "notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Bool)
-> (RpbCounterGetReq -> Maybe Bool -> RpbCounterGetReq)
-> Lens RpbCounterGetReq RpbCounterGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'notfoundOk
           (\ RpbCounterGetReq
x__ Maybe Bool
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'notfoundOk :: Maybe Bool
_RpbCounterGetReq'notfoundOk = 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 RpbCounterGetReq "maybe'notfoundOk" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'notfoundOk"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCounterGetReq
-> f RpbCounterGetReq
fieldOf Proxy# "maybe'notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCounterGetReq -> f RpbCounterGetReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCounterGetReq
-> f RpbCounterGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetReq -> Maybe Bool)
-> (RpbCounterGetReq -> Maybe Bool -> RpbCounterGetReq)
-> Lens RpbCounterGetReq RpbCounterGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'notfoundOk
           (\ RpbCounterGetReq
x__ Maybe Bool
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'notfoundOk :: Maybe Bool
_RpbCounterGetReq'notfoundOk = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCounterGetReq where
  messageName :: Proxy RpbCounterGetReq -> Text
messageName Proxy RpbCounterGetReq
_ = String -> Text
Data.Text.pack String
"RpbCounterGetReq"
  packedMessageDescriptor :: Proxy RpbCounterGetReq -> ByteString
packedMessageDescriptor Proxy RpbCounterGetReq
_
    = ByteString
"\n\
      \\DLERpbCounterGetReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\f\n\
      \\SOHr\CAN\ETX \SOH(\rR\SOHr\DC2\SO\n\
      \\STXpr\CAN\EOT \SOH(\rR\STXpr\DC2!\n\
      \\fbasic_quorum\CAN\ENQ \SOH(\bR\vbasicQuorum\DC2\US\n\
      \\vnotfound_ok\CAN\ACK \SOH(\bR\n\
      \notfoundOk"
  packedFileDescriptor :: Proxy RpbCounterGetReq -> ByteString
packedFileDescriptor Proxy RpbCounterGetReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCounterGetReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbCounterGetReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCounterGetReq ByteString
-> FieldDescriptor RpbCounterGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbCounterGetReq RpbCounterGetReq ByteString ByteString
-> FieldAccessor RpbCounterGetReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterGetReq
        key__field_descriptor :: FieldDescriptor RpbCounterGetReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCounterGetReq ByteString
-> FieldDescriptor RpbCounterGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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 RpbCounterGetReq RpbCounterGetReq ByteString ByteString
-> FieldAccessor RpbCounterGetReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterGetReq
        r__field_descriptor :: FieldDescriptor RpbCounterGetReq
r__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCounterGetReq Word32
-> FieldDescriptor RpbCounterGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"r"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbCounterGetReq RpbCounterGetReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbCounterGetReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterGetReq
        pr__field_descriptor :: FieldDescriptor RpbCounterGetReq
pr__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCounterGetReq Word32
-> FieldDescriptor RpbCounterGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pr"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbCounterGetReq RpbCounterGetReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbCounterGetReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterGetReq
        basicQuorum__field_descriptor :: FieldDescriptor RpbCounterGetReq
basicQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbCounterGetReq Bool
-> FieldDescriptor RpbCounterGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"basic_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbCounterGetReq RpbCounterGetReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbCounterGetReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'basicQuorum")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterGetReq
        notfoundOk__field_descriptor :: FieldDescriptor RpbCounterGetReq
notfoundOk__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbCounterGetReq Bool
-> FieldDescriptor RpbCounterGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"notfound_ok"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbCounterGetReq RpbCounterGetReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbCounterGetReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'notfoundOk")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterGetReq
      in
        [(Tag, FieldDescriptor RpbCounterGetReq)]
-> Map Tag (FieldDescriptor RpbCounterGetReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCounterGetReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbCounterGetReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbCounterGetReq
r__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbCounterGetReq
pr__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbCounterGetReq
basicQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbCounterGetReq
notfoundOk__field_descriptor)]
  unknownFields :: LensLike' f RpbCounterGetReq FieldSet
unknownFields
    = (RpbCounterGetReq -> FieldSet)
-> (RpbCounterGetReq -> FieldSet -> RpbCounterGetReq)
-> Lens' RpbCounterGetReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCounterGetReq -> FieldSet
_RpbCounterGetReq'_unknownFields
        (\ RpbCounterGetReq
x__ FieldSet
y__ -> RpbCounterGetReq
x__ {_RpbCounterGetReq'_unknownFields :: FieldSet
_RpbCounterGetReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbCounterGetReq
defMessage
    = RpbCounterGetReq'_constructor :: ByteString
-> ByteString
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> FieldSet
-> RpbCounterGetReq
RpbCounterGetReq'_constructor
        {_RpbCounterGetReq'bucket :: ByteString
_RpbCounterGetReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCounterGetReq'key :: ByteString
_RpbCounterGetReq'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCounterGetReq'r :: Maybe Word32
_RpbCounterGetReq'r = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterGetReq'pr :: Maybe Word32
_RpbCounterGetReq'pr = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterGetReq'basicQuorum :: Maybe Bool
_RpbCounterGetReq'basicQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterGetReq'notfoundOk :: Maybe Bool
_RpbCounterGetReq'notfoundOk = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterGetReq'_unknownFields :: FieldSet
_RpbCounterGetReq'_unknownFields = []}
  parseMessage :: Parser RpbCounterGetReq
parseMessage
    = let
        loop ::
          RpbCounterGetReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbCounterGetReq
        loop :: RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop RpbCounterGetReq
x Bool
required'bucket Bool
required'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbCounterGetReq -> Parser RpbCounterGetReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCounterGetReq RpbCounterGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCounterGetReq -> RpbCounterGetReq
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 RpbCounterGetReq RpbCounterGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbCounterGetReq
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
"bucket"
                                RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop
                                  (Setter RpbCounterGetReq RpbCounterGetReq ByteString ByteString
-> ByteString -> RpbCounterGetReq -> RpbCounterGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbCounterGetReq
x)
                                  Bool
Prelude.False
                                  Bool
required'key
                        Word64
18
                          -> 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
"key"
                                RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop
                                  (Setter RpbCounterGetReq RpbCounterGetReq ByteString ByteString
-> ByteString -> RpbCounterGetReq -> RpbCounterGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbCounterGetReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
24
                          -> 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
"r"
                                RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop
                                  (Setter RpbCounterGetReq RpbCounterGetReq Word32 Word32
-> Word32 -> RpbCounterGetReq -> RpbCounterGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"r") Word32
y RpbCounterGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
32
                          -> 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
"pr"
                                RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop
                                  (Setter RpbCounterGetReq RpbCounterGetReq Word32 Word32
-> Word32 -> RpbCounterGetReq -> RpbCounterGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pr") Word32
y RpbCounterGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
40
                          -> 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
"basic_quorum"
                                RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop
                                  (Setter RpbCounterGetReq RpbCounterGetReq Bool Bool
-> Bool -> RpbCounterGetReq -> RpbCounterGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"basicQuorum") Bool
y RpbCounterGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
48
                          -> 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
"notfound_ok"
                                RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop
                                  (Setter RpbCounterGetReq RpbCounterGetReq Bool Bool
-> Bool -> RpbCounterGetReq -> RpbCounterGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"notfoundOk") Bool
y RpbCounterGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop
                                  (Setter RpbCounterGetReq RpbCounterGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCounterGetReq -> RpbCounterGetReq
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 RpbCounterGetReq RpbCounterGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCounterGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
      in
        Parser RpbCounterGetReq -> String -> Parser RpbCounterGetReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbCounterGetReq -> Bool -> Bool -> Parser RpbCounterGetReq
loop RpbCounterGetReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbCounterGetReq"
  buildMessage :: RpbCounterGetReq -> Builder
buildMessage
    = \ RpbCounterGetReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbCounterGetReq RpbCounterGetReq ByteString ByteString
-> RpbCounterGetReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbCounterGetReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString RpbCounterGetReq RpbCounterGetReq ByteString ByteString
-> RpbCounterGetReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") RpbCounterGetReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32)
  RpbCounterGetReq
  RpbCounterGetReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCounterGetReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r") RpbCounterGetReq
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Word32)
  RpbCounterGetReq
  RpbCounterGetReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCounterGetReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr") RpbCounterGetReq
_x
                       of
                         Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Word32
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe Bool)
  RpbCounterGetReq
  RpbCounterGetReq
  (Maybe Bool)
  (Maybe Bool)
-> RpbCounterGetReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'basicQuorum") RpbCounterGetReq
_x
                          of
                            Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Bool
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe Bool)
  RpbCounterGetReq
  RpbCounterGetReq
  (Maybe Bool)
  (Maybe Bool)
-> RpbCounterGetReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                   (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'notfoundOk") RpbCounterGetReq
_x
                             of
                               Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Bool
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      ((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))
                            (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                               (FoldLike
  FieldSet RpbCounterGetReq RpbCounterGetReq FieldSet FieldSet
-> RpbCounterGetReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbCounterGetReq RpbCounterGetReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCounterGetReq
_x)))))))
instance Control.DeepSeq.NFData RpbCounterGetReq where
  rnf :: RpbCounterGetReq -> ()
rnf
    = \ RpbCounterGetReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCounterGetReq -> FieldSet
_RpbCounterGetReq'_unknownFields RpbCounterGetReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbCounterGetReq -> ByteString
_RpbCounterGetReq'bucket RpbCounterGetReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbCounterGetReq -> ByteString
_RpbCounterGetReq'key RpbCounterGetReq
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'r RpbCounterGetReq
x__)
                      (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbCounterGetReq -> Maybe Word32
_RpbCounterGetReq'pr RpbCounterGetReq
x__)
                         (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'basicQuorum RpbCounterGetReq
x__)
                            (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbCounterGetReq -> Maybe Bool
_RpbCounterGetReq'notfoundOk RpbCounterGetReq
x__) ()))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.value' @:: Lens' RpbCounterGetResp Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'value' @:: Lens' RpbCounterGetResp (Prelude.Maybe Data.Int.Int64)@ -}
data RpbCounterGetResp
  = RpbCounterGetResp'_constructor {RpbCounterGetResp -> Maybe Int64
_RpbCounterGetResp'value :: !(Prelude.Maybe Data.Int.Int64),
                                    RpbCounterGetResp -> FieldSet
_RpbCounterGetResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCounterGetResp -> RpbCounterGetResp -> Bool
(RpbCounterGetResp -> RpbCounterGetResp -> Bool)
-> (RpbCounterGetResp -> RpbCounterGetResp -> Bool)
-> Eq RpbCounterGetResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
$c/= :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
== :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
$c== :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
Prelude.Eq, Eq RpbCounterGetResp
Eq RpbCounterGetResp
-> (RpbCounterGetResp -> RpbCounterGetResp -> Ordering)
-> (RpbCounterGetResp -> RpbCounterGetResp -> Bool)
-> (RpbCounterGetResp -> RpbCounterGetResp -> Bool)
-> (RpbCounterGetResp -> RpbCounterGetResp -> Bool)
-> (RpbCounterGetResp -> RpbCounterGetResp -> Bool)
-> (RpbCounterGetResp -> RpbCounterGetResp -> RpbCounterGetResp)
-> (RpbCounterGetResp -> RpbCounterGetResp -> RpbCounterGetResp)
-> Ord RpbCounterGetResp
RpbCounterGetResp -> RpbCounterGetResp -> Bool
RpbCounterGetResp -> RpbCounterGetResp -> Ordering
RpbCounterGetResp -> RpbCounterGetResp -> RpbCounterGetResp
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 :: RpbCounterGetResp -> RpbCounterGetResp -> RpbCounterGetResp
$cmin :: RpbCounterGetResp -> RpbCounterGetResp -> RpbCounterGetResp
max :: RpbCounterGetResp -> RpbCounterGetResp -> RpbCounterGetResp
$cmax :: RpbCounterGetResp -> RpbCounterGetResp -> RpbCounterGetResp
>= :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
$c>= :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
> :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
$c> :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
<= :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
$c<= :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
< :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
$c< :: RpbCounterGetResp -> RpbCounterGetResp -> Bool
compare :: RpbCounterGetResp -> RpbCounterGetResp -> Ordering
$ccompare :: RpbCounterGetResp -> RpbCounterGetResp -> Ordering
$cp1Ord :: Eq RpbCounterGetResp
Prelude.Ord)
instance Prelude.Show RpbCounterGetResp where
  showsPrec :: Int -> RpbCounterGetResp -> ShowS
showsPrec Int
_ RpbCounterGetResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCounterGetResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCounterGetResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCounterGetResp "value" Data.Int.Int64 where
  fieldOf :: Proxy# "value"
-> (Int64 -> f Int64) -> RpbCounterGetResp -> f RpbCounterGetResp
fieldOf Proxy# "value"
_
    = ((Maybe Int64 -> f (Maybe Int64))
 -> RpbCounterGetResp -> f RpbCounterGetResp)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> RpbCounterGetResp
-> f RpbCounterGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetResp -> Maybe Int64)
-> (RpbCounterGetResp -> Maybe Int64 -> RpbCounterGetResp)
-> Lens
     RpbCounterGetResp RpbCounterGetResp (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetResp -> Maybe Int64
_RpbCounterGetResp'value
           (\ RpbCounterGetResp
x__ Maybe Int64
y__ -> RpbCounterGetResp
x__ {_RpbCounterGetResp'value :: Maybe Int64
_RpbCounterGetResp'value = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCounterGetResp "maybe'value" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'value"
-> (Maybe Int64 -> f (Maybe Int64))
-> RpbCounterGetResp
-> f RpbCounterGetResp
fieldOf Proxy# "maybe'value"
_
    = ((Maybe Int64 -> f (Maybe Int64))
 -> RpbCounterGetResp -> f RpbCounterGetResp)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> RpbCounterGetResp
-> f RpbCounterGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterGetResp -> Maybe Int64)
-> (RpbCounterGetResp -> Maybe Int64 -> RpbCounterGetResp)
-> Lens
     RpbCounterGetResp RpbCounterGetResp (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterGetResp -> Maybe Int64
_RpbCounterGetResp'value
           (\ RpbCounterGetResp
x__ Maybe Int64
y__ -> RpbCounterGetResp
x__ {_RpbCounterGetResp'value :: Maybe Int64
_RpbCounterGetResp'value = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCounterGetResp where
  messageName :: Proxy RpbCounterGetResp -> Text
messageName Proxy RpbCounterGetResp
_ = String -> Text
Data.Text.pack String
"RpbCounterGetResp"
  packedMessageDescriptor :: Proxy RpbCounterGetResp -> ByteString
packedMessageDescriptor Proxy RpbCounterGetResp
_
    = ByteString
"\n\
      \\DC1RpbCounterGetResp\DC2\DC4\n\
      \\ENQvalue\CAN\SOH \SOH(\DC2R\ENQvalue"
  packedFileDescriptor :: Proxy RpbCounterGetResp -> ByteString
packedFileDescriptor Proxy RpbCounterGetResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCounterGetResp)
fieldsByTag
    = let
        value__field_descriptor :: FieldDescriptor RpbCounterGetResp
value__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor RpbCounterGetResp Int64
-> FieldDescriptor RpbCounterGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens
  RpbCounterGetResp RpbCounterGetResp (Maybe Int64) (Maybe Int64)
-> FieldAccessor RpbCounterGetResp Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterGetResp
      in
        [(Tag, FieldDescriptor RpbCounterGetResp)]
-> Map Tag (FieldDescriptor RpbCounterGetResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCounterGetResp
value__field_descriptor)]
  unknownFields :: LensLike' f RpbCounterGetResp FieldSet
unknownFields
    = (RpbCounterGetResp -> FieldSet)
-> (RpbCounterGetResp -> FieldSet -> RpbCounterGetResp)
-> Lens' RpbCounterGetResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCounterGetResp -> FieldSet
_RpbCounterGetResp'_unknownFields
        (\ RpbCounterGetResp
x__ FieldSet
y__ -> RpbCounterGetResp
x__ {_RpbCounterGetResp'_unknownFields :: FieldSet
_RpbCounterGetResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbCounterGetResp
defMessage
    = RpbCounterGetResp'_constructor :: Maybe Int64 -> FieldSet -> RpbCounterGetResp
RpbCounterGetResp'_constructor
        {_RpbCounterGetResp'value :: Maybe Int64
_RpbCounterGetResp'value = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterGetResp'_unknownFields :: FieldSet
_RpbCounterGetResp'_unknownFields = []}
  parseMessage :: Parser RpbCounterGetResp
parseMessage
    = let
        loop ::
          RpbCounterGetResp
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbCounterGetResp
        loop :: RpbCounterGetResp -> Parser RpbCounterGetResp
loop RpbCounterGetResp
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]))))
                      RpbCounterGetResp -> Parser RpbCounterGetResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCounterGetResp RpbCounterGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCounterGetResp -> RpbCounterGetResp
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 RpbCounterGetResp RpbCounterGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbCounterGetResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"value"
                                RpbCounterGetResp -> Parser RpbCounterGetResp
loop (Setter RpbCounterGetResp RpbCounterGetResp Int64 Int64
-> Int64 -> RpbCounterGetResp -> RpbCounterGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") Int64
y RpbCounterGetResp
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCounterGetResp -> Parser RpbCounterGetResp
loop
                                  (Setter RpbCounterGetResp RpbCounterGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCounterGetResp -> RpbCounterGetResp
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 RpbCounterGetResp RpbCounterGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCounterGetResp
x)
      in
        Parser RpbCounterGetResp -> String -> Parser RpbCounterGetResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbCounterGetResp -> Parser RpbCounterGetResp
loop RpbCounterGetResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbCounterGetResp"
  buildMessage :: RpbCounterGetResp -> Builder
buildMessage
    = \ RpbCounterGetResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Int64)
  RpbCounterGetResp
  RpbCounterGetResp
  (Maybe Int64)
  (Maybe Int64)
-> RpbCounterGetResp -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value") RpbCounterGetResp
_x
              of
                Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Int64
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                       ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                          Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                          Int64
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet RpbCounterGetResp RpbCounterGetResp FieldSet FieldSet
-> RpbCounterGetResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbCounterGetResp RpbCounterGetResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCounterGetResp
_x))
instance Control.DeepSeq.NFData RpbCounterGetResp where
  rnf :: RpbCounterGetResp -> ()
rnf
    = \ RpbCounterGetResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCounterGetResp -> FieldSet
_RpbCounterGetResp'_unknownFields RpbCounterGetResp
x__)
             (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbCounterGetResp -> Maybe Int64
_RpbCounterGetResp'value RpbCounterGetResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbCounterUpdateReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbCounterUpdateReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.amount' @:: Lens' RpbCounterUpdateReq Data.Int.Int64@
         * 'Proto.Riak_Fields.w' @:: Lens' RpbCounterUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'w' @:: Lens' RpbCounterUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.dw' @:: Lens' RpbCounterUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'dw' @:: Lens' RpbCounterUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pw' @:: Lens' RpbCounterUpdateReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pw' @:: Lens' RpbCounterUpdateReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.returnvalue' @:: Lens' RpbCounterUpdateReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'returnvalue' @:: Lens' RpbCounterUpdateReq (Prelude.Maybe Prelude.Bool)@ -}
data RpbCounterUpdateReq
  = RpbCounterUpdateReq'_constructor {RpbCounterUpdateReq -> ByteString
_RpbCounterUpdateReq'bucket :: !Data.ByteString.ByteString,
                                      RpbCounterUpdateReq -> ByteString
_RpbCounterUpdateReq'key :: !Data.ByteString.ByteString,
                                      RpbCounterUpdateReq -> Int64
_RpbCounterUpdateReq'amount :: !Data.Int.Int64,
                                      RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'w :: !(Prelude.Maybe Data.Word.Word32),
                                      RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'dw :: !(Prelude.Maybe Data.Word.Word32),
                                      RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'pw :: !(Prelude.Maybe Data.Word.Word32),
                                      RpbCounterUpdateReq -> Maybe Bool
_RpbCounterUpdateReq'returnvalue :: !(Prelude.Maybe Prelude.Bool),
                                      RpbCounterUpdateReq -> FieldSet
_RpbCounterUpdateReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
(RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool)
-> (RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool)
-> Eq RpbCounterUpdateReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
$c/= :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
== :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
$c== :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
Prelude.Eq, Eq RpbCounterUpdateReq
Eq RpbCounterUpdateReq
-> (RpbCounterUpdateReq -> RpbCounterUpdateReq -> Ordering)
-> (RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool)
-> (RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool)
-> (RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool)
-> (RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool)
-> (RpbCounterUpdateReq
    -> RpbCounterUpdateReq -> RpbCounterUpdateReq)
-> (RpbCounterUpdateReq
    -> RpbCounterUpdateReq -> RpbCounterUpdateReq)
-> Ord RpbCounterUpdateReq
RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
RpbCounterUpdateReq -> RpbCounterUpdateReq -> Ordering
RpbCounterUpdateReq -> RpbCounterUpdateReq -> RpbCounterUpdateReq
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 :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> RpbCounterUpdateReq
$cmin :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> RpbCounterUpdateReq
max :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> RpbCounterUpdateReq
$cmax :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> RpbCounterUpdateReq
>= :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
$c>= :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
> :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
$c> :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
<= :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
$c<= :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
< :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
$c< :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Bool
compare :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Ordering
$ccompare :: RpbCounterUpdateReq -> RpbCounterUpdateReq -> Ordering
$cp1Ord :: Eq RpbCounterUpdateReq
Prelude.Ord)
instance Prelude.Show RpbCounterUpdateReq where
  showsPrec :: Int -> RpbCounterUpdateReq -> ShowS
showsPrec Int
_ RpbCounterUpdateReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCounterUpdateReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCounterUpdateReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> ByteString)
-> (RpbCounterUpdateReq -> ByteString -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq RpbCounterUpdateReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> ByteString
_RpbCounterUpdateReq'bucket
           (\ RpbCounterUpdateReq
x__ ByteString
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'bucket :: ByteString
_RpbCounterUpdateReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString)
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> ByteString)
-> (RpbCounterUpdateReq -> ByteString -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq RpbCounterUpdateReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> ByteString
_RpbCounterUpdateReq'key
           (\ RpbCounterUpdateReq
x__ ByteString
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'key :: ByteString
_RpbCounterUpdateReq'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "amount" Data.Int.Int64 where
  fieldOf :: Proxy# "amount"
-> (Int64 -> f Int64)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "amount"
_
    = ((Int64 -> f Int64)
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Int64 -> f Int64) -> Int64 -> f Int64)
-> (Int64 -> f Int64)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Int64)
-> (RpbCounterUpdateReq -> Int64 -> RpbCounterUpdateReq)
-> Lens RpbCounterUpdateReq RpbCounterUpdateReq Int64 Int64
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Int64
_RpbCounterUpdateReq'amount
           (\ RpbCounterUpdateReq
x__ Int64
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'amount :: Int64
_RpbCounterUpdateReq'amount = Int64
y__}))
        (Int64 -> f Int64) -> Int64 -> f Int64
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "w" Data.Word.Word32 where
  fieldOf :: Proxy# "w"
-> (Word32 -> f Word32)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "w"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Word32)
-> (RpbCounterUpdateReq -> Maybe Word32 -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq
     RpbCounterUpdateReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'w
           (\ RpbCounterUpdateReq
x__ Maybe Word32
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'w :: Maybe Word32
_RpbCounterUpdateReq'w = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "maybe'w" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'w"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "maybe'w"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Word32)
-> (RpbCounterUpdateReq -> Maybe Word32 -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq
     RpbCounterUpdateReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'w
           (\ RpbCounterUpdateReq
x__ Maybe Word32
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'w :: Maybe Word32
_RpbCounterUpdateReq'w = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "dw" Data.Word.Word32 where
  fieldOf :: Proxy# "dw"
-> (Word32 -> f Word32)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "dw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Word32)
-> (RpbCounterUpdateReq -> Maybe Word32 -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq
     RpbCounterUpdateReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'dw
           (\ RpbCounterUpdateReq
x__ Maybe Word32
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'dw :: Maybe Word32
_RpbCounterUpdateReq'dw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "maybe'dw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'dw"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "maybe'dw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Word32)
-> (RpbCounterUpdateReq -> Maybe Word32 -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq
     RpbCounterUpdateReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'dw
           (\ RpbCounterUpdateReq
x__ Maybe Word32
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'dw :: Maybe Word32
_RpbCounterUpdateReq'dw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "pw" Data.Word.Word32 where
  fieldOf :: Proxy# "pw"
-> (Word32 -> f Word32)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "pw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Word32)
-> (RpbCounterUpdateReq -> Maybe Word32 -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq
     RpbCounterUpdateReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'pw
           (\ RpbCounterUpdateReq
x__ Maybe Word32
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'pw :: Maybe Word32
_RpbCounterUpdateReq'pw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "maybe'pw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pw"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "maybe'pw"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Word32)
-> (RpbCounterUpdateReq -> Maybe Word32 -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq
     RpbCounterUpdateReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'pw
           (\ RpbCounterUpdateReq
x__ Maybe Word32
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'pw :: Maybe Word32
_RpbCounterUpdateReq'pw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCounterUpdateReq "returnvalue" Prelude.Bool where
  fieldOf :: Proxy# "returnvalue"
-> (Bool -> f Bool) -> RpbCounterUpdateReq -> f RpbCounterUpdateReq
fieldOf Proxy# "returnvalue"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Bool)
-> (RpbCounterUpdateReq -> Maybe Bool -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq RpbCounterUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Bool
_RpbCounterUpdateReq'returnvalue
           (\ RpbCounterUpdateReq
x__ Maybe Bool
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'returnvalue :: Maybe Bool
_RpbCounterUpdateReq'returnvalue = 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 RpbCounterUpdateReq "maybe'returnvalue" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'returnvalue"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
fieldOf Proxy# "maybe'returnvalue"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbCounterUpdateReq -> f RpbCounterUpdateReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbCounterUpdateReq
-> f RpbCounterUpdateReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateReq -> Maybe Bool)
-> (RpbCounterUpdateReq -> Maybe Bool -> RpbCounterUpdateReq)
-> Lens
     RpbCounterUpdateReq RpbCounterUpdateReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateReq -> Maybe Bool
_RpbCounterUpdateReq'returnvalue
           (\ RpbCounterUpdateReq
x__ Maybe Bool
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'returnvalue :: Maybe Bool
_RpbCounterUpdateReq'returnvalue = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCounterUpdateReq where
  messageName :: Proxy RpbCounterUpdateReq -> Text
messageName Proxy RpbCounterUpdateReq
_ = String -> Text
Data.Text.pack String
"RpbCounterUpdateReq"
  packedMessageDescriptor :: Proxy RpbCounterUpdateReq -> ByteString
packedMessageDescriptor Proxy RpbCounterUpdateReq
_
    = ByteString
"\n\
      \\DC3RpbCounterUpdateReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\SYN\n\
      \\ACKamount\CAN\ETX \STX(\DC2R\ACKamount\DC2\f\n\
      \\SOHw\CAN\EOT \SOH(\rR\SOHw\DC2\SO\n\
      \\STXdw\CAN\ENQ \SOH(\rR\STXdw\DC2\SO\n\
      \\STXpw\CAN\ACK \SOH(\rR\STXpw\DC2 \n\
      \\vreturnvalue\CAN\a \SOH(\bR\vreturnvalue"
  packedFileDescriptor :: Proxy RpbCounterUpdateReq -> ByteString
packedFileDescriptor Proxy RpbCounterUpdateReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCounterUpdateReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbCounterUpdateReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCounterUpdateReq ByteString
-> FieldDescriptor RpbCounterUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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
     RpbCounterUpdateReq RpbCounterUpdateReq ByteString ByteString
-> FieldAccessor RpbCounterUpdateReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateReq
        key__field_descriptor :: FieldDescriptor RpbCounterUpdateReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCounterUpdateReq ByteString
-> FieldDescriptor RpbCounterUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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
     RpbCounterUpdateReq RpbCounterUpdateReq ByteString ByteString
-> FieldAccessor RpbCounterUpdateReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateReq
        amount__field_descriptor :: FieldDescriptor RpbCounterUpdateReq
amount__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor RpbCounterUpdateReq Int64
-> FieldDescriptor RpbCounterUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"amount"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (WireDefault Int64
-> Lens RpbCounterUpdateReq RpbCounterUpdateReq Int64 Int64
-> FieldAccessor RpbCounterUpdateReq Int64
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Int64
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "amount" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"amount")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateReq
        w__field_descriptor :: FieldDescriptor RpbCounterUpdateReq
w__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCounterUpdateReq Word32
-> FieldDescriptor RpbCounterUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"w"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> FieldAccessor RpbCounterUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateReq
        dw__field_descriptor :: FieldDescriptor RpbCounterUpdateReq
dw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCounterUpdateReq Word32
-> FieldDescriptor RpbCounterUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"dw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> FieldAccessor RpbCounterUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateReq
        pw__field_descriptor :: FieldDescriptor RpbCounterUpdateReq
pw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCounterUpdateReq Word32
-> FieldDescriptor RpbCounterUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> FieldAccessor RpbCounterUpdateReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateReq
        returnvalue__field_descriptor :: FieldDescriptor RpbCounterUpdateReq
returnvalue__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbCounterUpdateReq Bool
-> FieldDescriptor RpbCounterUpdateReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"returnvalue"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens
  RpbCounterUpdateReq RpbCounterUpdateReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbCounterUpdateReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'returnvalue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnvalue")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateReq
      in
        [(Tag, FieldDescriptor RpbCounterUpdateReq)]
-> Map Tag (FieldDescriptor RpbCounterUpdateReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCounterUpdateReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbCounterUpdateReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbCounterUpdateReq
amount__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbCounterUpdateReq
w__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbCounterUpdateReq
dw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbCounterUpdateReq
pw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbCounterUpdateReq
returnvalue__field_descriptor)]
  unknownFields :: LensLike' f RpbCounterUpdateReq FieldSet
unknownFields
    = (RpbCounterUpdateReq -> FieldSet)
-> (RpbCounterUpdateReq -> FieldSet -> RpbCounterUpdateReq)
-> Lens' RpbCounterUpdateReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCounterUpdateReq -> FieldSet
_RpbCounterUpdateReq'_unknownFields
        (\ RpbCounterUpdateReq
x__ FieldSet
y__ -> RpbCounterUpdateReq
x__ {_RpbCounterUpdateReq'_unknownFields :: FieldSet
_RpbCounterUpdateReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbCounterUpdateReq
defMessage
    = RpbCounterUpdateReq'_constructor :: ByteString
-> ByteString
-> Int64
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> FieldSet
-> RpbCounterUpdateReq
RpbCounterUpdateReq'_constructor
        {_RpbCounterUpdateReq'bucket :: ByteString
_RpbCounterUpdateReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCounterUpdateReq'key :: ByteString
_RpbCounterUpdateReq'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCounterUpdateReq'amount :: Int64
_RpbCounterUpdateReq'amount = Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCounterUpdateReq'w :: Maybe Word32
_RpbCounterUpdateReq'w = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterUpdateReq'dw :: Maybe Word32
_RpbCounterUpdateReq'dw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterUpdateReq'pw :: Maybe Word32
_RpbCounterUpdateReq'pw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterUpdateReq'returnvalue :: Maybe Bool
_RpbCounterUpdateReq'returnvalue = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterUpdateReq'_unknownFields :: FieldSet
_RpbCounterUpdateReq'_unknownFields = []}
  parseMessage :: Parser RpbCounterUpdateReq
parseMessage
    = let
        loop ::
          RpbCounterUpdateReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool
                   -> Data.ProtoLens.Encoding.Bytes.Parser RpbCounterUpdateReq
        loop :: RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop RpbCounterUpdateReq
x Bool
required'amount Bool
required'bucket Bool
required'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'amount then (:) String
"amount" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id) []))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbCounterUpdateReq -> Parser RpbCounterUpdateReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCounterUpdateReq RpbCounterUpdateReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbCounterUpdateReq
-> RpbCounterUpdateReq
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 RpbCounterUpdateReq RpbCounterUpdateReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbCounterUpdateReq
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
"bucket"
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter
  RpbCounterUpdateReq RpbCounterUpdateReq ByteString ByteString
-> ByteString -> RpbCounterUpdateReq -> RpbCounterUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbCounterUpdateReq
x)
                                  Bool
required'amount
                                  Bool
Prelude.False
                                  Bool
required'key
                        Word64
18
                          -> 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
"key"
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter
  RpbCounterUpdateReq RpbCounterUpdateReq ByteString ByteString
-> ByteString -> RpbCounterUpdateReq -> RpbCounterUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbCounterUpdateReq
x)
                                  Bool
required'amount
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
24
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"amount"
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter RpbCounterUpdateReq RpbCounterUpdateReq Int64 Int64
-> Int64 -> RpbCounterUpdateReq -> RpbCounterUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "amount" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"amount") Int64
y RpbCounterUpdateReq
x)
                                  Bool
Prelude.False
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
32
                          -> 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
"w"
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter RpbCounterUpdateReq RpbCounterUpdateReq Word32 Word32
-> Word32 -> RpbCounterUpdateReq -> RpbCounterUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"w") Word32
y RpbCounterUpdateReq
x)
                                  Bool
required'amount
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
40
                          -> 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
"dw"
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter RpbCounterUpdateReq RpbCounterUpdateReq Word32 Word32
-> Word32 -> RpbCounterUpdateReq -> RpbCounterUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"dw") Word32
y RpbCounterUpdateReq
x)
                                  Bool
required'amount
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
48
                          -> 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
"pw"
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter RpbCounterUpdateReq RpbCounterUpdateReq Word32 Word32
-> Word32 -> RpbCounterUpdateReq -> RpbCounterUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pw") Word32
y RpbCounterUpdateReq
x)
                                  Bool
required'amount
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
56
                          -> 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
"returnvalue"
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter RpbCounterUpdateReq RpbCounterUpdateReq Bool Bool
-> Bool -> RpbCounterUpdateReq -> RpbCounterUpdateReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "returnvalue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"returnvalue") Bool
y RpbCounterUpdateReq
x)
                                  Bool
required'amount
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                                  (Setter RpbCounterUpdateReq RpbCounterUpdateReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbCounterUpdateReq
-> RpbCounterUpdateReq
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 RpbCounterUpdateReq RpbCounterUpdateReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCounterUpdateReq
x)
                                  Bool
required'amount
                                  Bool
required'bucket
                                  Bool
required'key
      in
        Parser RpbCounterUpdateReq -> String -> Parser RpbCounterUpdateReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbCounterUpdateReq
-> Bool -> Bool -> Bool -> Parser RpbCounterUpdateReq
loop
                RpbCounterUpdateReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Bool
Prelude.True)
          String
"RpbCounterUpdateReq"
  buildMessage :: RpbCounterUpdateReq -> Builder
buildMessage
    = \ RpbCounterUpdateReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  ByteString
  ByteString
-> RpbCounterUpdateReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbCounterUpdateReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  ByteString
  ByteString
-> RpbCounterUpdateReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") RpbCounterUpdateReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                      ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                            Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                         Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                         (FoldLike Int64 RpbCounterUpdateReq RpbCounterUpdateReq Int64 Int64
-> RpbCounterUpdateReq -> Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "amount" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"amount") RpbCounterUpdateReq
_x)))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Word32)
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCounterUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w") RpbCounterUpdateReq
_x
                       of
                         Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Word32
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe Word32)
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCounterUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw") RpbCounterUpdateReq
_x
                          of
                            Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Word32
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe Word32)
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCounterUpdateReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw") RpbCounterUpdateReq
_x
                             of
                               Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Word32
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      ((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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Bool)
  RpbCounterUpdateReq
  RpbCounterUpdateReq
  (Maybe Bool)
  (Maybe Bool)
-> RpbCounterUpdateReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'returnvalue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnvalue") RpbCounterUpdateReq
_x
                                of
                                  Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Bool
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                                  (FoldLike
  FieldSet RpbCounterUpdateReq RpbCounterUpdateReq FieldSet FieldSet
-> RpbCounterUpdateReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbCounterUpdateReq RpbCounterUpdateReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCounterUpdateReq
_x))))))))
instance Control.DeepSeq.NFData RpbCounterUpdateReq where
  rnf :: RpbCounterUpdateReq -> ()
rnf
    = \ RpbCounterUpdateReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCounterUpdateReq -> FieldSet
_RpbCounterUpdateReq'_unknownFields RpbCounterUpdateReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbCounterUpdateReq -> ByteString
_RpbCounterUpdateReq'bucket RpbCounterUpdateReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbCounterUpdateReq -> ByteString
_RpbCounterUpdateReq'key RpbCounterUpdateReq
x__)
                   (Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbCounterUpdateReq -> Int64
_RpbCounterUpdateReq'amount RpbCounterUpdateReq
x__)
                      (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'w RpbCounterUpdateReq
x__)
                         (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'dw RpbCounterUpdateReq
x__)
                            (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbCounterUpdateReq -> Maybe Word32
_RpbCounterUpdateReq'pw RpbCounterUpdateReq
x__)
                               (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbCounterUpdateReq -> Maybe Bool
_RpbCounterUpdateReq'returnvalue RpbCounterUpdateReq
x__) ())))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.value' @:: Lens' RpbCounterUpdateResp Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'value' @:: Lens' RpbCounterUpdateResp (Prelude.Maybe Data.Int.Int64)@ -}
data RpbCounterUpdateResp
  = RpbCounterUpdateResp'_constructor {RpbCounterUpdateResp -> Maybe Int64
_RpbCounterUpdateResp'value :: !(Prelude.Maybe Data.Int.Int64),
                                       RpbCounterUpdateResp -> FieldSet
_RpbCounterUpdateResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
(RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool)
-> (RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool)
-> Eq RpbCounterUpdateResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
$c/= :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
== :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
$c== :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
Prelude.Eq, Eq RpbCounterUpdateResp
Eq RpbCounterUpdateResp
-> (RpbCounterUpdateResp -> RpbCounterUpdateResp -> Ordering)
-> (RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool)
-> (RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool)
-> (RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool)
-> (RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool)
-> (RpbCounterUpdateResp
    -> RpbCounterUpdateResp -> RpbCounterUpdateResp)
-> (RpbCounterUpdateResp
    -> RpbCounterUpdateResp -> RpbCounterUpdateResp)
-> Ord RpbCounterUpdateResp
RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
RpbCounterUpdateResp -> RpbCounterUpdateResp -> Ordering
RpbCounterUpdateResp
-> RpbCounterUpdateResp -> RpbCounterUpdateResp
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 :: RpbCounterUpdateResp
-> RpbCounterUpdateResp -> RpbCounterUpdateResp
$cmin :: RpbCounterUpdateResp
-> RpbCounterUpdateResp -> RpbCounterUpdateResp
max :: RpbCounterUpdateResp
-> RpbCounterUpdateResp -> RpbCounterUpdateResp
$cmax :: RpbCounterUpdateResp
-> RpbCounterUpdateResp -> RpbCounterUpdateResp
>= :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
$c>= :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
> :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
$c> :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
<= :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
$c<= :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
< :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
$c< :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Bool
compare :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Ordering
$ccompare :: RpbCounterUpdateResp -> RpbCounterUpdateResp -> Ordering
$cp1Ord :: Eq RpbCounterUpdateResp
Prelude.Ord)
instance Prelude.Show RpbCounterUpdateResp where
  showsPrec :: Int -> RpbCounterUpdateResp -> ShowS
showsPrec Int
_ RpbCounterUpdateResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCounterUpdateResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCounterUpdateResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCounterUpdateResp "value" Data.Int.Int64 where
  fieldOf :: Proxy# "value"
-> (Int64 -> f Int64)
-> RpbCounterUpdateResp
-> f RpbCounterUpdateResp
fieldOf Proxy# "value"
_
    = ((Maybe Int64 -> f (Maybe Int64))
 -> RpbCounterUpdateResp -> f RpbCounterUpdateResp)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> RpbCounterUpdateResp
-> f RpbCounterUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateResp -> Maybe Int64)
-> (RpbCounterUpdateResp -> Maybe Int64 -> RpbCounterUpdateResp)
-> Lens
     RpbCounterUpdateResp
     RpbCounterUpdateResp
     (Maybe Int64)
     (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateResp -> Maybe Int64
_RpbCounterUpdateResp'value
           (\ RpbCounterUpdateResp
x__ Maybe Int64
y__ -> RpbCounterUpdateResp
x__ {_RpbCounterUpdateResp'value :: Maybe Int64
_RpbCounterUpdateResp'value = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCounterUpdateResp "maybe'value" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'value"
-> (Maybe Int64 -> f (Maybe Int64))
-> RpbCounterUpdateResp
-> f RpbCounterUpdateResp
fieldOf Proxy# "maybe'value"
_
    = ((Maybe Int64 -> f (Maybe Int64))
 -> RpbCounterUpdateResp -> f RpbCounterUpdateResp)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> RpbCounterUpdateResp
-> f RpbCounterUpdateResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCounterUpdateResp -> Maybe Int64)
-> (RpbCounterUpdateResp -> Maybe Int64 -> RpbCounterUpdateResp)
-> Lens
     RpbCounterUpdateResp
     RpbCounterUpdateResp
     (Maybe Int64)
     (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCounterUpdateResp -> Maybe Int64
_RpbCounterUpdateResp'value
           (\ RpbCounterUpdateResp
x__ Maybe Int64
y__ -> RpbCounterUpdateResp
x__ {_RpbCounterUpdateResp'value :: Maybe Int64
_RpbCounterUpdateResp'value = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCounterUpdateResp where
  messageName :: Proxy RpbCounterUpdateResp -> Text
messageName Proxy RpbCounterUpdateResp
_ = String -> Text
Data.Text.pack String
"RpbCounterUpdateResp"
  packedMessageDescriptor :: Proxy RpbCounterUpdateResp -> ByteString
packedMessageDescriptor Proxy RpbCounterUpdateResp
_
    = ByteString
"\n\
      \\DC4RpbCounterUpdateResp\DC2\DC4\n\
      \\ENQvalue\CAN\SOH \SOH(\DC2R\ENQvalue"
  packedFileDescriptor :: Proxy RpbCounterUpdateResp -> ByteString
packedFileDescriptor Proxy RpbCounterUpdateResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCounterUpdateResp)
fieldsByTag
    = let
        value__field_descriptor :: FieldDescriptor RpbCounterUpdateResp
value__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor RpbCounterUpdateResp Int64
-> FieldDescriptor RpbCounterUpdateResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens
  RpbCounterUpdateResp
  RpbCounterUpdateResp
  (Maybe Int64)
  (Maybe Int64)
-> FieldAccessor RpbCounterUpdateResp Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value")) ::
              Data.ProtoLens.FieldDescriptor RpbCounterUpdateResp
      in
        [(Tag, FieldDescriptor RpbCounterUpdateResp)]
-> Map Tag (FieldDescriptor RpbCounterUpdateResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCounterUpdateResp
value__field_descriptor)]
  unknownFields :: LensLike' f RpbCounterUpdateResp FieldSet
unknownFields
    = (RpbCounterUpdateResp -> FieldSet)
-> (RpbCounterUpdateResp -> FieldSet -> RpbCounterUpdateResp)
-> Lens' RpbCounterUpdateResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCounterUpdateResp -> FieldSet
_RpbCounterUpdateResp'_unknownFields
        (\ RpbCounterUpdateResp
x__ FieldSet
y__ -> RpbCounterUpdateResp
x__ {_RpbCounterUpdateResp'_unknownFields :: FieldSet
_RpbCounterUpdateResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbCounterUpdateResp
defMessage
    = RpbCounterUpdateResp'_constructor :: Maybe Int64 -> FieldSet -> RpbCounterUpdateResp
RpbCounterUpdateResp'_constructor
        {_RpbCounterUpdateResp'value :: Maybe Int64
_RpbCounterUpdateResp'value = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _RpbCounterUpdateResp'_unknownFields :: FieldSet
_RpbCounterUpdateResp'_unknownFields = []}
  parseMessage :: Parser RpbCounterUpdateResp
parseMessage
    = let
        loop ::
          RpbCounterUpdateResp
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbCounterUpdateResp
        loop :: RpbCounterUpdateResp -> Parser RpbCounterUpdateResp
loop RpbCounterUpdateResp
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]))))
                      RpbCounterUpdateResp -> Parser RpbCounterUpdateResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCounterUpdateResp RpbCounterUpdateResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbCounterUpdateResp
-> RpbCounterUpdateResp
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 RpbCounterUpdateResp RpbCounterUpdateResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbCounterUpdateResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
8 -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"value"
                                RpbCounterUpdateResp -> Parser RpbCounterUpdateResp
loop (Setter RpbCounterUpdateResp RpbCounterUpdateResp Int64 Int64
-> Int64 -> RpbCounterUpdateResp -> RpbCounterUpdateResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") Int64
y RpbCounterUpdateResp
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCounterUpdateResp -> Parser RpbCounterUpdateResp
loop
                                  (Setter RpbCounterUpdateResp RpbCounterUpdateResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbCounterUpdateResp
-> RpbCounterUpdateResp
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 RpbCounterUpdateResp RpbCounterUpdateResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCounterUpdateResp
x)
      in
        Parser RpbCounterUpdateResp
-> String -> Parser RpbCounterUpdateResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbCounterUpdateResp -> Parser RpbCounterUpdateResp
loop RpbCounterUpdateResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbCounterUpdateResp"
  buildMessage :: RpbCounterUpdateResp -> Builder
buildMessage
    = \ RpbCounterUpdateResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Int64)
  RpbCounterUpdateResp
  RpbCounterUpdateResp
  (Maybe Int64)
  (Maybe Int64)
-> RpbCounterUpdateResp -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value") RpbCounterUpdateResp
_x
              of
                Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Int64
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
8)
                       ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                          Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                          Int64
_v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RpbCounterUpdateResp
  RpbCounterUpdateResp
  FieldSet
  FieldSet
-> RpbCounterUpdateResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbCounterUpdateResp
  RpbCounterUpdateResp
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCounterUpdateResp
_x))
instance Control.DeepSeq.NFData RpbCounterUpdateResp where
  rnf :: RpbCounterUpdateResp -> ()
rnf
    = \ RpbCounterUpdateResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCounterUpdateResp -> FieldSet
_RpbCounterUpdateResp'_unknownFields RpbCounterUpdateResp
x__)
             (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbCounterUpdateResp -> Maybe Int64
_RpbCounterUpdateResp'value RpbCounterUpdateResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.ip' @:: Lens' RpbCoverageEntry Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.port' @:: Lens' RpbCoverageEntry Data.Word.Word32@
         * 'Proto.Riak_Fields.keyspaceDesc' @:: Lens' RpbCoverageEntry Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'keyspaceDesc' @:: Lens' RpbCoverageEntry (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.coverContext' @:: Lens' RpbCoverageEntry Data.ByteString.ByteString@ -}
data RpbCoverageEntry
  = RpbCoverageEntry'_constructor {RpbCoverageEntry -> ByteString
_RpbCoverageEntry'ip :: !Data.ByteString.ByteString,
                                   RpbCoverageEntry -> Word32
_RpbCoverageEntry'port :: !Data.Word.Word32,
                                   RpbCoverageEntry -> Maybe ByteString
_RpbCoverageEntry'keyspaceDesc :: !(Prelude.Maybe Data.ByteString.ByteString),
                                   RpbCoverageEntry -> ByteString
_RpbCoverageEntry'coverContext :: !Data.ByteString.ByteString,
                                   RpbCoverageEntry -> FieldSet
_RpbCoverageEntry'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCoverageEntry -> RpbCoverageEntry -> Bool
(RpbCoverageEntry -> RpbCoverageEntry -> Bool)
-> (RpbCoverageEntry -> RpbCoverageEntry -> Bool)
-> Eq RpbCoverageEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
$c/= :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
== :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
$c== :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
Prelude.Eq, Eq RpbCoverageEntry
Eq RpbCoverageEntry
-> (RpbCoverageEntry -> RpbCoverageEntry -> Ordering)
-> (RpbCoverageEntry -> RpbCoverageEntry -> Bool)
-> (RpbCoverageEntry -> RpbCoverageEntry -> Bool)
-> (RpbCoverageEntry -> RpbCoverageEntry -> Bool)
-> (RpbCoverageEntry -> RpbCoverageEntry -> Bool)
-> (RpbCoverageEntry -> RpbCoverageEntry -> RpbCoverageEntry)
-> (RpbCoverageEntry -> RpbCoverageEntry -> RpbCoverageEntry)
-> Ord RpbCoverageEntry
RpbCoverageEntry -> RpbCoverageEntry -> Bool
RpbCoverageEntry -> RpbCoverageEntry -> Ordering
RpbCoverageEntry -> RpbCoverageEntry -> RpbCoverageEntry
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 :: RpbCoverageEntry -> RpbCoverageEntry -> RpbCoverageEntry
$cmin :: RpbCoverageEntry -> RpbCoverageEntry -> RpbCoverageEntry
max :: RpbCoverageEntry -> RpbCoverageEntry -> RpbCoverageEntry
$cmax :: RpbCoverageEntry -> RpbCoverageEntry -> RpbCoverageEntry
>= :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
$c>= :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
> :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
$c> :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
<= :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
$c<= :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
< :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
$c< :: RpbCoverageEntry -> RpbCoverageEntry -> Bool
compare :: RpbCoverageEntry -> RpbCoverageEntry -> Ordering
$ccompare :: RpbCoverageEntry -> RpbCoverageEntry -> Ordering
$cp1Ord :: Eq RpbCoverageEntry
Prelude.Ord)
instance Prelude.Show RpbCoverageEntry where
  showsPrec :: Int -> RpbCoverageEntry -> ShowS
showsPrec Int
_ RpbCoverageEntry
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCoverageEntry -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCoverageEntry
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCoverageEntry "ip" Data.ByteString.ByteString where
  fieldOf :: Proxy# "ip"
-> (ByteString -> f ByteString)
-> RpbCoverageEntry
-> f RpbCoverageEntry
fieldOf Proxy# "ip"
_
    = ((ByteString -> f ByteString)
 -> RpbCoverageEntry -> f RpbCoverageEntry)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCoverageEntry
-> f RpbCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageEntry -> ByteString)
-> (RpbCoverageEntry -> ByteString -> RpbCoverageEntry)
-> Lens RpbCoverageEntry RpbCoverageEntry ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageEntry -> ByteString
_RpbCoverageEntry'ip
           (\ RpbCoverageEntry
x__ ByteString
y__ -> RpbCoverageEntry
x__ {_RpbCoverageEntry'ip :: ByteString
_RpbCoverageEntry'ip = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCoverageEntry "port" Data.Word.Word32 where
  fieldOf :: Proxy# "port"
-> (Word32 -> f Word32) -> RpbCoverageEntry -> f RpbCoverageEntry
fieldOf Proxy# "port"
_
    = ((Word32 -> f Word32) -> RpbCoverageEntry -> f RpbCoverageEntry)
-> ((Word32 -> f Word32) -> Word32 -> f Word32)
-> (Word32 -> f Word32)
-> RpbCoverageEntry
-> f RpbCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageEntry -> Word32)
-> (RpbCoverageEntry -> Word32 -> RpbCoverageEntry)
-> Lens RpbCoverageEntry RpbCoverageEntry Word32 Word32
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageEntry -> Word32
_RpbCoverageEntry'port
           (\ RpbCoverageEntry
x__ Word32
y__ -> RpbCoverageEntry
x__ {_RpbCoverageEntry'port :: Word32
_RpbCoverageEntry'port = Word32
y__}))
        (Word32 -> f Word32) -> Word32 -> f Word32
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCoverageEntry "keyspaceDesc" Data.ByteString.ByteString where
  fieldOf :: Proxy# "keyspaceDesc"
-> (ByteString -> f ByteString)
-> RpbCoverageEntry
-> f RpbCoverageEntry
fieldOf Proxy# "keyspaceDesc"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCoverageEntry -> f RpbCoverageEntry)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCoverageEntry
-> f RpbCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageEntry -> Maybe ByteString)
-> (RpbCoverageEntry -> Maybe ByteString -> RpbCoverageEntry)
-> Lens
     RpbCoverageEntry
     RpbCoverageEntry
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageEntry -> Maybe ByteString
_RpbCoverageEntry'keyspaceDesc
           (\ RpbCoverageEntry
x__ Maybe ByteString
y__ -> RpbCoverageEntry
x__ {_RpbCoverageEntry'keyspaceDesc :: Maybe ByteString
_RpbCoverageEntry'keyspaceDesc = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCoverageEntry "maybe'keyspaceDesc" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'keyspaceDesc"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCoverageEntry
-> f RpbCoverageEntry
fieldOf Proxy# "maybe'keyspaceDesc"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCoverageEntry -> f RpbCoverageEntry)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCoverageEntry
-> f RpbCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageEntry -> Maybe ByteString)
-> (RpbCoverageEntry -> Maybe ByteString -> RpbCoverageEntry)
-> Lens
     RpbCoverageEntry
     RpbCoverageEntry
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageEntry -> Maybe ByteString
_RpbCoverageEntry'keyspaceDesc
           (\ RpbCoverageEntry
x__ Maybe ByteString
y__ -> RpbCoverageEntry
x__ {_RpbCoverageEntry'keyspaceDesc :: Maybe ByteString
_RpbCoverageEntry'keyspaceDesc = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCoverageEntry "coverContext" Data.ByteString.ByteString where
  fieldOf :: Proxy# "coverContext"
-> (ByteString -> f ByteString)
-> RpbCoverageEntry
-> f RpbCoverageEntry
fieldOf Proxy# "coverContext"
_
    = ((ByteString -> f ByteString)
 -> RpbCoverageEntry -> f RpbCoverageEntry)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCoverageEntry
-> f RpbCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageEntry -> ByteString)
-> (RpbCoverageEntry -> ByteString -> RpbCoverageEntry)
-> Lens RpbCoverageEntry RpbCoverageEntry ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageEntry -> ByteString
_RpbCoverageEntry'coverContext
           (\ RpbCoverageEntry
x__ ByteString
y__ -> RpbCoverageEntry
x__ {_RpbCoverageEntry'coverContext :: ByteString
_RpbCoverageEntry'coverContext = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCoverageEntry where
  messageName :: Proxy RpbCoverageEntry -> Text
messageName Proxy RpbCoverageEntry
_ = String -> Text
Data.Text.pack String
"RpbCoverageEntry"
  packedMessageDescriptor :: Proxy RpbCoverageEntry -> ByteString
packedMessageDescriptor Proxy RpbCoverageEntry
_
    = ByteString
"\n\
      \\DLERpbCoverageEntry\DC2\SO\n\
      \\STXip\CAN\SOH \STX(\fR\STXip\DC2\DC2\n\
      \\EOTport\CAN\STX \STX(\rR\EOTport\DC2#\n\
      \\rkeyspace_desc\CAN\ETX \SOH(\fR\fkeyspaceDesc\DC2#\n\
      \\rcover_context\CAN\EOT \STX(\fR\fcoverContext"
  packedFileDescriptor :: Proxy RpbCoverageEntry -> ByteString
packedFileDescriptor Proxy RpbCoverageEntry
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCoverageEntry)
fieldsByTag
    = let
        ip__field_descriptor :: FieldDescriptor RpbCoverageEntry
ip__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCoverageEntry ByteString
-> FieldDescriptor RpbCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"ip"
              (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 RpbCoverageEntry RpbCoverageEntry ByteString ByteString
-> FieldAccessor RpbCoverageEntry ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "ip" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ip")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageEntry
        port__field_descriptor :: FieldDescriptor RpbCoverageEntry
port__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCoverageEntry Word32
-> FieldDescriptor RpbCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"port"
              (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 RpbCoverageEntry RpbCoverageEntry Word32 Word32
-> FieldAccessor RpbCoverageEntry Word32
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Word32
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "port" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"port")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageEntry
        keyspaceDesc__field_descriptor :: FieldDescriptor RpbCoverageEntry
keyspaceDesc__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCoverageEntry ByteString
-> FieldDescriptor RpbCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"keyspace_desc"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCoverageEntry
  RpbCoverageEntry
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbCoverageEntry ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'keyspaceDesc" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'keyspaceDesc")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageEntry
        coverContext__field_descriptor :: FieldDescriptor RpbCoverageEntry
coverContext__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCoverageEntry ByteString
-> FieldDescriptor RpbCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"cover_context"
              (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 RpbCoverageEntry RpbCoverageEntry ByteString ByteString
-> FieldAccessor RpbCoverageEntry ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageEntry
      in
        [(Tag, FieldDescriptor RpbCoverageEntry)]
-> Map Tag (FieldDescriptor RpbCoverageEntry)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCoverageEntry
ip__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbCoverageEntry
port__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbCoverageEntry
keyspaceDesc__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbCoverageEntry
coverContext__field_descriptor)]
  unknownFields :: LensLike' f RpbCoverageEntry FieldSet
unknownFields
    = (RpbCoverageEntry -> FieldSet)
-> (RpbCoverageEntry -> FieldSet -> RpbCoverageEntry)
-> Lens' RpbCoverageEntry FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCoverageEntry -> FieldSet
_RpbCoverageEntry'_unknownFields
        (\ RpbCoverageEntry
x__ FieldSet
y__ -> RpbCoverageEntry
x__ {_RpbCoverageEntry'_unknownFields :: FieldSet
_RpbCoverageEntry'_unknownFields = FieldSet
y__})
  defMessage :: RpbCoverageEntry
defMessage
    = RpbCoverageEntry'_constructor :: ByteString
-> Word32
-> Maybe ByteString
-> ByteString
-> FieldSet
-> RpbCoverageEntry
RpbCoverageEntry'_constructor
        {_RpbCoverageEntry'ip :: ByteString
_RpbCoverageEntry'ip = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCoverageEntry'port :: Word32
_RpbCoverageEntry'port = Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCoverageEntry'keyspaceDesc :: Maybe ByteString
_RpbCoverageEntry'keyspaceDesc = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCoverageEntry'coverContext :: ByteString
_RpbCoverageEntry'coverContext = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCoverageEntry'_unknownFields :: FieldSet
_RpbCoverageEntry'_unknownFields = []}
  parseMessage :: Parser RpbCoverageEntry
parseMessage
    = let
        loop ::
          RpbCoverageEntry
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool
                   -> Data.ProtoLens.Encoding.Bytes.Parser RpbCoverageEntry
        loop :: RpbCoverageEntry -> Bool -> Bool -> Bool -> Parser RpbCoverageEntry
loop RpbCoverageEntry
x Bool
required'coverContext Bool
required'ip Bool
required'port
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'coverContext then
                                  (:) String
"cover_context"
                              else
                                  [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'ip then (:) String
"ip" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'port then (:) String
"port" else [String] -> [String]
forall a. a -> a
Prelude.id) []))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbCoverageEntry -> Parser RpbCoverageEntry
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCoverageEntry RpbCoverageEntry FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCoverageEntry -> RpbCoverageEntry
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 RpbCoverageEntry RpbCoverageEntry FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbCoverageEntry
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
"ip"
                                RpbCoverageEntry -> Bool -> Bool -> Bool -> Parser RpbCoverageEntry
loop
                                  (Setter RpbCoverageEntry RpbCoverageEntry ByteString ByteString
-> ByteString -> RpbCoverageEntry -> RpbCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "ip" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ip") ByteString
y RpbCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
Prelude.False
                                  Bool
required'port
                        Word64
16
                          -> 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
"port"
                                RpbCoverageEntry -> Bool -> Bool -> Bool -> Parser RpbCoverageEntry
loop
                                  (Setter RpbCoverageEntry RpbCoverageEntry Word32 Word32
-> Word32 -> RpbCoverageEntry -> RpbCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "port" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"port") Word32
y RpbCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
required'ip
                                  Bool
Prelude.False
                        Word64
26
                          -> 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
"keyspace_desc"
                                RpbCoverageEntry -> Bool -> Bool -> Bool -> Parser RpbCoverageEntry
loop
                                  (Setter RpbCoverageEntry RpbCoverageEntry ByteString ByteString
-> ByteString -> RpbCoverageEntry -> RpbCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "keyspaceDesc" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"keyspaceDesc") ByteString
y RpbCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
required'ip
                                  Bool
required'port
                        Word64
34
                          -> 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
"cover_context"
                                RpbCoverageEntry -> Bool -> Bool -> Bool -> Parser RpbCoverageEntry
loop
                                  (Setter RpbCoverageEntry RpbCoverageEntry ByteString ByteString
-> ByteString -> RpbCoverageEntry -> RpbCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext") ByteString
y RpbCoverageEntry
x)
                                  Bool
Prelude.False
                                  Bool
required'ip
                                  Bool
required'port
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCoverageEntry -> Bool -> Bool -> Bool -> Parser RpbCoverageEntry
loop
                                  (Setter RpbCoverageEntry RpbCoverageEntry FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCoverageEntry -> RpbCoverageEntry
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 RpbCoverageEntry RpbCoverageEntry FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
required'ip
                                  Bool
required'port
      in
        Parser RpbCoverageEntry -> String -> Parser RpbCoverageEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbCoverageEntry -> Bool -> Bool -> Bool -> Parser RpbCoverageEntry
loop
                RpbCoverageEntry
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Bool
Prelude.True)
          String
"RpbCoverageEntry"
  buildMessage :: RpbCoverageEntry -> Builder
buildMessage
    = \ RpbCoverageEntry
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbCoverageEntry RpbCoverageEntry ByteString ByteString
-> RpbCoverageEntry -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "ip" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ip") RpbCoverageEntry
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                   ((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
                      (FoldLike Word32 RpbCoverageEntry RpbCoverageEntry Word32 Word32
-> RpbCoverageEntry -> Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "port" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"port") RpbCoverageEntry
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbCoverageEntry
  RpbCoverageEntry
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCoverageEntry -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'keyspaceDesc" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'keyspaceDesc") RpbCoverageEntry
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                         ((\ 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))
                            (FoldLike
  ByteString RpbCoverageEntry RpbCoverageEntry ByteString ByteString
-> RpbCoverageEntry -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                               (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext") RpbCoverageEntry
_x)))
                      (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                         (FoldLike
  FieldSet RpbCoverageEntry RpbCoverageEntry FieldSet FieldSet
-> RpbCoverageEntry -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbCoverageEntry RpbCoverageEntry FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCoverageEntry
_x)))))
instance Control.DeepSeq.NFData RpbCoverageEntry where
  rnf :: RpbCoverageEntry -> ()
rnf
    = \ RpbCoverageEntry
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCoverageEntry -> FieldSet
_RpbCoverageEntry'_unknownFields RpbCoverageEntry
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbCoverageEntry -> ByteString
_RpbCoverageEntry'ip RpbCoverageEntry
x__)
                (Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbCoverageEntry -> Word32
_RpbCoverageEntry'port RpbCoverageEntry
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbCoverageEntry -> Maybe ByteString
_RpbCoverageEntry'keyspaceDesc RpbCoverageEntry
x__)
                      (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbCoverageEntry -> ByteString
_RpbCoverageEntry'coverContext RpbCoverageEntry
x__) ()))))
{- | Fields :
     
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbCoverageReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbCoverageReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbCoverageReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.minPartitions' @:: Lens' RpbCoverageReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'minPartitions' @:: Lens' RpbCoverageReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.replaceCover' @:: Lens' RpbCoverageReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'replaceCover' @:: Lens' RpbCoverageReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.unavailableCover' @:: Lens' RpbCoverageReq [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'unavailableCover' @:: Lens' RpbCoverageReq (Data.Vector.Vector Data.ByteString.ByteString)@ -}
data RpbCoverageReq
  = RpbCoverageReq'_constructor {RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbCoverageReq -> ByteString
_RpbCoverageReq'bucket :: !Data.ByteString.ByteString,
                                 RpbCoverageReq -> Maybe Word32
_RpbCoverageReq'minPartitions :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'replaceCover :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbCoverageReq -> Vector ByteString
_RpbCoverageReq'unavailableCover :: !(Data.Vector.Vector Data.ByteString.ByteString),
                                 RpbCoverageReq -> FieldSet
_RpbCoverageReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCoverageReq -> RpbCoverageReq -> Bool
(RpbCoverageReq -> RpbCoverageReq -> Bool)
-> (RpbCoverageReq -> RpbCoverageReq -> Bool) -> Eq RpbCoverageReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCoverageReq -> RpbCoverageReq -> Bool
$c/= :: RpbCoverageReq -> RpbCoverageReq -> Bool
== :: RpbCoverageReq -> RpbCoverageReq -> Bool
$c== :: RpbCoverageReq -> RpbCoverageReq -> Bool
Prelude.Eq, Eq RpbCoverageReq
Eq RpbCoverageReq
-> (RpbCoverageReq -> RpbCoverageReq -> Ordering)
-> (RpbCoverageReq -> RpbCoverageReq -> Bool)
-> (RpbCoverageReq -> RpbCoverageReq -> Bool)
-> (RpbCoverageReq -> RpbCoverageReq -> Bool)
-> (RpbCoverageReq -> RpbCoverageReq -> Bool)
-> (RpbCoverageReq -> RpbCoverageReq -> RpbCoverageReq)
-> (RpbCoverageReq -> RpbCoverageReq -> RpbCoverageReq)
-> Ord RpbCoverageReq
RpbCoverageReq -> RpbCoverageReq -> Bool
RpbCoverageReq -> RpbCoverageReq -> Ordering
RpbCoverageReq -> RpbCoverageReq -> RpbCoverageReq
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 :: RpbCoverageReq -> RpbCoverageReq -> RpbCoverageReq
$cmin :: RpbCoverageReq -> RpbCoverageReq -> RpbCoverageReq
max :: RpbCoverageReq -> RpbCoverageReq -> RpbCoverageReq
$cmax :: RpbCoverageReq -> RpbCoverageReq -> RpbCoverageReq
>= :: RpbCoverageReq -> RpbCoverageReq -> Bool
$c>= :: RpbCoverageReq -> RpbCoverageReq -> Bool
> :: RpbCoverageReq -> RpbCoverageReq -> Bool
$c> :: RpbCoverageReq -> RpbCoverageReq -> Bool
<= :: RpbCoverageReq -> RpbCoverageReq -> Bool
$c<= :: RpbCoverageReq -> RpbCoverageReq -> Bool
< :: RpbCoverageReq -> RpbCoverageReq -> Bool
$c< :: RpbCoverageReq -> RpbCoverageReq -> Bool
compare :: RpbCoverageReq -> RpbCoverageReq -> Ordering
$ccompare :: RpbCoverageReq -> RpbCoverageReq -> Ordering
$cp1Ord :: Eq RpbCoverageReq
Prelude.Ord)
instance Prelude.Show RpbCoverageReq where
  showsPrec :: Int -> RpbCoverageReq -> ShowS
showsPrec Int
_ RpbCoverageReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCoverageReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCoverageReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCoverageReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Maybe ByteString)
-> (RpbCoverageReq -> Maybe ByteString -> RpbCoverageReq)
-> Lens
     RpbCoverageReq RpbCoverageReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'type'
           (\ RpbCoverageReq
x__ Maybe ByteString
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'type' :: Maybe ByteString
_RpbCoverageReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCoverageReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Maybe ByteString)
-> (RpbCoverageReq -> Maybe ByteString -> RpbCoverageReq)
-> Lens
     RpbCoverageReq RpbCoverageReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'type'
           (\ RpbCoverageReq
x__ Maybe ByteString
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'type' :: Maybe ByteString
_RpbCoverageReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCoverageReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> ByteString)
-> (RpbCoverageReq -> ByteString -> RpbCoverageReq)
-> Lens RpbCoverageReq RpbCoverageReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> ByteString
_RpbCoverageReq'bucket
           (\ RpbCoverageReq
x__ ByteString
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'bucket :: ByteString
_RpbCoverageReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCoverageReq "minPartitions" Data.Word.Word32 where
  fieldOf :: Proxy# "minPartitions"
-> (Word32 -> f Word32) -> RpbCoverageReq -> f RpbCoverageReq
fieldOf Proxy# "minPartitions"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Maybe Word32)
-> (RpbCoverageReq -> Maybe Word32 -> RpbCoverageReq)
-> Lens RpbCoverageReq RpbCoverageReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Maybe Word32
_RpbCoverageReq'minPartitions
           (\ RpbCoverageReq
x__ Maybe Word32
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'minPartitions :: Maybe Word32
_RpbCoverageReq'minPartitions = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCoverageReq "maybe'minPartitions" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'minPartitions"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "maybe'minPartitions"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Maybe Word32)
-> (RpbCoverageReq -> Maybe Word32 -> RpbCoverageReq)
-> Lens RpbCoverageReq RpbCoverageReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Maybe Word32
_RpbCoverageReq'minPartitions
           (\ RpbCoverageReq
x__ Maybe Word32
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'minPartitions :: Maybe Word32
_RpbCoverageReq'minPartitions = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCoverageReq "replaceCover" Data.ByteString.ByteString where
  fieldOf :: Proxy# "replaceCover"
-> (ByteString -> f ByteString)
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "replaceCover"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Maybe ByteString)
-> (RpbCoverageReq -> Maybe ByteString -> RpbCoverageReq)
-> Lens
     RpbCoverageReq RpbCoverageReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'replaceCover
           (\ RpbCoverageReq
x__ Maybe ByteString
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'replaceCover :: Maybe ByteString
_RpbCoverageReq'replaceCover = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbCoverageReq "maybe'replaceCover" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'replaceCover"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "maybe'replaceCover"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Maybe ByteString)
-> (RpbCoverageReq -> Maybe ByteString -> RpbCoverageReq)
-> Lens
     RpbCoverageReq RpbCoverageReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'replaceCover
           (\ RpbCoverageReq
x__ Maybe ByteString
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'replaceCover :: Maybe ByteString
_RpbCoverageReq'replaceCover = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbCoverageReq "unavailableCover" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "unavailableCover"
-> ([ByteString] -> f [ByteString])
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "unavailableCover"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Vector ByteString)
-> (RpbCoverageReq -> Vector ByteString -> RpbCoverageReq)
-> Lens
     RpbCoverageReq
     RpbCoverageReq
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Vector ByteString
_RpbCoverageReq'unavailableCover
           (\ RpbCoverageReq
x__ Vector ByteString
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'unavailableCover :: Vector ByteString
_RpbCoverageReq'unavailableCover = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField RpbCoverageReq "vec'unavailableCover" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'unavailableCover"
-> (Vector ByteString -> f (Vector ByteString))
-> RpbCoverageReq
-> f RpbCoverageReq
fieldOf Proxy# "vec'unavailableCover"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbCoverageReq -> f RpbCoverageReq)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> RpbCoverageReq
-> f RpbCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageReq -> Vector ByteString)
-> (RpbCoverageReq -> Vector ByteString -> RpbCoverageReq)
-> Lens
     RpbCoverageReq
     RpbCoverageReq
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageReq -> Vector ByteString
_RpbCoverageReq'unavailableCover
           (\ RpbCoverageReq
x__ Vector ByteString
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'unavailableCover :: Vector ByteString
_RpbCoverageReq'unavailableCover = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCoverageReq where
  messageName :: Proxy RpbCoverageReq -> Text
messageName Proxy RpbCoverageReq
_ = String -> Text
Data.Text.pack String
"RpbCoverageReq"
  packedMessageDescriptor :: Proxy RpbCoverageReq -> ByteString
packedMessageDescriptor Proxy RpbCoverageReq
_
    = ByteString
"\n\
      \\SORpbCoverageReq\DC2\DC2\n\
      \\EOTtype\CAN\SOH \SOH(\fR\EOTtype\DC2\SYN\n\
      \\ACKbucket\CAN\STX \STX(\fR\ACKbucket\DC2%\n\
      \\SOmin_partitions\CAN\ETX \SOH(\rR\rminPartitions\DC2#\n\
      \\rreplace_cover\CAN\EOT \SOH(\fR\freplaceCover\DC2+\n\
      \\DC1unavailable_cover\CAN\ENQ \ETX(\fR\DLEunavailableCover"
  packedFileDescriptor :: Proxy RpbCoverageReq -> ByteString
packedFileDescriptor Proxy RpbCoverageReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCoverageReq)
fieldsByTag
    = let
        type'__field_descriptor :: FieldDescriptor RpbCoverageReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCoverageReq ByteString
-> FieldDescriptor RpbCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCoverageReq RpbCoverageReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbCoverageReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageReq
        bucket__field_descriptor :: FieldDescriptor RpbCoverageReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCoverageReq ByteString
-> FieldDescriptor RpbCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbCoverageReq RpbCoverageReq ByteString ByteString
-> FieldAccessor RpbCoverageReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageReq
        minPartitions__field_descriptor :: FieldDescriptor RpbCoverageReq
minPartitions__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbCoverageReq Word32
-> FieldDescriptor RpbCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"min_partitions"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbCoverageReq RpbCoverageReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbCoverageReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'minPartitions" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'minPartitions")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageReq
        replaceCover__field_descriptor :: FieldDescriptor RpbCoverageReq
replaceCover__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCoverageReq ByteString
-> FieldDescriptor RpbCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"replace_cover"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbCoverageReq RpbCoverageReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbCoverageReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'replaceCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'replaceCover")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageReq
        unavailableCover__field_descriptor :: FieldDescriptor RpbCoverageReq
unavailableCover__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbCoverageReq ByteString
-> FieldDescriptor RpbCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"unavailable_cover"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' RpbCoverageReq [ByteString]
-> FieldAccessor RpbCoverageReq ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "unavailableCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"unavailableCover")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageReq
      in
        [(Tag, FieldDescriptor RpbCoverageReq)]
-> Map Tag (FieldDescriptor RpbCoverageReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCoverageReq
type'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbCoverageReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbCoverageReq
minPartitions__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbCoverageReq
replaceCover__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbCoverageReq
unavailableCover__field_descriptor)]
  unknownFields :: LensLike' f RpbCoverageReq FieldSet
unknownFields
    = (RpbCoverageReq -> FieldSet)
-> (RpbCoverageReq -> FieldSet -> RpbCoverageReq)
-> Lens' RpbCoverageReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCoverageReq -> FieldSet
_RpbCoverageReq'_unknownFields
        (\ RpbCoverageReq
x__ FieldSet
y__ -> RpbCoverageReq
x__ {_RpbCoverageReq'_unknownFields :: FieldSet
_RpbCoverageReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbCoverageReq
defMessage
    = RpbCoverageReq'_constructor :: Maybe ByteString
-> ByteString
-> Maybe Word32
-> Maybe ByteString
-> Vector ByteString
-> FieldSet
-> RpbCoverageReq
RpbCoverageReq'_constructor
        {_RpbCoverageReq'type' :: Maybe ByteString
_RpbCoverageReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCoverageReq'bucket :: ByteString
_RpbCoverageReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbCoverageReq'minPartitions :: Maybe Word32
_RpbCoverageReq'minPartitions = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbCoverageReq'replaceCover :: Maybe ByteString
_RpbCoverageReq'replaceCover = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbCoverageReq'unavailableCover :: Vector ByteString
_RpbCoverageReq'unavailableCover = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbCoverageReq'_unknownFields :: FieldSet
_RpbCoverageReq'_unknownFields = []}
  parseMessage :: Parser RpbCoverageReq
parseMessage
    = let
        loop ::
          RpbCoverageReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbCoverageReq
        loop :: RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop RpbCoverageReq
x Bool
required'bucket Growing Vector RealWorld ByteString
mutable'unavailableCover
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'unavailableCover <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                                   (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'unavailableCover)
                      (let
                         missing :: [String]
missing = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbCoverageReq -> Parser RpbCoverageReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCoverageReq RpbCoverageReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCoverageReq -> RpbCoverageReq
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 RpbCoverageReq RpbCoverageReq FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbCoverageReq
  RpbCoverageReq
  (Vector ByteString)
  (Vector ByteString)
-> Vector ByteString -> RpbCoverageReq -> RpbCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'unavailableCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'unavailableCover")
                              Vector ByteString
frozen'unavailableCover
                              RpbCoverageReq
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
"type"
                                RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop
                                  (Setter RpbCoverageReq RpbCoverageReq ByteString ByteString
-> ByteString -> RpbCoverageReq -> RpbCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbCoverageReq
x)
                                  Bool
required'bucket
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
                        Word64
18
                          -> 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
"bucket"
                                RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop
                                  (Setter RpbCoverageReq RpbCoverageReq ByteString ByteString
-> ByteString -> RpbCoverageReq -> RpbCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbCoverageReq
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
                        Word64
24
                          -> 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
"min_partitions"
                                RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop
                                  (Setter RpbCoverageReq RpbCoverageReq Word32 Word32
-> Word32 -> RpbCoverageReq -> RpbCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "minPartitions" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"minPartitions") Word32
y RpbCoverageReq
x)
                                  Bool
required'bucket
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
                        Word64
34
                          -> 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
"replace_cover"
                                RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop
                                  (Setter RpbCoverageReq RpbCoverageReq ByteString ByteString
-> ByteString -> RpbCoverageReq -> RpbCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "replaceCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"replaceCover") ByteString
y RpbCoverageReq
x)
                                  Bool
required'bucket
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
                        Word64
42
                          -> 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
"unavailable_cover"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'unavailableCover ByteString
y)
                                RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop RpbCoverageReq
x Bool
required'bucket Growing Vector RealWorld ByteString
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop
                                  (Setter RpbCoverageReq RpbCoverageReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCoverageReq -> RpbCoverageReq
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 RpbCoverageReq RpbCoverageReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCoverageReq
x)
                                  Bool
required'bucket
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
      in
        Parser RpbCoverageReq -> String -> Parser RpbCoverageReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'unavailableCover <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                            IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbCoverageReq
loop
                RpbCoverageReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Growing Vector RealWorld ByteString
mutable'unavailableCover)
          String
"RpbCoverageReq"
  buildMessage :: RpbCoverageReq -> Builder
buildMessage
    = \ RpbCoverageReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe ByteString)
  RpbCoverageReq
  RpbCoverageReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCoverageReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbCoverageReq
_x
              of
                Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just ByteString
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString RpbCoverageReq RpbCoverageReq ByteString ByteString
-> RpbCoverageReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbCoverageReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32)
  RpbCoverageReq
  RpbCoverageReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbCoverageReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'minPartitions" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'minPartitions") RpbCoverageReq
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe ByteString)
  RpbCoverageReq
  RpbCoverageReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbCoverageReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                             (forall s a (f :: * -> *).
(HasField s "maybe'replaceCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'replaceCover") RpbCoverageReq
_x
                       of
                         Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just ByteString
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((\ 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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                            (\ ByteString
_v
                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                                    ((\ 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))
                            (FoldLike
  (Vector ByteString)
  RpbCoverageReq
  RpbCoverageReq
  (Vector ByteString)
  (Vector ByteString)
-> RpbCoverageReq -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                               (forall s a (f :: * -> *).
(HasField s "vec'unavailableCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'unavailableCover") RpbCoverageReq
_x))
                         (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                            (FoldLike FieldSet RpbCoverageReq RpbCoverageReq FieldSet FieldSet
-> RpbCoverageReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbCoverageReq RpbCoverageReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCoverageReq
_x))))))
instance Control.DeepSeq.NFData RpbCoverageReq where
  rnf :: RpbCoverageReq -> ()
rnf
    = \ RpbCoverageReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCoverageReq -> FieldSet
_RpbCoverageReq'_unknownFields RpbCoverageReq
x__)
             (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'type' RpbCoverageReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbCoverageReq -> ByteString
_RpbCoverageReq'bucket RpbCoverageReq
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbCoverageReq -> Maybe Word32
_RpbCoverageReq'minPartitions RpbCoverageReq
x__)
                      (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbCoverageReq -> Maybe ByteString
_RpbCoverageReq'replaceCover RpbCoverageReq
x__)
                         (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbCoverageReq -> Vector ByteString
_RpbCoverageReq'unavailableCover RpbCoverageReq
x__) ())))))
{- | Fields :
     
         * 'Proto.Riak_Fields.entries' @:: Lens' RpbCoverageResp [RpbCoverageEntry]@
         * 'Proto.Riak_Fields.vec'entries' @:: Lens' RpbCoverageResp (Data.Vector.Vector RpbCoverageEntry)@ -}
data RpbCoverageResp
  = RpbCoverageResp'_constructor {RpbCoverageResp -> Vector RpbCoverageEntry
_RpbCoverageResp'entries :: !(Data.Vector.Vector RpbCoverageEntry),
                                  RpbCoverageResp -> FieldSet
_RpbCoverageResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbCoverageResp -> RpbCoverageResp -> Bool
(RpbCoverageResp -> RpbCoverageResp -> Bool)
-> (RpbCoverageResp -> RpbCoverageResp -> Bool)
-> Eq RpbCoverageResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbCoverageResp -> RpbCoverageResp -> Bool
$c/= :: RpbCoverageResp -> RpbCoverageResp -> Bool
== :: RpbCoverageResp -> RpbCoverageResp -> Bool
$c== :: RpbCoverageResp -> RpbCoverageResp -> Bool
Prelude.Eq, Eq RpbCoverageResp
Eq RpbCoverageResp
-> (RpbCoverageResp -> RpbCoverageResp -> Ordering)
-> (RpbCoverageResp -> RpbCoverageResp -> Bool)
-> (RpbCoverageResp -> RpbCoverageResp -> Bool)
-> (RpbCoverageResp -> RpbCoverageResp -> Bool)
-> (RpbCoverageResp -> RpbCoverageResp -> Bool)
-> (RpbCoverageResp -> RpbCoverageResp -> RpbCoverageResp)
-> (RpbCoverageResp -> RpbCoverageResp -> RpbCoverageResp)
-> Ord RpbCoverageResp
RpbCoverageResp -> RpbCoverageResp -> Bool
RpbCoverageResp -> RpbCoverageResp -> Ordering
RpbCoverageResp -> RpbCoverageResp -> RpbCoverageResp
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 :: RpbCoverageResp -> RpbCoverageResp -> RpbCoverageResp
$cmin :: RpbCoverageResp -> RpbCoverageResp -> RpbCoverageResp
max :: RpbCoverageResp -> RpbCoverageResp -> RpbCoverageResp
$cmax :: RpbCoverageResp -> RpbCoverageResp -> RpbCoverageResp
>= :: RpbCoverageResp -> RpbCoverageResp -> Bool
$c>= :: RpbCoverageResp -> RpbCoverageResp -> Bool
> :: RpbCoverageResp -> RpbCoverageResp -> Bool
$c> :: RpbCoverageResp -> RpbCoverageResp -> Bool
<= :: RpbCoverageResp -> RpbCoverageResp -> Bool
$c<= :: RpbCoverageResp -> RpbCoverageResp -> Bool
< :: RpbCoverageResp -> RpbCoverageResp -> Bool
$c< :: RpbCoverageResp -> RpbCoverageResp -> Bool
compare :: RpbCoverageResp -> RpbCoverageResp -> Ordering
$ccompare :: RpbCoverageResp -> RpbCoverageResp -> Ordering
$cp1Ord :: Eq RpbCoverageResp
Prelude.Ord)
instance Prelude.Show RpbCoverageResp where
  showsPrec :: Int -> RpbCoverageResp -> ShowS
showsPrec Int
_ RpbCoverageResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbCoverageResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbCoverageResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbCoverageResp "entries" [RpbCoverageEntry] where
  fieldOf :: Proxy# "entries"
-> ([RpbCoverageEntry] -> f [RpbCoverageEntry])
-> RpbCoverageResp
-> f RpbCoverageResp
fieldOf Proxy# "entries"
_
    = ((Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
 -> RpbCoverageResp -> f RpbCoverageResp)
-> (([RpbCoverageEntry] -> f [RpbCoverageEntry])
    -> Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
-> ([RpbCoverageEntry] -> f [RpbCoverageEntry])
-> RpbCoverageResp
-> f RpbCoverageResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageResp -> Vector RpbCoverageEntry)
-> (RpbCoverageResp -> Vector RpbCoverageEntry -> RpbCoverageResp)
-> Lens
     RpbCoverageResp
     RpbCoverageResp
     (Vector RpbCoverageEntry)
     (Vector RpbCoverageEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageResp -> Vector RpbCoverageEntry
_RpbCoverageResp'entries
           (\ RpbCoverageResp
x__ Vector RpbCoverageEntry
y__ -> RpbCoverageResp
x__ {_RpbCoverageResp'entries :: Vector RpbCoverageEntry
_RpbCoverageResp'entries = Vector RpbCoverageEntry
y__}))
        ((Vector RpbCoverageEntry -> [RpbCoverageEntry])
-> (Vector RpbCoverageEntry
    -> [RpbCoverageEntry] -> Vector RpbCoverageEntry)
-> Lens
     (Vector RpbCoverageEntry)
     (Vector RpbCoverageEntry)
     [RpbCoverageEntry]
     [RpbCoverageEntry]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbCoverageEntry -> [RpbCoverageEntry]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbCoverageEntry
_ [RpbCoverageEntry]
y__ -> [RpbCoverageEntry] -> Vector RpbCoverageEntry
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbCoverageEntry]
y__))
instance Data.ProtoLens.Field.HasField RpbCoverageResp "vec'entries" (Data.Vector.Vector RpbCoverageEntry) where
  fieldOf :: Proxy# "vec'entries"
-> (Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
-> RpbCoverageResp
-> f RpbCoverageResp
fieldOf Proxy# "vec'entries"
_
    = ((Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
 -> RpbCoverageResp -> f RpbCoverageResp)
-> ((Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
    -> Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
-> (Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
-> RpbCoverageResp
-> f RpbCoverageResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbCoverageResp -> Vector RpbCoverageEntry)
-> (RpbCoverageResp -> Vector RpbCoverageEntry -> RpbCoverageResp)
-> Lens
     RpbCoverageResp
     RpbCoverageResp
     (Vector RpbCoverageEntry)
     (Vector RpbCoverageEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbCoverageResp -> Vector RpbCoverageEntry
_RpbCoverageResp'entries
           (\ RpbCoverageResp
x__ Vector RpbCoverageEntry
y__ -> RpbCoverageResp
x__ {_RpbCoverageResp'entries :: Vector RpbCoverageEntry
_RpbCoverageResp'entries = Vector RpbCoverageEntry
y__}))
        (Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry))
-> Vector RpbCoverageEntry -> f (Vector RpbCoverageEntry)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbCoverageResp where
  messageName :: Proxy RpbCoverageResp -> Text
messageName Proxy RpbCoverageResp
_ = String -> Text
Data.Text.pack String
"RpbCoverageResp"
  packedMessageDescriptor :: Proxy RpbCoverageResp -> ByteString
packedMessageDescriptor Proxy RpbCoverageResp
_
    = ByteString
"\n\
      \\SIRpbCoverageResp\DC2+\n\
      \\aentries\CAN\SOH \ETX(\v2\DC1.RpbCoverageEntryR\aentries"
  packedFileDescriptor :: Proxy RpbCoverageResp -> ByteString
packedFileDescriptor Proxy RpbCoverageResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbCoverageResp)
fieldsByTag
    = let
        entries__field_descriptor :: FieldDescriptor RpbCoverageResp
entries__field_descriptor
          = String
-> FieldTypeDescriptor RpbCoverageEntry
-> FieldAccessor RpbCoverageResp RpbCoverageEntry
-> FieldDescriptor RpbCoverageResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"entries"
              (MessageOrGroup -> FieldTypeDescriptor RpbCoverageEntry
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbCoverageEntry)
              (Packing
-> Lens' RpbCoverageResp [RpbCoverageEntry]
-> FieldAccessor RpbCoverageResp RpbCoverageEntry
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "entries" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"entries")) ::
              Data.ProtoLens.FieldDescriptor RpbCoverageResp
      in
        [(Tag, FieldDescriptor RpbCoverageResp)]
-> Map Tag (FieldDescriptor RpbCoverageResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbCoverageResp
entries__field_descriptor)]
  unknownFields :: LensLike' f RpbCoverageResp FieldSet
unknownFields
    = (RpbCoverageResp -> FieldSet)
-> (RpbCoverageResp -> FieldSet -> RpbCoverageResp)
-> Lens' RpbCoverageResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbCoverageResp -> FieldSet
_RpbCoverageResp'_unknownFields
        (\ RpbCoverageResp
x__ FieldSet
y__ -> RpbCoverageResp
x__ {_RpbCoverageResp'_unknownFields :: FieldSet
_RpbCoverageResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbCoverageResp
defMessage
    = RpbCoverageResp'_constructor :: Vector RpbCoverageEntry -> FieldSet -> RpbCoverageResp
RpbCoverageResp'_constructor
        {_RpbCoverageResp'entries :: Vector RpbCoverageEntry
_RpbCoverageResp'entries = Vector RpbCoverageEntry
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbCoverageResp'_unknownFields :: FieldSet
_RpbCoverageResp'_unknownFields = []}
  parseMessage :: Parser RpbCoverageResp
parseMessage
    = let
        loop ::
          RpbCoverageResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbCoverageEntry
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbCoverageResp
        loop :: RpbCoverageResp
-> Growing Vector RealWorld RpbCoverageEntry
-> Parser RpbCoverageResp
loop RpbCoverageResp
x Growing Vector RealWorld RpbCoverageEntry
mutable'entries
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbCoverageEntry
frozen'entries <- IO (Vector RpbCoverageEntry) -> Parser (Vector RpbCoverageEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) RpbCoverageEntry
-> IO (Vector RpbCoverageEntry)
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 RpbCoverageEntry
Growing Vector (PrimState IO) RpbCoverageEntry
mutable'entries)
                      (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]))))
                      RpbCoverageResp -> Parser RpbCoverageResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbCoverageResp RpbCoverageResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCoverageResp -> RpbCoverageResp
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 RpbCoverageResp RpbCoverageResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbCoverageResp
  RpbCoverageResp
  (Vector RpbCoverageEntry)
  (Vector RpbCoverageEntry)
-> Vector RpbCoverageEntry -> RpbCoverageResp -> RpbCoverageResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'entries" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'entries") Vector RpbCoverageEntry
frozen'entries RpbCoverageResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbCoverageEntry
y <- Parser RpbCoverageEntry -> String -> Parser RpbCoverageEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbCoverageEntry -> Parser RpbCoverageEntry
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 RpbCoverageEntry
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"entries"
                                Growing Vector RealWorld RpbCoverageEntry
v <- IO (Growing Vector RealWorld RpbCoverageEntry)
-> Parser (Growing Vector RealWorld RpbCoverageEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbCoverageEntry
-> RpbCoverageEntry
-> IO (Growing Vector (PrimState IO) RpbCoverageEntry)
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 RpbCoverageEntry
Growing Vector (PrimState IO) RpbCoverageEntry
mutable'entries RpbCoverageEntry
y)
                                RpbCoverageResp
-> Growing Vector RealWorld RpbCoverageEntry
-> Parser RpbCoverageResp
loop RpbCoverageResp
x Growing Vector RealWorld RpbCoverageEntry
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbCoverageResp
-> Growing Vector RealWorld RpbCoverageEntry
-> Parser RpbCoverageResp
loop
                                  (Setter RpbCoverageResp RpbCoverageResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbCoverageResp -> RpbCoverageResp
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 RpbCoverageResp RpbCoverageResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbCoverageResp
x)
                                  Growing Vector RealWorld RpbCoverageEntry
mutable'entries
      in
        Parser RpbCoverageResp -> String -> Parser RpbCoverageResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbCoverageEntry
mutable'entries <- IO (Growing Vector RealWorld RpbCoverageEntry)
-> Parser (Growing Vector RealWorld RpbCoverageEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld RpbCoverageEntry)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbCoverageResp
-> Growing Vector RealWorld RpbCoverageEntry
-> Parser RpbCoverageResp
loop RpbCoverageResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbCoverageEntry
mutable'entries)
          String
"RpbCoverageResp"
  buildMessage :: RpbCoverageResp -> Builder
buildMessage
    = \ RpbCoverageResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbCoverageEntry -> Builder) -> Vector RpbCoverageEntry -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbCoverageEntry
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbCoverageEntry -> ByteString) -> RpbCoverageEntry -> 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))
                           RpbCoverageEntry -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbCoverageEntry
_v))
                (FoldLike
  (Vector RpbCoverageEntry)
  RpbCoverageResp
  RpbCoverageResp
  (Vector RpbCoverageEntry)
  (Vector RpbCoverageEntry)
-> RpbCoverageResp -> Vector RpbCoverageEntry
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'entries" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'entries") RpbCoverageResp
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet RpbCoverageResp RpbCoverageResp FieldSet FieldSet
-> RpbCoverageResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbCoverageResp RpbCoverageResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbCoverageResp
_x))
instance Control.DeepSeq.NFData RpbCoverageResp where
  rnf :: RpbCoverageResp -> ()
rnf
    = \ RpbCoverageResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbCoverageResp -> FieldSet
_RpbCoverageResp'_unknownFields RpbCoverageResp
x__)
             (Vector RpbCoverageEntry -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbCoverageResp -> Vector RpbCoverageEntry
_RpbCoverageResp'entries RpbCoverageResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbDelReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbDelReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.rw' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'rw' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.vclock' @:: Lens' RpbDelReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'vclock' @:: Lens' RpbDelReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.r' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'r' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.w' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'w' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pr' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pr' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pw' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pw' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.dw' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'dw' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.sloppyQuorum' @:: Lens' RpbDelReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'sloppyQuorum' @:: Lens' RpbDelReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.nVal' @:: Lens' RpbDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'nVal' @:: Lens' RpbDelReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbDelReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbDelReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbDelReq
  = RpbDelReq'_constructor {RpbDelReq -> ByteString
_RpbDelReq'bucket :: !Data.ByteString.ByteString,
                            RpbDelReq -> ByteString
_RpbDelReq'key :: !Data.ByteString.ByteString,
                            RpbDelReq -> Maybe Word32
_RpbDelReq'rw :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe ByteString
_RpbDelReq'vclock :: !(Prelude.Maybe Data.ByteString.ByteString),
                            RpbDelReq -> Maybe Word32
_RpbDelReq'r :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe Word32
_RpbDelReq'w :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe Word32
_RpbDelReq'pr :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe Word32
_RpbDelReq'pw :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe Word32
_RpbDelReq'dw :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe Word32
_RpbDelReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe Bool
_RpbDelReq'sloppyQuorum :: !(Prelude.Maybe Prelude.Bool),
                            RpbDelReq -> Maybe Word32
_RpbDelReq'nVal :: !(Prelude.Maybe Data.Word.Word32),
                            RpbDelReq -> Maybe ByteString
_RpbDelReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                            RpbDelReq -> FieldSet
_RpbDelReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbDelReq -> RpbDelReq -> Bool
(RpbDelReq -> RpbDelReq -> Bool)
-> (RpbDelReq -> RpbDelReq -> Bool) -> Eq RpbDelReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbDelReq -> RpbDelReq -> Bool
$c/= :: RpbDelReq -> RpbDelReq -> Bool
== :: RpbDelReq -> RpbDelReq -> Bool
$c== :: RpbDelReq -> RpbDelReq -> Bool
Prelude.Eq, Eq RpbDelReq
Eq RpbDelReq
-> (RpbDelReq -> RpbDelReq -> Ordering)
-> (RpbDelReq -> RpbDelReq -> Bool)
-> (RpbDelReq -> RpbDelReq -> Bool)
-> (RpbDelReq -> RpbDelReq -> Bool)
-> (RpbDelReq -> RpbDelReq -> Bool)
-> (RpbDelReq -> RpbDelReq -> RpbDelReq)
-> (RpbDelReq -> RpbDelReq -> RpbDelReq)
-> Ord RpbDelReq
RpbDelReq -> RpbDelReq -> Bool
RpbDelReq -> RpbDelReq -> Ordering
RpbDelReq -> RpbDelReq -> RpbDelReq
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 :: RpbDelReq -> RpbDelReq -> RpbDelReq
$cmin :: RpbDelReq -> RpbDelReq -> RpbDelReq
max :: RpbDelReq -> RpbDelReq -> RpbDelReq
$cmax :: RpbDelReq -> RpbDelReq -> RpbDelReq
>= :: RpbDelReq -> RpbDelReq -> Bool
$c>= :: RpbDelReq -> RpbDelReq -> Bool
> :: RpbDelReq -> RpbDelReq -> Bool
$c> :: RpbDelReq -> RpbDelReq -> Bool
<= :: RpbDelReq -> RpbDelReq -> Bool
$c<= :: RpbDelReq -> RpbDelReq -> Bool
< :: RpbDelReq -> RpbDelReq -> Bool
$c< :: RpbDelReq -> RpbDelReq -> Bool
compare :: RpbDelReq -> RpbDelReq -> Ordering
$ccompare :: RpbDelReq -> RpbDelReq -> Ordering
$cp1Ord :: Eq RpbDelReq
Prelude.Ord)
instance Prelude.Show RpbDelReq where
  showsPrec :: Int -> RpbDelReq -> ShowS
showsPrec Int
_ RpbDelReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbDelReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbDelReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbDelReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString) -> RpbDelReq -> f RpbDelReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> ByteString)
-> (RpbDelReq -> ByteString -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> ByteString
_RpbDelReq'bucket (\ RpbDelReq
x__ ByteString
y__ -> RpbDelReq
x__ {_RpbDelReq'bucket :: ByteString
_RpbDelReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString) -> RpbDelReq -> f RpbDelReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> ByteString)
-> (RpbDelReq -> ByteString -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> ByteString
_RpbDelReq'key (\ RpbDelReq
x__ ByteString
y__ -> RpbDelReq
x__ {_RpbDelReq'key :: ByteString
_RpbDelReq'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "rw" Data.Word.Word32 where
  fieldOf :: Proxy# "rw" -> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "rw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'rw (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'rw :: Maybe Word32
_RpbDelReq'rw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'rw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'rw"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'rw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'rw (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'rw :: Maybe Word32
_RpbDelReq'rw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "vclock" Data.ByteString.ByteString where
  fieldOf :: Proxy# "vclock"
-> (ByteString -> f ByteString) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbDelReq -> f RpbDelReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe ByteString)
-> (RpbDelReq -> Maybe ByteString -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe ByteString
_RpbDelReq'vclock (\ RpbDelReq
x__ Maybe ByteString
y__ -> RpbDelReq
x__ {_RpbDelReq'vclock :: Maybe ByteString
_RpbDelReq'vclock = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'vclock" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'vclock"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbDelReq
-> f RpbDelReq
fieldOf Proxy# "maybe'vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbDelReq -> f RpbDelReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe ByteString)
-> (RpbDelReq -> Maybe ByteString -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe ByteString
_RpbDelReq'vclock (\ RpbDelReq
x__ Maybe ByteString
y__ -> RpbDelReq
x__ {_RpbDelReq'vclock :: Maybe ByteString
_RpbDelReq'vclock = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "r" Data.Word.Word32 where
  fieldOf :: Proxy# "r" -> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "r"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'r (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'r :: Maybe Word32
_RpbDelReq'r = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'r" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'r"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'r"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'r (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'r :: Maybe Word32
_RpbDelReq'r = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "w" Data.Word.Word32 where
  fieldOf :: Proxy# "w" -> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "w"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'w (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'w :: Maybe Word32
_RpbDelReq'w = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'w" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'w"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'w"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'w (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'w :: Maybe Word32
_RpbDelReq'w = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "pr" Data.Word.Word32 where
  fieldOf :: Proxy# "pr" -> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "pr"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'pr (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'pr :: Maybe Word32
_RpbDelReq'pr = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'pr" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pr"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'pr"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'pr (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'pr :: Maybe Word32
_RpbDelReq'pr = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "pw" Data.Word.Word32 where
  fieldOf :: Proxy# "pw" -> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "pw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'pw (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'pw :: Maybe Word32
_RpbDelReq'pw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'pw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pw"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'pw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'pw (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'pw :: Maybe Word32
_RpbDelReq'pw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "dw" Data.Word.Word32 where
  fieldOf :: Proxy# "dw" -> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "dw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'dw (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'dw :: Maybe Word32
_RpbDelReq'dw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'dw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'dw"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'dw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'dw (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'dw :: Maybe Word32
_RpbDelReq'dw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'timeout (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'timeout :: Maybe Word32
_RpbDelReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'timeout (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'timeout :: Maybe Word32
_RpbDelReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "sloppyQuorum" Prelude.Bool where
  fieldOf :: Proxy# "sloppyQuorum"
-> (Bool -> f Bool) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbDelReq -> f RpbDelReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Bool)
-> (RpbDelReq -> Maybe Bool -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Bool
_RpbDelReq'sloppyQuorum
           (\ RpbDelReq
x__ Maybe Bool
y__ -> RpbDelReq
x__ {_RpbDelReq'sloppyQuorum :: Maybe Bool
_RpbDelReq'sloppyQuorum = 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 RpbDelReq "maybe'sloppyQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'sloppyQuorum"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Bool)
-> (RpbDelReq -> Maybe Bool -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Bool
_RpbDelReq'sloppyQuorum
           (\ RpbDelReq
x__ Maybe Bool
y__ -> RpbDelReq
x__ {_RpbDelReq'sloppyQuorum :: Maybe Bool
_RpbDelReq'sloppyQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "nVal" Data.Word.Word32 where
  fieldOf :: Proxy# "nVal" -> (Word32 -> f Word32) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'nVal (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'nVal :: Maybe Word32
_RpbDelReq'nVal = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'nVal" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'nVal"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "maybe'nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbDelReq -> f RpbDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe Word32)
-> (RpbDelReq -> Maybe Word32 -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe Word32
_RpbDelReq'nVal (\ RpbDelReq
x__ Maybe Word32
y__ -> RpbDelReq
x__ {_RpbDelReq'nVal :: Maybe Word32
_RpbDelReq'nVal = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbDelReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString) -> RpbDelReq -> f RpbDelReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbDelReq -> f RpbDelReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe ByteString)
-> (RpbDelReq -> Maybe ByteString -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe ByteString
_RpbDelReq'type' (\ RpbDelReq
x__ Maybe ByteString
y__ -> RpbDelReq
x__ {_RpbDelReq'type' :: Maybe ByteString
_RpbDelReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbDelReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbDelReq
-> f RpbDelReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbDelReq -> f RpbDelReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbDelReq
-> f RpbDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbDelReq -> Maybe ByteString)
-> (RpbDelReq -> Maybe ByteString -> RpbDelReq)
-> Lens RpbDelReq RpbDelReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbDelReq -> Maybe ByteString
_RpbDelReq'type' (\ RpbDelReq
x__ Maybe ByteString
y__ -> RpbDelReq
x__ {_RpbDelReq'type' :: Maybe ByteString
_RpbDelReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbDelReq where
  messageName :: Proxy RpbDelReq -> Text
messageName Proxy RpbDelReq
_ = String -> Text
Data.Text.pack String
"RpbDelReq"
  packedMessageDescriptor :: Proxy RpbDelReq -> ByteString
packedMessageDescriptor Proxy RpbDelReq
_
    = ByteString
"\n\
      \\tRpbDelReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\SO\n\
      \\STXrw\CAN\ETX \SOH(\rR\STXrw\DC2\SYN\n\
      \\ACKvclock\CAN\EOT \SOH(\fR\ACKvclock\DC2\f\n\
      \\SOHr\CAN\ENQ \SOH(\rR\SOHr\DC2\f\n\
      \\SOHw\CAN\ACK \SOH(\rR\SOHw\DC2\SO\n\
      \\STXpr\CAN\a \SOH(\rR\STXpr\DC2\SO\n\
      \\STXpw\CAN\b \SOH(\rR\STXpw\DC2\SO\n\
      \\STXdw\CAN\t \SOH(\rR\STXdw\DC2\CAN\n\
      \\atimeout\CAN\n\
      \ \SOH(\rR\atimeout\DC2#\n\
      \\rsloppy_quorum\CAN\v \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
      \\ENQn_val\CAN\f \SOH(\rR\EOTnVal\DC2\DC2\n\
      \\EOTtype\CAN\r \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbDelReq -> ByteString
packedFileDescriptor Proxy RpbDelReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbDelReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbDelReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbDelReq ByteString
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbDelReq RpbDelReq ByteString ByteString
-> FieldAccessor RpbDelReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        key__field_descriptor :: FieldDescriptor RpbDelReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbDelReq ByteString
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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 RpbDelReq RpbDelReq ByteString ByteString
-> FieldAccessor RpbDelReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        rw__field_descriptor :: FieldDescriptor RpbDelReq
rw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"rw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'rw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rw")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        vclock__field_descriptor :: FieldDescriptor RpbDelReq
vclock__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbDelReq ByteString
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"vclock"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbDelReq RpbDelReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbDelReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        r__field_descriptor :: FieldDescriptor RpbDelReq
r__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"r"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        w__field_descriptor :: FieldDescriptor RpbDelReq
w__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"w"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        pr__field_descriptor :: FieldDescriptor RpbDelReq
pr__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pr"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        pw__field_descriptor :: FieldDescriptor RpbDelReq
pw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        dw__field_descriptor :: FieldDescriptor RpbDelReq
dw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"dw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        timeout__field_descriptor :: FieldDescriptor RpbDelReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        sloppyQuorum__field_descriptor :: FieldDescriptor RpbDelReq
sloppyQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbDelReq Bool
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"sloppy_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbDelReq RpbDelReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbDelReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        nVal__field_descriptor :: FieldDescriptor RpbDelReq
nVal__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbDelReq Word32
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"n_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)
              (Lens RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
        type'__field_descriptor :: FieldDescriptor RpbDelReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbDelReq ByteString
-> FieldDescriptor RpbDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbDelReq RpbDelReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbDelReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbDelReq
      in
        [(Tag, FieldDescriptor RpbDelReq)]
-> Map Tag (FieldDescriptor RpbDelReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbDelReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbDelReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbDelReq
rw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbDelReq
vclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbDelReq
r__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbDelReq
w__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbDelReq
pr__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbDelReq
pw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbDelReq
dw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbDelReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor RpbDelReq
sloppyQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
12, FieldDescriptor RpbDelReq
nVal__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
13, FieldDescriptor RpbDelReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbDelReq FieldSet
unknownFields
    = (RpbDelReq -> FieldSet)
-> (RpbDelReq -> FieldSet -> RpbDelReq) -> Lens' RpbDelReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbDelReq -> FieldSet
_RpbDelReq'_unknownFields
        (\ RpbDelReq
x__ FieldSet
y__ -> RpbDelReq
x__ {_RpbDelReq'_unknownFields :: FieldSet
_RpbDelReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbDelReq
defMessage
    = RpbDelReq'_constructor :: ByteString
-> ByteString
-> Maybe Word32
-> Maybe ByteString
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Word32
-> Maybe ByteString
-> FieldSet
-> RpbDelReq
RpbDelReq'_constructor
        {_RpbDelReq'bucket :: ByteString
_RpbDelReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbDelReq'key :: ByteString
_RpbDelReq'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbDelReq'rw :: Maybe Word32
_RpbDelReq'rw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'vclock :: Maybe ByteString
_RpbDelReq'vclock = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'r :: Maybe Word32
_RpbDelReq'r = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _RpbDelReq'w :: Maybe Word32
_RpbDelReq'w = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'pr :: Maybe Word32
_RpbDelReq'pr = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _RpbDelReq'pw :: Maybe Word32
_RpbDelReq'pw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'dw :: Maybe Word32
_RpbDelReq'dw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'timeout :: Maybe Word32
_RpbDelReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'sloppyQuorum :: Maybe Bool
_RpbDelReq'sloppyQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'nVal :: Maybe Word32
_RpbDelReq'nVal = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbDelReq'type' :: Maybe ByteString
_RpbDelReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing, _RpbDelReq'_unknownFields :: FieldSet
_RpbDelReq'_unknownFields = []}
  parseMessage :: Parser RpbDelReq
parseMessage
    = let
        loop ::
          RpbDelReq
          -> Prelude.Bool
             -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser RpbDelReq
        loop :: RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop RpbDelReq
x Bool
required'bucket Bool
required'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbDelReq -> Parser RpbDelReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbDelReq RpbDelReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbDelReq -> RpbDelReq
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 RpbDelReq RpbDelReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbDelReq
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
"bucket"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq ByteString ByteString
-> ByteString -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbDelReq
x)
                                  Bool
Prelude.False
                                  Bool
required'key
                        Word64
18
                          -> 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
"key"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq ByteString ByteString
-> ByteString -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
24
                          -> 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
"rw"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "rw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rw") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
34
                          -> 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
"vclock"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq ByteString ByteString
-> ByteString -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vclock") ByteString
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
40
                          -> 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
"r"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"r") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
48
                          -> 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
"w"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"w") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
56
                          -> 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
"pr"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pr") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
64
                          -> 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
"pw"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pw") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
72
                          -> 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
"dw"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"dw") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
80
                          -> 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
"timeout"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
88
                          -> 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
"sloppy_quorum"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Bool Bool
-> Bool -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"sloppyQuorum") Bool
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
96
                          -> 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
"n_val"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq Word32 Word32
-> Word32 -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nVal") Word32
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
106
                          -> 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
"type"
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq ByteString ByteString
-> ByteString -> RpbDelReq -> RpbDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop
                                  (Setter RpbDelReq RpbDelReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbDelReq -> RpbDelReq
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 RpbDelReq RpbDelReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbDelReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
      in
        Parser RpbDelReq -> String -> Parser RpbDelReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbDelReq -> Bool -> Bool -> Parser RpbDelReq
loop RpbDelReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbDelReq"
  buildMessage :: RpbDelReq -> Builder
buildMessage
    = \ RpbDelReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbDelReq RpbDelReq ByteString ByteString
-> RpbDelReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbDelReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike ByteString RpbDelReq RpbDelReq ByteString ByteString
-> RpbDelReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") RpbDelReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'rw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rw") RpbDelReq
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe ByteString)
  RpbDelReq
  RpbDelReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbDelReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock") RpbDelReq
_x
                       of
                         Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just ByteString
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((\ 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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r") RpbDelReq
_x
                          of
                            Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Word32
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w") RpbDelReq
_x
                             of
                               Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Word32
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      ((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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr") RpbDelReq
_x
                                of
                                  Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Word32
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw") RpbDelReq
_x
                                   of
                                     Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Word32
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw") RpbDelReq
_x
                                      of
                                        Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just Word32
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
72)
                                               ((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))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") RpbDelReq
_x
                                         of
                                           Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just Word32
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
80)
                                                  ((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))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike (Maybe Bool) RpbDelReq RpbDelReq (Maybe Bool) (Maybe Bool)
-> RpbDelReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")
                                                  RpbDelReq
_x
                                            of
                                              Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Bool
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                              (case
                                                   FoldLike
  (Maybe Word32) RpbDelReq RpbDelReq (Maybe Word32) (Maybe Word32)
-> RpbDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                     (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal") RpbDelReq
_x
                                               of
                                                 Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                 (Prelude.Just Word32
_v)
                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
96)
                                                        ((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))
                                              (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                 (case
                                                      FoldLike
  (Maybe ByteString)
  RpbDelReq
  RpbDelReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbDelReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                        (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")
                                                        RpbDelReq
_x
                                                  of
                                                    Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                    (Prelude.Just ByteString
_v)
                                                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                              Word64
106)
                                                           ((\ 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 RpbDelReq RpbDelReq FieldSet FieldSet
-> RpbDelReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                       FoldLike FieldSet RpbDelReq RpbDelReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbDelReq
_x))))))))))))))
instance Control.DeepSeq.NFData RpbDelReq where
  rnf :: RpbDelReq -> ()
rnf
    = \ RpbDelReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbDelReq -> FieldSet
_RpbDelReq'_unknownFields RpbDelReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbDelReq -> ByteString
_RpbDelReq'bucket RpbDelReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbDelReq -> ByteString
_RpbDelReq'key RpbDelReq
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbDelReq -> Maybe Word32
_RpbDelReq'rw RpbDelReq
x__)
                      (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbDelReq -> Maybe ByteString
_RpbDelReq'vclock RpbDelReq
x__)
                         (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbDelReq -> Maybe Word32
_RpbDelReq'r RpbDelReq
x__)
                            (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbDelReq -> Maybe Word32
_RpbDelReq'w RpbDelReq
x__)
                               (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbDelReq -> Maybe Word32
_RpbDelReq'pr RpbDelReq
x__)
                                  (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbDelReq -> Maybe Word32
_RpbDelReq'pw RpbDelReq
x__)
                                     (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbDelReq -> Maybe Word32
_RpbDelReq'dw RpbDelReq
x__)
                                        (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbDelReq -> Maybe Word32
_RpbDelReq'timeout RpbDelReq
x__)
                                           (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (RpbDelReq -> Maybe Bool
_RpbDelReq'sloppyQuorum RpbDelReq
x__)
                                              (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                 (RpbDelReq -> Maybe Word32
_RpbDelReq'nVal RpbDelReq
x__)
                                                 (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                    (RpbDelReq -> Maybe ByteString
_RpbDelReq'type' RpbDelReq
x__) ())))))))))))))
{- | Fields :
      -}
data RpbDelResp
  = RpbDelResp'_constructor {RpbDelResp -> FieldSet
_RpbDelResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbDelResp -> RpbDelResp -> Bool
(RpbDelResp -> RpbDelResp -> Bool)
-> (RpbDelResp -> RpbDelResp -> Bool) -> Eq RpbDelResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbDelResp -> RpbDelResp -> Bool
$c/= :: RpbDelResp -> RpbDelResp -> Bool
== :: RpbDelResp -> RpbDelResp -> Bool
$c== :: RpbDelResp -> RpbDelResp -> Bool
Prelude.Eq, Eq RpbDelResp
Eq RpbDelResp
-> (RpbDelResp -> RpbDelResp -> Ordering)
-> (RpbDelResp -> RpbDelResp -> Bool)
-> (RpbDelResp -> RpbDelResp -> Bool)
-> (RpbDelResp -> RpbDelResp -> Bool)
-> (RpbDelResp -> RpbDelResp -> Bool)
-> (RpbDelResp -> RpbDelResp -> RpbDelResp)
-> (RpbDelResp -> RpbDelResp -> RpbDelResp)
-> Ord RpbDelResp
RpbDelResp -> RpbDelResp -> Bool
RpbDelResp -> RpbDelResp -> Ordering
RpbDelResp -> RpbDelResp -> RpbDelResp
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 :: RpbDelResp -> RpbDelResp -> RpbDelResp
$cmin :: RpbDelResp -> RpbDelResp -> RpbDelResp
max :: RpbDelResp -> RpbDelResp -> RpbDelResp
$cmax :: RpbDelResp -> RpbDelResp -> RpbDelResp
>= :: RpbDelResp -> RpbDelResp -> Bool
$c>= :: RpbDelResp -> RpbDelResp -> Bool
> :: RpbDelResp -> RpbDelResp -> Bool
$c> :: RpbDelResp -> RpbDelResp -> Bool
<= :: RpbDelResp -> RpbDelResp -> Bool
$c<= :: RpbDelResp -> RpbDelResp -> Bool
< :: RpbDelResp -> RpbDelResp -> Bool
$c< :: RpbDelResp -> RpbDelResp -> Bool
compare :: RpbDelResp -> RpbDelResp -> Ordering
$ccompare :: RpbDelResp -> RpbDelResp -> Ordering
$cp1Ord :: Eq RpbDelResp
Prelude.Ord)
instance Prelude.Show RpbDelResp where
  showsPrec :: Int -> RpbDelResp -> ShowS
showsPrec Int
_ RpbDelResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbDelResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbDelResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbDelResp where
  messageName :: Proxy RpbDelResp -> Text
messageName Proxy RpbDelResp
_ = String -> Text
Data.Text.pack String
"RpbDelResp"
  packedMessageDescriptor :: Proxy RpbDelResp -> ByteString
packedMessageDescriptor Proxy RpbDelResp
_
    = ByteString
"\n\
      \\n\
      \RpbDelResp"
  packedFileDescriptor :: Proxy RpbDelResp -> ByteString
packedFileDescriptor Proxy RpbDelResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbDelResp)
fieldsByTag = let in [(Tag, FieldDescriptor RpbDelResp)]
-> Map Tag (FieldDescriptor RpbDelResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbDelResp FieldSet
unknownFields
    = (RpbDelResp -> FieldSet)
-> (RpbDelResp -> FieldSet -> RpbDelResp)
-> Lens' RpbDelResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbDelResp -> FieldSet
_RpbDelResp'_unknownFields
        (\ RpbDelResp
x__ FieldSet
y__ -> RpbDelResp
x__ {_RpbDelResp'_unknownFields :: FieldSet
_RpbDelResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbDelResp
defMessage
    = RpbDelResp'_constructor :: FieldSet -> RpbDelResp
RpbDelResp'_constructor {_RpbDelResp'_unknownFields :: FieldSet
_RpbDelResp'_unknownFields = []}
  parseMessage :: Parser RpbDelResp
parseMessage
    = let
        loop ::
          RpbDelResp -> Data.ProtoLens.Encoding.Bytes.Parser RpbDelResp
        loop :: RpbDelResp -> Parser RpbDelResp
loop RpbDelResp
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]))))
                      RpbDelResp -> Parser RpbDelResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbDelResp RpbDelResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbDelResp -> RpbDelResp
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 RpbDelResp RpbDelResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbDelResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbDelResp -> Parser RpbDelResp
loop
                                  (Setter RpbDelResp RpbDelResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbDelResp -> RpbDelResp
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 RpbDelResp RpbDelResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbDelResp
x) }
      in
        Parser RpbDelResp -> String -> Parser RpbDelResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbDelResp -> Parser RpbDelResp
loop RpbDelResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbDelResp"
  buildMessage :: RpbDelResp -> Builder
buildMessage
    = \ RpbDelResp
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike FieldSet RpbDelResp RpbDelResp FieldSet FieldSet
-> RpbDelResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbDelResp RpbDelResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbDelResp
_x)
instance Control.DeepSeq.NFData RpbDelResp where
  rnf :: RpbDelResp -> ()
rnf
    = \ RpbDelResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbDelResp -> FieldSet
_RpbDelResp'_unknownFields RpbDelResp
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.errmsg' @:: Lens' RpbErrorResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.errcode' @:: Lens' RpbErrorResp Data.Word.Word32@ -}
data RpbErrorResp
  = RpbErrorResp'_constructor {RpbErrorResp -> ByteString
_RpbErrorResp'errmsg :: !Data.ByteString.ByteString,
                               RpbErrorResp -> Word32
_RpbErrorResp'errcode :: !Data.Word.Word32,
                               RpbErrorResp -> FieldSet
_RpbErrorResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbErrorResp -> RpbErrorResp -> Bool
(RpbErrorResp -> RpbErrorResp -> Bool)
-> (RpbErrorResp -> RpbErrorResp -> Bool) -> Eq RpbErrorResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbErrorResp -> RpbErrorResp -> Bool
$c/= :: RpbErrorResp -> RpbErrorResp -> Bool
== :: RpbErrorResp -> RpbErrorResp -> Bool
$c== :: RpbErrorResp -> RpbErrorResp -> Bool
Prelude.Eq, Eq RpbErrorResp
Eq RpbErrorResp
-> (RpbErrorResp -> RpbErrorResp -> Ordering)
-> (RpbErrorResp -> RpbErrorResp -> Bool)
-> (RpbErrorResp -> RpbErrorResp -> Bool)
-> (RpbErrorResp -> RpbErrorResp -> Bool)
-> (RpbErrorResp -> RpbErrorResp -> Bool)
-> (RpbErrorResp -> RpbErrorResp -> RpbErrorResp)
-> (RpbErrorResp -> RpbErrorResp -> RpbErrorResp)
-> Ord RpbErrorResp
RpbErrorResp -> RpbErrorResp -> Bool
RpbErrorResp -> RpbErrorResp -> Ordering
RpbErrorResp -> RpbErrorResp -> RpbErrorResp
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 :: RpbErrorResp -> RpbErrorResp -> RpbErrorResp
$cmin :: RpbErrorResp -> RpbErrorResp -> RpbErrorResp
max :: RpbErrorResp -> RpbErrorResp -> RpbErrorResp
$cmax :: RpbErrorResp -> RpbErrorResp -> RpbErrorResp
>= :: RpbErrorResp -> RpbErrorResp -> Bool
$c>= :: RpbErrorResp -> RpbErrorResp -> Bool
> :: RpbErrorResp -> RpbErrorResp -> Bool
$c> :: RpbErrorResp -> RpbErrorResp -> Bool
<= :: RpbErrorResp -> RpbErrorResp -> Bool
$c<= :: RpbErrorResp -> RpbErrorResp -> Bool
< :: RpbErrorResp -> RpbErrorResp -> Bool
$c< :: RpbErrorResp -> RpbErrorResp -> Bool
compare :: RpbErrorResp -> RpbErrorResp -> Ordering
$ccompare :: RpbErrorResp -> RpbErrorResp -> Ordering
$cp1Ord :: Eq RpbErrorResp
Prelude.Ord)
instance Prelude.Show RpbErrorResp where
  showsPrec :: Int -> RpbErrorResp -> ShowS
showsPrec Int
_ RpbErrorResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbErrorResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbErrorResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbErrorResp "errmsg" Data.ByteString.ByteString where
  fieldOf :: Proxy# "errmsg"
-> (ByteString -> f ByteString) -> RpbErrorResp -> f RpbErrorResp
fieldOf Proxy# "errmsg"
_
    = ((ByteString -> f ByteString) -> RpbErrorResp -> f RpbErrorResp)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbErrorResp
-> f RpbErrorResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbErrorResp -> ByteString)
-> (RpbErrorResp -> ByteString -> RpbErrorResp)
-> Lens RpbErrorResp RpbErrorResp ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbErrorResp -> ByteString
_RpbErrorResp'errmsg
           (\ RpbErrorResp
x__ ByteString
y__ -> RpbErrorResp
x__ {_RpbErrorResp'errmsg :: ByteString
_RpbErrorResp'errmsg = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbErrorResp "errcode" Data.Word.Word32 where
  fieldOf :: Proxy# "errcode"
-> (Word32 -> f Word32) -> RpbErrorResp -> f RpbErrorResp
fieldOf Proxy# "errcode"
_
    = ((Word32 -> f Word32) -> RpbErrorResp -> f RpbErrorResp)
-> ((Word32 -> f Word32) -> Word32 -> f Word32)
-> (Word32 -> f Word32)
-> RpbErrorResp
-> f RpbErrorResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbErrorResp -> Word32)
-> (RpbErrorResp -> Word32 -> RpbErrorResp)
-> Lens RpbErrorResp RpbErrorResp Word32 Word32
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbErrorResp -> Word32
_RpbErrorResp'errcode
           (\ RpbErrorResp
x__ Word32
y__ -> RpbErrorResp
x__ {_RpbErrorResp'errcode :: Word32
_RpbErrorResp'errcode = Word32
y__}))
        (Word32 -> f Word32) -> Word32 -> f Word32
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbErrorResp where
  messageName :: Proxy RpbErrorResp -> Text
messageName Proxy RpbErrorResp
_ = String -> Text
Data.Text.pack String
"RpbErrorResp"
  packedMessageDescriptor :: Proxy RpbErrorResp -> ByteString
packedMessageDescriptor Proxy RpbErrorResp
_
    = ByteString
"\n\
      \\fRpbErrorResp\DC2\SYN\n\
      \\ACKerrmsg\CAN\SOH \STX(\fR\ACKerrmsg\DC2\CAN\n\
      \\aerrcode\CAN\STX \STX(\rR\aerrcode"
  packedFileDescriptor :: Proxy RpbErrorResp -> ByteString
packedFileDescriptor Proxy RpbErrorResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbErrorResp)
fieldsByTag
    = let
        errmsg__field_descriptor :: FieldDescriptor RpbErrorResp
errmsg__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbErrorResp ByteString
-> FieldDescriptor RpbErrorResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"errmsg"
              (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 RpbErrorResp RpbErrorResp ByteString ByteString
-> FieldAccessor RpbErrorResp ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "errmsg" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"errmsg")) ::
              Data.ProtoLens.FieldDescriptor RpbErrorResp
        errcode__field_descriptor :: FieldDescriptor RpbErrorResp
errcode__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbErrorResp Word32
-> FieldDescriptor RpbErrorResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"errcode"
              (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 RpbErrorResp RpbErrorResp Word32 Word32
-> FieldAccessor RpbErrorResp Word32
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Word32
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "errcode" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"errcode")) ::
              Data.ProtoLens.FieldDescriptor RpbErrorResp
      in
        [(Tag, FieldDescriptor RpbErrorResp)]
-> Map Tag (FieldDescriptor RpbErrorResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbErrorResp
errmsg__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbErrorResp
errcode__field_descriptor)]
  unknownFields :: LensLike' f RpbErrorResp FieldSet
unknownFields
    = (RpbErrorResp -> FieldSet)
-> (RpbErrorResp -> FieldSet -> RpbErrorResp)
-> Lens' RpbErrorResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbErrorResp -> FieldSet
_RpbErrorResp'_unknownFields
        (\ RpbErrorResp
x__ FieldSet
y__ -> RpbErrorResp
x__ {_RpbErrorResp'_unknownFields :: FieldSet
_RpbErrorResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbErrorResp
defMessage
    = RpbErrorResp'_constructor :: ByteString -> Word32 -> FieldSet -> RpbErrorResp
RpbErrorResp'_constructor
        {_RpbErrorResp'errmsg :: ByteString
_RpbErrorResp'errmsg = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbErrorResp'errcode :: Word32
_RpbErrorResp'errcode = Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbErrorResp'_unknownFields :: FieldSet
_RpbErrorResp'_unknownFields = []}
  parseMessage :: Parser RpbErrorResp
parseMessage
    = let
        loop ::
          RpbErrorResp
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbErrorResp
        loop :: RpbErrorResp -> Bool -> Bool -> Parser RpbErrorResp
loop RpbErrorResp
x Bool
required'errcode Bool
required'errmsg
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'errcode then (:) String
"errcode" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'errmsg then (:) String
"errmsg" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbErrorResp -> Parser RpbErrorResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbErrorResp RpbErrorResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbErrorResp -> RpbErrorResp
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 RpbErrorResp RpbErrorResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbErrorResp
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
"errmsg"
                                RpbErrorResp -> Bool -> Bool -> Parser RpbErrorResp
loop
                                  (Setter RpbErrorResp RpbErrorResp ByteString ByteString
-> ByteString -> RpbErrorResp -> RpbErrorResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "errmsg" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"errmsg") ByteString
y RpbErrorResp
x)
                                  Bool
required'errcode
                                  Bool
Prelude.False
                        Word64
16
                          -> 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
"errcode"
                                RpbErrorResp -> Bool -> Bool -> Parser RpbErrorResp
loop
                                  (Setter RpbErrorResp RpbErrorResp Word32 Word32
-> Word32 -> RpbErrorResp -> RpbErrorResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "errcode" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"errcode") Word32
y RpbErrorResp
x)
                                  Bool
Prelude.False
                                  Bool
required'errmsg
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbErrorResp -> Bool -> Bool -> Parser RpbErrorResp
loop
                                  (Setter RpbErrorResp RpbErrorResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbErrorResp -> RpbErrorResp
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 RpbErrorResp RpbErrorResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbErrorResp
x)
                                  Bool
required'errcode
                                  Bool
required'errmsg
      in
        Parser RpbErrorResp -> String -> Parser RpbErrorResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbErrorResp -> Bool -> Bool -> Parser RpbErrorResp
loop RpbErrorResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbErrorResp"
  buildMessage :: RpbErrorResp -> Builder
buildMessage
    = \ RpbErrorResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbErrorResp RpbErrorResp ByteString ByteString
-> RpbErrorResp -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "errmsg" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"errmsg") RpbErrorResp
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                   ((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
                      (FoldLike Word32 RpbErrorResp RpbErrorResp Word32 Word32
-> RpbErrorResp -> Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "errcode" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"errcode") RpbErrorResp
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet RpbErrorResp RpbErrorResp FieldSet FieldSet
-> RpbErrorResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbErrorResp RpbErrorResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbErrorResp
_x)))
instance Control.DeepSeq.NFData RpbErrorResp where
  rnf :: RpbErrorResp -> ()
rnf
    = \ RpbErrorResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbErrorResp -> FieldSet
_RpbErrorResp'_unknownFields RpbErrorResp
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbErrorResp -> ByteString
_RpbErrorResp'errmsg RpbErrorResp
x__)
                (Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbErrorResp -> Word32
_RpbErrorResp'errcode RpbErrorResp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbGetBucketKeyPreflistReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbGetBucketKeyPreflistReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbGetBucketKeyPreflistReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbGetBucketKeyPreflistReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbGetBucketKeyPreflistReq
  = RpbGetBucketKeyPreflistReq'_constructor {RpbGetBucketKeyPreflistReq -> ByteString
_RpbGetBucketKeyPreflistReq'bucket :: !Data.ByteString.ByteString,
                                             RpbGetBucketKeyPreflistReq -> ByteString
_RpbGetBucketKeyPreflistReq'key :: !Data.ByteString.ByteString,
                                             RpbGetBucketKeyPreflistReq -> Maybe ByteString
_RpbGetBucketKeyPreflistReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                             RpbGetBucketKeyPreflistReq -> FieldSet
_RpbGetBucketKeyPreflistReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
(RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool)
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> Bool)
-> Eq RpbGetBucketKeyPreflistReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
$c/= :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
== :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
$c== :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
Prelude.Eq, Eq RpbGetBucketKeyPreflistReq
Eq RpbGetBucketKeyPreflistReq
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> Ordering)
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> Bool)
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> Bool)
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> Bool)
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> Bool)
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq)
-> (RpbGetBucketKeyPreflistReq
    -> RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq)
-> Ord RpbGetBucketKeyPreflistReq
RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> Ordering
RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq
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 :: RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq
$cmin :: RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq
max :: RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq
$cmax :: RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq
>= :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
$c>= :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
> :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
$c> :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
<= :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
$c<= :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
< :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
$c< :: RpbGetBucketKeyPreflistReq -> RpbGetBucketKeyPreflistReq -> Bool
compare :: RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> Ordering
$ccompare :: RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq -> Ordering
$cp1Ord :: Eq RpbGetBucketKeyPreflistReq
Prelude.Ord)
instance Prelude.Show RpbGetBucketKeyPreflistReq where
  showsPrec :: Int -> RpbGetBucketKeyPreflistReq -> ShowS
showsPrec Int
_ RpbGetBucketKeyPreflistReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetBucketKeyPreflistReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetBucketKeyPreflistReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetBucketKeyPreflistReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbGetBucketKeyPreflistReq -> f RpbGetBucketKeyPreflistReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketKeyPreflistReq -> ByteString)
-> (RpbGetBucketKeyPreflistReq
    -> ByteString -> RpbGetBucketKeyPreflistReq)
-> Lens
     RpbGetBucketKeyPreflistReq
     RpbGetBucketKeyPreflistReq
     ByteString
     ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketKeyPreflistReq -> ByteString
_RpbGetBucketKeyPreflistReq'bucket
           (\ RpbGetBucketKeyPreflistReq
x__ ByteString
y__ -> RpbGetBucketKeyPreflistReq
x__ {_RpbGetBucketKeyPreflistReq'bucket :: ByteString
_RpbGetBucketKeyPreflistReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetBucketKeyPreflistReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString)
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString)
 -> RpbGetBucketKeyPreflistReq -> f RpbGetBucketKeyPreflistReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketKeyPreflistReq -> ByteString)
-> (RpbGetBucketKeyPreflistReq
    -> ByteString -> RpbGetBucketKeyPreflistReq)
-> Lens
     RpbGetBucketKeyPreflistReq
     RpbGetBucketKeyPreflistReq
     ByteString
     ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketKeyPreflistReq -> ByteString
_RpbGetBucketKeyPreflistReq'key
           (\ RpbGetBucketKeyPreflistReq
x__ ByteString
y__ -> RpbGetBucketKeyPreflistReq
x__ {_RpbGetBucketKeyPreflistReq'key :: ByteString
_RpbGetBucketKeyPreflistReq'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetBucketKeyPreflistReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetBucketKeyPreflistReq -> f RpbGetBucketKeyPreflistReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketKeyPreflistReq -> Maybe ByteString)
-> (RpbGetBucketKeyPreflistReq
    -> Maybe ByteString -> RpbGetBucketKeyPreflistReq)
-> Lens
     RpbGetBucketKeyPreflistReq
     RpbGetBucketKeyPreflistReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketKeyPreflistReq -> Maybe ByteString
_RpbGetBucketKeyPreflistReq'type'
           (\ RpbGetBucketKeyPreflistReq
x__ Maybe ByteString
y__ -> RpbGetBucketKeyPreflistReq
x__ {_RpbGetBucketKeyPreflistReq'type' :: Maybe ByteString
_RpbGetBucketKeyPreflistReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetBucketKeyPreflistReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetBucketKeyPreflistReq -> f RpbGetBucketKeyPreflistReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetBucketKeyPreflistReq
-> f RpbGetBucketKeyPreflistReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketKeyPreflistReq -> Maybe ByteString)
-> (RpbGetBucketKeyPreflistReq
    -> Maybe ByteString -> RpbGetBucketKeyPreflistReq)
-> Lens
     RpbGetBucketKeyPreflistReq
     RpbGetBucketKeyPreflistReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketKeyPreflistReq -> Maybe ByteString
_RpbGetBucketKeyPreflistReq'type'
           (\ RpbGetBucketKeyPreflistReq
x__ Maybe ByteString
y__ -> RpbGetBucketKeyPreflistReq
x__ {_RpbGetBucketKeyPreflistReq'type' :: Maybe ByteString
_RpbGetBucketKeyPreflistReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetBucketKeyPreflistReq where
  messageName :: Proxy RpbGetBucketKeyPreflistReq -> Text
messageName Proxy RpbGetBucketKeyPreflistReq
_ = String -> Text
Data.Text.pack String
"RpbGetBucketKeyPreflistReq"
  packedMessageDescriptor :: Proxy RpbGetBucketKeyPreflistReq -> ByteString
packedMessageDescriptor Proxy RpbGetBucketKeyPreflistReq
_
    = ByteString
"\n\
      \\SUBRpbGetBucketKeyPreflistReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\DC2\n\
      \\EOTtype\CAN\ETX \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbGetBucketKeyPreflistReq -> ByteString
packedFileDescriptor Proxy RpbGetBucketKeyPreflistReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetBucketKeyPreflistReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbGetBucketKeyPreflistReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetBucketKeyPreflistReq ByteString
-> FieldDescriptor RpbGetBucketKeyPreflistReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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
     RpbGetBucketKeyPreflistReq
     RpbGetBucketKeyPreflistReq
     ByteString
     ByteString
-> FieldAccessor RpbGetBucketKeyPreflistReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketKeyPreflistReq
        key__field_descriptor :: FieldDescriptor RpbGetBucketKeyPreflistReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetBucketKeyPreflistReq ByteString
-> FieldDescriptor RpbGetBucketKeyPreflistReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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
     RpbGetBucketKeyPreflistReq
     RpbGetBucketKeyPreflistReq
     ByteString
     ByteString
-> FieldAccessor RpbGetBucketKeyPreflistReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketKeyPreflistReq
        type'__field_descriptor :: FieldDescriptor RpbGetBucketKeyPreflistReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetBucketKeyPreflistReq ByteString
-> FieldDescriptor RpbGetBucketKeyPreflistReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbGetBucketKeyPreflistReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketKeyPreflistReq
      in
        [(Tag, FieldDescriptor RpbGetBucketKeyPreflistReq)]
-> Map Tag (FieldDescriptor RpbGetBucketKeyPreflistReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetBucketKeyPreflistReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbGetBucketKeyPreflistReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbGetBucketKeyPreflistReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbGetBucketKeyPreflistReq FieldSet
unknownFields
    = (RpbGetBucketKeyPreflistReq -> FieldSet)
-> (RpbGetBucketKeyPreflistReq
    -> FieldSet -> RpbGetBucketKeyPreflistReq)
-> Lens' RpbGetBucketKeyPreflistReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetBucketKeyPreflistReq -> FieldSet
_RpbGetBucketKeyPreflistReq'_unknownFields
        (\ RpbGetBucketKeyPreflistReq
x__ FieldSet
y__
           -> RpbGetBucketKeyPreflistReq
x__ {_RpbGetBucketKeyPreflistReq'_unknownFields :: FieldSet
_RpbGetBucketKeyPreflistReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetBucketKeyPreflistReq
defMessage
    = RpbGetBucketKeyPreflistReq'_constructor :: ByteString
-> ByteString
-> Maybe ByteString
-> FieldSet
-> RpbGetBucketKeyPreflistReq
RpbGetBucketKeyPreflistReq'_constructor
        {_RpbGetBucketKeyPreflistReq'bucket :: ByteString
_RpbGetBucketKeyPreflistReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbGetBucketKeyPreflistReq'key :: ByteString
_RpbGetBucketKeyPreflistReq'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbGetBucketKeyPreflistReq'type' :: Maybe ByteString
_RpbGetBucketKeyPreflistReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbGetBucketKeyPreflistReq'_unknownFields :: FieldSet
_RpbGetBucketKeyPreflistReq'_unknownFields = []}
  parseMessage :: Parser RpbGetBucketKeyPreflistReq
parseMessage
    = let
        loop ::
          RpbGetBucketKeyPreflistReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetBucketKeyPreflistReq
        loop :: RpbGetBucketKeyPreflistReq
-> Bool -> Bool -> Parser RpbGetBucketKeyPreflistReq
loop RpbGetBucketKeyPreflistReq
x Bool
required'bucket Bool
required'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbGetBucketKeyPreflistReq -> Parser RpbGetBucketKeyPreflistReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  FieldSet
  FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq
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
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  FieldSet
  FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetBucketKeyPreflistReq
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
"bucket"
                                RpbGetBucketKeyPreflistReq
-> Bool -> Bool -> Parser RpbGetBucketKeyPreflistReq
loop
                                  (Setter
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  ByteString
  ByteString
-> ByteString
-> RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbGetBucketKeyPreflistReq
x)
                                  Bool
Prelude.False
                                  Bool
required'key
                        Word64
18
                          -> 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
"key"
                                RpbGetBucketKeyPreflistReq
-> Bool -> Bool -> Parser RpbGetBucketKeyPreflistReq
loop
                                  (Setter
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  ByteString
  ByteString
-> ByteString
-> RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbGetBucketKeyPreflistReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
26
                          -> 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
"type"
                                RpbGetBucketKeyPreflistReq
-> Bool -> Bool -> Parser RpbGetBucketKeyPreflistReq
loop
                                  (Setter
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  ByteString
  ByteString
-> ByteString
-> RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbGetBucketKeyPreflistReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetBucketKeyPreflistReq
-> Bool -> Bool -> Parser RpbGetBucketKeyPreflistReq
loop
                                  (Setter
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  FieldSet
  FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetBucketKeyPreflistReq
-> RpbGetBucketKeyPreflistReq
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
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  FieldSet
  FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetBucketKeyPreflistReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
      in
        Parser RpbGetBucketKeyPreflistReq
-> String -> Parser RpbGetBucketKeyPreflistReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetBucketKeyPreflistReq
-> Bool -> Bool -> Parser RpbGetBucketKeyPreflistReq
loop RpbGetBucketKeyPreflistReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbGetBucketKeyPreflistReq"
  buildMessage :: RpbGetBucketKeyPreflistReq -> Builder
buildMessage
    = \ RpbGetBucketKeyPreflistReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  ByteString
  ByteString
-> RpbGetBucketKeyPreflistReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbGetBucketKeyPreflistReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  ByteString
  ByteString
-> RpbGetBucketKeyPreflistReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") RpbGetBucketKeyPreflistReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbGetBucketKeyPreflistReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbGetBucketKeyPreflistReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  FieldSet
  FieldSet
-> RpbGetBucketKeyPreflistReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbGetBucketKeyPreflistReq
  RpbGetBucketKeyPreflistReq
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetBucketKeyPreflistReq
_x))))
instance Control.DeepSeq.NFData RpbGetBucketKeyPreflistReq where
  rnf :: RpbGetBucketKeyPreflistReq -> ()
rnf
    = \ RpbGetBucketKeyPreflistReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetBucketKeyPreflistReq -> FieldSet
_RpbGetBucketKeyPreflistReq'_unknownFields RpbGetBucketKeyPreflistReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbGetBucketKeyPreflistReq -> ByteString
_RpbGetBucketKeyPreflistReq'bucket RpbGetBucketKeyPreflistReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbGetBucketKeyPreflistReq -> ByteString
_RpbGetBucketKeyPreflistReq'key RpbGetBucketKeyPreflistReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbGetBucketKeyPreflistReq -> Maybe ByteString
_RpbGetBucketKeyPreflistReq'type' RpbGetBucketKeyPreflistReq
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.preflist' @:: Lens' RpbGetBucketKeyPreflistResp [RpbBucketKeyPreflistItem]@
         * 'Proto.Riak_Fields.vec'preflist' @:: Lens' RpbGetBucketKeyPreflistResp (Data.Vector.Vector RpbBucketKeyPreflistItem)@ -}
data RpbGetBucketKeyPreflistResp
  = RpbGetBucketKeyPreflistResp'_constructor {RpbGetBucketKeyPreflistResp -> Vector RpbBucketKeyPreflistItem
_RpbGetBucketKeyPreflistResp'preflist :: !(Data.Vector.Vector RpbBucketKeyPreflistItem),
                                              RpbGetBucketKeyPreflistResp -> FieldSet
_RpbGetBucketKeyPreflistResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
(RpbGetBucketKeyPreflistResp
 -> RpbGetBucketKeyPreflistResp -> Bool)
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> Bool)
-> Eq RpbGetBucketKeyPreflistResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
$c/= :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
== :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
$c== :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
Prelude.Eq, Eq RpbGetBucketKeyPreflistResp
Eq RpbGetBucketKeyPreflistResp
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> Ordering)
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> Bool)
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> Bool)
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> Bool)
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> Bool)
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp)
-> (RpbGetBucketKeyPreflistResp
    -> RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp)
-> Ord RpbGetBucketKeyPreflistResp
RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> Ordering
RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp
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 :: RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp
$cmin :: RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp
max :: RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp
$cmax :: RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp
>= :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
$c>= :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
> :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
$c> :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
<= :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
$c<= :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
< :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
$c< :: RpbGetBucketKeyPreflistResp -> RpbGetBucketKeyPreflistResp -> Bool
compare :: RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> Ordering
$ccompare :: RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp -> Ordering
$cp1Ord :: Eq RpbGetBucketKeyPreflistResp
Prelude.Ord)
instance Prelude.Show RpbGetBucketKeyPreflistResp where
  showsPrec :: Int -> RpbGetBucketKeyPreflistResp -> ShowS
showsPrec Int
_ RpbGetBucketKeyPreflistResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetBucketKeyPreflistResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetBucketKeyPreflistResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetBucketKeyPreflistResp "preflist" [RpbBucketKeyPreflistItem] where
  fieldOf :: Proxy# "preflist"
-> ([RpbBucketKeyPreflistItem] -> f [RpbBucketKeyPreflistItem])
-> RpbGetBucketKeyPreflistResp
-> f RpbGetBucketKeyPreflistResp
fieldOf Proxy# "preflist"
_
    = ((Vector RpbBucketKeyPreflistItem
  -> f (Vector RpbBucketKeyPreflistItem))
 -> RpbGetBucketKeyPreflistResp -> f RpbGetBucketKeyPreflistResp)
-> (([RpbBucketKeyPreflistItem] -> f [RpbBucketKeyPreflistItem])
    -> Vector RpbBucketKeyPreflistItem
    -> f (Vector RpbBucketKeyPreflistItem))
-> ([RpbBucketKeyPreflistItem] -> f [RpbBucketKeyPreflistItem])
-> RpbGetBucketKeyPreflistResp
-> f RpbGetBucketKeyPreflistResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketKeyPreflistResp -> Vector RpbBucketKeyPreflistItem)
-> (RpbGetBucketKeyPreflistResp
    -> Vector RpbBucketKeyPreflistItem -> RpbGetBucketKeyPreflistResp)
-> Lens
     RpbGetBucketKeyPreflistResp
     RpbGetBucketKeyPreflistResp
     (Vector RpbBucketKeyPreflistItem)
     (Vector RpbBucketKeyPreflistItem)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketKeyPreflistResp -> Vector RpbBucketKeyPreflistItem
_RpbGetBucketKeyPreflistResp'preflist
           (\ RpbGetBucketKeyPreflistResp
x__ Vector RpbBucketKeyPreflistItem
y__ -> RpbGetBucketKeyPreflistResp
x__ {_RpbGetBucketKeyPreflistResp'preflist :: Vector RpbBucketKeyPreflistItem
_RpbGetBucketKeyPreflistResp'preflist = Vector RpbBucketKeyPreflistItem
y__}))
        ((Vector RpbBucketKeyPreflistItem -> [RpbBucketKeyPreflistItem])
-> (Vector RpbBucketKeyPreflistItem
    -> [RpbBucketKeyPreflistItem] -> Vector RpbBucketKeyPreflistItem)
-> Lens
     (Vector RpbBucketKeyPreflistItem)
     (Vector RpbBucketKeyPreflistItem)
     [RpbBucketKeyPreflistItem]
     [RpbBucketKeyPreflistItem]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbBucketKeyPreflistItem -> [RpbBucketKeyPreflistItem]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbBucketKeyPreflistItem
_ [RpbBucketKeyPreflistItem]
y__ -> [RpbBucketKeyPreflistItem] -> Vector RpbBucketKeyPreflistItem
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbBucketKeyPreflistItem]
y__))
instance Data.ProtoLens.Field.HasField RpbGetBucketKeyPreflistResp "vec'preflist" (Data.Vector.Vector RpbBucketKeyPreflistItem) where
  fieldOf :: Proxy# "vec'preflist"
-> (Vector RpbBucketKeyPreflistItem
    -> f (Vector RpbBucketKeyPreflistItem))
-> RpbGetBucketKeyPreflistResp
-> f RpbGetBucketKeyPreflistResp
fieldOf Proxy# "vec'preflist"
_
    = ((Vector RpbBucketKeyPreflistItem
  -> f (Vector RpbBucketKeyPreflistItem))
 -> RpbGetBucketKeyPreflistResp -> f RpbGetBucketKeyPreflistResp)
-> ((Vector RpbBucketKeyPreflistItem
     -> f (Vector RpbBucketKeyPreflistItem))
    -> Vector RpbBucketKeyPreflistItem
    -> f (Vector RpbBucketKeyPreflistItem))
-> (Vector RpbBucketKeyPreflistItem
    -> f (Vector RpbBucketKeyPreflistItem))
-> RpbGetBucketKeyPreflistResp
-> f RpbGetBucketKeyPreflistResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketKeyPreflistResp -> Vector RpbBucketKeyPreflistItem)
-> (RpbGetBucketKeyPreflistResp
    -> Vector RpbBucketKeyPreflistItem -> RpbGetBucketKeyPreflistResp)
-> Lens
     RpbGetBucketKeyPreflistResp
     RpbGetBucketKeyPreflistResp
     (Vector RpbBucketKeyPreflistItem)
     (Vector RpbBucketKeyPreflistItem)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketKeyPreflistResp -> Vector RpbBucketKeyPreflistItem
_RpbGetBucketKeyPreflistResp'preflist
           (\ RpbGetBucketKeyPreflistResp
x__ Vector RpbBucketKeyPreflistItem
y__ -> RpbGetBucketKeyPreflistResp
x__ {_RpbGetBucketKeyPreflistResp'preflist :: Vector RpbBucketKeyPreflistItem
_RpbGetBucketKeyPreflistResp'preflist = Vector RpbBucketKeyPreflistItem
y__}))
        (Vector RpbBucketKeyPreflistItem
 -> f (Vector RpbBucketKeyPreflistItem))
-> Vector RpbBucketKeyPreflistItem
-> f (Vector RpbBucketKeyPreflistItem)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetBucketKeyPreflistResp where
  messageName :: Proxy RpbGetBucketKeyPreflistResp -> Text
messageName Proxy RpbGetBucketKeyPreflistResp
_ = String -> Text
Data.Text.pack String
"RpbGetBucketKeyPreflistResp"
  packedMessageDescriptor :: Proxy RpbGetBucketKeyPreflistResp -> ByteString
packedMessageDescriptor Proxy RpbGetBucketKeyPreflistResp
_
    = ByteString
"\n\
      \\ESCRpbGetBucketKeyPreflistResp\DC25\n\
      \\bpreflist\CAN\SOH \ETX(\v2\EM.RpbBucketKeyPreflistItemR\bpreflist"
  packedFileDescriptor :: Proxy RpbGetBucketKeyPreflistResp -> ByteString
packedFileDescriptor Proxy RpbGetBucketKeyPreflistResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetBucketKeyPreflistResp)
fieldsByTag
    = let
        preflist__field_descriptor :: FieldDescriptor RpbGetBucketKeyPreflistResp
preflist__field_descriptor
          = String
-> FieldTypeDescriptor RpbBucketKeyPreflistItem
-> FieldAccessor
     RpbGetBucketKeyPreflistResp RpbBucketKeyPreflistItem
-> FieldDescriptor RpbGetBucketKeyPreflistResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"preflist"
              (MessageOrGroup -> FieldTypeDescriptor RpbBucketKeyPreflistItem
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbBucketKeyPreflistItem)
              (Packing
-> Lens' RpbGetBucketKeyPreflistResp [RpbBucketKeyPreflistItem]
-> FieldAccessor
     RpbGetBucketKeyPreflistResp RpbBucketKeyPreflistItem
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "preflist" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"preflist")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketKeyPreflistResp
      in
        [(Tag, FieldDescriptor RpbGetBucketKeyPreflistResp)]
-> Map Tag (FieldDescriptor RpbGetBucketKeyPreflistResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetBucketKeyPreflistResp
preflist__field_descriptor)]
  unknownFields :: LensLike' f RpbGetBucketKeyPreflistResp FieldSet
unknownFields
    = (RpbGetBucketKeyPreflistResp -> FieldSet)
-> (RpbGetBucketKeyPreflistResp
    -> FieldSet -> RpbGetBucketKeyPreflistResp)
-> Lens' RpbGetBucketKeyPreflistResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetBucketKeyPreflistResp -> FieldSet
_RpbGetBucketKeyPreflistResp'_unknownFields
        (\ RpbGetBucketKeyPreflistResp
x__ FieldSet
y__
           -> RpbGetBucketKeyPreflistResp
x__ {_RpbGetBucketKeyPreflistResp'_unknownFields :: FieldSet
_RpbGetBucketKeyPreflistResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetBucketKeyPreflistResp
defMessage
    = RpbGetBucketKeyPreflistResp'_constructor :: Vector RpbBucketKeyPreflistItem
-> FieldSet -> RpbGetBucketKeyPreflistResp
RpbGetBucketKeyPreflistResp'_constructor
        {_RpbGetBucketKeyPreflistResp'preflist :: Vector RpbBucketKeyPreflistItem
_RpbGetBucketKeyPreflistResp'preflist = Vector RpbBucketKeyPreflistItem
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbGetBucketKeyPreflistResp'_unknownFields :: FieldSet
_RpbGetBucketKeyPreflistResp'_unknownFields = []}
  parseMessage :: Parser RpbGetBucketKeyPreflistResp
parseMessage
    = let
        loop ::
          RpbGetBucketKeyPreflistResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbBucketKeyPreflistItem
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetBucketKeyPreflistResp
        loop :: RpbGetBucketKeyPreflistResp
-> Growing Vector RealWorld RpbBucketKeyPreflistItem
-> Parser RpbGetBucketKeyPreflistResp
loop RpbGetBucketKeyPreflistResp
x Growing Vector RealWorld RpbBucketKeyPreflistItem
mutable'preflist
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbBucketKeyPreflistItem
frozen'preflist <- IO (Vector RpbBucketKeyPreflistItem)
-> Parser (Vector RpbBucketKeyPreflistItem)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                           (Growing Vector (PrimState IO) RpbBucketKeyPreflistItem
-> IO (Vector RpbBucketKeyPreflistItem)
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 RpbBucketKeyPreflistItem
Growing Vector (PrimState IO) RpbBucketKeyPreflistItem
mutable'preflist)
                      (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]))))
                      RpbGetBucketKeyPreflistResp -> Parser RpbGetBucketKeyPreflistResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  FieldSet
  FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp
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
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  FieldSet
  FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  (Vector RpbBucketKeyPreflistItem)
  (Vector RpbBucketKeyPreflistItem)
-> Vector RpbBucketKeyPreflistItem
-> RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'preflist" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'preflist") Vector RpbBucketKeyPreflistItem
frozen'preflist RpbGetBucketKeyPreflistResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbBucketKeyPreflistItem
y <- Parser RpbBucketKeyPreflistItem
-> String -> Parser RpbBucketKeyPreflistItem
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int
-> Parser RpbBucketKeyPreflistItem
-> Parser RpbBucketKeyPreflistItem
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 RpbBucketKeyPreflistItem
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"preflist"
                                Growing Vector RealWorld RpbBucketKeyPreflistItem
v <- IO (Growing Vector RealWorld RpbBucketKeyPreflistItem)
-> Parser (Growing Vector RealWorld RpbBucketKeyPreflistItem)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbBucketKeyPreflistItem
-> RpbBucketKeyPreflistItem
-> IO (Growing Vector (PrimState IO) RpbBucketKeyPreflistItem)
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 RpbBucketKeyPreflistItem
Growing Vector (PrimState IO) RpbBucketKeyPreflistItem
mutable'preflist RpbBucketKeyPreflistItem
y)
                                RpbGetBucketKeyPreflistResp
-> Growing Vector RealWorld RpbBucketKeyPreflistItem
-> Parser RpbGetBucketKeyPreflistResp
loop RpbGetBucketKeyPreflistResp
x Growing Vector RealWorld RpbBucketKeyPreflistItem
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetBucketKeyPreflistResp
-> Growing Vector RealWorld RpbBucketKeyPreflistItem
-> Parser RpbGetBucketKeyPreflistResp
loop
                                  (Setter
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  FieldSet
  FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetBucketKeyPreflistResp
-> RpbGetBucketKeyPreflistResp
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
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  FieldSet
  FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetBucketKeyPreflistResp
x)
                                  Growing Vector RealWorld RpbBucketKeyPreflistItem
mutable'preflist
      in
        Parser RpbGetBucketKeyPreflistResp
-> String -> Parser RpbGetBucketKeyPreflistResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbBucketKeyPreflistItem
mutable'preflist <- IO (Growing Vector RealWorld RpbBucketKeyPreflistItem)
-> Parser (Growing Vector RealWorld RpbBucketKeyPreflistItem)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                    IO (Growing Vector RealWorld RpbBucketKeyPreflistItem)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbGetBucketKeyPreflistResp
-> Growing Vector RealWorld RpbBucketKeyPreflistItem
-> Parser RpbGetBucketKeyPreflistResp
loop RpbGetBucketKeyPreflistResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbBucketKeyPreflistItem
mutable'preflist)
          String
"RpbGetBucketKeyPreflistResp"
  buildMessage :: RpbGetBucketKeyPreflistResp -> Builder
buildMessage
    = \ RpbGetBucketKeyPreflistResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbBucketKeyPreflistItem -> Builder)
-> Vector RpbBucketKeyPreflistItem -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbBucketKeyPreflistItem
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbBucketKeyPreflistItem -> ByteString)
-> RpbBucketKeyPreflistItem
-> 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))
                           RpbBucketKeyPreflistItem -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbBucketKeyPreflistItem
_v))
                (FoldLike
  (Vector RpbBucketKeyPreflistItem)
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  (Vector RpbBucketKeyPreflistItem)
  (Vector RpbBucketKeyPreflistItem)
-> RpbGetBucketKeyPreflistResp -> Vector RpbBucketKeyPreflistItem
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                   (forall s a (f :: * -> *).
(HasField s "vec'preflist" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'preflist") RpbGetBucketKeyPreflistResp
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  FieldSet
  FieldSet
-> RpbGetBucketKeyPreflistResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbGetBucketKeyPreflistResp
  RpbGetBucketKeyPreflistResp
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetBucketKeyPreflistResp
_x))
instance Control.DeepSeq.NFData RpbGetBucketKeyPreflistResp where
  rnf :: RpbGetBucketKeyPreflistResp -> ()
rnf
    = \ RpbGetBucketKeyPreflistResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetBucketKeyPreflistResp -> FieldSet
_RpbGetBucketKeyPreflistResp'_unknownFields RpbGetBucketKeyPreflistResp
x__)
             (Vector RpbBucketKeyPreflistItem -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbGetBucketKeyPreflistResp -> Vector RpbBucketKeyPreflistItem
_RpbGetBucketKeyPreflistResp'preflist RpbGetBucketKeyPreflistResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbGetBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbGetBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbGetBucketReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbGetBucketReq
  = RpbGetBucketReq'_constructor {RpbGetBucketReq -> ByteString
_RpbGetBucketReq'bucket :: !Data.ByteString.ByteString,
                                  RpbGetBucketReq -> Maybe ByteString
_RpbGetBucketReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                  RpbGetBucketReq -> FieldSet
_RpbGetBucketReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetBucketReq -> RpbGetBucketReq -> Bool
(RpbGetBucketReq -> RpbGetBucketReq -> Bool)
-> (RpbGetBucketReq -> RpbGetBucketReq -> Bool)
-> Eq RpbGetBucketReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
$c/= :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
== :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
$c== :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
Prelude.Eq, Eq RpbGetBucketReq
Eq RpbGetBucketReq
-> (RpbGetBucketReq -> RpbGetBucketReq -> Ordering)
-> (RpbGetBucketReq -> RpbGetBucketReq -> Bool)
-> (RpbGetBucketReq -> RpbGetBucketReq -> Bool)
-> (RpbGetBucketReq -> RpbGetBucketReq -> Bool)
-> (RpbGetBucketReq -> RpbGetBucketReq -> Bool)
-> (RpbGetBucketReq -> RpbGetBucketReq -> RpbGetBucketReq)
-> (RpbGetBucketReq -> RpbGetBucketReq -> RpbGetBucketReq)
-> Ord RpbGetBucketReq
RpbGetBucketReq -> RpbGetBucketReq -> Bool
RpbGetBucketReq -> RpbGetBucketReq -> Ordering
RpbGetBucketReq -> RpbGetBucketReq -> RpbGetBucketReq
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 :: RpbGetBucketReq -> RpbGetBucketReq -> RpbGetBucketReq
$cmin :: RpbGetBucketReq -> RpbGetBucketReq -> RpbGetBucketReq
max :: RpbGetBucketReq -> RpbGetBucketReq -> RpbGetBucketReq
$cmax :: RpbGetBucketReq -> RpbGetBucketReq -> RpbGetBucketReq
>= :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
$c>= :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
> :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
$c> :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
<= :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
$c<= :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
< :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
$c< :: RpbGetBucketReq -> RpbGetBucketReq -> Bool
compare :: RpbGetBucketReq -> RpbGetBucketReq -> Ordering
$ccompare :: RpbGetBucketReq -> RpbGetBucketReq -> Ordering
$cp1Ord :: Eq RpbGetBucketReq
Prelude.Ord)
instance Prelude.Show RpbGetBucketReq where
  showsPrec :: Int -> RpbGetBucketReq -> ShowS
showsPrec Int
_ RpbGetBucketReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetBucketReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetBucketReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetBucketReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbGetBucketReq
-> f RpbGetBucketReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbGetBucketReq -> f RpbGetBucketReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbGetBucketReq
-> f RpbGetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketReq -> ByteString)
-> (RpbGetBucketReq -> ByteString -> RpbGetBucketReq)
-> Lens RpbGetBucketReq RpbGetBucketReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketReq -> ByteString
_RpbGetBucketReq'bucket
           (\ RpbGetBucketReq
x__ ByteString
y__ -> RpbGetBucketReq
x__ {_RpbGetBucketReq'bucket :: ByteString
_RpbGetBucketReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetBucketReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbGetBucketReq
-> f RpbGetBucketReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetBucketReq -> f RpbGetBucketReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbGetBucketReq
-> f RpbGetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketReq -> Maybe ByteString)
-> (RpbGetBucketReq -> Maybe ByteString -> RpbGetBucketReq)
-> Lens
     RpbGetBucketReq
     RpbGetBucketReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketReq -> Maybe ByteString
_RpbGetBucketReq'type'
           (\ RpbGetBucketReq
x__ Maybe ByteString
y__ -> RpbGetBucketReq
x__ {_RpbGetBucketReq'type' :: Maybe ByteString
_RpbGetBucketReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetBucketReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetBucketReq
-> f RpbGetBucketReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetBucketReq -> f RpbGetBucketReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetBucketReq
-> f RpbGetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketReq -> Maybe ByteString)
-> (RpbGetBucketReq -> Maybe ByteString -> RpbGetBucketReq)
-> Lens
     RpbGetBucketReq
     RpbGetBucketReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketReq -> Maybe ByteString
_RpbGetBucketReq'type'
           (\ RpbGetBucketReq
x__ Maybe ByteString
y__ -> RpbGetBucketReq
x__ {_RpbGetBucketReq'type' :: Maybe ByteString
_RpbGetBucketReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetBucketReq where
  messageName :: Proxy RpbGetBucketReq -> Text
messageName Proxy RpbGetBucketReq
_ = String -> Text
Data.Text.pack String
"RpbGetBucketReq"
  packedMessageDescriptor :: Proxy RpbGetBucketReq -> ByteString
packedMessageDescriptor Proxy RpbGetBucketReq
_
    = ByteString
"\n\
      \\SIRpbGetBucketReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DC2\n\
      \\EOTtype\CAN\STX \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbGetBucketReq -> ByteString
packedFileDescriptor Proxy RpbGetBucketReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetBucketReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbGetBucketReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetBucketReq ByteString
-> FieldDescriptor RpbGetBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbGetBucketReq RpbGetBucketReq ByteString ByteString
-> FieldAccessor RpbGetBucketReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketReq
        type'__field_descriptor :: FieldDescriptor RpbGetBucketReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetBucketReq ByteString
-> FieldDescriptor RpbGetBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbGetBucketReq
  RpbGetBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbGetBucketReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketReq
      in
        [(Tag, FieldDescriptor RpbGetBucketReq)]
-> Map Tag (FieldDescriptor RpbGetBucketReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetBucketReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbGetBucketReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbGetBucketReq FieldSet
unknownFields
    = (RpbGetBucketReq -> FieldSet)
-> (RpbGetBucketReq -> FieldSet -> RpbGetBucketReq)
-> Lens' RpbGetBucketReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetBucketReq -> FieldSet
_RpbGetBucketReq'_unknownFields
        (\ RpbGetBucketReq
x__ FieldSet
y__ -> RpbGetBucketReq
x__ {_RpbGetBucketReq'_unknownFields :: FieldSet
_RpbGetBucketReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetBucketReq
defMessage
    = RpbGetBucketReq'_constructor :: ByteString -> Maybe ByteString -> FieldSet -> RpbGetBucketReq
RpbGetBucketReq'_constructor
        {_RpbGetBucketReq'bucket :: ByteString
_RpbGetBucketReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbGetBucketReq'type' :: Maybe ByteString
_RpbGetBucketReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbGetBucketReq'_unknownFields :: FieldSet
_RpbGetBucketReq'_unknownFields = []}
  parseMessage :: Parser RpbGetBucketReq
parseMessage
    = let
        loop ::
          RpbGetBucketReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetBucketReq
        loop :: RpbGetBucketReq -> Bool -> Parser RpbGetBucketReq
loop RpbGetBucketReq
x Bool
required'bucket
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbGetBucketReq -> Parser RpbGetBucketReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetBucketReq RpbGetBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetBucketReq -> RpbGetBucketReq
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 RpbGetBucketReq RpbGetBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetBucketReq
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
"bucket"
                                RpbGetBucketReq -> Bool -> Parser RpbGetBucketReq
loop
                                  (Setter RpbGetBucketReq RpbGetBucketReq ByteString ByteString
-> ByteString -> RpbGetBucketReq -> RpbGetBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbGetBucketReq
x)
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"type"
                                RpbGetBucketReq -> Bool -> Parser RpbGetBucketReq
loop
                                  (Setter RpbGetBucketReq RpbGetBucketReq ByteString ByteString
-> ByteString -> RpbGetBucketReq -> RpbGetBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbGetBucketReq
x)
                                  Bool
required'bucket
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetBucketReq -> Bool -> Parser RpbGetBucketReq
loop
                                  (Setter RpbGetBucketReq RpbGetBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetBucketReq -> RpbGetBucketReq
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 RpbGetBucketReq RpbGetBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetBucketReq
x)
                                  Bool
required'bucket
      in
        Parser RpbGetBucketReq -> String -> Parser RpbGetBucketReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetBucketReq -> Bool -> Parser RpbGetBucketReq
loop RpbGetBucketReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"RpbGetBucketReq"
  buildMessage :: RpbGetBucketReq -> Builder
buildMessage
    = \ RpbGetBucketReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbGetBucketReq RpbGetBucketReq ByteString ByteString
-> RpbGetBucketReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbGetBucketReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbGetBucketReq
  RpbGetBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbGetBucketReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbGetBucketReq
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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 RpbGetBucketReq RpbGetBucketReq FieldSet FieldSet
-> RpbGetBucketReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbGetBucketReq RpbGetBucketReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetBucketReq
_x)))
instance Control.DeepSeq.NFData RpbGetBucketReq where
  rnf :: RpbGetBucketReq -> ()
rnf
    = \ RpbGetBucketReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetBucketReq -> FieldSet
_RpbGetBucketReq'_unknownFields RpbGetBucketReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbGetBucketReq -> ByteString
_RpbGetBucketReq'bucket RpbGetBucketReq
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbGetBucketReq -> Maybe ByteString
_RpbGetBucketReq'type' RpbGetBucketReq
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.props' @:: Lens' RpbGetBucketResp RpbBucketProps@ -}
data RpbGetBucketResp
  = RpbGetBucketResp'_constructor {RpbGetBucketResp -> RpbBucketProps
_RpbGetBucketResp'props :: !RpbBucketProps,
                                   RpbGetBucketResp -> FieldSet
_RpbGetBucketResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetBucketResp -> RpbGetBucketResp -> Bool
(RpbGetBucketResp -> RpbGetBucketResp -> Bool)
-> (RpbGetBucketResp -> RpbGetBucketResp -> Bool)
-> Eq RpbGetBucketResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
$c/= :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
== :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
$c== :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
Prelude.Eq, Eq RpbGetBucketResp
Eq RpbGetBucketResp
-> (RpbGetBucketResp -> RpbGetBucketResp -> Ordering)
-> (RpbGetBucketResp -> RpbGetBucketResp -> Bool)
-> (RpbGetBucketResp -> RpbGetBucketResp -> Bool)
-> (RpbGetBucketResp -> RpbGetBucketResp -> Bool)
-> (RpbGetBucketResp -> RpbGetBucketResp -> Bool)
-> (RpbGetBucketResp -> RpbGetBucketResp -> RpbGetBucketResp)
-> (RpbGetBucketResp -> RpbGetBucketResp -> RpbGetBucketResp)
-> Ord RpbGetBucketResp
RpbGetBucketResp -> RpbGetBucketResp -> Bool
RpbGetBucketResp -> RpbGetBucketResp -> Ordering
RpbGetBucketResp -> RpbGetBucketResp -> RpbGetBucketResp
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 :: RpbGetBucketResp -> RpbGetBucketResp -> RpbGetBucketResp
$cmin :: RpbGetBucketResp -> RpbGetBucketResp -> RpbGetBucketResp
max :: RpbGetBucketResp -> RpbGetBucketResp -> RpbGetBucketResp
$cmax :: RpbGetBucketResp -> RpbGetBucketResp -> RpbGetBucketResp
>= :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
$c>= :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
> :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
$c> :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
<= :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
$c<= :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
< :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
$c< :: RpbGetBucketResp -> RpbGetBucketResp -> Bool
compare :: RpbGetBucketResp -> RpbGetBucketResp -> Ordering
$ccompare :: RpbGetBucketResp -> RpbGetBucketResp -> Ordering
$cp1Ord :: Eq RpbGetBucketResp
Prelude.Ord)
instance Prelude.Show RpbGetBucketResp where
  showsPrec :: Int -> RpbGetBucketResp -> ShowS
showsPrec Int
_ RpbGetBucketResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetBucketResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetBucketResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetBucketResp "props" RpbBucketProps where
  fieldOf :: Proxy# "props"
-> (RpbBucketProps -> f RpbBucketProps)
-> RpbGetBucketResp
-> f RpbGetBucketResp
fieldOf Proxy# "props"
_
    = ((RpbBucketProps -> f RpbBucketProps)
 -> RpbGetBucketResp -> f RpbGetBucketResp)
-> ((RpbBucketProps -> f RpbBucketProps)
    -> RpbBucketProps -> f RpbBucketProps)
-> (RpbBucketProps -> f RpbBucketProps)
-> RpbGetBucketResp
-> f RpbGetBucketResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketResp -> RpbBucketProps)
-> (RpbGetBucketResp -> RpbBucketProps -> RpbGetBucketResp)
-> Lens
     RpbGetBucketResp RpbGetBucketResp RpbBucketProps RpbBucketProps
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketResp -> RpbBucketProps
_RpbGetBucketResp'props
           (\ RpbGetBucketResp
x__ RpbBucketProps
y__ -> RpbGetBucketResp
x__ {_RpbGetBucketResp'props :: RpbBucketProps
_RpbGetBucketResp'props = RpbBucketProps
y__}))
        (RpbBucketProps -> f RpbBucketProps)
-> RpbBucketProps -> f RpbBucketProps
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetBucketResp where
  messageName :: Proxy RpbGetBucketResp -> Text
messageName Proxy RpbGetBucketResp
_ = String -> Text
Data.Text.pack String
"RpbGetBucketResp"
  packedMessageDescriptor :: Proxy RpbGetBucketResp -> ByteString
packedMessageDescriptor Proxy RpbGetBucketResp
_
    = ByteString
"\n\
      \\DLERpbGetBucketResp\DC2%\n\
      \\ENQprops\CAN\SOH \STX(\v2\SI.RpbBucketPropsR\ENQprops"
  packedFileDescriptor :: Proxy RpbGetBucketResp -> ByteString
packedFileDescriptor Proxy RpbGetBucketResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetBucketResp)
fieldsByTag
    = let
        props__field_descriptor :: FieldDescriptor RpbGetBucketResp
props__field_descriptor
          = String
-> FieldTypeDescriptor RpbBucketProps
-> FieldAccessor RpbGetBucketResp RpbBucketProps
-> FieldDescriptor RpbGetBucketResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"props"
              (MessageOrGroup -> FieldTypeDescriptor RpbBucketProps
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbBucketProps)
              (WireDefault RpbBucketProps
-> Lens
     RpbGetBucketResp RpbGetBucketResp RpbBucketProps RpbBucketProps
-> FieldAccessor RpbGetBucketResp RpbBucketProps
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbBucketProps
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketResp
      in
        [(Tag, FieldDescriptor RpbGetBucketResp)]
-> Map Tag (FieldDescriptor RpbGetBucketResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetBucketResp
props__field_descriptor)]
  unknownFields :: LensLike' f RpbGetBucketResp FieldSet
unknownFields
    = (RpbGetBucketResp -> FieldSet)
-> (RpbGetBucketResp -> FieldSet -> RpbGetBucketResp)
-> Lens' RpbGetBucketResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetBucketResp -> FieldSet
_RpbGetBucketResp'_unknownFields
        (\ RpbGetBucketResp
x__ FieldSet
y__ -> RpbGetBucketResp
x__ {_RpbGetBucketResp'_unknownFields :: FieldSet
_RpbGetBucketResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetBucketResp
defMessage
    = RpbGetBucketResp'_constructor :: RpbBucketProps -> FieldSet -> RpbGetBucketResp
RpbGetBucketResp'_constructor
        {_RpbGetBucketResp'props :: RpbBucketProps
_RpbGetBucketResp'props = RpbBucketProps
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbGetBucketResp'_unknownFields :: FieldSet
_RpbGetBucketResp'_unknownFields = []}
  parseMessage :: Parser RpbGetBucketResp
parseMessage
    = let
        loop ::
          RpbGetBucketResp
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetBucketResp
        loop :: RpbGetBucketResp -> Bool -> Parser RpbGetBucketResp
loop RpbGetBucketResp
x Bool
required'props
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'props then (:) String
"props" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbGetBucketResp -> Parser RpbGetBucketResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetBucketResp RpbGetBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetBucketResp -> RpbGetBucketResp
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 RpbGetBucketResp RpbGetBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetBucketResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do RpbBucketProps
y <- Parser RpbBucketProps -> String -> Parser RpbBucketProps
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbBucketProps -> Parser RpbBucketProps
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 RpbBucketProps
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"props"
                                RpbGetBucketResp -> Bool -> Parser RpbGetBucketResp
loop
                                  (Setter
  RpbGetBucketResp RpbGetBucketResp RpbBucketProps RpbBucketProps
-> RpbBucketProps -> RpbGetBucketResp -> RpbGetBucketResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props") RpbBucketProps
y RpbGetBucketResp
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetBucketResp -> Bool -> Parser RpbGetBucketResp
loop
                                  (Setter RpbGetBucketResp RpbGetBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetBucketResp -> RpbGetBucketResp
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 RpbGetBucketResp RpbGetBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetBucketResp
x)
                                  Bool
required'props
      in
        Parser RpbGetBucketResp -> String -> Parser RpbGetBucketResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetBucketResp -> Bool -> Parser RpbGetBucketResp
loop RpbGetBucketResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"RpbGetBucketResp"
  buildMessage :: RpbGetBucketResp -> Builder
buildMessage
    = \ RpbGetBucketResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                ((ByteString -> Builder)
-> (RpbBucketProps -> ByteString) -> RpbBucketProps -> 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))
                   RpbBucketProps -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                   (FoldLike
  RpbBucketProps
  RpbGetBucketResp
  RpbGetBucketResp
  RpbBucketProps
  RpbBucketProps
-> RpbGetBucketResp -> RpbBucketProps
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props") RpbGetBucketResp
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet RpbGetBucketResp RpbGetBucketResp FieldSet FieldSet
-> RpbGetBucketResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbGetBucketResp RpbGetBucketResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetBucketResp
_x))
instance Control.DeepSeq.NFData RpbGetBucketResp where
  rnf :: RpbGetBucketResp -> ()
rnf
    = \ RpbGetBucketResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetBucketResp -> FieldSet
_RpbGetBucketResp'_unknownFields RpbGetBucketResp
x__)
             (RpbBucketProps -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbGetBucketResp -> RpbBucketProps
_RpbGetBucketResp'props RpbGetBucketResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbGetBucketTypeReq Data.ByteString.ByteString@ -}
data RpbGetBucketTypeReq
  = RpbGetBucketTypeReq'_constructor {RpbGetBucketTypeReq -> ByteString
_RpbGetBucketTypeReq'type' :: !Data.ByteString.ByteString,
                                      RpbGetBucketTypeReq -> FieldSet
_RpbGetBucketTypeReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
(RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool)
-> (RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool)
-> Eq RpbGetBucketTypeReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
$c/= :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
== :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
$c== :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
Prelude.Eq, Eq RpbGetBucketTypeReq
Eq RpbGetBucketTypeReq
-> (RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Ordering)
-> (RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool)
-> (RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool)
-> (RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool)
-> (RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool)
-> (RpbGetBucketTypeReq
    -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq)
-> (RpbGetBucketTypeReq
    -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq)
-> Ord RpbGetBucketTypeReq
RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Ordering
RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq
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 :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq
$cmin :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq
max :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq
$cmax :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq
>= :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
$c>= :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
> :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
$c> :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
<= :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
$c<= :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
< :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
$c< :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Bool
compare :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Ordering
$ccompare :: RpbGetBucketTypeReq -> RpbGetBucketTypeReq -> Ordering
$cp1Ord :: Eq RpbGetBucketTypeReq
Prelude.Ord)
instance Prelude.Show RpbGetBucketTypeReq where
  showsPrec :: Int -> RpbGetBucketTypeReq -> ShowS
showsPrec Int
_ RpbGetBucketTypeReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetBucketTypeReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetBucketTypeReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetBucketTypeReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbGetBucketTypeReq
-> f RpbGetBucketTypeReq
fieldOf Proxy# "type'"
_
    = ((ByteString -> f ByteString)
 -> RpbGetBucketTypeReq -> f RpbGetBucketTypeReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbGetBucketTypeReq
-> f RpbGetBucketTypeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetBucketTypeReq -> ByteString)
-> (RpbGetBucketTypeReq -> ByteString -> RpbGetBucketTypeReq)
-> Lens
     RpbGetBucketTypeReq RpbGetBucketTypeReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetBucketTypeReq -> ByteString
_RpbGetBucketTypeReq'type'
           (\ RpbGetBucketTypeReq
x__ ByteString
y__ -> RpbGetBucketTypeReq
x__ {_RpbGetBucketTypeReq'type' :: ByteString
_RpbGetBucketTypeReq'type' = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetBucketTypeReq where
  messageName :: Proxy RpbGetBucketTypeReq -> Text
messageName Proxy RpbGetBucketTypeReq
_ = String -> Text
Data.Text.pack String
"RpbGetBucketTypeReq"
  packedMessageDescriptor :: Proxy RpbGetBucketTypeReq -> ByteString
packedMessageDescriptor Proxy RpbGetBucketTypeReq
_
    = ByteString
"\n\
      \\DC3RpbGetBucketTypeReq\DC2\DC2\n\
      \\EOTtype\CAN\SOH \STX(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbGetBucketTypeReq -> ByteString
packedFileDescriptor Proxy RpbGetBucketTypeReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetBucketTypeReq)
fieldsByTag
    = let
        type'__field_descriptor :: FieldDescriptor RpbGetBucketTypeReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetBucketTypeReq ByteString
-> FieldDescriptor RpbGetBucketTypeReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (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
     RpbGetBucketTypeReq RpbGetBucketTypeReq ByteString ByteString
-> FieldAccessor RpbGetBucketTypeReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'")) ::
              Data.ProtoLens.FieldDescriptor RpbGetBucketTypeReq
      in
        [(Tag, FieldDescriptor RpbGetBucketTypeReq)]
-> Map Tag (FieldDescriptor RpbGetBucketTypeReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetBucketTypeReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbGetBucketTypeReq FieldSet
unknownFields
    = (RpbGetBucketTypeReq -> FieldSet)
-> (RpbGetBucketTypeReq -> FieldSet -> RpbGetBucketTypeReq)
-> Lens' RpbGetBucketTypeReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetBucketTypeReq -> FieldSet
_RpbGetBucketTypeReq'_unknownFields
        (\ RpbGetBucketTypeReq
x__ FieldSet
y__ -> RpbGetBucketTypeReq
x__ {_RpbGetBucketTypeReq'_unknownFields :: FieldSet
_RpbGetBucketTypeReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetBucketTypeReq
defMessage
    = RpbGetBucketTypeReq'_constructor :: ByteString -> FieldSet -> RpbGetBucketTypeReq
RpbGetBucketTypeReq'_constructor
        {_RpbGetBucketTypeReq'type' :: ByteString
_RpbGetBucketTypeReq'type' = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbGetBucketTypeReq'_unknownFields :: FieldSet
_RpbGetBucketTypeReq'_unknownFields = []}
  parseMessage :: Parser RpbGetBucketTypeReq
parseMessage
    = let
        loop ::
          RpbGetBucketTypeReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetBucketTypeReq
        loop :: RpbGetBucketTypeReq -> Bool -> Parser RpbGetBucketTypeReq
loop RpbGetBucketTypeReq
x Bool
required'type'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'type' then (:) String
"type" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbGetBucketTypeReq -> Parser RpbGetBucketTypeReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetBucketTypeReq RpbGetBucketTypeReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetBucketTypeReq
-> RpbGetBucketTypeReq
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 RpbGetBucketTypeReq RpbGetBucketTypeReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetBucketTypeReq
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
"type"
                                RpbGetBucketTypeReq -> Bool -> Parser RpbGetBucketTypeReq
loop
                                  (Setter
  RpbGetBucketTypeReq RpbGetBucketTypeReq ByteString ByteString
-> ByteString -> RpbGetBucketTypeReq -> RpbGetBucketTypeReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbGetBucketTypeReq
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetBucketTypeReq -> Bool -> Parser RpbGetBucketTypeReq
loop
                                  (Setter RpbGetBucketTypeReq RpbGetBucketTypeReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetBucketTypeReq
-> RpbGetBucketTypeReq
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 RpbGetBucketTypeReq RpbGetBucketTypeReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetBucketTypeReq
x)
                                  Bool
required'type'
      in
        Parser RpbGetBucketTypeReq -> String -> Parser RpbGetBucketTypeReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetBucketTypeReq -> Bool -> Parser RpbGetBucketTypeReq
loop RpbGetBucketTypeReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbGetBucketTypeReq"
  buildMessage :: RpbGetBucketTypeReq -> Builder
buildMessage
    = \ RpbGetBucketTypeReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbGetBucketTypeReq
  RpbGetBucketTypeReq
  ByteString
  ByteString
-> RpbGetBucketTypeReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") RpbGetBucketTypeReq
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet RpbGetBucketTypeReq RpbGetBucketTypeReq FieldSet FieldSet
-> RpbGetBucketTypeReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbGetBucketTypeReq RpbGetBucketTypeReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetBucketTypeReq
_x))
instance Control.DeepSeq.NFData RpbGetBucketTypeReq where
  rnf :: RpbGetBucketTypeReq -> ()
rnf
    = \ RpbGetBucketTypeReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetBucketTypeReq -> FieldSet
_RpbGetBucketTypeReq'_unknownFields RpbGetBucketTypeReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbGetBucketTypeReq -> ByteString
_RpbGetBucketTypeReq'type' RpbGetBucketTypeReq
x__) ())
{- | Fields :
      -}
data RpbGetClientIdReq
  = RpbGetClientIdReq'_constructor {RpbGetClientIdReq -> FieldSet
_RpbGetClientIdReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
(RpbGetClientIdReq -> RpbGetClientIdReq -> Bool)
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> Bool)
-> Eq RpbGetClientIdReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
$c/= :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
== :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
$c== :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
Prelude.Eq, Eq RpbGetClientIdReq
Eq RpbGetClientIdReq
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> Ordering)
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> Bool)
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> Bool)
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> Bool)
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> Bool)
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> RpbGetClientIdReq)
-> (RpbGetClientIdReq -> RpbGetClientIdReq -> RpbGetClientIdReq)
-> Ord RpbGetClientIdReq
RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
RpbGetClientIdReq -> RpbGetClientIdReq -> Ordering
RpbGetClientIdReq -> RpbGetClientIdReq -> RpbGetClientIdReq
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 :: RpbGetClientIdReq -> RpbGetClientIdReq -> RpbGetClientIdReq
$cmin :: RpbGetClientIdReq -> RpbGetClientIdReq -> RpbGetClientIdReq
max :: RpbGetClientIdReq -> RpbGetClientIdReq -> RpbGetClientIdReq
$cmax :: RpbGetClientIdReq -> RpbGetClientIdReq -> RpbGetClientIdReq
>= :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
$c>= :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
> :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
$c> :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
<= :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
$c<= :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
< :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
$c< :: RpbGetClientIdReq -> RpbGetClientIdReq -> Bool
compare :: RpbGetClientIdReq -> RpbGetClientIdReq -> Ordering
$ccompare :: RpbGetClientIdReq -> RpbGetClientIdReq -> Ordering
$cp1Ord :: Eq RpbGetClientIdReq
Prelude.Ord)
instance Prelude.Show RpbGetClientIdReq where
  showsPrec :: Int -> RpbGetClientIdReq -> ShowS
showsPrec Int
_ RpbGetClientIdReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetClientIdReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetClientIdReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbGetClientIdReq where
  messageName :: Proxy RpbGetClientIdReq -> Text
messageName Proxy RpbGetClientIdReq
_ = String -> Text
Data.Text.pack String
"RpbGetClientIdReq"
  packedMessageDescriptor :: Proxy RpbGetClientIdReq -> ByteString
packedMessageDescriptor Proxy RpbGetClientIdReq
_
    = ByteString
"\n\
      \\DC1RpbGetClientIdReq"
  packedFileDescriptor :: Proxy RpbGetClientIdReq -> ByteString
packedFileDescriptor Proxy RpbGetClientIdReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetClientIdReq)
fieldsByTag = let in [(Tag, FieldDescriptor RpbGetClientIdReq)]
-> Map Tag (FieldDescriptor RpbGetClientIdReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbGetClientIdReq FieldSet
unknownFields
    = (RpbGetClientIdReq -> FieldSet)
-> (RpbGetClientIdReq -> FieldSet -> RpbGetClientIdReq)
-> Lens' RpbGetClientIdReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetClientIdReq -> FieldSet
_RpbGetClientIdReq'_unknownFields
        (\ RpbGetClientIdReq
x__ FieldSet
y__ -> RpbGetClientIdReq
x__ {_RpbGetClientIdReq'_unknownFields :: FieldSet
_RpbGetClientIdReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetClientIdReq
defMessage
    = RpbGetClientIdReq'_constructor :: FieldSet -> RpbGetClientIdReq
RpbGetClientIdReq'_constructor
        {_RpbGetClientIdReq'_unknownFields :: FieldSet
_RpbGetClientIdReq'_unknownFields = []}
  parseMessage :: Parser RpbGetClientIdReq
parseMessage
    = let
        loop ::
          RpbGetClientIdReq
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetClientIdReq
        loop :: RpbGetClientIdReq -> Parser RpbGetClientIdReq
loop RpbGetClientIdReq
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]))))
                      RpbGetClientIdReq -> Parser RpbGetClientIdReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetClientIdReq RpbGetClientIdReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetClientIdReq -> RpbGetClientIdReq
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 RpbGetClientIdReq RpbGetClientIdReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetClientIdReq
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetClientIdReq -> Parser RpbGetClientIdReq
loop
                                  (Setter RpbGetClientIdReq RpbGetClientIdReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetClientIdReq -> RpbGetClientIdReq
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 RpbGetClientIdReq RpbGetClientIdReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetClientIdReq
x) }
      in
        Parser RpbGetClientIdReq -> String -> Parser RpbGetClientIdReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetClientIdReq -> Parser RpbGetClientIdReq
loop RpbGetClientIdReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbGetClientIdReq"
  buildMessage :: RpbGetClientIdReq -> Builder
buildMessage
    = \ RpbGetClientIdReq
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike
  FieldSet RpbGetClientIdReq RpbGetClientIdReq FieldSet FieldSet
-> RpbGetClientIdReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbGetClientIdReq RpbGetClientIdReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetClientIdReq
_x)
instance Control.DeepSeq.NFData RpbGetClientIdReq where
  rnf :: RpbGetClientIdReq -> ()
rnf
    = \ RpbGetClientIdReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetClientIdReq -> FieldSet
_RpbGetClientIdReq'_unknownFields RpbGetClientIdReq
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.clientId' @:: Lens' RpbGetClientIdResp Data.ByteString.ByteString@ -}
data RpbGetClientIdResp
  = RpbGetClientIdResp'_constructor {RpbGetClientIdResp -> ByteString
_RpbGetClientIdResp'clientId :: !Data.ByteString.ByteString,
                                     RpbGetClientIdResp -> FieldSet
_RpbGetClientIdResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
(RpbGetClientIdResp -> RpbGetClientIdResp -> Bool)
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> Bool)
-> Eq RpbGetClientIdResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
$c/= :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
== :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
$c== :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
Prelude.Eq, Eq RpbGetClientIdResp
Eq RpbGetClientIdResp
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> Ordering)
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> Bool)
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> Bool)
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> Bool)
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> Bool)
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> RpbGetClientIdResp)
-> (RpbGetClientIdResp -> RpbGetClientIdResp -> RpbGetClientIdResp)
-> Ord RpbGetClientIdResp
RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
RpbGetClientIdResp -> RpbGetClientIdResp -> Ordering
RpbGetClientIdResp -> RpbGetClientIdResp -> RpbGetClientIdResp
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 :: RpbGetClientIdResp -> RpbGetClientIdResp -> RpbGetClientIdResp
$cmin :: RpbGetClientIdResp -> RpbGetClientIdResp -> RpbGetClientIdResp
max :: RpbGetClientIdResp -> RpbGetClientIdResp -> RpbGetClientIdResp
$cmax :: RpbGetClientIdResp -> RpbGetClientIdResp -> RpbGetClientIdResp
>= :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
$c>= :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
> :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
$c> :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
<= :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
$c<= :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
< :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
$c< :: RpbGetClientIdResp -> RpbGetClientIdResp -> Bool
compare :: RpbGetClientIdResp -> RpbGetClientIdResp -> Ordering
$ccompare :: RpbGetClientIdResp -> RpbGetClientIdResp -> Ordering
$cp1Ord :: Eq RpbGetClientIdResp
Prelude.Ord)
instance Prelude.Show RpbGetClientIdResp where
  showsPrec :: Int -> RpbGetClientIdResp -> ShowS
showsPrec Int
_ RpbGetClientIdResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetClientIdResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetClientIdResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetClientIdResp "clientId" Data.ByteString.ByteString where
  fieldOf :: Proxy# "clientId"
-> (ByteString -> f ByteString)
-> RpbGetClientIdResp
-> f RpbGetClientIdResp
fieldOf Proxy# "clientId"
_
    = ((ByteString -> f ByteString)
 -> RpbGetClientIdResp -> f RpbGetClientIdResp)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbGetClientIdResp
-> f RpbGetClientIdResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetClientIdResp -> ByteString)
-> (RpbGetClientIdResp -> ByteString -> RpbGetClientIdResp)
-> Lens RpbGetClientIdResp RpbGetClientIdResp ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetClientIdResp -> ByteString
_RpbGetClientIdResp'clientId
           (\ RpbGetClientIdResp
x__ ByteString
y__ -> RpbGetClientIdResp
x__ {_RpbGetClientIdResp'clientId :: ByteString
_RpbGetClientIdResp'clientId = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetClientIdResp where
  messageName :: Proxy RpbGetClientIdResp -> Text
messageName Proxy RpbGetClientIdResp
_ = String -> Text
Data.Text.pack String
"RpbGetClientIdResp"
  packedMessageDescriptor :: Proxy RpbGetClientIdResp -> ByteString
packedMessageDescriptor Proxy RpbGetClientIdResp
_
    = ByteString
"\n\
      \\DC2RpbGetClientIdResp\DC2\ESC\n\
      \\tclient_id\CAN\SOH \STX(\fR\bclientId"
  packedFileDescriptor :: Proxy RpbGetClientIdResp -> ByteString
packedFileDescriptor Proxy RpbGetClientIdResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetClientIdResp)
fieldsByTag
    = let
        clientId__field_descriptor :: FieldDescriptor RpbGetClientIdResp
clientId__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetClientIdResp ByteString
-> FieldDescriptor RpbGetClientIdResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"client_id"
              (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 RpbGetClientIdResp RpbGetClientIdResp ByteString ByteString
-> FieldAccessor RpbGetClientIdResp ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "clientId" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"clientId")) ::
              Data.ProtoLens.FieldDescriptor RpbGetClientIdResp
      in
        [(Tag, FieldDescriptor RpbGetClientIdResp)]
-> Map Tag (FieldDescriptor RpbGetClientIdResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetClientIdResp
clientId__field_descriptor)]
  unknownFields :: LensLike' f RpbGetClientIdResp FieldSet
unknownFields
    = (RpbGetClientIdResp -> FieldSet)
-> (RpbGetClientIdResp -> FieldSet -> RpbGetClientIdResp)
-> Lens' RpbGetClientIdResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetClientIdResp -> FieldSet
_RpbGetClientIdResp'_unknownFields
        (\ RpbGetClientIdResp
x__ FieldSet
y__ -> RpbGetClientIdResp
x__ {_RpbGetClientIdResp'_unknownFields :: FieldSet
_RpbGetClientIdResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetClientIdResp
defMessage
    = RpbGetClientIdResp'_constructor :: ByteString -> FieldSet -> RpbGetClientIdResp
RpbGetClientIdResp'_constructor
        {_RpbGetClientIdResp'clientId :: ByteString
_RpbGetClientIdResp'clientId = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbGetClientIdResp'_unknownFields :: FieldSet
_RpbGetClientIdResp'_unknownFields = []}
  parseMessage :: Parser RpbGetClientIdResp
parseMessage
    = let
        loop ::
          RpbGetClientIdResp
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetClientIdResp
        loop :: RpbGetClientIdResp -> Bool -> Parser RpbGetClientIdResp
loop RpbGetClientIdResp
x Bool
required'clientId
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'clientId then (:) String
"client_id" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbGetClientIdResp -> Parser RpbGetClientIdResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetClientIdResp RpbGetClientIdResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetClientIdResp
-> RpbGetClientIdResp
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 RpbGetClientIdResp RpbGetClientIdResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetClientIdResp
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
"client_id"
                                RpbGetClientIdResp -> Bool -> Parser RpbGetClientIdResp
loop
                                  (Setter RpbGetClientIdResp RpbGetClientIdResp ByteString ByteString
-> ByteString -> RpbGetClientIdResp -> RpbGetClientIdResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "clientId" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"clientId") ByteString
y RpbGetClientIdResp
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetClientIdResp -> Bool -> Parser RpbGetClientIdResp
loop
                                  (Setter RpbGetClientIdResp RpbGetClientIdResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetClientIdResp
-> RpbGetClientIdResp
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 RpbGetClientIdResp RpbGetClientIdResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetClientIdResp
x)
                                  Bool
required'clientId
      in
        Parser RpbGetClientIdResp -> String -> Parser RpbGetClientIdResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetClientIdResp -> Bool -> Parser RpbGetClientIdResp
loop RpbGetClientIdResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbGetClientIdResp"
  buildMessage :: RpbGetClientIdResp -> Builder
buildMessage
    = \ RpbGetClientIdResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbGetClientIdResp
  RpbGetClientIdResp
  ByteString
  ByteString
-> RpbGetClientIdResp -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "clientId" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"clientId") RpbGetClientIdResp
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet RpbGetClientIdResp RpbGetClientIdResp FieldSet FieldSet
-> RpbGetClientIdResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbGetClientIdResp RpbGetClientIdResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetClientIdResp
_x))
instance Control.DeepSeq.NFData RpbGetClientIdResp where
  rnf :: RpbGetClientIdResp -> ()
rnf
    = \ RpbGetClientIdResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetClientIdResp -> FieldSet
_RpbGetClientIdResp'_unknownFields RpbGetClientIdResp
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbGetClientIdResp -> ByteString
_RpbGetClientIdResp'clientId RpbGetClientIdResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.r' @:: Lens' RpbGetReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'r' @:: Lens' RpbGetReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.pr' @:: Lens' RpbGetReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pr' @:: Lens' RpbGetReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.basicQuorum' @:: Lens' RpbGetReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'basicQuorum' @:: Lens' RpbGetReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.notfoundOk' @:: Lens' RpbGetReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'notfoundOk' @:: Lens' RpbGetReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.ifModified' @:: Lens' RpbGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'ifModified' @:: Lens' RpbGetReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.head' @:: Lens' RpbGetReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'head' @:: Lens' RpbGetReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.deletedvclock' @:: Lens' RpbGetReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'deletedvclock' @:: Lens' RpbGetReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbGetReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbGetReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.sloppyQuorum' @:: Lens' RpbGetReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'sloppyQuorum' @:: Lens' RpbGetReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.nVal' @:: Lens' RpbGetReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'nVal' @:: Lens' RpbGetReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbGetReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbGetReq
  = RpbGetReq'_constructor {RpbGetReq -> ByteString
_RpbGetReq'bucket :: !Data.ByteString.ByteString,
                            RpbGetReq -> ByteString
_RpbGetReq'key :: !Data.ByteString.ByteString,
                            RpbGetReq -> Maybe Word32
_RpbGetReq'r :: !(Prelude.Maybe Data.Word.Word32),
                            RpbGetReq -> Maybe Word32
_RpbGetReq'pr :: !(Prelude.Maybe Data.Word.Word32),
                            RpbGetReq -> Maybe Bool
_RpbGetReq'basicQuorum :: !(Prelude.Maybe Prelude.Bool),
                            RpbGetReq -> Maybe Bool
_RpbGetReq'notfoundOk :: !(Prelude.Maybe Prelude.Bool),
                            RpbGetReq -> Maybe ByteString
_RpbGetReq'ifModified :: !(Prelude.Maybe Data.ByteString.ByteString),
                            RpbGetReq -> Maybe Bool
_RpbGetReq'head :: !(Prelude.Maybe Prelude.Bool),
                            RpbGetReq -> Maybe Bool
_RpbGetReq'deletedvclock :: !(Prelude.Maybe Prelude.Bool),
                            RpbGetReq -> Maybe Word32
_RpbGetReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                            RpbGetReq -> Maybe Bool
_RpbGetReq'sloppyQuorum :: !(Prelude.Maybe Prelude.Bool),
                            RpbGetReq -> Maybe Word32
_RpbGetReq'nVal :: !(Prelude.Maybe Data.Word.Word32),
                            RpbGetReq -> Maybe ByteString
_RpbGetReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                            RpbGetReq -> FieldSet
_RpbGetReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetReq -> RpbGetReq -> Bool
(RpbGetReq -> RpbGetReq -> Bool)
-> (RpbGetReq -> RpbGetReq -> Bool) -> Eq RpbGetReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetReq -> RpbGetReq -> Bool
$c/= :: RpbGetReq -> RpbGetReq -> Bool
== :: RpbGetReq -> RpbGetReq -> Bool
$c== :: RpbGetReq -> RpbGetReq -> Bool
Prelude.Eq, Eq RpbGetReq
Eq RpbGetReq
-> (RpbGetReq -> RpbGetReq -> Ordering)
-> (RpbGetReq -> RpbGetReq -> Bool)
-> (RpbGetReq -> RpbGetReq -> Bool)
-> (RpbGetReq -> RpbGetReq -> Bool)
-> (RpbGetReq -> RpbGetReq -> Bool)
-> (RpbGetReq -> RpbGetReq -> RpbGetReq)
-> (RpbGetReq -> RpbGetReq -> RpbGetReq)
-> Ord RpbGetReq
RpbGetReq -> RpbGetReq -> Bool
RpbGetReq -> RpbGetReq -> Ordering
RpbGetReq -> RpbGetReq -> RpbGetReq
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 :: RpbGetReq -> RpbGetReq -> RpbGetReq
$cmin :: RpbGetReq -> RpbGetReq -> RpbGetReq
max :: RpbGetReq -> RpbGetReq -> RpbGetReq
$cmax :: RpbGetReq -> RpbGetReq -> RpbGetReq
>= :: RpbGetReq -> RpbGetReq -> Bool
$c>= :: RpbGetReq -> RpbGetReq -> Bool
> :: RpbGetReq -> RpbGetReq -> Bool
$c> :: RpbGetReq -> RpbGetReq -> Bool
<= :: RpbGetReq -> RpbGetReq -> Bool
$c<= :: RpbGetReq -> RpbGetReq -> Bool
< :: RpbGetReq -> RpbGetReq -> Bool
$c< :: RpbGetReq -> RpbGetReq -> Bool
compare :: RpbGetReq -> RpbGetReq -> Ordering
$ccompare :: RpbGetReq -> RpbGetReq -> Ordering
$cp1Ord :: Eq RpbGetReq
Prelude.Ord)
instance Prelude.Show RpbGetReq where
  showsPrec :: Int -> RpbGetReq -> ShowS
showsPrec Int
_ RpbGetReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString) -> RpbGetReq -> f RpbGetReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> ByteString)
-> (RpbGetReq -> ByteString -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> ByteString
_RpbGetReq'bucket (\ RpbGetReq
x__ ByteString
y__ -> RpbGetReq
x__ {_RpbGetReq'bucket :: ByteString
_RpbGetReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString) -> RpbGetReq -> f RpbGetReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> ByteString)
-> (RpbGetReq -> ByteString -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> ByteString
_RpbGetReq'key (\ RpbGetReq
x__ ByteString
y__ -> RpbGetReq
x__ {_RpbGetReq'key :: ByteString
_RpbGetReq'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "r" Data.Word.Word32 where
  fieldOf :: Proxy# "r" -> (Word32 -> f Word32) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "r"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'r (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'r :: Maybe Word32
_RpbGetReq'r = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetReq "maybe'r" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'r"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'r"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'r (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'r :: Maybe Word32
_RpbGetReq'r = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "pr" Data.Word.Word32 where
  fieldOf :: Proxy# "pr" -> (Word32 -> f Word32) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "pr"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'pr (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'pr :: Maybe Word32
_RpbGetReq'pr = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetReq "maybe'pr" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pr"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'pr"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'pr (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'pr :: Maybe Word32
_RpbGetReq'pr = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "basicQuorum" Prelude.Bool where
  fieldOf :: Proxy# "basicQuorum"
-> (Bool -> f Bool) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'basicQuorum
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'basicQuorum :: Maybe Bool
_RpbGetReq'basicQuorum = 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 RpbGetReq "maybe'basicQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'basicQuorum"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'basicQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'basicQuorum
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'basicQuorum :: Maybe Bool
_RpbGetReq'basicQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "notfoundOk" Prelude.Bool where
  fieldOf :: Proxy# "notfoundOk" -> (Bool -> f Bool) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'notfoundOk
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'notfoundOk :: Maybe Bool
_RpbGetReq'notfoundOk = 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 RpbGetReq "maybe'notfoundOk" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'notfoundOk"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'notfoundOk"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'notfoundOk
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'notfoundOk :: Maybe Bool
_RpbGetReq'notfoundOk = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "ifModified" Data.ByteString.ByteString where
  fieldOf :: Proxy# "ifModified"
-> (ByteString -> f ByteString) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "ifModified"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetReq -> f RpbGetReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe ByteString)
-> (RpbGetReq -> Maybe ByteString -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe ByteString
_RpbGetReq'ifModified
           (\ RpbGetReq
x__ Maybe ByteString
y__ -> RpbGetReq
x__ {_RpbGetReq'ifModified :: Maybe ByteString
_RpbGetReq'ifModified = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetReq "maybe'ifModified" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'ifModified"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetReq
-> f RpbGetReq
fieldOf Proxy# "maybe'ifModified"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetReq -> f RpbGetReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe ByteString)
-> (RpbGetReq -> Maybe ByteString -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe ByteString
_RpbGetReq'ifModified
           (\ RpbGetReq
x__ Maybe ByteString
y__ -> RpbGetReq
x__ {_RpbGetReq'ifModified :: Maybe ByteString
_RpbGetReq'ifModified = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "head" Prelude.Bool where
  fieldOf :: Proxy# "head" -> (Bool -> f Bool) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "head"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'head (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'head :: Maybe Bool
_RpbGetReq'head = 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 RpbGetReq "maybe'head" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'head"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'head"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'head (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'head :: Maybe Bool
_RpbGetReq'head = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "deletedvclock" Prelude.Bool where
  fieldOf :: Proxy# "deletedvclock"
-> (Bool -> f Bool) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "deletedvclock"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'deletedvclock
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'deletedvclock :: Maybe Bool
_RpbGetReq'deletedvclock = 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 RpbGetReq "maybe'deletedvclock" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'deletedvclock"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'deletedvclock"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'deletedvclock
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'deletedvclock :: Maybe Bool
_RpbGetReq'deletedvclock = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'timeout (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'timeout :: Maybe Word32
_RpbGetReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'timeout (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'timeout :: Maybe Word32
_RpbGetReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "sloppyQuorum" Prelude.Bool where
  fieldOf :: Proxy# "sloppyQuorum"
-> (Bool -> f Bool) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'sloppyQuorum
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'sloppyQuorum :: Maybe Bool
_RpbGetReq'sloppyQuorum = 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 RpbGetReq "maybe'sloppyQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'sloppyQuorum"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Bool)
-> (RpbGetReq -> Maybe Bool -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Bool
_RpbGetReq'sloppyQuorum
           (\ RpbGetReq
x__ Maybe Bool
y__ -> RpbGetReq
x__ {_RpbGetReq'sloppyQuorum :: Maybe Bool
_RpbGetReq'sloppyQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "nVal" Data.Word.Word32 where
  fieldOf :: Proxy# "nVal" -> (Word32 -> f Word32) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'nVal (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'nVal :: Maybe Word32
_RpbGetReq'nVal = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetReq "maybe'nVal" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'nVal"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "maybe'nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbGetReq -> f RpbGetReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe Word32)
-> (RpbGetReq -> Maybe Word32 -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe Word32
_RpbGetReq'nVal (\ RpbGetReq
x__ Maybe Word32
y__ -> RpbGetReq
x__ {_RpbGetReq'nVal :: Maybe Word32
_RpbGetReq'nVal = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString) -> RpbGetReq -> f RpbGetReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetReq -> f RpbGetReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe ByteString)
-> (RpbGetReq -> Maybe ByteString -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe ByteString
_RpbGetReq'type' (\ RpbGetReq
x__ Maybe ByteString
y__ -> RpbGetReq
x__ {_RpbGetReq'type' :: Maybe ByteString
_RpbGetReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetReq
-> f RpbGetReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetReq -> f RpbGetReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetReq
-> f RpbGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetReq -> Maybe ByteString)
-> (RpbGetReq -> Maybe ByteString -> RpbGetReq)
-> Lens RpbGetReq RpbGetReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetReq -> Maybe ByteString
_RpbGetReq'type' (\ RpbGetReq
x__ Maybe ByteString
y__ -> RpbGetReq
x__ {_RpbGetReq'type' :: Maybe ByteString
_RpbGetReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetReq where
  messageName :: Proxy RpbGetReq -> Text
messageName Proxy RpbGetReq
_ = String -> Text
Data.Text.pack String
"RpbGetReq"
  packedMessageDescriptor :: Proxy RpbGetReq -> ByteString
packedMessageDescriptor Proxy RpbGetReq
_
    = ByteString
"\n\
      \\tRpbGetReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\f\n\
      \\SOHr\CAN\ETX \SOH(\rR\SOHr\DC2\SO\n\
      \\STXpr\CAN\EOT \SOH(\rR\STXpr\DC2!\n\
      \\fbasic_quorum\CAN\ENQ \SOH(\bR\vbasicQuorum\DC2\US\n\
      \\vnotfound_ok\CAN\ACK \SOH(\bR\n\
      \notfoundOk\DC2\US\n\
      \\vif_modified\CAN\a \SOH(\fR\n\
      \ifModified\DC2\DC2\n\
      \\EOThead\CAN\b \SOH(\bR\EOThead\DC2$\n\
      \\rdeletedvclock\CAN\t \SOH(\bR\rdeletedvclock\DC2\CAN\n\
      \\atimeout\CAN\n\
      \ \SOH(\rR\atimeout\DC2#\n\
      \\rsloppy_quorum\CAN\v \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
      \\ENQn_val\CAN\f \SOH(\rR\EOTnVal\DC2\DC2\n\
      \\EOTtype\CAN\r \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbGetReq -> ByteString
packedFileDescriptor Proxy RpbGetReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbGetReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetReq ByteString
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbGetReq RpbGetReq ByteString ByteString
-> FieldAccessor RpbGetReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        key__field_descriptor :: FieldDescriptor RpbGetReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetReq ByteString
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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 RpbGetReq RpbGetReq ByteString ByteString
-> FieldAccessor RpbGetReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        r__field_descriptor :: FieldDescriptor RpbGetReq
r__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbGetReq Word32
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"r"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbGetReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        pr__field_descriptor :: FieldDescriptor RpbGetReq
pr__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbGetReq Word32
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pr"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbGetReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        basicQuorum__field_descriptor :: FieldDescriptor RpbGetReq
basicQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbGetReq Bool
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"basic_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbGetReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'basicQuorum")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        notfoundOk__field_descriptor :: FieldDescriptor RpbGetReq
notfoundOk__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbGetReq Bool
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"notfound_ok"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbGetReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'notfoundOk")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        ifModified__field_descriptor :: FieldDescriptor RpbGetReq
ifModified__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetReq ByteString
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"if_modified"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbGetReq RpbGetReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbGetReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'ifModified" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ifModified")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        head__field_descriptor :: FieldDescriptor RpbGetReq
head__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbGetReq Bool
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"head"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbGetReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'head" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'head")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        deletedvclock__field_descriptor :: FieldDescriptor RpbGetReq
deletedvclock__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbGetReq Bool
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"deletedvclock"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbGetReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'deletedvclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'deletedvclock")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        timeout__field_descriptor :: FieldDescriptor RpbGetReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbGetReq Word32
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbGetReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        sloppyQuorum__field_descriptor :: FieldDescriptor RpbGetReq
sloppyQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbGetReq Bool
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"sloppy_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbGetReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        nVal__field_descriptor :: FieldDescriptor RpbGetReq
nVal__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbGetReq Word32
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"n_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)
              (Lens RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbGetReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
        type'__field_descriptor :: FieldDescriptor RpbGetReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetReq ByteString
-> FieldDescriptor RpbGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbGetReq RpbGetReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbGetReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbGetReq
      in
        [(Tag, FieldDescriptor RpbGetReq)]
-> Map Tag (FieldDescriptor RpbGetReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbGetReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbGetReq
r__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbGetReq
pr__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbGetReq
basicQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbGetReq
notfoundOk__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbGetReq
ifModified__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbGetReq
head__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbGetReq
deletedvclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbGetReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor RpbGetReq
sloppyQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
12, FieldDescriptor RpbGetReq
nVal__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
13, FieldDescriptor RpbGetReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbGetReq FieldSet
unknownFields
    = (RpbGetReq -> FieldSet)
-> (RpbGetReq -> FieldSet -> RpbGetReq) -> Lens' RpbGetReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetReq -> FieldSet
_RpbGetReq'_unknownFields
        (\ RpbGetReq
x__ FieldSet
y__ -> RpbGetReq
x__ {_RpbGetReq'_unknownFields :: FieldSet
_RpbGetReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetReq
defMessage
    = RpbGetReq'_constructor :: ByteString
-> ByteString
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Maybe ByteString
-> Maybe Bool
-> Maybe Bool
-> Maybe Word32
-> Maybe Bool
-> Maybe Word32
-> Maybe ByteString
-> FieldSet
-> RpbGetReq
RpbGetReq'_constructor
        {_RpbGetReq'bucket :: ByteString
_RpbGetReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbGetReq'key :: ByteString
_RpbGetReq'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbGetReq'r :: Maybe Word32
_RpbGetReq'r = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _RpbGetReq'pr :: Maybe Word32
_RpbGetReq'pr = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'basicQuorum :: Maybe Bool
_RpbGetReq'basicQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'notfoundOk :: Maybe Bool
_RpbGetReq'notfoundOk = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'ifModified :: Maybe ByteString
_RpbGetReq'ifModified = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'head :: Maybe Bool
_RpbGetReq'head = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'deletedvclock :: Maybe Bool
_RpbGetReq'deletedvclock = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'timeout :: Maybe Word32
_RpbGetReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'sloppyQuorum :: Maybe Bool
_RpbGetReq'sloppyQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'nVal :: Maybe Word32
_RpbGetReq'nVal = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbGetReq'type' :: Maybe ByteString
_RpbGetReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing, _RpbGetReq'_unknownFields :: FieldSet
_RpbGetReq'_unknownFields = []}
  parseMessage :: Parser RpbGetReq
parseMessage
    = let
        loop ::
          RpbGetReq
          -> Prelude.Bool
             -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetReq
        loop :: RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop RpbGetReq
x Bool
required'bucket Bool
required'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbGetReq -> Parser RpbGetReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetReq RpbGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetReq -> RpbGetReq
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 RpbGetReq RpbGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetReq
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
"bucket"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq ByteString ByteString
-> ByteString -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbGetReq
x)
                                  Bool
Prelude.False
                                  Bool
required'key
                        Word64
18
                          -> 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
"key"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq ByteString ByteString
-> ByteString -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
24
                          -> 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
"r"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Word32 Word32
-> Word32 -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"r") Word32
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
32
                          -> 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
"pr"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Word32 Word32
-> Word32 -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pr") Word32
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
40
                          -> 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
"basic_quorum"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Bool Bool
-> Bool -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"basicQuorum") Bool
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
48
                          -> 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
"notfound_ok"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Bool Bool
-> Bool -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"notfoundOk") Bool
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
58
                          -> 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
"if_modified"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq ByteString ByteString
-> ByteString -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "ifModified" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ifModified") ByteString
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
64
                          -> 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
"head"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Bool Bool
-> Bool -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "head" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"head") Bool
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
72
                          -> 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
"deletedvclock"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Bool Bool
-> Bool -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "deletedvclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"deletedvclock") Bool
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
80
                          -> 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
"timeout"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Word32 Word32
-> Word32 -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
88
                          -> 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
"sloppy_quorum"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Bool Bool
-> Bool -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"sloppyQuorum") Bool
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
96
                          -> 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
"n_val"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq Word32 Word32
-> Word32 -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nVal") Word32
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
106
                          -> 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
"type"
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq ByteString ByteString
-> ByteString -> RpbGetReq -> RpbGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop
                                  (Setter RpbGetReq RpbGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetReq -> RpbGetReq
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 RpbGetReq RpbGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetReq
x)
                                  Bool
required'bucket
                                  Bool
required'key
      in
        Parser RpbGetReq -> String -> Parser RpbGetReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetReq -> Bool -> Bool -> Parser RpbGetReq
loop RpbGetReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbGetReq"
  buildMessage :: RpbGetReq -> Builder
buildMessage
    = \ RpbGetReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbGetReq RpbGetReq ByteString ByteString
-> RpbGetReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbGetReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike ByteString RpbGetReq RpbGetReq ByteString ByteString
-> RpbGetReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") RpbGetReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32) RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> RpbGetReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'r" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'r") RpbGetReq
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Word32) RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> RpbGetReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pr" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pr") RpbGetReq
_x
                       of
                         Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Word32
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike (Maybe Bool) RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> RpbGetReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                (forall s a (f :: * -> *).
(HasField s "maybe'basicQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'basicQuorum") RpbGetReq
_x
                          of
                            Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Bool
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike (Maybe Bool) RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> RpbGetReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                   (forall s a (f :: * -> *).
(HasField s "maybe'notfoundOk" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'notfoundOk") RpbGetReq
_x
                             of
                               Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Bool
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      ((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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe ByteString)
  RpbGetReq
  RpbGetReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbGetReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'ifModified" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ifModified") RpbGetReq
_x
                                of
                                  Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just ByteString
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
58)
                                         ((\ 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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike (Maybe Bool) RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> RpbGetReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                         (forall s a (f :: * -> *).
(HasField s "maybe'head" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'head") RpbGetReq
_x
                                   of
                                     Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Bool
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike (Maybe Bool) RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> RpbGetReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'deletedvclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'deletedvclock") RpbGetReq
_x
                                      of
                                        Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just Bool
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
72)
                                               ((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))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe Word32) RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> RpbGetReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") RpbGetReq
_x
                                         of
                                           Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just Word32
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
80)
                                                  ((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))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike (Maybe Bool) RpbGetReq RpbGetReq (Maybe Bool) (Maybe Bool)
-> RpbGetReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")
                                                  RpbGetReq
_x
                                            of
                                              Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Bool
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                              (case
                                                   FoldLike
  (Maybe Word32) RpbGetReq RpbGetReq (Maybe Word32) (Maybe Word32)
-> RpbGetReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                     (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal") RpbGetReq
_x
                                               of
                                                 Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                 (Prelude.Just Word32
_v)
                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
96)
                                                        ((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))
                                              (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                 (case
                                                      FoldLike
  (Maybe ByteString)
  RpbGetReq
  RpbGetReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbGetReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                        (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")
                                                        RpbGetReq
_x
                                                  of
                                                    Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                    (Prelude.Just ByteString
_v)
                                                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                              Word64
106)
                                                           ((\ 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 RpbGetReq RpbGetReq FieldSet FieldSet
-> RpbGetReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                       FoldLike FieldSet RpbGetReq RpbGetReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetReq
_x))))))))))))))
instance Control.DeepSeq.NFData RpbGetReq where
  rnf :: RpbGetReq -> ()
rnf
    = \ RpbGetReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetReq -> FieldSet
_RpbGetReq'_unknownFields RpbGetReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbGetReq -> ByteString
_RpbGetReq'bucket RpbGetReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbGetReq -> ByteString
_RpbGetReq'key RpbGetReq
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbGetReq -> Maybe Word32
_RpbGetReq'r RpbGetReq
x__)
                      (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbGetReq -> Maybe Word32
_RpbGetReq'pr RpbGetReq
x__)
                         (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbGetReq -> Maybe Bool
_RpbGetReq'basicQuorum RpbGetReq
x__)
                            (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbGetReq -> Maybe Bool
_RpbGetReq'notfoundOk RpbGetReq
x__)
                               (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbGetReq -> Maybe ByteString
_RpbGetReq'ifModified RpbGetReq
x__)
                                  (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbGetReq -> Maybe Bool
_RpbGetReq'head RpbGetReq
x__)
                                     (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbGetReq -> Maybe Bool
_RpbGetReq'deletedvclock RpbGetReq
x__)
                                        (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbGetReq -> Maybe Word32
_RpbGetReq'timeout RpbGetReq
x__)
                                           (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (RpbGetReq -> Maybe Bool
_RpbGetReq'sloppyQuorum RpbGetReq
x__)
                                              (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                 (RpbGetReq -> Maybe Word32
_RpbGetReq'nVal RpbGetReq
x__)
                                                 (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                    (RpbGetReq -> Maybe ByteString
_RpbGetReq'type' RpbGetReq
x__) ())))))))))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.content' @:: Lens' RpbGetResp [RpbContent]@
         * 'Proto.Riak_Fields.vec'content' @:: Lens' RpbGetResp (Data.Vector.Vector RpbContent)@
         * 'Proto.Riak_Fields.vclock' @:: Lens' RpbGetResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'vclock' @:: Lens' RpbGetResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.unchanged' @:: Lens' RpbGetResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'unchanged' @:: Lens' RpbGetResp (Prelude.Maybe Prelude.Bool)@ -}
data RpbGetResp
  = RpbGetResp'_constructor {RpbGetResp -> Vector RpbContent
_RpbGetResp'content :: !(Data.Vector.Vector RpbContent),
                             RpbGetResp -> Maybe ByteString
_RpbGetResp'vclock :: !(Prelude.Maybe Data.ByteString.ByteString),
                             RpbGetResp -> Maybe Bool
_RpbGetResp'unchanged :: !(Prelude.Maybe Prelude.Bool),
                             RpbGetResp -> FieldSet
_RpbGetResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetResp -> RpbGetResp -> Bool
(RpbGetResp -> RpbGetResp -> Bool)
-> (RpbGetResp -> RpbGetResp -> Bool) -> Eq RpbGetResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetResp -> RpbGetResp -> Bool
$c/= :: RpbGetResp -> RpbGetResp -> Bool
== :: RpbGetResp -> RpbGetResp -> Bool
$c== :: RpbGetResp -> RpbGetResp -> Bool
Prelude.Eq, Eq RpbGetResp
Eq RpbGetResp
-> (RpbGetResp -> RpbGetResp -> Ordering)
-> (RpbGetResp -> RpbGetResp -> Bool)
-> (RpbGetResp -> RpbGetResp -> Bool)
-> (RpbGetResp -> RpbGetResp -> Bool)
-> (RpbGetResp -> RpbGetResp -> Bool)
-> (RpbGetResp -> RpbGetResp -> RpbGetResp)
-> (RpbGetResp -> RpbGetResp -> RpbGetResp)
-> Ord RpbGetResp
RpbGetResp -> RpbGetResp -> Bool
RpbGetResp -> RpbGetResp -> Ordering
RpbGetResp -> RpbGetResp -> RpbGetResp
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 :: RpbGetResp -> RpbGetResp -> RpbGetResp
$cmin :: RpbGetResp -> RpbGetResp -> RpbGetResp
max :: RpbGetResp -> RpbGetResp -> RpbGetResp
$cmax :: RpbGetResp -> RpbGetResp -> RpbGetResp
>= :: RpbGetResp -> RpbGetResp -> Bool
$c>= :: RpbGetResp -> RpbGetResp -> Bool
> :: RpbGetResp -> RpbGetResp -> Bool
$c> :: RpbGetResp -> RpbGetResp -> Bool
<= :: RpbGetResp -> RpbGetResp -> Bool
$c<= :: RpbGetResp -> RpbGetResp -> Bool
< :: RpbGetResp -> RpbGetResp -> Bool
$c< :: RpbGetResp -> RpbGetResp -> Bool
compare :: RpbGetResp -> RpbGetResp -> Ordering
$ccompare :: RpbGetResp -> RpbGetResp -> Ordering
$cp1Ord :: Eq RpbGetResp
Prelude.Ord)
instance Prelude.Show RpbGetResp where
  showsPrec :: Int -> RpbGetResp -> ShowS
showsPrec Int
_ RpbGetResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetResp "content" [RpbContent] where
  fieldOf :: Proxy# "content"
-> ([RpbContent] -> f [RpbContent]) -> RpbGetResp -> f RpbGetResp
fieldOf Proxy# "content"
_
    = ((Vector RpbContent -> f (Vector RpbContent))
 -> RpbGetResp -> f RpbGetResp)
-> (([RpbContent] -> f [RpbContent])
    -> Vector RpbContent -> f (Vector RpbContent))
-> ([RpbContent] -> f [RpbContent])
-> RpbGetResp
-> f RpbGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetResp -> Vector RpbContent)
-> (RpbGetResp -> Vector RpbContent -> RpbGetResp)
-> Lens
     RpbGetResp RpbGetResp (Vector RpbContent) (Vector RpbContent)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetResp -> Vector RpbContent
_RpbGetResp'content (\ RpbGetResp
x__ Vector RpbContent
y__ -> RpbGetResp
x__ {_RpbGetResp'content :: Vector RpbContent
_RpbGetResp'content = Vector RpbContent
y__}))
        ((Vector RpbContent -> [RpbContent])
-> (Vector RpbContent -> [RpbContent] -> Vector RpbContent)
-> Lens
     (Vector RpbContent) (Vector RpbContent) [RpbContent] [RpbContent]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbContent -> [RpbContent]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbContent
_ [RpbContent]
y__ -> [RpbContent] -> Vector RpbContent
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbContent]
y__))
instance Data.ProtoLens.Field.HasField RpbGetResp "vec'content" (Data.Vector.Vector RpbContent) where
  fieldOf :: Proxy# "vec'content"
-> (Vector RpbContent -> f (Vector RpbContent))
-> RpbGetResp
-> f RpbGetResp
fieldOf Proxy# "vec'content"
_
    = ((Vector RpbContent -> f (Vector RpbContent))
 -> RpbGetResp -> f RpbGetResp)
-> ((Vector RpbContent -> f (Vector RpbContent))
    -> Vector RpbContent -> f (Vector RpbContent))
-> (Vector RpbContent -> f (Vector RpbContent))
-> RpbGetResp
-> f RpbGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetResp -> Vector RpbContent)
-> (RpbGetResp -> Vector RpbContent -> RpbGetResp)
-> Lens
     RpbGetResp RpbGetResp (Vector RpbContent) (Vector RpbContent)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetResp -> Vector RpbContent
_RpbGetResp'content (\ RpbGetResp
x__ Vector RpbContent
y__ -> RpbGetResp
x__ {_RpbGetResp'content :: Vector RpbContent
_RpbGetResp'content = Vector RpbContent
y__}))
        (Vector RpbContent -> f (Vector RpbContent))
-> Vector RpbContent -> f (Vector RpbContent)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetResp "vclock" Data.ByteString.ByteString where
  fieldOf :: Proxy# "vclock"
-> (ByteString -> f ByteString) -> RpbGetResp -> f RpbGetResp
fieldOf Proxy# "vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetResp -> f RpbGetResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbGetResp
-> f RpbGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetResp -> Maybe ByteString)
-> (RpbGetResp -> Maybe ByteString -> RpbGetResp)
-> Lens RpbGetResp RpbGetResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetResp -> Maybe ByteString
_RpbGetResp'vclock (\ RpbGetResp
x__ Maybe ByteString
y__ -> RpbGetResp
x__ {_RpbGetResp'vclock :: Maybe ByteString
_RpbGetResp'vclock = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetResp "maybe'vclock" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'vclock"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetResp
-> f RpbGetResp
fieldOf Proxy# "maybe'vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetResp -> f RpbGetResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetResp
-> f RpbGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetResp -> Maybe ByteString)
-> (RpbGetResp -> Maybe ByteString -> RpbGetResp)
-> Lens RpbGetResp RpbGetResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetResp -> Maybe ByteString
_RpbGetResp'vclock (\ RpbGetResp
x__ Maybe ByteString
y__ -> RpbGetResp
x__ {_RpbGetResp'vclock :: Maybe ByteString
_RpbGetResp'vclock = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetResp "unchanged" Prelude.Bool where
  fieldOf :: Proxy# "unchanged"
-> (Bool -> f Bool) -> RpbGetResp -> f RpbGetResp
fieldOf Proxy# "unchanged"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetResp -> f RpbGetResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbGetResp
-> f RpbGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetResp -> Maybe Bool)
-> (RpbGetResp -> Maybe Bool -> RpbGetResp)
-> Lens RpbGetResp RpbGetResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetResp -> Maybe Bool
_RpbGetResp'unchanged
           (\ RpbGetResp
x__ Maybe Bool
y__ -> RpbGetResp
x__ {_RpbGetResp'unchanged :: Maybe Bool
_RpbGetResp'unchanged = 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 RpbGetResp "maybe'unchanged" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'unchanged"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbGetResp -> f RpbGetResp
fieldOf Proxy# "maybe'unchanged"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbGetResp -> f RpbGetResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbGetResp
-> f RpbGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetResp -> Maybe Bool)
-> (RpbGetResp -> Maybe Bool -> RpbGetResp)
-> Lens RpbGetResp RpbGetResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetResp -> Maybe Bool
_RpbGetResp'unchanged
           (\ RpbGetResp
x__ Maybe Bool
y__ -> RpbGetResp
x__ {_RpbGetResp'unchanged :: Maybe Bool
_RpbGetResp'unchanged = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetResp where
  messageName :: Proxy RpbGetResp -> Text
messageName Proxy RpbGetResp
_ = String -> Text
Data.Text.pack String
"RpbGetResp"
  packedMessageDescriptor :: Proxy RpbGetResp -> ByteString
packedMessageDescriptor Proxy RpbGetResp
_
    = ByteString
"\n\
      \\n\
      \RpbGetResp\DC2%\n\
      \\acontent\CAN\SOH \ETX(\v2\v.RpbContentR\acontent\DC2\SYN\n\
      \\ACKvclock\CAN\STX \SOH(\fR\ACKvclock\DC2\FS\n\
      \\tunchanged\CAN\ETX \SOH(\bR\tunchanged"
  packedFileDescriptor :: Proxy RpbGetResp -> ByteString
packedFileDescriptor Proxy RpbGetResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetResp)
fieldsByTag
    = let
        content__field_descriptor :: FieldDescriptor RpbGetResp
content__field_descriptor
          = String
-> FieldTypeDescriptor RpbContent
-> FieldAccessor RpbGetResp RpbContent
-> FieldDescriptor RpbGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"content"
              (MessageOrGroup -> FieldTypeDescriptor RpbContent
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbContent)
              (Packing
-> Lens' RpbGetResp [RpbContent]
-> FieldAccessor RpbGetResp RpbContent
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"content")) ::
              Data.ProtoLens.FieldDescriptor RpbGetResp
        vclock__field_descriptor :: FieldDescriptor RpbGetResp
vclock__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetResp ByteString
-> FieldDescriptor RpbGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"vclock"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbGetResp RpbGetResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbGetResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock")) ::
              Data.ProtoLens.FieldDescriptor RpbGetResp
        unchanged__field_descriptor :: FieldDescriptor RpbGetResp
unchanged__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbGetResp Bool
-> FieldDescriptor RpbGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"unchanged"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbGetResp RpbGetResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbGetResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'unchanged" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'unchanged")) ::
              Data.ProtoLens.FieldDescriptor RpbGetResp
      in
        [(Tag, FieldDescriptor RpbGetResp)]
-> Map Tag (FieldDescriptor RpbGetResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetResp
content__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbGetResp
vclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbGetResp
unchanged__field_descriptor)]
  unknownFields :: LensLike' f RpbGetResp FieldSet
unknownFields
    = (RpbGetResp -> FieldSet)
-> (RpbGetResp -> FieldSet -> RpbGetResp)
-> Lens' RpbGetResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetResp -> FieldSet
_RpbGetResp'_unknownFields
        (\ RpbGetResp
x__ FieldSet
y__ -> RpbGetResp
x__ {_RpbGetResp'_unknownFields :: FieldSet
_RpbGetResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetResp
defMessage
    = RpbGetResp'_constructor :: Vector RpbContent
-> Maybe ByteString -> Maybe Bool -> FieldSet -> RpbGetResp
RpbGetResp'_constructor
        {_RpbGetResp'content :: Vector RpbContent
_RpbGetResp'content = Vector RpbContent
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbGetResp'vclock :: Maybe ByteString
_RpbGetResp'vclock = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbGetResp'unchanged :: Maybe Bool
_RpbGetResp'unchanged = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbGetResp'_unknownFields :: FieldSet
_RpbGetResp'_unknownFields = []}
  parseMessage :: Parser RpbGetResp
parseMessage
    = let
        loop ::
          RpbGetResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbContent
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetResp
        loop :: RpbGetResp
-> Growing Vector RealWorld RpbContent -> Parser RpbGetResp
loop RpbGetResp
x Growing Vector RealWorld RpbContent
mutable'content
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbContent
frozen'content <- IO (Vector RpbContent) -> Parser (Vector RpbContent)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) RpbContent -> IO (Vector RpbContent)
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 RpbContent
Growing Vector (PrimState IO) RpbContent
mutable'content)
                      (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]))))
                      RpbGetResp -> Parser RpbGetResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetResp RpbGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetResp -> RpbGetResp
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 RpbGetResp RpbGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbGetResp RpbGetResp (Vector RpbContent) (Vector RpbContent)
-> Vector RpbContent -> RpbGetResp -> RpbGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'content") Vector RpbContent
frozen'content RpbGetResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbContent
y <- Parser RpbContent -> String -> Parser RpbContent
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbContent -> Parser RpbContent
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 RpbContent
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"content"
                                Growing Vector RealWorld RpbContent
v <- IO (Growing Vector RealWorld RpbContent)
-> Parser (Growing Vector RealWorld RpbContent)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbContent
-> RpbContent -> IO (Growing Vector (PrimState IO) RpbContent)
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 RpbContent
Growing Vector (PrimState IO) RpbContent
mutable'content RpbContent
y)
                                RpbGetResp
-> Growing Vector RealWorld RpbContent -> Parser RpbGetResp
loop RpbGetResp
x Growing Vector RealWorld RpbContent
v
                        Word64
18
                          -> 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
"vclock"
                                RpbGetResp
-> Growing Vector RealWorld RpbContent -> Parser RpbGetResp
loop
                                  (Setter RpbGetResp RpbGetResp ByteString ByteString
-> ByteString -> RpbGetResp -> RpbGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vclock") ByteString
y RpbGetResp
x)
                                  Growing Vector RealWorld RpbContent
mutable'content
                        Word64
24
                          -> 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
"unchanged"
                                RpbGetResp
-> Growing Vector RealWorld RpbContent -> Parser RpbGetResp
loop
                                  (Setter RpbGetResp RpbGetResp Bool Bool
-> Bool -> RpbGetResp -> RpbGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "unchanged" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"unchanged") Bool
y RpbGetResp
x)
                                  Growing Vector RealWorld RpbContent
mutable'content
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetResp
-> Growing Vector RealWorld RpbContent -> Parser RpbGetResp
loop
                                  (Setter RpbGetResp RpbGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbGetResp -> RpbGetResp
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 RpbGetResp RpbGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetResp
x)
                                  Growing Vector RealWorld RpbContent
mutable'content
      in
        Parser RpbGetResp -> String -> Parser RpbGetResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbContent
mutable'content <- IO (Growing Vector RealWorld RpbContent)
-> Parser (Growing Vector RealWorld RpbContent)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld RpbContent)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbGetResp
-> Growing Vector RealWorld RpbContent -> Parser RpbGetResp
loop RpbGetResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbContent
mutable'content)
          String
"RpbGetResp"
  buildMessage :: RpbGetResp -> Builder
buildMessage
    = \ RpbGetResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbContent -> Builder) -> Vector RpbContent -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbContent
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbContent -> ByteString) -> RpbContent -> 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))
                           RpbContent -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbContent
_v))
                (FoldLike
  (Vector RpbContent)
  RpbGetResp
  RpbGetResp
  (Vector RpbContent)
  (Vector RpbContent)
-> RpbGetResp -> Vector RpbContent
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'content") RpbGetResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbGetResp
  RpbGetResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbGetResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock") RpbGetResp
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Bool) RpbGetResp RpbGetResp (Maybe Bool) (Maybe Bool)
-> RpbGetResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'unchanged" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'unchanged") RpbGetResp
_x
                    of
                      Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Bool
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike FieldSet RpbGetResp RpbGetResp FieldSet FieldSet
-> RpbGetResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbGetResp RpbGetResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetResp
_x))))
instance Control.DeepSeq.NFData RpbGetResp where
  rnf :: RpbGetResp -> ()
rnf
    = \ RpbGetResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetResp -> FieldSet
_RpbGetResp'_unknownFields RpbGetResp
x__)
             (Vector RpbContent -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbGetResp -> Vector RpbContent
_RpbGetResp'content RpbGetResp
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbGetResp -> Maybe ByteString
_RpbGetResp'vclock RpbGetResp
x__)
                   (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbGetResp -> Maybe Bool
_RpbGetResp'unchanged RpbGetResp
x__) ())))
{- | Fields :
      -}
data RpbGetServerInfoReq
  = RpbGetServerInfoReq'_constructor {RpbGetServerInfoReq -> FieldSet
_RpbGetServerInfoReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
(RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool)
-> (RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool)
-> Eq RpbGetServerInfoReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
$c/= :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
== :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
$c== :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
Prelude.Eq, Eq RpbGetServerInfoReq
Eq RpbGetServerInfoReq
-> (RpbGetServerInfoReq -> RpbGetServerInfoReq -> Ordering)
-> (RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool)
-> (RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool)
-> (RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool)
-> (RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool)
-> (RpbGetServerInfoReq
    -> RpbGetServerInfoReq -> RpbGetServerInfoReq)
-> (RpbGetServerInfoReq
    -> RpbGetServerInfoReq -> RpbGetServerInfoReq)
-> Ord RpbGetServerInfoReq
RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
RpbGetServerInfoReq -> RpbGetServerInfoReq -> Ordering
RpbGetServerInfoReq -> RpbGetServerInfoReq -> RpbGetServerInfoReq
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 :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> RpbGetServerInfoReq
$cmin :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> RpbGetServerInfoReq
max :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> RpbGetServerInfoReq
$cmax :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> RpbGetServerInfoReq
>= :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
$c>= :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
> :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
$c> :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
<= :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
$c<= :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
< :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
$c< :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Bool
compare :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Ordering
$ccompare :: RpbGetServerInfoReq -> RpbGetServerInfoReq -> Ordering
$cp1Ord :: Eq RpbGetServerInfoReq
Prelude.Ord)
instance Prelude.Show RpbGetServerInfoReq where
  showsPrec :: Int -> RpbGetServerInfoReq -> ShowS
showsPrec Int
_ RpbGetServerInfoReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetServerInfoReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetServerInfoReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbGetServerInfoReq where
  messageName :: Proxy RpbGetServerInfoReq -> Text
messageName Proxy RpbGetServerInfoReq
_ = String -> Text
Data.Text.pack String
"RpbGetServerInfoReq"
  packedMessageDescriptor :: Proxy RpbGetServerInfoReq -> ByteString
packedMessageDescriptor Proxy RpbGetServerInfoReq
_
    = ByteString
"\n\
      \\DC3RpbGetServerInfoReq"
  packedFileDescriptor :: Proxy RpbGetServerInfoReq -> ByteString
packedFileDescriptor Proxy RpbGetServerInfoReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetServerInfoReq)
fieldsByTag = let in [(Tag, FieldDescriptor RpbGetServerInfoReq)]
-> Map Tag (FieldDescriptor RpbGetServerInfoReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbGetServerInfoReq FieldSet
unknownFields
    = (RpbGetServerInfoReq -> FieldSet)
-> (RpbGetServerInfoReq -> FieldSet -> RpbGetServerInfoReq)
-> Lens' RpbGetServerInfoReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetServerInfoReq -> FieldSet
_RpbGetServerInfoReq'_unknownFields
        (\ RpbGetServerInfoReq
x__ FieldSet
y__ -> RpbGetServerInfoReq
x__ {_RpbGetServerInfoReq'_unknownFields :: FieldSet
_RpbGetServerInfoReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetServerInfoReq
defMessage
    = RpbGetServerInfoReq'_constructor :: FieldSet -> RpbGetServerInfoReq
RpbGetServerInfoReq'_constructor
        {_RpbGetServerInfoReq'_unknownFields :: FieldSet
_RpbGetServerInfoReq'_unknownFields = []}
  parseMessage :: Parser RpbGetServerInfoReq
parseMessage
    = let
        loop ::
          RpbGetServerInfoReq
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetServerInfoReq
        loop :: RpbGetServerInfoReq -> Parser RpbGetServerInfoReq
loop RpbGetServerInfoReq
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]))))
                      RpbGetServerInfoReq -> Parser RpbGetServerInfoReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetServerInfoReq RpbGetServerInfoReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetServerInfoReq
-> RpbGetServerInfoReq
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 RpbGetServerInfoReq RpbGetServerInfoReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetServerInfoReq
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetServerInfoReq -> Parser RpbGetServerInfoReq
loop
                                  (Setter RpbGetServerInfoReq RpbGetServerInfoReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetServerInfoReq
-> RpbGetServerInfoReq
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 RpbGetServerInfoReq RpbGetServerInfoReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetServerInfoReq
x) }
      in
        Parser RpbGetServerInfoReq -> String -> Parser RpbGetServerInfoReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetServerInfoReq -> Parser RpbGetServerInfoReq
loop RpbGetServerInfoReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbGetServerInfoReq"
  buildMessage :: RpbGetServerInfoReq -> Builder
buildMessage
    = \ RpbGetServerInfoReq
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike
  FieldSet RpbGetServerInfoReq RpbGetServerInfoReq FieldSet FieldSet
-> RpbGetServerInfoReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbGetServerInfoReq RpbGetServerInfoReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetServerInfoReq
_x)
instance Control.DeepSeq.NFData RpbGetServerInfoReq where
  rnf :: RpbGetServerInfoReq -> ()
rnf
    = \ RpbGetServerInfoReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetServerInfoReq -> FieldSet
_RpbGetServerInfoReq'_unknownFields RpbGetServerInfoReq
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.node' @:: Lens' RpbGetServerInfoResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'node' @:: Lens' RpbGetServerInfoResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.serverVersion' @:: Lens' RpbGetServerInfoResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'serverVersion' @:: Lens' RpbGetServerInfoResp (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbGetServerInfoResp
  = RpbGetServerInfoResp'_constructor {RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'node :: !(Prelude.Maybe Data.ByteString.ByteString),
                                       RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'serverVersion :: !(Prelude.Maybe Data.ByteString.ByteString),
                                       RpbGetServerInfoResp -> FieldSet
_RpbGetServerInfoResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
(RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool)
-> (RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool)
-> Eq RpbGetServerInfoResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
$c/= :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
== :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
$c== :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
Prelude.Eq, Eq RpbGetServerInfoResp
Eq RpbGetServerInfoResp
-> (RpbGetServerInfoResp -> RpbGetServerInfoResp -> Ordering)
-> (RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool)
-> (RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool)
-> (RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool)
-> (RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool)
-> (RpbGetServerInfoResp
    -> RpbGetServerInfoResp -> RpbGetServerInfoResp)
-> (RpbGetServerInfoResp
    -> RpbGetServerInfoResp -> RpbGetServerInfoResp)
-> Ord RpbGetServerInfoResp
RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
RpbGetServerInfoResp -> RpbGetServerInfoResp -> Ordering
RpbGetServerInfoResp
-> RpbGetServerInfoResp -> RpbGetServerInfoResp
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 :: RpbGetServerInfoResp
-> RpbGetServerInfoResp -> RpbGetServerInfoResp
$cmin :: RpbGetServerInfoResp
-> RpbGetServerInfoResp -> RpbGetServerInfoResp
max :: RpbGetServerInfoResp
-> RpbGetServerInfoResp -> RpbGetServerInfoResp
$cmax :: RpbGetServerInfoResp
-> RpbGetServerInfoResp -> RpbGetServerInfoResp
>= :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
$c>= :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
> :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
$c> :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
<= :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
$c<= :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
< :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
$c< :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Bool
compare :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Ordering
$ccompare :: RpbGetServerInfoResp -> RpbGetServerInfoResp -> Ordering
$cp1Ord :: Eq RpbGetServerInfoResp
Prelude.Ord)
instance Prelude.Show RpbGetServerInfoResp where
  showsPrec :: Int -> RpbGetServerInfoResp -> ShowS
showsPrec Int
_ RpbGetServerInfoResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbGetServerInfoResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbGetServerInfoResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbGetServerInfoResp "node" Data.ByteString.ByteString where
  fieldOf :: Proxy# "node"
-> (ByteString -> f ByteString)
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
fieldOf Proxy# "node"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetServerInfoResp -> f RpbGetServerInfoResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetServerInfoResp -> Maybe ByteString)
-> (RpbGetServerInfoResp
    -> Maybe ByteString -> RpbGetServerInfoResp)
-> Lens
     RpbGetServerInfoResp
     RpbGetServerInfoResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'node
           (\ RpbGetServerInfoResp
x__ Maybe ByteString
y__ -> RpbGetServerInfoResp
x__ {_RpbGetServerInfoResp'node :: Maybe ByteString
_RpbGetServerInfoResp'node = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetServerInfoResp "maybe'node" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'node"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
fieldOf Proxy# "maybe'node"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetServerInfoResp -> f RpbGetServerInfoResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetServerInfoResp -> Maybe ByteString)
-> (RpbGetServerInfoResp
    -> Maybe ByteString -> RpbGetServerInfoResp)
-> Lens
     RpbGetServerInfoResp
     RpbGetServerInfoResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'node
           (\ RpbGetServerInfoResp
x__ Maybe ByteString
y__ -> RpbGetServerInfoResp
x__ {_RpbGetServerInfoResp'node :: Maybe ByteString
_RpbGetServerInfoResp'node = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbGetServerInfoResp "serverVersion" Data.ByteString.ByteString where
  fieldOf :: Proxy# "serverVersion"
-> (ByteString -> f ByteString)
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
fieldOf Proxy# "serverVersion"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetServerInfoResp -> f RpbGetServerInfoResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetServerInfoResp -> Maybe ByteString)
-> (RpbGetServerInfoResp
    -> Maybe ByteString -> RpbGetServerInfoResp)
-> Lens
     RpbGetServerInfoResp
     RpbGetServerInfoResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'serverVersion
           (\ RpbGetServerInfoResp
x__ Maybe ByteString
y__ -> RpbGetServerInfoResp
x__ {_RpbGetServerInfoResp'serverVersion :: Maybe ByteString
_RpbGetServerInfoResp'serverVersion = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbGetServerInfoResp "maybe'serverVersion" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'serverVersion"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
fieldOf Proxy# "maybe'serverVersion"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbGetServerInfoResp -> f RpbGetServerInfoResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbGetServerInfoResp
-> f RpbGetServerInfoResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbGetServerInfoResp -> Maybe ByteString)
-> (RpbGetServerInfoResp
    -> Maybe ByteString -> RpbGetServerInfoResp)
-> Lens
     RpbGetServerInfoResp
     RpbGetServerInfoResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'serverVersion
           (\ RpbGetServerInfoResp
x__ Maybe ByteString
y__ -> RpbGetServerInfoResp
x__ {_RpbGetServerInfoResp'serverVersion :: Maybe ByteString
_RpbGetServerInfoResp'serverVersion = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbGetServerInfoResp where
  messageName :: Proxy RpbGetServerInfoResp -> Text
messageName Proxy RpbGetServerInfoResp
_ = String -> Text
Data.Text.pack String
"RpbGetServerInfoResp"
  packedMessageDescriptor :: Proxy RpbGetServerInfoResp -> ByteString
packedMessageDescriptor Proxy RpbGetServerInfoResp
_
    = ByteString
"\n\
      \\DC4RpbGetServerInfoResp\DC2\DC2\n\
      \\EOTnode\CAN\SOH \SOH(\fR\EOTnode\DC2%\n\
      \\SOserver_version\CAN\STX \SOH(\fR\rserverVersion"
  packedFileDescriptor :: Proxy RpbGetServerInfoResp -> ByteString
packedFileDescriptor Proxy RpbGetServerInfoResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbGetServerInfoResp)
fieldsByTag
    = let
        node__field_descriptor :: FieldDescriptor RpbGetServerInfoResp
node__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetServerInfoResp ByteString
-> FieldDescriptor RpbGetServerInfoResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"node"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbGetServerInfoResp
  RpbGetServerInfoResp
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbGetServerInfoResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'node" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'node")) ::
              Data.ProtoLens.FieldDescriptor RpbGetServerInfoResp
        serverVersion__field_descriptor :: FieldDescriptor RpbGetServerInfoResp
serverVersion__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbGetServerInfoResp ByteString
-> FieldDescriptor RpbGetServerInfoResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"server_version"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbGetServerInfoResp
  RpbGetServerInfoResp
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbGetServerInfoResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'serverVersion" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'serverVersion")) ::
              Data.ProtoLens.FieldDescriptor RpbGetServerInfoResp
      in
        [(Tag, FieldDescriptor RpbGetServerInfoResp)]
-> Map Tag (FieldDescriptor RpbGetServerInfoResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbGetServerInfoResp
node__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbGetServerInfoResp
serverVersion__field_descriptor)]
  unknownFields :: LensLike' f RpbGetServerInfoResp FieldSet
unknownFields
    = (RpbGetServerInfoResp -> FieldSet)
-> (RpbGetServerInfoResp -> FieldSet -> RpbGetServerInfoResp)
-> Lens' RpbGetServerInfoResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbGetServerInfoResp -> FieldSet
_RpbGetServerInfoResp'_unknownFields
        (\ RpbGetServerInfoResp
x__ FieldSet
y__ -> RpbGetServerInfoResp
x__ {_RpbGetServerInfoResp'_unknownFields :: FieldSet
_RpbGetServerInfoResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbGetServerInfoResp
defMessage
    = RpbGetServerInfoResp'_constructor :: Maybe ByteString
-> Maybe ByteString -> FieldSet -> RpbGetServerInfoResp
RpbGetServerInfoResp'_constructor
        {_RpbGetServerInfoResp'node :: Maybe ByteString
_RpbGetServerInfoResp'node = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbGetServerInfoResp'serverVersion :: Maybe ByteString
_RpbGetServerInfoResp'serverVersion = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbGetServerInfoResp'_unknownFields :: FieldSet
_RpbGetServerInfoResp'_unknownFields = []}
  parseMessage :: Parser RpbGetServerInfoResp
parseMessage
    = let
        loop ::
          RpbGetServerInfoResp
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbGetServerInfoResp
        loop :: RpbGetServerInfoResp -> Parser RpbGetServerInfoResp
loop RpbGetServerInfoResp
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]))))
                      RpbGetServerInfoResp -> Parser RpbGetServerInfoResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbGetServerInfoResp RpbGetServerInfoResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetServerInfoResp
-> RpbGetServerInfoResp
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 RpbGetServerInfoResp RpbGetServerInfoResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbGetServerInfoResp
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
"node"
                                RpbGetServerInfoResp -> Parser RpbGetServerInfoResp
loop (Setter
  RpbGetServerInfoResp RpbGetServerInfoResp ByteString ByteString
-> ByteString -> RpbGetServerInfoResp -> RpbGetServerInfoResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "node" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"node") ByteString
y RpbGetServerInfoResp
x)
                        Word64
18
                          -> 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
"server_version"
                                RpbGetServerInfoResp -> Parser RpbGetServerInfoResp
loop
                                  (Setter
  RpbGetServerInfoResp RpbGetServerInfoResp ByteString ByteString
-> ByteString -> RpbGetServerInfoResp -> RpbGetServerInfoResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "serverVersion" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"serverVersion") ByteString
y RpbGetServerInfoResp
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbGetServerInfoResp -> Parser RpbGetServerInfoResp
loop
                                  (Setter RpbGetServerInfoResp RpbGetServerInfoResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbGetServerInfoResp
-> RpbGetServerInfoResp
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 RpbGetServerInfoResp RpbGetServerInfoResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbGetServerInfoResp
x)
      in
        Parser RpbGetServerInfoResp
-> String -> Parser RpbGetServerInfoResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbGetServerInfoResp -> Parser RpbGetServerInfoResp
loop RpbGetServerInfoResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbGetServerInfoResp"
  buildMessage :: RpbGetServerInfoResp -> Builder
buildMessage
    = \ RpbGetServerInfoResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe ByteString)
  RpbGetServerInfoResp
  RpbGetServerInfoResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbGetServerInfoResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'node" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'node") RpbGetServerInfoResp
_x
              of
                Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just ByteString
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbGetServerInfoResp
  RpbGetServerInfoResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbGetServerInfoResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'serverVersion" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'serverVersion") RpbGetServerInfoResp
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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
  RpbGetServerInfoResp
  RpbGetServerInfoResp
  FieldSet
  FieldSet
-> RpbGetServerInfoResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbGetServerInfoResp
  RpbGetServerInfoResp
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbGetServerInfoResp
_x)))
instance Control.DeepSeq.NFData RpbGetServerInfoResp where
  rnf :: RpbGetServerInfoResp -> ()
rnf
    = \ RpbGetServerInfoResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbGetServerInfoResp -> FieldSet
_RpbGetServerInfoResp'_unknownFields RpbGetServerInfoResp
x__)
             (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'node RpbGetServerInfoResp
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbGetServerInfoResp -> Maybe ByteString
_RpbGetServerInfoResp'serverVersion RpbGetServerInfoResp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.objects' @:: Lens' RpbIndexBodyResp [RpbIndexObject]@
         * 'Proto.Riak_Fields.vec'objects' @:: Lens' RpbIndexBodyResp (Data.Vector.Vector RpbIndexObject)@
         * 'Proto.Riak_Fields.continuation' @:: Lens' RpbIndexBodyResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'continuation' @:: Lens' RpbIndexBodyResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.done' @:: Lens' RpbIndexBodyResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' RpbIndexBodyResp (Prelude.Maybe Prelude.Bool)@ -}
data RpbIndexBodyResp
  = RpbIndexBodyResp'_constructor {RpbIndexBodyResp -> Vector RpbIndexObject
_RpbIndexBodyResp'objects :: !(Data.Vector.Vector RpbIndexObject),
                                   RpbIndexBodyResp -> Maybe ByteString
_RpbIndexBodyResp'continuation :: !(Prelude.Maybe Data.ByteString.ByteString),
                                   RpbIndexBodyResp -> Maybe Bool
_RpbIndexBodyResp'done :: !(Prelude.Maybe Prelude.Bool),
                                   RpbIndexBodyResp -> FieldSet
_RpbIndexBodyResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
(RpbIndexBodyResp -> RpbIndexBodyResp -> Bool)
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> Bool)
-> Eq RpbIndexBodyResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
$c/= :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
== :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
$c== :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
Prelude.Eq, Eq RpbIndexBodyResp
Eq RpbIndexBodyResp
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> Ordering)
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> Bool)
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> Bool)
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> Bool)
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> Bool)
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> RpbIndexBodyResp)
-> (RpbIndexBodyResp -> RpbIndexBodyResp -> RpbIndexBodyResp)
-> Ord RpbIndexBodyResp
RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
RpbIndexBodyResp -> RpbIndexBodyResp -> Ordering
RpbIndexBodyResp -> RpbIndexBodyResp -> RpbIndexBodyResp
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 :: RpbIndexBodyResp -> RpbIndexBodyResp -> RpbIndexBodyResp
$cmin :: RpbIndexBodyResp -> RpbIndexBodyResp -> RpbIndexBodyResp
max :: RpbIndexBodyResp -> RpbIndexBodyResp -> RpbIndexBodyResp
$cmax :: RpbIndexBodyResp -> RpbIndexBodyResp -> RpbIndexBodyResp
>= :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
$c>= :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
> :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
$c> :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
<= :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
$c<= :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
< :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
$c< :: RpbIndexBodyResp -> RpbIndexBodyResp -> Bool
compare :: RpbIndexBodyResp -> RpbIndexBodyResp -> Ordering
$ccompare :: RpbIndexBodyResp -> RpbIndexBodyResp -> Ordering
$cp1Ord :: Eq RpbIndexBodyResp
Prelude.Ord)
instance Prelude.Show RpbIndexBodyResp where
  showsPrec :: Int -> RpbIndexBodyResp -> ShowS
showsPrec Int
_ RpbIndexBodyResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbIndexBodyResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbIndexBodyResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbIndexBodyResp "objects" [RpbIndexObject] where
  fieldOf :: Proxy# "objects"
-> ([RpbIndexObject] -> f [RpbIndexObject])
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
fieldOf Proxy# "objects"
_
    = ((Vector RpbIndexObject -> f (Vector RpbIndexObject))
 -> RpbIndexBodyResp -> f RpbIndexBodyResp)
-> (([RpbIndexObject] -> f [RpbIndexObject])
    -> Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> ([RpbIndexObject] -> f [RpbIndexObject])
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexBodyResp -> Vector RpbIndexObject)
-> (RpbIndexBodyResp -> Vector RpbIndexObject -> RpbIndexBodyResp)
-> Lens
     RpbIndexBodyResp
     RpbIndexBodyResp
     (Vector RpbIndexObject)
     (Vector RpbIndexObject)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexBodyResp -> Vector RpbIndexObject
_RpbIndexBodyResp'objects
           (\ RpbIndexBodyResp
x__ Vector RpbIndexObject
y__ -> RpbIndexBodyResp
x__ {_RpbIndexBodyResp'objects :: Vector RpbIndexObject
_RpbIndexBodyResp'objects = Vector RpbIndexObject
y__}))
        ((Vector RpbIndexObject -> [RpbIndexObject])
-> (Vector RpbIndexObject
    -> [RpbIndexObject] -> Vector RpbIndexObject)
-> Lens
     (Vector RpbIndexObject)
     (Vector RpbIndexObject)
     [RpbIndexObject]
     [RpbIndexObject]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbIndexObject -> [RpbIndexObject]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbIndexObject
_ [RpbIndexObject]
y__ -> [RpbIndexObject] -> Vector RpbIndexObject
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbIndexObject]
y__))
instance Data.ProtoLens.Field.HasField RpbIndexBodyResp "vec'objects" (Data.Vector.Vector RpbIndexObject) where
  fieldOf :: Proxy# "vec'objects"
-> (Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
fieldOf Proxy# "vec'objects"
_
    = ((Vector RpbIndexObject -> f (Vector RpbIndexObject))
 -> RpbIndexBodyResp -> f RpbIndexBodyResp)
-> ((Vector RpbIndexObject -> f (Vector RpbIndexObject))
    -> Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> (Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexBodyResp -> Vector RpbIndexObject)
-> (RpbIndexBodyResp -> Vector RpbIndexObject -> RpbIndexBodyResp)
-> Lens
     RpbIndexBodyResp
     RpbIndexBodyResp
     (Vector RpbIndexObject)
     (Vector RpbIndexObject)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexBodyResp -> Vector RpbIndexObject
_RpbIndexBodyResp'objects
           (\ RpbIndexBodyResp
x__ Vector RpbIndexObject
y__ -> RpbIndexBodyResp
x__ {_RpbIndexBodyResp'objects :: Vector RpbIndexObject
_RpbIndexBodyResp'objects = Vector RpbIndexObject
y__}))
        (Vector RpbIndexObject -> f (Vector RpbIndexObject))
-> Vector RpbIndexObject -> f (Vector RpbIndexObject)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexBodyResp "continuation" Data.ByteString.ByteString where
  fieldOf :: Proxy# "continuation"
-> (ByteString -> f ByteString)
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
fieldOf Proxy# "continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexBodyResp -> f RpbIndexBodyResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexBodyResp -> Maybe ByteString)
-> (RpbIndexBodyResp -> Maybe ByteString -> RpbIndexBodyResp)
-> Lens
     RpbIndexBodyResp
     RpbIndexBodyResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexBodyResp -> Maybe ByteString
_RpbIndexBodyResp'continuation
           (\ RpbIndexBodyResp
x__ Maybe ByteString
y__ -> RpbIndexBodyResp
x__ {_RpbIndexBodyResp'continuation :: Maybe ByteString
_RpbIndexBodyResp'continuation = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexBodyResp "maybe'continuation" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'continuation"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
fieldOf Proxy# "maybe'continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexBodyResp -> f RpbIndexBodyResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexBodyResp -> Maybe ByteString)
-> (RpbIndexBodyResp -> Maybe ByteString -> RpbIndexBodyResp)
-> Lens
     RpbIndexBodyResp
     RpbIndexBodyResp
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexBodyResp -> Maybe ByteString
_RpbIndexBodyResp'continuation
           (\ RpbIndexBodyResp
x__ Maybe ByteString
y__ -> RpbIndexBodyResp
x__ {_RpbIndexBodyResp'continuation :: Maybe ByteString
_RpbIndexBodyResp'continuation = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexBodyResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done"
-> (Bool -> f Bool) -> RpbIndexBodyResp -> f RpbIndexBodyResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbIndexBodyResp -> f RpbIndexBodyResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexBodyResp -> Maybe Bool)
-> (RpbIndexBodyResp -> Maybe Bool -> RpbIndexBodyResp)
-> Lens RpbIndexBodyResp RpbIndexBodyResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexBodyResp -> Maybe Bool
_RpbIndexBodyResp'done
           (\ RpbIndexBodyResp
x__ Maybe Bool
y__ -> RpbIndexBodyResp
x__ {_RpbIndexBodyResp'done :: Maybe Bool
_RpbIndexBodyResp'done = 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 RpbIndexBodyResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbIndexBodyResp -> f RpbIndexBodyResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbIndexBodyResp
-> f RpbIndexBodyResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexBodyResp -> Maybe Bool)
-> (RpbIndexBodyResp -> Maybe Bool -> RpbIndexBodyResp)
-> Lens RpbIndexBodyResp RpbIndexBodyResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexBodyResp -> Maybe Bool
_RpbIndexBodyResp'done
           (\ RpbIndexBodyResp
x__ Maybe Bool
y__ -> RpbIndexBodyResp
x__ {_RpbIndexBodyResp'done :: Maybe Bool
_RpbIndexBodyResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbIndexBodyResp where
  messageName :: Proxy RpbIndexBodyResp -> Text
messageName Proxy RpbIndexBodyResp
_ = String -> Text
Data.Text.pack String
"RpbIndexBodyResp"
  packedMessageDescriptor :: Proxy RpbIndexBodyResp -> ByteString
packedMessageDescriptor Proxy RpbIndexBodyResp
_
    = ByteString
"\n\
      \\DLERpbIndexBodyResp\DC2)\n\
      \\aobjects\CAN\SOH \ETX(\v2\SI.RpbIndexObjectR\aobjects\DC2\"\n\
      \\fcontinuation\CAN\STX \SOH(\fR\fcontinuation\DC2\DC2\n\
      \\EOTdone\CAN\ETX \SOH(\bR\EOTdone"
  packedFileDescriptor :: Proxy RpbIndexBodyResp -> ByteString
packedFileDescriptor Proxy RpbIndexBodyResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbIndexBodyResp)
fieldsByTag
    = let
        objects__field_descriptor :: FieldDescriptor RpbIndexBodyResp
objects__field_descriptor
          = String
-> FieldTypeDescriptor RpbIndexObject
-> FieldAccessor RpbIndexBodyResp RpbIndexObject
-> FieldDescriptor RpbIndexBodyResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"objects"
              (MessageOrGroup -> FieldTypeDescriptor RpbIndexObject
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbIndexObject)
              (Packing
-> Lens' RpbIndexBodyResp [RpbIndexObject]
-> FieldAccessor RpbIndexBodyResp RpbIndexObject
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "objects" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"objects")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexBodyResp
        continuation__field_descriptor :: FieldDescriptor RpbIndexBodyResp
continuation__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexBodyResp ByteString
-> FieldDescriptor RpbIndexBodyResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"continuation"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbIndexBodyResp
  RpbIndexBodyResp
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbIndexBodyResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexBodyResp
        done__field_descriptor :: FieldDescriptor RpbIndexBodyResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbIndexBodyResp Bool
-> FieldDescriptor RpbIndexBodyResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbIndexBodyResp RpbIndexBodyResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbIndexBodyResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexBodyResp
      in
        [(Tag, FieldDescriptor RpbIndexBodyResp)]
-> Map Tag (FieldDescriptor RpbIndexBodyResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbIndexBodyResp
objects__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbIndexBodyResp
continuation__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbIndexBodyResp
done__field_descriptor)]
  unknownFields :: LensLike' f RpbIndexBodyResp FieldSet
unknownFields
    = (RpbIndexBodyResp -> FieldSet)
-> (RpbIndexBodyResp -> FieldSet -> RpbIndexBodyResp)
-> Lens' RpbIndexBodyResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbIndexBodyResp -> FieldSet
_RpbIndexBodyResp'_unknownFields
        (\ RpbIndexBodyResp
x__ FieldSet
y__ -> RpbIndexBodyResp
x__ {_RpbIndexBodyResp'_unknownFields :: FieldSet
_RpbIndexBodyResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbIndexBodyResp
defMessage
    = RpbIndexBodyResp'_constructor :: Vector RpbIndexObject
-> Maybe ByteString -> Maybe Bool -> FieldSet -> RpbIndexBodyResp
RpbIndexBodyResp'_constructor
        {_RpbIndexBodyResp'objects :: Vector RpbIndexObject
_RpbIndexBodyResp'objects = Vector RpbIndexObject
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbIndexBodyResp'continuation :: Maybe ByteString
_RpbIndexBodyResp'continuation = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexBodyResp'done :: Maybe Bool
_RpbIndexBodyResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexBodyResp'_unknownFields :: FieldSet
_RpbIndexBodyResp'_unknownFields = []}
  parseMessage :: Parser RpbIndexBodyResp
parseMessage
    = let
        loop ::
          RpbIndexBodyResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbIndexObject
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbIndexBodyResp
        loop :: RpbIndexBodyResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbIndexBodyResp
loop RpbIndexBodyResp
x Growing Vector RealWorld RpbIndexObject
mutable'objects
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbIndexObject
frozen'objects <- IO (Vector RpbIndexObject) -> Parser (Vector RpbIndexObject)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) RpbIndexObject
-> IO (Vector RpbIndexObject)
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 RpbIndexObject
Growing Vector (PrimState IO) RpbIndexObject
mutable'objects)
                      (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]))))
                      RpbIndexBodyResp -> Parser RpbIndexBodyResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbIndexBodyResp RpbIndexBodyResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexBodyResp -> RpbIndexBodyResp
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 RpbIndexBodyResp RpbIndexBodyResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbIndexBodyResp
  RpbIndexBodyResp
  (Vector RpbIndexObject)
  (Vector RpbIndexObject)
-> Vector RpbIndexObject -> RpbIndexBodyResp -> RpbIndexBodyResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'objects" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'objects") Vector RpbIndexObject
frozen'objects RpbIndexBodyResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbIndexObject
y <- Parser RpbIndexObject -> String -> Parser RpbIndexObject
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbIndexObject -> Parser RpbIndexObject
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 RpbIndexObject
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"objects"
                                Growing Vector RealWorld RpbIndexObject
v <- IO (Growing Vector RealWorld RpbIndexObject)
-> Parser (Growing Vector RealWorld RpbIndexObject)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbIndexObject
-> RpbIndexObject
-> IO (Growing Vector (PrimState IO) RpbIndexObject)
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 RpbIndexObject
Growing Vector (PrimState IO) RpbIndexObject
mutable'objects RpbIndexObject
y)
                                RpbIndexBodyResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbIndexBodyResp
loop RpbIndexBodyResp
x Growing Vector RealWorld RpbIndexObject
v
                        Word64
18
                          -> 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
"continuation"
                                RpbIndexBodyResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbIndexBodyResp
loop
                                  (Setter RpbIndexBodyResp RpbIndexBodyResp ByteString ByteString
-> ByteString -> RpbIndexBodyResp -> RpbIndexBodyResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"continuation") ByteString
y RpbIndexBodyResp
x)
                                  Growing Vector RealWorld RpbIndexObject
mutable'objects
                        Word64
24
                          -> 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
"done"
                                RpbIndexBodyResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbIndexBodyResp
loop
                                  (Setter RpbIndexBodyResp RpbIndexBodyResp Bool Bool
-> Bool -> RpbIndexBodyResp -> RpbIndexBodyResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y RpbIndexBodyResp
x)
                                  Growing Vector RealWorld RpbIndexObject
mutable'objects
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbIndexBodyResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbIndexBodyResp
loop
                                  (Setter RpbIndexBodyResp RpbIndexBodyResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexBodyResp -> RpbIndexBodyResp
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 RpbIndexBodyResp RpbIndexBodyResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbIndexBodyResp
x)
                                  Growing Vector RealWorld RpbIndexObject
mutable'objects
      in
        Parser RpbIndexBodyResp -> String -> Parser RpbIndexBodyResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbIndexObject
mutable'objects <- IO (Growing Vector RealWorld RpbIndexObject)
-> Parser (Growing Vector RealWorld RpbIndexObject)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld RpbIndexObject)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbIndexBodyResp
-> Growing Vector RealWorld RpbIndexObject
-> Parser RpbIndexBodyResp
loop RpbIndexBodyResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbIndexObject
mutable'objects)
          String
"RpbIndexBodyResp"
  buildMessage :: RpbIndexBodyResp -> Builder
buildMessage
    = \ RpbIndexBodyResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbIndexObject -> Builder) -> Vector RpbIndexObject -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbIndexObject
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbIndexObject -> ByteString) -> RpbIndexObject -> 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))
                           RpbIndexObject -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbIndexObject
_v))
                (FoldLike
  (Vector RpbIndexObject)
  RpbIndexBodyResp
  RpbIndexBodyResp
  (Vector RpbIndexObject)
  (Vector RpbIndexObject)
-> RpbIndexBodyResp -> Vector RpbIndexObject
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'objects" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'objects") RpbIndexBodyResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbIndexBodyResp
  RpbIndexBodyResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexBodyResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation") RpbIndexBodyResp
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Bool)
  RpbIndexBodyResp
  RpbIndexBodyResp
  (Maybe Bool)
  (Maybe Bool)
-> RpbIndexBodyResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") RpbIndexBodyResp
_x
                    of
                      Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Bool
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike
  FieldSet RpbIndexBodyResp RpbIndexBodyResp FieldSet FieldSet
-> RpbIndexBodyResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbIndexBodyResp RpbIndexBodyResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbIndexBodyResp
_x))))
instance Control.DeepSeq.NFData RpbIndexBodyResp where
  rnf :: RpbIndexBodyResp -> ()
rnf
    = \ RpbIndexBodyResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbIndexBodyResp -> FieldSet
_RpbIndexBodyResp'_unknownFields RpbIndexBodyResp
x__)
             (Vector RpbIndexObject -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbIndexBodyResp -> Vector RpbIndexObject
_RpbIndexBodyResp'objects RpbIndexBodyResp
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbIndexBodyResp -> Maybe ByteString
_RpbIndexBodyResp'continuation RpbIndexBodyResp
x__)
                   (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbIndexBodyResp -> Maybe Bool
_RpbIndexBodyResp'done RpbIndexBodyResp
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.key' @:: Lens' RpbIndexObject Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.object' @:: Lens' RpbIndexObject RpbGetResp@ -}
data RpbIndexObject
  = RpbIndexObject'_constructor {RpbIndexObject -> ByteString
_RpbIndexObject'key :: !Data.ByteString.ByteString,
                                 RpbIndexObject -> RpbGetResp
_RpbIndexObject'object :: !RpbGetResp,
                                 RpbIndexObject -> FieldSet
_RpbIndexObject'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbIndexObject -> RpbIndexObject -> Bool
(RpbIndexObject -> RpbIndexObject -> Bool)
-> (RpbIndexObject -> RpbIndexObject -> Bool) -> Eq RpbIndexObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbIndexObject -> RpbIndexObject -> Bool
$c/= :: RpbIndexObject -> RpbIndexObject -> Bool
== :: RpbIndexObject -> RpbIndexObject -> Bool
$c== :: RpbIndexObject -> RpbIndexObject -> Bool
Prelude.Eq, Eq RpbIndexObject
Eq RpbIndexObject
-> (RpbIndexObject -> RpbIndexObject -> Ordering)
-> (RpbIndexObject -> RpbIndexObject -> Bool)
-> (RpbIndexObject -> RpbIndexObject -> Bool)
-> (RpbIndexObject -> RpbIndexObject -> Bool)
-> (RpbIndexObject -> RpbIndexObject -> Bool)
-> (RpbIndexObject -> RpbIndexObject -> RpbIndexObject)
-> (RpbIndexObject -> RpbIndexObject -> RpbIndexObject)
-> Ord RpbIndexObject
RpbIndexObject -> RpbIndexObject -> Bool
RpbIndexObject -> RpbIndexObject -> Ordering
RpbIndexObject -> RpbIndexObject -> RpbIndexObject
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 :: RpbIndexObject -> RpbIndexObject -> RpbIndexObject
$cmin :: RpbIndexObject -> RpbIndexObject -> RpbIndexObject
max :: RpbIndexObject -> RpbIndexObject -> RpbIndexObject
$cmax :: RpbIndexObject -> RpbIndexObject -> RpbIndexObject
>= :: RpbIndexObject -> RpbIndexObject -> Bool
$c>= :: RpbIndexObject -> RpbIndexObject -> Bool
> :: RpbIndexObject -> RpbIndexObject -> Bool
$c> :: RpbIndexObject -> RpbIndexObject -> Bool
<= :: RpbIndexObject -> RpbIndexObject -> Bool
$c<= :: RpbIndexObject -> RpbIndexObject -> Bool
< :: RpbIndexObject -> RpbIndexObject -> Bool
$c< :: RpbIndexObject -> RpbIndexObject -> Bool
compare :: RpbIndexObject -> RpbIndexObject -> Ordering
$ccompare :: RpbIndexObject -> RpbIndexObject -> Ordering
$cp1Ord :: Eq RpbIndexObject
Prelude.Ord)
instance Prelude.Show RpbIndexObject where
  showsPrec :: Int -> RpbIndexObject -> ShowS
showsPrec Int
_ RpbIndexObject
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbIndexObject -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbIndexObject
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbIndexObject "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString)
-> RpbIndexObject
-> f RpbIndexObject
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString)
 -> RpbIndexObject -> f RpbIndexObject)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbIndexObject
-> f RpbIndexObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexObject -> ByteString)
-> (RpbIndexObject -> ByteString -> RpbIndexObject)
-> Lens RpbIndexObject RpbIndexObject ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexObject -> ByteString
_RpbIndexObject'key (\ RpbIndexObject
x__ ByteString
y__ -> RpbIndexObject
x__ {_RpbIndexObject'key :: ByteString
_RpbIndexObject'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexObject "object" RpbGetResp where
  fieldOf :: Proxy# "object"
-> (RpbGetResp -> f RpbGetResp)
-> RpbIndexObject
-> f RpbIndexObject
fieldOf Proxy# "object"
_
    = ((RpbGetResp -> f RpbGetResp)
 -> RpbIndexObject -> f RpbIndexObject)
-> ((RpbGetResp -> f RpbGetResp) -> RpbGetResp -> f RpbGetResp)
-> (RpbGetResp -> f RpbGetResp)
-> RpbIndexObject
-> f RpbIndexObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexObject -> RpbGetResp)
-> (RpbIndexObject -> RpbGetResp -> RpbIndexObject)
-> Lens RpbIndexObject RpbIndexObject RpbGetResp RpbGetResp
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexObject -> RpbGetResp
_RpbIndexObject'object
           (\ RpbIndexObject
x__ RpbGetResp
y__ -> RpbIndexObject
x__ {_RpbIndexObject'object :: RpbGetResp
_RpbIndexObject'object = RpbGetResp
y__}))
        (RpbGetResp -> f RpbGetResp) -> RpbGetResp -> f RpbGetResp
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbIndexObject where
  messageName :: Proxy RpbIndexObject -> Text
messageName Proxy RpbIndexObject
_ = String -> Text
Data.Text.pack String
"RpbIndexObject"
  packedMessageDescriptor :: Proxy RpbIndexObject -> ByteString
packedMessageDescriptor Proxy RpbIndexObject
_
    = ByteString
"\n\
      \\SORpbIndexObject\DC2\DLE\n\
      \\ETXkey\CAN\SOH \STX(\fR\ETXkey\DC2#\n\
      \\ACKobject\CAN\STX \STX(\v2\v.RpbGetRespR\ACKobject"
  packedFileDescriptor :: Proxy RpbIndexObject -> ByteString
packedFileDescriptor Proxy RpbIndexObject
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbIndexObject)
fieldsByTag
    = let
        key__field_descriptor :: FieldDescriptor RpbIndexObject
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexObject ByteString
-> FieldDescriptor RpbIndexObject
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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 RpbIndexObject RpbIndexObject ByteString ByteString
-> FieldAccessor RpbIndexObject ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexObject
        object__field_descriptor :: FieldDescriptor RpbIndexObject
object__field_descriptor
          = String
-> FieldTypeDescriptor RpbGetResp
-> FieldAccessor RpbIndexObject RpbGetResp
-> FieldDescriptor RpbIndexObject
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"object"
              (MessageOrGroup -> FieldTypeDescriptor RpbGetResp
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbGetResp)
              (WireDefault RpbGetResp
-> Lens RpbIndexObject RpbIndexObject RpbGetResp RpbGetResp
-> FieldAccessor RpbIndexObject RpbGetResp
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbGetResp
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "object" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"object")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexObject
      in
        [(Tag, FieldDescriptor RpbIndexObject)]
-> Map Tag (FieldDescriptor RpbIndexObject)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbIndexObject
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbIndexObject
object__field_descriptor)]
  unknownFields :: LensLike' f RpbIndexObject FieldSet
unknownFields
    = (RpbIndexObject -> FieldSet)
-> (RpbIndexObject -> FieldSet -> RpbIndexObject)
-> Lens' RpbIndexObject FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbIndexObject -> FieldSet
_RpbIndexObject'_unknownFields
        (\ RpbIndexObject
x__ FieldSet
y__ -> RpbIndexObject
x__ {_RpbIndexObject'_unknownFields :: FieldSet
_RpbIndexObject'_unknownFields = FieldSet
y__})
  defMessage :: RpbIndexObject
defMessage
    = RpbIndexObject'_constructor :: ByteString -> RpbGetResp -> FieldSet -> RpbIndexObject
RpbIndexObject'_constructor
        {_RpbIndexObject'key :: ByteString
_RpbIndexObject'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbIndexObject'object :: RpbGetResp
_RpbIndexObject'object = RpbGetResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbIndexObject'_unknownFields :: FieldSet
_RpbIndexObject'_unknownFields = []}
  parseMessage :: Parser RpbIndexObject
parseMessage
    = let
        loop ::
          RpbIndexObject
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbIndexObject
        loop :: RpbIndexObject -> Bool -> Bool -> Parser RpbIndexObject
loop RpbIndexObject
x Bool
required'key Bool
required'object
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'object then (:) String
"object" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbIndexObject -> Parser RpbIndexObject
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbIndexObject RpbIndexObject FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexObject -> RpbIndexObject
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 RpbIndexObject RpbIndexObject FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbIndexObject
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
"key"
                                RpbIndexObject -> Bool -> Bool -> Parser RpbIndexObject
loop
                                  (Setter RpbIndexObject RpbIndexObject ByteString ByteString
-> ByteString -> RpbIndexObject -> RpbIndexObject
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbIndexObject
x)
                                  Bool
Prelude.False
                                  Bool
required'object
                        Word64
18
                          -> do RpbGetResp
y <- Parser RpbGetResp -> String -> Parser RpbGetResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbGetResp -> Parser RpbGetResp
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 RpbGetResp
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"object"
                                RpbIndexObject -> Bool -> Bool -> Parser RpbIndexObject
loop
                                  (Setter RpbIndexObject RpbIndexObject RpbGetResp RpbGetResp
-> RpbGetResp -> RpbIndexObject -> RpbIndexObject
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "object" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"object") RpbGetResp
y RpbIndexObject
x)
                                  Bool
required'key
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbIndexObject -> Bool -> Bool -> Parser RpbIndexObject
loop
                                  (Setter RpbIndexObject RpbIndexObject FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexObject -> RpbIndexObject
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 RpbIndexObject RpbIndexObject FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbIndexObject
x)
                                  Bool
required'key
                                  Bool
required'object
      in
        Parser RpbIndexObject -> String -> Parser RpbIndexObject
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbIndexObject -> Bool -> Bool -> Parser RpbIndexObject
loop RpbIndexObject
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbIndexObject"
  buildMessage :: RpbIndexObject -> Builder
buildMessage
    = \ RpbIndexObject
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbIndexObject RpbIndexObject ByteString ByteString
-> RpbIndexObject -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") RpbIndexObject
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((ByteString -> Builder)
-> (RpbGetResp -> ByteString) -> RpbGetResp -> 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))
                      RpbGetResp -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                      (FoldLike
  RpbGetResp RpbIndexObject RpbIndexObject RpbGetResp RpbGetResp
-> RpbIndexObject -> RpbGetResp
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "object" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"object") RpbIndexObject
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet RpbIndexObject RpbIndexObject FieldSet FieldSet
-> RpbIndexObject -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbIndexObject RpbIndexObject FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbIndexObject
_x)))
instance Control.DeepSeq.NFData RpbIndexObject where
  rnf :: RpbIndexObject -> ()
rnf
    = \ RpbIndexObject
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbIndexObject -> FieldSet
_RpbIndexObject'_unknownFields RpbIndexObject
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbIndexObject -> ByteString
_RpbIndexObject'key RpbIndexObject
x__)
                (RpbGetResp -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbIndexObject -> RpbGetResp
_RpbIndexObject'object RpbIndexObject
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.index' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.qtype' @:: Lens' RpbIndexReq RpbIndexReq'IndexQueryType@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'key' @:: Lens' RpbIndexReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.rangeMin' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'rangeMin' @:: Lens' RpbIndexReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.rangeMax' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'rangeMax' @:: Lens' RpbIndexReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.returnTerms' @:: Lens' RpbIndexReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'returnTerms' @:: Lens' RpbIndexReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.stream' @:: Lens' RpbIndexReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'stream' @:: Lens' RpbIndexReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.maxResults' @:: Lens' RpbIndexReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'maxResults' @:: Lens' RpbIndexReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.continuation' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'continuation' @:: Lens' RpbIndexReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbIndexReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbIndexReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbIndexReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.termRegex' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'termRegex' @:: Lens' RpbIndexReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.paginationSort' @:: Lens' RpbIndexReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'paginationSort' @:: Lens' RpbIndexReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.coverContext' @:: Lens' RpbIndexReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'coverContext' @:: Lens' RpbIndexReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.returnBody' @:: Lens' RpbIndexReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'returnBody' @:: Lens' RpbIndexReq (Prelude.Maybe Prelude.Bool)@ -}
data RpbIndexReq
  = RpbIndexReq'_constructor {RpbIndexReq -> ByteString
_RpbIndexReq'bucket :: !Data.ByteString.ByteString,
                              RpbIndexReq -> ByteString
_RpbIndexReq'index :: !Data.ByteString.ByteString,
                              RpbIndexReq -> RpbIndexReq'IndexQueryType
_RpbIndexReq'qtype :: !RpbIndexReq'IndexQueryType,
                              RpbIndexReq -> Maybe ByteString
_RpbIndexReq'key :: !(Prelude.Maybe Data.ByteString.ByteString),
                              RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMin :: !(Prelude.Maybe Data.ByteString.ByteString),
                              RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMax :: !(Prelude.Maybe Data.ByteString.ByteString),
                              RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnTerms :: !(Prelude.Maybe Prelude.Bool),
                              RpbIndexReq -> Maybe Bool
_RpbIndexReq'stream :: !(Prelude.Maybe Prelude.Bool),
                              RpbIndexReq -> Maybe Word32
_RpbIndexReq'maxResults :: !(Prelude.Maybe Data.Word.Word32),
                              RpbIndexReq -> Maybe ByteString
_RpbIndexReq'continuation :: !(Prelude.Maybe Data.ByteString.ByteString),
                              RpbIndexReq -> Maybe Word32
_RpbIndexReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                              RpbIndexReq -> Maybe ByteString
_RpbIndexReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                              RpbIndexReq -> Maybe ByteString
_RpbIndexReq'termRegex :: !(Prelude.Maybe Data.ByteString.ByteString),
                              RpbIndexReq -> Maybe Bool
_RpbIndexReq'paginationSort :: !(Prelude.Maybe Prelude.Bool),
                              RpbIndexReq -> Maybe ByteString
_RpbIndexReq'coverContext :: !(Prelude.Maybe Data.ByteString.ByteString),
                              RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnBody :: !(Prelude.Maybe Prelude.Bool),
                              RpbIndexReq -> FieldSet
_RpbIndexReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbIndexReq -> RpbIndexReq -> Bool
(RpbIndexReq -> RpbIndexReq -> Bool)
-> (RpbIndexReq -> RpbIndexReq -> Bool) -> Eq RpbIndexReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbIndexReq -> RpbIndexReq -> Bool
$c/= :: RpbIndexReq -> RpbIndexReq -> Bool
== :: RpbIndexReq -> RpbIndexReq -> Bool
$c== :: RpbIndexReq -> RpbIndexReq -> Bool
Prelude.Eq, Eq RpbIndexReq
Eq RpbIndexReq
-> (RpbIndexReq -> RpbIndexReq -> Ordering)
-> (RpbIndexReq -> RpbIndexReq -> Bool)
-> (RpbIndexReq -> RpbIndexReq -> Bool)
-> (RpbIndexReq -> RpbIndexReq -> Bool)
-> (RpbIndexReq -> RpbIndexReq -> Bool)
-> (RpbIndexReq -> RpbIndexReq -> RpbIndexReq)
-> (RpbIndexReq -> RpbIndexReq -> RpbIndexReq)
-> Ord RpbIndexReq
RpbIndexReq -> RpbIndexReq -> Bool
RpbIndexReq -> RpbIndexReq -> Ordering
RpbIndexReq -> RpbIndexReq -> RpbIndexReq
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 :: RpbIndexReq -> RpbIndexReq -> RpbIndexReq
$cmin :: RpbIndexReq -> RpbIndexReq -> RpbIndexReq
max :: RpbIndexReq -> RpbIndexReq -> RpbIndexReq
$cmax :: RpbIndexReq -> RpbIndexReq -> RpbIndexReq
>= :: RpbIndexReq -> RpbIndexReq -> Bool
$c>= :: RpbIndexReq -> RpbIndexReq -> Bool
> :: RpbIndexReq -> RpbIndexReq -> Bool
$c> :: RpbIndexReq -> RpbIndexReq -> Bool
<= :: RpbIndexReq -> RpbIndexReq -> Bool
$c<= :: RpbIndexReq -> RpbIndexReq -> Bool
< :: RpbIndexReq -> RpbIndexReq -> Bool
$c< :: RpbIndexReq -> RpbIndexReq -> Bool
compare :: RpbIndexReq -> RpbIndexReq -> Ordering
$ccompare :: RpbIndexReq -> RpbIndexReq -> Ordering
$cp1Ord :: Eq RpbIndexReq
Prelude.Ord)
instance Prelude.Show RpbIndexReq where
  showsPrec :: Int -> RpbIndexReq -> ShowS
showsPrec Int
_ RpbIndexReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbIndexReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbIndexReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbIndexReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> ByteString)
-> (RpbIndexReq -> ByteString -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> ByteString
_RpbIndexReq'bucket (\ RpbIndexReq
x__ ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'bucket :: ByteString
_RpbIndexReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "index" Data.ByteString.ByteString where
  fieldOf :: Proxy# "index"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "index"
_
    = ((ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> ByteString)
-> (RpbIndexReq -> ByteString -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> ByteString
_RpbIndexReq'index (\ RpbIndexReq
x__ ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'index :: ByteString
_RpbIndexReq'index = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "qtype" RpbIndexReq'IndexQueryType where
  fieldOf :: Proxy# "qtype"
-> (RpbIndexReq'IndexQueryType -> f RpbIndexReq'IndexQueryType)
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "qtype"
_
    = ((RpbIndexReq'IndexQueryType -> f RpbIndexReq'IndexQueryType)
 -> RpbIndexReq -> f RpbIndexReq)
-> ((RpbIndexReq'IndexQueryType -> f RpbIndexReq'IndexQueryType)
    -> RpbIndexReq'IndexQueryType -> f RpbIndexReq'IndexQueryType)
-> (RpbIndexReq'IndexQueryType -> f RpbIndexReq'IndexQueryType)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> RpbIndexReq'IndexQueryType)
-> (RpbIndexReq -> RpbIndexReq'IndexQueryType -> RpbIndexReq)
-> Lens
     RpbIndexReq
     RpbIndexReq
     RpbIndexReq'IndexQueryType
     RpbIndexReq'IndexQueryType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> RpbIndexReq'IndexQueryType
_RpbIndexReq'qtype (\ RpbIndexReq
x__ RpbIndexReq'IndexQueryType
y__ -> RpbIndexReq
x__ {_RpbIndexReq'qtype :: RpbIndexReq'IndexQueryType
_RpbIndexReq'qtype = RpbIndexReq'IndexQueryType
y__}))
        (RpbIndexReq'IndexQueryType -> f RpbIndexReq'IndexQueryType)
-> RpbIndexReq'IndexQueryType -> f RpbIndexReq'IndexQueryType
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'key (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'key :: Maybe ByteString
_RpbIndexReq'key = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'key" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'key"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'key (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'key :: Maybe ByteString
_RpbIndexReq'key = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "rangeMin" Data.ByteString.ByteString where
  fieldOf :: Proxy# "rangeMin"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "rangeMin"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMin
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'rangeMin :: Maybe ByteString
_RpbIndexReq'rangeMin = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'rangeMin" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'rangeMin"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'rangeMin"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMin
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'rangeMin :: Maybe ByteString
_RpbIndexReq'rangeMin = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "rangeMax" Data.ByteString.ByteString where
  fieldOf :: Proxy# "rangeMax"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "rangeMax"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMax
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'rangeMax :: Maybe ByteString
_RpbIndexReq'rangeMax = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'rangeMax" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'rangeMax"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'rangeMax"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMax
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'rangeMax :: Maybe ByteString
_RpbIndexReq'rangeMax = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "returnTerms" Prelude.Bool where
  fieldOf :: Proxy# "returnTerms"
-> (Bool -> f Bool) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "returnTerms"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnTerms
           (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'returnTerms :: Maybe Bool
_RpbIndexReq'returnTerms = 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 RpbIndexReq "maybe'returnTerms" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'returnTerms"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "maybe'returnTerms"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnTerms
           (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'returnTerms :: Maybe Bool
_RpbIndexReq'returnTerms = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "stream" Prelude.Bool where
  fieldOf :: Proxy# "stream" -> (Bool -> f Bool) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "stream"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'stream (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'stream :: Maybe Bool
_RpbIndexReq'stream = 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 RpbIndexReq "maybe'stream" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'stream"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "maybe'stream"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'stream (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'stream :: Maybe Bool
_RpbIndexReq'stream = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "maxResults" Data.Word.Word32 where
  fieldOf :: Proxy# "maxResults"
-> (Word32 -> f Word32) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "maxResults"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Word32)
-> (RpbIndexReq -> Maybe Word32 -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Word32
_RpbIndexReq'maxResults
           (\ RpbIndexReq
x__ Maybe Word32
y__ -> RpbIndexReq
x__ {_RpbIndexReq'maxResults :: Maybe Word32
_RpbIndexReq'maxResults = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'maxResults" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'maxResults"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'maxResults"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Word32)
-> (RpbIndexReq -> Maybe Word32 -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Word32
_RpbIndexReq'maxResults
           (\ RpbIndexReq
x__ Maybe Word32
y__ -> RpbIndexReq
x__ {_RpbIndexReq'maxResults :: Maybe Word32
_RpbIndexReq'maxResults = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "continuation" Data.ByteString.ByteString where
  fieldOf :: Proxy# "continuation"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'continuation
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'continuation :: Maybe ByteString
_RpbIndexReq'continuation = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'continuation" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'continuation"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'continuation
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'continuation :: Maybe ByteString
_RpbIndexReq'continuation = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Word32)
-> (RpbIndexReq -> Maybe Word32 -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Word32
_RpbIndexReq'timeout
           (\ RpbIndexReq
x__ Maybe Word32
y__ -> RpbIndexReq
x__ {_RpbIndexReq'timeout :: Maybe Word32
_RpbIndexReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Word32)
-> (RpbIndexReq -> Maybe Word32 -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Word32
_RpbIndexReq'timeout
           (\ RpbIndexReq
x__ Maybe Word32
y__ -> RpbIndexReq
x__ {_RpbIndexReq'timeout :: Maybe Word32
_RpbIndexReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'type' (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'type' :: Maybe ByteString
_RpbIndexReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'type' (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'type' :: Maybe ByteString
_RpbIndexReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "termRegex" Data.ByteString.ByteString where
  fieldOf :: Proxy# "termRegex"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "termRegex"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'termRegex
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'termRegex :: Maybe ByteString
_RpbIndexReq'termRegex = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'termRegex" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'termRegex"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'termRegex"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'termRegex
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'termRegex :: Maybe ByteString
_RpbIndexReq'termRegex = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "paginationSort" Prelude.Bool where
  fieldOf :: Proxy# "paginationSort"
-> (Bool -> f Bool) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "paginationSort"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'paginationSort
           (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'paginationSort :: Maybe Bool
_RpbIndexReq'paginationSort = 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 RpbIndexReq "maybe'paginationSort" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'paginationSort"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "maybe'paginationSort"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'paginationSort
           (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'paginationSort :: Maybe Bool
_RpbIndexReq'paginationSort = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "coverContext" Data.ByteString.ByteString where
  fieldOf :: Proxy# "coverContext"
-> (ByteString -> f ByteString) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "coverContext"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'coverContext
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'coverContext :: Maybe ByteString
_RpbIndexReq'coverContext = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexReq "maybe'coverContext" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'coverContext"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
fieldOf Proxy# "maybe'coverContext"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe ByteString)
-> (RpbIndexReq -> Maybe ByteString -> RpbIndexReq)
-> Lens
     RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe ByteString
_RpbIndexReq'coverContext
           (\ RpbIndexReq
x__ Maybe ByteString
y__ -> RpbIndexReq
x__ {_RpbIndexReq'coverContext :: Maybe ByteString
_RpbIndexReq'coverContext = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexReq "returnBody" Prelude.Bool where
  fieldOf :: Proxy# "returnBody"
-> (Bool -> f Bool) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "returnBody"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnBody
           (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'returnBody :: Maybe Bool
_RpbIndexReq'returnBody = 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 RpbIndexReq "maybe'returnBody" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'returnBody"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq
fieldOf Proxy# "maybe'returnBody"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexReq -> f RpbIndexReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbIndexReq
-> f RpbIndexReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexReq -> Maybe Bool)
-> (RpbIndexReq -> Maybe Bool -> RpbIndexReq)
-> Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnBody
           (\ RpbIndexReq
x__ Maybe Bool
y__ -> RpbIndexReq
x__ {_RpbIndexReq'returnBody :: Maybe Bool
_RpbIndexReq'returnBody = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbIndexReq where
  messageName :: Proxy RpbIndexReq -> Text
messageName Proxy RpbIndexReq
_ = String -> Text
Data.Text.pack String
"RpbIndexReq"
  packedMessageDescriptor :: Proxy RpbIndexReq -> ByteString
packedMessageDescriptor Proxy RpbIndexReq
_
    = ByteString
"\n\
      \\vRpbIndexReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DC4\n\
      \\ENQindex\CAN\STX \STX(\fR\ENQindex\DC21\n\
      \\ENQqtype\CAN\ETX \STX(\SO2\ESC.RpbIndexReq.IndexQueryTypeR\ENQqtype\DC2\DLE\n\
      \\ETXkey\CAN\EOT \SOH(\fR\ETXkey\DC2\ESC\n\
      \\trange_min\CAN\ENQ \SOH(\fR\brangeMin\DC2\ESC\n\
      \\trange_max\CAN\ACK \SOH(\fR\brangeMax\DC2!\n\
      \\freturn_terms\CAN\a \SOH(\bR\vreturnTerms\DC2\SYN\n\
      \\ACKstream\CAN\b \SOH(\bR\ACKstream\DC2\US\n\
      \\vmax_results\CAN\t \SOH(\rR\n\
      \maxResults\DC2\"\n\
      \\fcontinuation\CAN\n\
      \ \SOH(\fR\fcontinuation\DC2\CAN\n\
      \\atimeout\CAN\v \SOH(\rR\atimeout\DC2\DC2\n\
      \\EOTtype\CAN\f \SOH(\fR\EOTtype\DC2\GS\n\
      \\n\
      \term_regex\CAN\r \SOH(\fR\ttermRegex\DC2'\n\
      \\SIpagination_sort\CAN\SO \SOH(\bR\SOpaginationSort\DC2#\n\
      \\rcover_context\CAN\SI \SOH(\fR\fcoverContext\DC2\US\n\
      \\vreturn_body\CAN\DLE \SOH(\bR\n\
      \returnBody\"#\n\
      \\SOIndexQueryType\DC2\ACK\n\
      \\STXeq\DLE\NUL\DC2\t\n\
      \\ENQrange\DLE\SOH"
  packedFileDescriptor :: Proxy RpbIndexReq -> ByteString
packedFileDescriptor Proxy RpbIndexReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbIndexReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbIndexReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbIndexReq RpbIndexReq ByteString ByteString
-> FieldAccessor RpbIndexReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        index__field_descriptor :: FieldDescriptor RpbIndexReq
index__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"index"
              (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 RpbIndexReq RpbIndexReq ByteString ByteString
-> FieldAccessor RpbIndexReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        qtype__field_descriptor :: FieldDescriptor RpbIndexReq
qtype__field_descriptor
          = String
-> FieldTypeDescriptor RpbIndexReq'IndexQueryType
-> FieldAccessor RpbIndexReq RpbIndexReq'IndexQueryType
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"qtype"
              (ScalarField RpbIndexReq'IndexQueryType
-> FieldTypeDescriptor RpbIndexReq'IndexQueryType
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField RpbIndexReq'IndexQueryType
forall t. MessageEnum t => ScalarField t
Data.ProtoLens.EnumField ::
                 Data.ProtoLens.FieldTypeDescriptor RpbIndexReq'IndexQueryType)
              (WireDefault RpbIndexReq'IndexQueryType
-> Lens
     RpbIndexReq
     RpbIndexReq
     RpbIndexReq'IndexQueryType
     RpbIndexReq'IndexQueryType
-> FieldAccessor RpbIndexReq RpbIndexReq'IndexQueryType
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbIndexReq'IndexQueryType
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "qtype" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"qtype")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        key__field_descriptor :: FieldDescriptor RpbIndexReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        rangeMin__field_descriptor :: FieldDescriptor RpbIndexReq
rangeMin__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"range_min"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'rangeMin" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rangeMin")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        rangeMax__field_descriptor :: FieldDescriptor RpbIndexReq
rangeMax__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"range_max"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'rangeMax" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rangeMax")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        returnTerms__field_descriptor :: FieldDescriptor RpbIndexReq
returnTerms__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbIndexReq Bool
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"return_terms"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbIndexReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'returnTerms" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnTerms")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        stream__field_descriptor :: FieldDescriptor RpbIndexReq
stream__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbIndexReq Bool
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"stream"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbIndexReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'stream")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        maxResults__field_descriptor :: FieldDescriptor RpbIndexReq
maxResults__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbIndexReq Word32
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"max_results"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbIndexReq RpbIndexReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbIndexReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'maxResults" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'maxResults")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        continuation__field_descriptor :: FieldDescriptor RpbIndexReq
continuation__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"continuation"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        timeout__field_descriptor :: FieldDescriptor RpbIndexReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbIndexReq Word32
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbIndexReq RpbIndexReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbIndexReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        type'__field_descriptor :: FieldDescriptor RpbIndexReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        termRegex__field_descriptor :: FieldDescriptor RpbIndexReq
termRegex__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"term_regex"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'termRegex" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'termRegex")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        paginationSort__field_descriptor :: FieldDescriptor RpbIndexReq
paginationSort__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbIndexReq Bool
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pagination_sort"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbIndexReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'paginationSort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'paginationSort")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        coverContext__field_descriptor :: FieldDescriptor RpbIndexReq
coverContext__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexReq ByteString
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"cover_context"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbIndexReq RpbIndexReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'coverContext")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
        returnBody__field_descriptor :: FieldDescriptor RpbIndexReq
returnBody__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbIndexReq Bool
-> FieldDescriptor RpbIndexReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"return_body"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbIndexReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnBody")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexReq
      in
        [(Tag, FieldDescriptor RpbIndexReq)]
-> Map Tag (FieldDescriptor RpbIndexReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbIndexReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbIndexReq
index__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbIndexReq
qtype__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbIndexReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbIndexReq
rangeMin__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbIndexReq
rangeMax__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbIndexReq
returnTerms__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbIndexReq
stream__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbIndexReq
maxResults__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbIndexReq
continuation__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor RpbIndexReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
12, FieldDescriptor RpbIndexReq
type'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
13, FieldDescriptor RpbIndexReq
termRegex__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
14, FieldDescriptor RpbIndexReq
paginationSort__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
15, FieldDescriptor RpbIndexReq
coverContext__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
16, FieldDescriptor RpbIndexReq
returnBody__field_descriptor)]
  unknownFields :: LensLike' f RpbIndexReq FieldSet
unknownFields
    = (RpbIndexReq -> FieldSet)
-> (RpbIndexReq -> FieldSet -> RpbIndexReq)
-> Lens' RpbIndexReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbIndexReq -> FieldSet
_RpbIndexReq'_unknownFields
        (\ RpbIndexReq
x__ FieldSet
y__ -> RpbIndexReq
x__ {_RpbIndexReq'_unknownFields :: FieldSet
_RpbIndexReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbIndexReq
defMessage
    = RpbIndexReq'_constructor :: ByteString
-> ByteString
-> RpbIndexReq'IndexQueryType
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe Bool
-> Maybe Bool
-> Maybe Word32
-> Maybe ByteString
-> Maybe Word32
-> Maybe ByteString
-> Maybe ByteString
-> Maybe Bool
-> Maybe ByteString
-> Maybe Bool
-> FieldSet
-> RpbIndexReq
RpbIndexReq'_constructor
        {_RpbIndexReq'bucket :: ByteString
_RpbIndexReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbIndexReq'index :: ByteString
_RpbIndexReq'index = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbIndexReq'qtype :: RpbIndexReq'IndexQueryType
_RpbIndexReq'qtype = RpbIndexReq'IndexQueryType
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbIndexReq'key :: Maybe ByteString
_RpbIndexReq'key = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'rangeMin :: Maybe ByteString
_RpbIndexReq'rangeMin = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'rangeMax :: Maybe ByteString
_RpbIndexReq'rangeMax = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'returnTerms :: Maybe Bool
_RpbIndexReq'returnTerms = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'stream :: Maybe Bool
_RpbIndexReq'stream = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'maxResults :: Maybe Word32
_RpbIndexReq'maxResults = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'continuation :: Maybe ByteString
_RpbIndexReq'continuation = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'timeout :: Maybe Word32
_RpbIndexReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'type' :: Maybe ByteString
_RpbIndexReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'termRegex :: Maybe ByteString
_RpbIndexReq'termRegex = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'paginationSort :: Maybe Bool
_RpbIndexReq'paginationSort = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'coverContext :: Maybe ByteString
_RpbIndexReq'coverContext = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'returnBody :: Maybe Bool
_RpbIndexReq'returnBody = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexReq'_unknownFields :: FieldSet
_RpbIndexReq'_unknownFields = []}
  parseMessage :: Parser RpbIndexReq
parseMessage
    = let
        loop ::
          RpbIndexReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser RpbIndexReq
        loop :: RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop RpbIndexReq
x Bool
required'bucket Bool
required'index Bool
required'qtype
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'index then (:) String
"index" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'qtype then (:) String
"qtype" else [String] -> [String]
forall a. a -> a
Prelude.id) []))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbIndexReq -> Parser RpbIndexReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbIndexReq RpbIndexReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexReq -> RpbIndexReq
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 RpbIndexReq RpbIndexReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbIndexReq
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
"bucket"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbIndexReq
x)
                                  Bool
Prelude.False
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
18
                          -> 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
"index"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                                  Bool
required'qtype
                        Word64
24
                          -> do RpbIndexReq'IndexQueryType
y <- Parser RpbIndexReq'IndexQueryType
-> String -> Parser RpbIndexReq'IndexQueryType
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Int -> RpbIndexReq'IndexQueryType)
-> Parser Int -> Parser RpbIndexReq'IndexQueryType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Int -> RpbIndexReq'IndexQueryType
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
"qtype"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter
  RpbIndexReq
  RpbIndexReq
  RpbIndexReq'IndexQueryType
  RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "qtype" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"qtype") RpbIndexReq'IndexQueryType
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
Prelude.False
                        Word64
34
                          -> 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
"key"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
42
                          -> 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
"range_min"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "rangeMin" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rangeMin") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
50
                          -> 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
"range_max"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "rangeMax" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rangeMax") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
56
                          -> 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
"return_terms"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq Bool Bool
-> Bool -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "returnTerms" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"returnTerms") Bool
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
64
                          -> 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
"stream"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq Bool Bool
-> Bool -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"stream") Bool
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
72
                          -> 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
"max_results"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq Word32 Word32
-> Word32 -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "maxResults" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maxResults") Word32
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
82
                          -> 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
"continuation"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"continuation") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
88
                          -> 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
"timeout"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq Word32 Word32
-> Word32 -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
98
                          -> 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
"type"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
106
                          -> 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
"term_regex"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "termRegex" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"termRegex") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
112
                          -> 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
"pagination_sort"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq Bool Bool
-> Bool -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "paginationSort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"paginationSort") Bool
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
122
                          -> 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
"cover_context"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq ByteString ByteString
-> ByteString -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext") ByteString
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
128
                          -> 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
"return_body"
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq Bool Bool
-> Bool -> RpbIndexReq -> RpbIndexReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"returnBody") Bool
y RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                                  (Setter RpbIndexReq RpbIndexReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexReq -> RpbIndexReq
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 RpbIndexReq RpbIndexReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbIndexReq
x)
                                  Bool
required'bucket
                                  Bool
required'index
                                  Bool
required'qtype
      in
        Parser RpbIndexReq -> String -> Parser RpbIndexReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbIndexReq -> Bool -> Bool -> Bool -> Parser RpbIndexReq
loop
                RpbIndexReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Bool
Prelude.True)
          String
"RpbIndexReq"
  buildMessage :: RpbIndexReq -> Builder
buildMessage
    = \ RpbIndexReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbIndexReq RpbIndexReq ByteString ByteString
-> RpbIndexReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbIndexReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike ByteString RpbIndexReq RpbIndexReq ByteString ByteString
-> RpbIndexReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index") RpbIndexReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                      ((Int -> Builder)
-> (RpbIndexReq'IndexQueryType -> Int)
-> RpbIndexReq'IndexQueryType
-> 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)
                         RpbIndexReq'IndexQueryType -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum
                         (FoldLike
  RpbIndexReq'IndexQueryType
  RpbIndexReq
  RpbIndexReq
  RpbIndexReq'IndexQueryType
  RpbIndexReq'IndexQueryType
-> RpbIndexReq -> RpbIndexReq'IndexQueryType
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "qtype" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"qtype") RpbIndexReq
_x)))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe ByteString)
  RpbIndexReq
  RpbIndexReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key") RpbIndexReq
_x
                       of
                         Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just ByteString
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((\ 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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe ByteString)
  RpbIndexReq
  RpbIndexReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'rangeMin" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rangeMin") RpbIndexReq
_x
                          of
                            Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just ByteString
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                                   ((\ 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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe ByteString)
  RpbIndexReq
  RpbIndexReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'rangeMax" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rangeMax") RpbIndexReq
_x
                             of
                               Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just ByteString
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                                      ((\ 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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe Bool) RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> RpbIndexReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'returnTerms" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnTerms") RpbIndexReq
_x
                                of
                                  Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Bool
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe Bool) RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> RpbIndexReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                         (forall s a (f :: * -> *).
(HasField s "maybe'stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'stream") RpbIndexReq
_x
                                   of
                                     Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Bool
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike
  (Maybe Word32)
  RpbIndexReq
  RpbIndexReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbIndexReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'maxResults" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'maxResults") RpbIndexReq
_x
                                      of
                                        Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just Word32
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
72)
                                               ((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))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe ByteString)
  RpbIndexReq
  RpbIndexReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation") RpbIndexReq
_x
                                         of
                                           Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just ByteString
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
82)
                                                  ((\ 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))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike
  (Maybe Word32)
  RpbIndexReq
  RpbIndexReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbIndexReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") RpbIndexReq
_x
                                            of
                                              Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Word32
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                              (case
                                                   FoldLike
  (Maybe ByteString)
  RpbIndexReq
  RpbIndexReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                     (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbIndexReq
_x
                                               of
                                                 Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                 (Prelude.Just ByteString
_v)
                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
98)
                                                        ((\ 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))
                                              (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                 (case
                                                      FoldLike
  (Maybe ByteString)
  RpbIndexReq
  RpbIndexReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                        (forall s a (f :: * -> *).
(HasField s "maybe'termRegex" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                           @"maybe'termRegex")
                                                        RpbIndexReq
_x
                                                  of
                                                    Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                    (Prelude.Just ByteString
_v)
                                                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                              Word64
106)
                                                           ((\ 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))
                                                 (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                    (case
                                                         FoldLike
  (Maybe Bool) RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> RpbIndexReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                           (forall s a (f :: * -> *).
(HasField s "maybe'paginationSort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                              @"maybe'paginationSort")
                                                           RpbIndexReq
_x
                                                     of
                                                       Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                       (Prelude.Just Bool
_v)
                                                         -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                              (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                 Word64
112)
                                                              ((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))
                                                    (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                       (case
                                                            FoldLike
  (Maybe ByteString)
  RpbIndexReq
  RpbIndexReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                              (forall s a (f :: * -> *).
(HasField s "maybe'coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                 @"maybe'coverContext")
                                                              RpbIndexReq
_x
                                                        of
                                                          Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                          (Prelude.Just ByteString
_v)
                                                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                    Word64
122)
                                                                 ((\ 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))
                                                       (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                          (case
                                                               FoldLike
  (Maybe Bool) RpbIndexReq RpbIndexReq (Maybe Bool) (Maybe Bool)
-> RpbIndexReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                 (forall s a (f :: * -> *).
(HasField s "maybe'returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                    @"maybe'returnBody")
                                                                 RpbIndexReq
_x
                                                           of
                                                             Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                             (Prelude.Just Bool
_v)
                                                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                       Word64
128)
                                                                    ((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))
                                                          (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                                                             (FoldLike FieldSet RpbIndexReq RpbIndexReq FieldSet FieldSet
-> RpbIndexReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                FoldLike FieldSet RpbIndexReq RpbIndexReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields
                                                                RpbIndexReq
_x)))))))))))))))))
instance Control.DeepSeq.NFData RpbIndexReq where
  rnf :: RpbIndexReq -> ()
rnf
    = \ RpbIndexReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbIndexReq -> FieldSet
_RpbIndexReq'_unknownFields RpbIndexReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbIndexReq -> ByteString
_RpbIndexReq'bucket RpbIndexReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbIndexReq -> ByteString
_RpbIndexReq'index RpbIndexReq
x__)
                   (RpbIndexReq'IndexQueryType -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbIndexReq -> RpbIndexReq'IndexQueryType
_RpbIndexReq'qtype RpbIndexReq
x__)
                      (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbIndexReq -> Maybe ByteString
_RpbIndexReq'key RpbIndexReq
x__)
                         (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMin RpbIndexReq
x__)
                            (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbIndexReq -> Maybe ByteString
_RpbIndexReq'rangeMax RpbIndexReq
x__)
                               (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnTerms RpbIndexReq
x__)
                                  (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbIndexReq -> Maybe Bool
_RpbIndexReq'stream RpbIndexReq
x__)
                                     (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbIndexReq -> Maybe Word32
_RpbIndexReq'maxResults RpbIndexReq
x__)
                                        (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbIndexReq -> Maybe ByteString
_RpbIndexReq'continuation RpbIndexReq
x__)
                                           (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (RpbIndexReq -> Maybe Word32
_RpbIndexReq'timeout RpbIndexReq
x__)
                                              (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                 (RpbIndexReq -> Maybe ByteString
_RpbIndexReq'type' RpbIndexReq
x__)
                                                 (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                    (RpbIndexReq -> Maybe ByteString
_RpbIndexReq'termRegex RpbIndexReq
x__)
                                                    (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                       (RpbIndexReq -> Maybe Bool
_RpbIndexReq'paginationSort RpbIndexReq
x__)
                                                       (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                          (RpbIndexReq -> Maybe ByteString
_RpbIndexReq'coverContext RpbIndexReq
x__)
                                                          (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                             (RpbIndexReq -> Maybe Bool
_RpbIndexReq'returnBody RpbIndexReq
x__)
                                                             ()))))))))))))))))
data RpbIndexReq'IndexQueryType
  = RpbIndexReq'Eq | RpbIndexReq'Range
  deriving stock (Int -> RpbIndexReq'IndexQueryType -> ShowS
[RpbIndexReq'IndexQueryType] -> ShowS
RpbIndexReq'IndexQueryType -> String
(Int -> RpbIndexReq'IndexQueryType -> ShowS)
-> (RpbIndexReq'IndexQueryType -> String)
-> ([RpbIndexReq'IndexQueryType] -> ShowS)
-> Show RpbIndexReq'IndexQueryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpbIndexReq'IndexQueryType] -> ShowS
$cshowList :: [RpbIndexReq'IndexQueryType] -> ShowS
show :: RpbIndexReq'IndexQueryType -> String
$cshow :: RpbIndexReq'IndexQueryType -> String
showsPrec :: Int -> RpbIndexReq'IndexQueryType -> ShowS
$cshowsPrec :: Int -> RpbIndexReq'IndexQueryType -> ShowS
Prelude.Show, RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
(RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool)
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> Bool)
-> Eq RpbIndexReq'IndexQueryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
$c/= :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
== :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
$c== :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
Prelude.Eq, Eq RpbIndexReq'IndexQueryType
Eq RpbIndexReq'IndexQueryType
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> Ordering)
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> Bool)
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> Bool)
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> Bool)
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> Bool)
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType)
-> (RpbIndexReq'IndexQueryType
    -> RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType)
-> Ord RpbIndexReq'IndexQueryType
RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> Ordering
RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
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 :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
$cmin :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
max :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
$cmax :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
>= :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
$c>= :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
> :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
$c> :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
<= :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
$c<= :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
< :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
$c< :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType -> Bool
compare :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> Ordering
$ccompare :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> Ordering
$cp1Ord :: Eq RpbIndexReq'IndexQueryType
Prelude.Ord)
instance Data.ProtoLens.MessageEnum RpbIndexReq'IndexQueryType where
  maybeToEnum :: Int -> Maybe RpbIndexReq'IndexQueryType
maybeToEnum Int
0 = RpbIndexReq'IndexQueryType -> Maybe RpbIndexReq'IndexQueryType
forall a. a -> Maybe a
Prelude.Just RpbIndexReq'IndexQueryType
RpbIndexReq'Eq
  maybeToEnum Int
1 = RpbIndexReq'IndexQueryType -> Maybe RpbIndexReq'IndexQueryType
forall a. a -> Maybe a
Prelude.Just RpbIndexReq'IndexQueryType
RpbIndexReq'Range
  maybeToEnum Int
_ = Maybe RpbIndexReq'IndexQueryType
forall a. Maybe a
Prelude.Nothing
  showEnum :: RpbIndexReq'IndexQueryType -> String
showEnum RpbIndexReq'IndexQueryType
RpbIndexReq'Eq = String
"eq"
  showEnum RpbIndexReq'IndexQueryType
RpbIndexReq'Range = String
"range"
  readEnum :: String -> Maybe RpbIndexReq'IndexQueryType
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"eq" = RpbIndexReq'IndexQueryType -> Maybe RpbIndexReq'IndexQueryType
forall a. a -> Maybe a
Prelude.Just RpbIndexReq'IndexQueryType
RpbIndexReq'Eq
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"range" = RpbIndexReq'IndexQueryType -> Maybe RpbIndexReq'IndexQueryType
forall a. a -> Maybe a
Prelude.Just RpbIndexReq'IndexQueryType
RpbIndexReq'Range
    | Bool
Prelude.otherwise
    = Maybe Int
-> (Int -> Maybe RpbIndexReq'IndexQueryType)
-> Maybe RpbIndexReq'IndexQueryType
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 RpbIndexReq'IndexQueryType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded RpbIndexReq'IndexQueryType where
  minBound :: RpbIndexReq'IndexQueryType
minBound = RpbIndexReq'IndexQueryType
RpbIndexReq'Eq
  maxBound :: RpbIndexReq'IndexQueryType
maxBound = RpbIndexReq'IndexQueryType
RpbIndexReq'Range
instance Prelude.Enum RpbIndexReq'IndexQueryType where
  toEnum :: Int -> RpbIndexReq'IndexQueryType
toEnum Int
k__
    = RpbIndexReq'IndexQueryType
-> (RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType)
-> Maybe RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> RpbIndexReq'IndexQueryType
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum IndexQueryType: "
              (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
forall a. a -> a
Prelude.id
        (Int -> Maybe RpbIndexReq'IndexQueryType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: RpbIndexReq'IndexQueryType -> Int
fromEnum RpbIndexReq'IndexQueryType
RpbIndexReq'Eq = Int
0
  fromEnum RpbIndexReq'IndexQueryType
RpbIndexReq'Range = Int
1
  succ :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
succ RpbIndexReq'IndexQueryType
RpbIndexReq'Range
    = String -> RpbIndexReq'IndexQueryType
forall a. HasCallStack => String -> a
Prelude.error
        String
"RpbIndexReq'IndexQueryType.succ: bad argument RpbIndexReq'Range. This value would be out of bounds."
  succ RpbIndexReq'IndexQueryType
RpbIndexReq'Eq = RpbIndexReq'IndexQueryType
RpbIndexReq'Range
  pred :: RpbIndexReq'IndexQueryType -> RpbIndexReq'IndexQueryType
pred RpbIndexReq'IndexQueryType
RpbIndexReq'Eq
    = String -> RpbIndexReq'IndexQueryType
forall a. HasCallStack => String -> a
Prelude.error
        String
"RpbIndexReq'IndexQueryType.pred: bad argument RpbIndexReq'Eq. This value would be out of bounds."
  pred RpbIndexReq'IndexQueryType
RpbIndexReq'Range = RpbIndexReq'IndexQueryType
RpbIndexReq'Eq
  enumFrom :: RpbIndexReq'IndexQueryType -> [RpbIndexReq'IndexQueryType]
enumFrom = RpbIndexReq'IndexQueryType -> [RpbIndexReq'IndexQueryType]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> [RpbIndexReq'IndexQueryType]
enumFromTo = RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> [RpbIndexReq'IndexQueryType]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> [RpbIndexReq'IndexQueryType]
enumFromThen = RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType -> [RpbIndexReq'IndexQueryType]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType
-> [RpbIndexReq'IndexQueryType]
enumFromThenTo = RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType
-> RpbIndexReq'IndexQueryType
-> [RpbIndexReq'IndexQueryType]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault RpbIndexReq'IndexQueryType where
  fieldDefault :: RpbIndexReq'IndexQueryType
fieldDefault = RpbIndexReq'IndexQueryType
RpbIndexReq'Eq
instance Control.DeepSeq.NFData RpbIndexReq'IndexQueryType where
  rnf :: RpbIndexReq'IndexQueryType -> ()
rnf RpbIndexReq'IndexQueryType
x__ = RpbIndexReq'IndexQueryType -> () -> ()
Prelude.seq RpbIndexReq'IndexQueryType
x__ ()
{- | Fields :
     
         * 'Proto.Riak_Fields.keys' @:: Lens' RpbIndexResp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'keys' @:: Lens' RpbIndexResp (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.results' @:: Lens' RpbIndexResp [RpbPair]@
         * 'Proto.Riak_Fields.vec'results' @:: Lens' RpbIndexResp (Data.Vector.Vector RpbPair)@
         * 'Proto.Riak_Fields.continuation' @:: Lens' RpbIndexResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'continuation' @:: Lens' RpbIndexResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.done' @:: Lens' RpbIndexResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' RpbIndexResp (Prelude.Maybe Prelude.Bool)@ -}
data RpbIndexResp
  = RpbIndexResp'_constructor {RpbIndexResp -> Vector ByteString
_RpbIndexResp'keys :: !(Data.Vector.Vector Data.ByteString.ByteString),
                               RpbIndexResp -> Vector RpbPair
_RpbIndexResp'results :: !(Data.Vector.Vector RpbPair),
                               RpbIndexResp -> Maybe ByteString
_RpbIndexResp'continuation :: !(Prelude.Maybe Data.ByteString.ByteString),
                               RpbIndexResp -> Maybe Bool
_RpbIndexResp'done :: !(Prelude.Maybe Prelude.Bool),
                               RpbIndexResp -> FieldSet
_RpbIndexResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbIndexResp -> RpbIndexResp -> Bool
(RpbIndexResp -> RpbIndexResp -> Bool)
-> (RpbIndexResp -> RpbIndexResp -> Bool) -> Eq RpbIndexResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbIndexResp -> RpbIndexResp -> Bool
$c/= :: RpbIndexResp -> RpbIndexResp -> Bool
== :: RpbIndexResp -> RpbIndexResp -> Bool
$c== :: RpbIndexResp -> RpbIndexResp -> Bool
Prelude.Eq, Eq RpbIndexResp
Eq RpbIndexResp
-> (RpbIndexResp -> RpbIndexResp -> Ordering)
-> (RpbIndexResp -> RpbIndexResp -> Bool)
-> (RpbIndexResp -> RpbIndexResp -> Bool)
-> (RpbIndexResp -> RpbIndexResp -> Bool)
-> (RpbIndexResp -> RpbIndexResp -> Bool)
-> (RpbIndexResp -> RpbIndexResp -> RpbIndexResp)
-> (RpbIndexResp -> RpbIndexResp -> RpbIndexResp)
-> Ord RpbIndexResp
RpbIndexResp -> RpbIndexResp -> Bool
RpbIndexResp -> RpbIndexResp -> Ordering
RpbIndexResp -> RpbIndexResp -> RpbIndexResp
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 :: RpbIndexResp -> RpbIndexResp -> RpbIndexResp
$cmin :: RpbIndexResp -> RpbIndexResp -> RpbIndexResp
max :: RpbIndexResp -> RpbIndexResp -> RpbIndexResp
$cmax :: RpbIndexResp -> RpbIndexResp -> RpbIndexResp
>= :: RpbIndexResp -> RpbIndexResp -> Bool
$c>= :: RpbIndexResp -> RpbIndexResp -> Bool
> :: RpbIndexResp -> RpbIndexResp -> Bool
$c> :: RpbIndexResp -> RpbIndexResp -> Bool
<= :: RpbIndexResp -> RpbIndexResp -> Bool
$c<= :: RpbIndexResp -> RpbIndexResp -> Bool
< :: RpbIndexResp -> RpbIndexResp -> Bool
$c< :: RpbIndexResp -> RpbIndexResp -> Bool
compare :: RpbIndexResp -> RpbIndexResp -> Ordering
$ccompare :: RpbIndexResp -> RpbIndexResp -> Ordering
$cp1Ord :: Eq RpbIndexResp
Prelude.Ord)
instance Prelude.Show RpbIndexResp where
  showsPrec :: Int -> RpbIndexResp -> ShowS
showsPrec Int
_ RpbIndexResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbIndexResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbIndexResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbIndexResp "keys" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "keys"
-> ([ByteString] -> f [ByteString])
-> RpbIndexResp
-> f RpbIndexResp
fieldOf Proxy# "keys"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbIndexResp -> f RpbIndexResp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Vector ByteString)
-> (RpbIndexResp -> Vector ByteString -> RpbIndexResp)
-> Lens
     RpbIndexResp RpbIndexResp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Vector ByteString
_RpbIndexResp'keys (\ RpbIndexResp
x__ Vector ByteString
y__ -> RpbIndexResp
x__ {_RpbIndexResp'keys :: Vector ByteString
_RpbIndexResp'keys = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField RpbIndexResp "vec'keys" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'keys"
-> (Vector ByteString -> f (Vector ByteString))
-> RpbIndexResp
-> f RpbIndexResp
fieldOf Proxy# "vec'keys"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbIndexResp -> f RpbIndexResp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Vector ByteString)
-> (RpbIndexResp -> Vector ByteString -> RpbIndexResp)
-> Lens
     RpbIndexResp RpbIndexResp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Vector ByteString
_RpbIndexResp'keys (\ RpbIndexResp
x__ Vector ByteString
y__ -> RpbIndexResp
x__ {_RpbIndexResp'keys :: Vector ByteString
_RpbIndexResp'keys = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexResp "results" [RpbPair] where
  fieldOf :: Proxy# "results"
-> ([RpbPair] -> f [RpbPair]) -> RpbIndexResp -> f RpbIndexResp
fieldOf Proxy# "results"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbIndexResp -> f RpbIndexResp)
-> (([RpbPair] -> f [RpbPair])
    -> Vector RpbPair -> f (Vector RpbPair))
-> ([RpbPair] -> f [RpbPair])
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Vector RpbPair)
-> (RpbIndexResp -> Vector RpbPair -> RpbIndexResp)
-> Lens RpbIndexResp RpbIndexResp (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Vector RpbPair
_RpbIndexResp'results
           (\ RpbIndexResp
x__ Vector RpbPair
y__ -> RpbIndexResp
x__ {_RpbIndexResp'results :: Vector RpbPair
_RpbIndexResp'results = Vector RpbPair
y__}))
        ((Vector RpbPair -> [RpbPair])
-> (Vector RpbPair -> [RpbPair] -> Vector RpbPair)
-> Lens (Vector RpbPair) (Vector RpbPair) [RpbPair] [RpbPair]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbPair -> [RpbPair]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbPair
_ [RpbPair]
y__ -> [RpbPair] -> Vector RpbPair
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbPair]
y__))
instance Data.ProtoLens.Field.HasField RpbIndexResp "vec'results" (Data.Vector.Vector RpbPair) where
  fieldOf :: Proxy# "vec'results"
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbIndexResp
-> f RpbIndexResp
fieldOf Proxy# "vec'results"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbIndexResp -> f RpbIndexResp)
-> ((Vector RpbPair -> f (Vector RpbPair))
    -> Vector RpbPair -> f (Vector RpbPair))
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Vector RpbPair)
-> (RpbIndexResp -> Vector RpbPair -> RpbIndexResp)
-> Lens RpbIndexResp RpbIndexResp (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Vector RpbPair
_RpbIndexResp'results
           (\ RpbIndexResp
x__ Vector RpbPair
y__ -> RpbIndexResp
x__ {_RpbIndexResp'results :: Vector RpbPair
_RpbIndexResp'results = Vector RpbPair
y__}))
        (Vector RpbPair -> f (Vector RpbPair))
-> Vector RpbPair -> f (Vector RpbPair)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexResp "continuation" Data.ByteString.ByteString where
  fieldOf :: Proxy# "continuation"
-> (ByteString -> f ByteString) -> RpbIndexResp -> f RpbIndexResp
fieldOf Proxy# "continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexResp -> f RpbIndexResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Maybe ByteString)
-> (RpbIndexResp -> Maybe ByteString -> RpbIndexResp)
-> Lens
     RpbIndexResp RpbIndexResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Maybe ByteString
_RpbIndexResp'continuation
           (\ RpbIndexResp
x__ Maybe ByteString
y__ -> RpbIndexResp
x__ {_RpbIndexResp'continuation :: Maybe ByteString
_RpbIndexResp'continuation = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbIndexResp "maybe'continuation" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'continuation"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexResp
-> f RpbIndexResp
fieldOf Proxy# "maybe'continuation"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbIndexResp -> f RpbIndexResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Maybe ByteString)
-> (RpbIndexResp -> Maybe ByteString -> RpbIndexResp)
-> Lens
     RpbIndexResp RpbIndexResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Maybe ByteString
_RpbIndexResp'continuation
           (\ RpbIndexResp
x__ Maybe ByteString
y__ -> RpbIndexResp
x__ {_RpbIndexResp'continuation :: Maybe ByteString
_RpbIndexResp'continuation = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbIndexResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done" -> (Bool -> f Bool) -> RpbIndexResp -> f RpbIndexResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexResp -> f RpbIndexResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Maybe Bool)
-> (RpbIndexResp -> Maybe Bool -> RpbIndexResp)
-> Lens RpbIndexResp RpbIndexResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Maybe Bool
_RpbIndexResp'done (\ RpbIndexResp
x__ Maybe Bool
y__ -> RpbIndexResp
x__ {_RpbIndexResp'done :: Maybe Bool
_RpbIndexResp'done = 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 RpbIndexResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbIndexResp -> f RpbIndexResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbIndexResp -> f RpbIndexResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbIndexResp
-> f RpbIndexResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbIndexResp -> Maybe Bool)
-> (RpbIndexResp -> Maybe Bool -> RpbIndexResp)
-> Lens RpbIndexResp RpbIndexResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbIndexResp -> Maybe Bool
_RpbIndexResp'done (\ RpbIndexResp
x__ Maybe Bool
y__ -> RpbIndexResp
x__ {_RpbIndexResp'done :: Maybe Bool
_RpbIndexResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbIndexResp where
  messageName :: Proxy RpbIndexResp -> Text
messageName Proxy RpbIndexResp
_ = String -> Text
Data.Text.pack String
"RpbIndexResp"
  packedMessageDescriptor :: Proxy RpbIndexResp -> ByteString
packedMessageDescriptor Proxy RpbIndexResp
_
    = ByteString
"\n\
      \\fRpbIndexResp\DC2\DC2\n\
      \\EOTkeys\CAN\SOH \ETX(\fR\EOTkeys\DC2\"\n\
      \\aresults\CAN\STX \ETX(\v2\b.RpbPairR\aresults\DC2\"\n\
      \\fcontinuation\CAN\ETX \SOH(\fR\fcontinuation\DC2\DC2\n\
      \\EOTdone\CAN\EOT \SOH(\bR\EOTdone"
  packedFileDescriptor :: Proxy RpbIndexResp -> ByteString
packedFileDescriptor Proxy RpbIndexResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbIndexResp)
fieldsByTag
    = let
        keys__field_descriptor :: FieldDescriptor RpbIndexResp
keys__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexResp ByteString
-> FieldDescriptor RpbIndexResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"keys"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' RpbIndexResp [ByteString]
-> FieldAccessor RpbIndexResp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"keys")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexResp
        results__field_descriptor :: FieldDescriptor RpbIndexResp
results__field_descriptor
          = String
-> FieldTypeDescriptor RpbPair
-> FieldAccessor RpbIndexResp RpbPair
-> FieldDescriptor RpbIndexResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"results"
              (MessageOrGroup -> FieldTypeDescriptor RpbPair
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbPair)
              (Packing
-> Lens' RpbIndexResp [RpbPair]
-> FieldAccessor RpbIndexResp RpbPair
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "results" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"results")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexResp
        continuation__field_descriptor :: FieldDescriptor RpbIndexResp
continuation__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbIndexResp ByteString
-> FieldDescriptor RpbIndexResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"continuation"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbIndexResp RpbIndexResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbIndexResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexResp
        done__field_descriptor :: FieldDescriptor RpbIndexResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbIndexResp Bool
-> FieldDescriptor RpbIndexResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbIndexResp RpbIndexResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbIndexResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor RpbIndexResp
      in
        [(Tag, FieldDescriptor RpbIndexResp)]
-> Map Tag (FieldDescriptor RpbIndexResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbIndexResp
keys__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbIndexResp
results__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbIndexResp
continuation__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbIndexResp
done__field_descriptor)]
  unknownFields :: LensLike' f RpbIndexResp FieldSet
unknownFields
    = (RpbIndexResp -> FieldSet)
-> (RpbIndexResp -> FieldSet -> RpbIndexResp)
-> Lens' RpbIndexResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbIndexResp -> FieldSet
_RpbIndexResp'_unknownFields
        (\ RpbIndexResp
x__ FieldSet
y__ -> RpbIndexResp
x__ {_RpbIndexResp'_unknownFields :: FieldSet
_RpbIndexResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbIndexResp
defMessage
    = RpbIndexResp'_constructor :: Vector ByteString
-> Vector RpbPair
-> Maybe ByteString
-> Maybe Bool
-> FieldSet
-> RpbIndexResp
RpbIndexResp'_constructor
        {_RpbIndexResp'keys :: Vector ByteString
_RpbIndexResp'keys = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbIndexResp'results :: Vector RpbPair
_RpbIndexResp'results = Vector RpbPair
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbIndexResp'continuation :: Maybe ByteString
_RpbIndexResp'continuation = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexResp'done :: Maybe Bool
_RpbIndexResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbIndexResp'_unknownFields :: FieldSet
_RpbIndexResp'_unknownFields = []}
  parseMessage :: Parser RpbIndexResp
parseMessage
    = let
        loop ::
          RpbIndexResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbPair
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbIndexResp
        loop :: RpbIndexResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld RpbPair
-> Parser RpbIndexResp
loop RpbIndexResp
x Growing Vector RealWorld ByteString
mutable'keys Growing Vector RealWorld RpbPair
mutable'results
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'keys <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'keys)
                      Vector RpbPair
frozen'results <- IO (Vector RpbPair) -> Parser (Vector RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) RpbPair -> IO (Vector RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'results)
                      (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]))))
                      RpbIndexResp -> Parser RpbIndexResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbIndexResp RpbIndexResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexResp -> RpbIndexResp
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 RpbIndexResp RpbIndexResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbIndexResp RpbIndexResp (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> RpbIndexResp -> RpbIndexResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'keys")
                              Vector ByteString
frozen'keys
                              (Setter RpbIndexResp RpbIndexResp (Vector RpbPair) (Vector RpbPair)
-> Vector RpbPair -> RpbIndexResp -> RpbIndexResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'results" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'results") Vector RpbPair
frozen'results RpbIndexResp
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
"keys"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'keys ByteString
y)
                                RpbIndexResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld RpbPair
-> Parser RpbIndexResp
loop RpbIndexResp
x Growing Vector RealWorld ByteString
v Growing Vector RealWorld RpbPair
mutable'results
                        Word64
18
                          -> do !RpbPair
y <- Parser RpbPair -> String -> Parser RpbPair
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbPair -> Parser RpbPair
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 RpbPair
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"results"
                                Growing Vector RealWorld RpbPair
v <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbPair
-> RpbPair -> IO (Growing Vector (PrimState IO) RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'results RpbPair
y)
                                RpbIndexResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld RpbPair
-> Parser RpbIndexResp
loop RpbIndexResp
x Growing Vector RealWorld ByteString
mutable'keys Growing Vector RealWorld RpbPair
v
                        Word64
26
                          -> 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
"continuation"
                                RpbIndexResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld RpbPair
-> Parser RpbIndexResp
loop
                                  (Setter RpbIndexResp RpbIndexResp ByteString ByteString
-> ByteString -> RpbIndexResp -> RpbIndexResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"continuation") ByteString
y RpbIndexResp
x)
                                  Growing Vector RealWorld ByteString
mutable'keys
                                  Growing Vector RealWorld RpbPair
mutable'results
                        Word64
32
                          -> 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
"done"
                                RpbIndexResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld RpbPair
-> Parser RpbIndexResp
loop
                                  (Setter RpbIndexResp RpbIndexResp Bool Bool
-> Bool -> RpbIndexResp -> RpbIndexResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y RpbIndexResp
x)
                                  Growing Vector RealWorld ByteString
mutable'keys
                                  Growing Vector RealWorld RpbPair
mutable'results
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbIndexResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld RpbPair
-> Parser RpbIndexResp
loop
                                  (Setter RpbIndexResp RpbIndexResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbIndexResp -> RpbIndexResp
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 RpbIndexResp RpbIndexResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbIndexResp
x)
                                  Growing Vector RealWorld ByteString
mutable'keys
                                  Growing Vector RealWorld RpbPair
mutable'results
      in
        Parser RpbIndexResp -> String -> Parser RpbIndexResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'keys <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld RpbPair
mutable'results <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld RpbPair)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbIndexResp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld RpbPair
-> Parser RpbIndexResp
loop RpbIndexResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld ByteString
mutable'keys Growing Vector RealWorld RpbPair
mutable'results)
          String
"RpbIndexResp"
  buildMessage :: RpbIndexResp -> Builder
buildMessage
    = \ RpbIndexResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ ByteString
_v
                   -> 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))
                (FoldLike
  (Vector ByteString)
  RpbIndexResp
  RpbIndexResp
  (Vector ByteString)
  (Vector ByteString)
-> RpbIndexResp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'keys") RpbIndexResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((RpbPair -> Builder) -> Vector RpbPair -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ RpbPair
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (RpbPair -> ByteString) -> RpbPair -> 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))
                              RpbPair -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              RpbPair
_v))
                   (FoldLike
  (Vector RpbPair)
  RpbIndexResp
  RpbIndexResp
  (Vector RpbPair)
  (Vector RpbPair)
-> RpbIndexResp -> Vector RpbPair
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'results" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'results") RpbIndexResp
_x))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbIndexResp
  RpbIndexResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbIndexResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'continuation" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'continuation") RpbIndexResp
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Bool) RpbIndexResp RpbIndexResp (Maybe Bool) (Maybe Bool)
-> RpbIndexResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") RpbIndexResp
_x
                       of
                         Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Bool
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                         (FoldLike FieldSet RpbIndexResp RpbIndexResp FieldSet FieldSet
-> RpbIndexResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbIndexResp RpbIndexResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbIndexResp
_x)))))
instance Control.DeepSeq.NFData RpbIndexResp where
  rnf :: RpbIndexResp -> ()
rnf
    = \ RpbIndexResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbIndexResp -> FieldSet
_RpbIndexResp'_unknownFields RpbIndexResp
x__)
             (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbIndexResp -> Vector ByteString
_RpbIndexResp'keys RpbIndexResp
x__)
                (Vector RpbPair -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbIndexResp -> Vector RpbPair
_RpbIndexResp'results RpbIndexResp
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbIndexResp -> Maybe ByteString
_RpbIndexResp'continuation RpbIndexResp
x__)
                      (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbIndexResp -> Maybe Bool
_RpbIndexResp'done RpbIndexResp
x__) ()))))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbLink Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'bucket' @:: Lens' RpbLink (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbLink Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'key' @:: Lens' RpbLink (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.tag' @:: Lens' RpbLink Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'tag' @:: Lens' RpbLink (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbLink
  = RpbLink'_constructor {RpbLink -> Maybe ByteString
_RpbLink'bucket :: !(Prelude.Maybe Data.ByteString.ByteString),
                          RpbLink -> Maybe ByteString
_RpbLink'key :: !(Prelude.Maybe Data.ByteString.ByteString),
                          RpbLink -> Maybe ByteString
_RpbLink'tag :: !(Prelude.Maybe Data.ByteString.ByteString),
                          RpbLink -> FieldSet
_RpbLink'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbLink -> RpbLink -> Bool
(RpbLink -> RpbLink -> Bool)
-> (RpbLink -> RpbLink -> Bool) -> Eq RpbLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbLink -> RpbLink -> Bool
$c/= :: RpbLink -> RpbLink -> Bool
== :: RpbLink -> RpbLink -> Bool
$c== :: RpbLink -> RpbLink -> Bool
Prelude.Eq, Eq RpbLink
Eq RpbLink
-> (RpbLink -> RpbLink -> Ordering)
-> (RpbLink -> RpbLink -> Bool)
-> (RpbLink -> RpbLink -> Bool)
-> (RpbLink -> RpbLink -> Bool)
-> (RpbLink -> RpbLink -> Bool)
-> (RpbLink -> RpbLink -> RpbLink)
-> (RpbLink -> RpbLink -> RpbLink)
-> Ord RpbLink
RpbLink -> RpbLink -> Bool
RpbLink -> RpbLink -> Ordering
RpbLink -> RpbLink -> RpbLink
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 :: RpbLink -> RpbLink -> RpbLink
$cmin :: RpbLink -> RpbLink -> RpbLink
max :: RpbLink -> RpbLink -> RpbLink
$cmax :: RpbLink -> RpbLink -> RpbLink
>= :: RpbLink -> RpbLink -> Bool
$c>= :: RpbLink -> RpbLink -> Bool
> :: RpbLink -> RpbLink -> Bool
$c> :: RpbLink -> RpbLink -> Bool
<= :: RpbLink -> RpbLink -> Bool
$c<= :: RpbLink -> RpbLink -> Bool
< :: RpbLink -> RpbLink -> Bool
$c< :: RpbLink -> RpbLink -> Bool
compare :: RpbLink -> RpbLink -> Ordering
$ccompare :: RpbLink -> RpbLink -> Ordering
$cp1Ord :: Eq RpbLink
Prelude.Ord)
instance Prelude.Show RpbLink where
  showsPrec :: Int -> RpbLink -> ShowS
showsPrec Int
_ RpbLink
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbLink -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbLink
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbLink "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString) -> RpbLink -> f RpbLink
fieldOf Proxy# "bucket"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbLink -> f RpbLink)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbLink
-> f RpbLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbLink -> Maybe ByteString)
-> (RpbLink -> Maybe ByteString -> RpbLink)
-> Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbLink -> Maybe ByteString
_RpbLink'bucket (\ RpbLink
x__ Maybe ByteString
y__ -> RpbLink
x__ {_RpbLink'bucket :: Maybe ByteString
_RpbLink'bucket = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbLink "maybe'bucket" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'bucket"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbLink
-> f RpbLink
fieldOf Proxy# "maybe'bucket"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbLink -> f RpbLink)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbLink
-> f RpbLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbLink -> Maybe ByteString)
-> (RpbLink -> Maybe ByteString -> RpbLink)
-> Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbLink -> Maybe ByteString
_RpbLink'bucket (\ RpbLink
x__ Maybe ByteString
y__ -> RpbLink
x__ {_RpbLink'bucket :: Maybe ByteString
_RpbLink'bucket = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbLink "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> RpbLink -> f RpbLink
fieldOf Proxy# "key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbLink -> f RpbLink)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbLink
-> f RpbLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbLink -> Maybe ByteString)
-> (RpbLink -> Maybe ByteString -> RpbLink)
-> Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbLink -> Maybe ByteString
_RpbLink'key (\ RpbLink
x__ Maybe ByteString
y__ -> RpbLink
x__ {_RpbLink'key :: Maybe ByteString
_RpbLink'key = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbLink "maybe'key" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'key"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbLink
-> f RpbLink
fieldOf Proxy# "maybe'key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbLink -> f RpbLink)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbLink
-> f RpbLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbLink -> Maybe ByteString)
-> (RpbLink -> Maybe ByteString -> RpbLink)
-> Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbLink -> Maybe ByteString
_RpbLink'key (\ RpbLink
x__ Maybe ByteString
y__ -> RpbLink
x__ {_RpbLink'key :: Maybe ByteString
_RpbLink'key = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbLink "tag" Data.ByteString.ByteString where
  fieldOf :: Proxy# "tag"
-> (ByteString -> f ByteString) -> RpbLink -> f RpbLink
fieldOf Proxy# "tag"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbLink -> f RpbLink)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbLink
-> f RpbLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbLink -> Maybe ByteString)
-> (RpbLink -> Maybe ByteString -> RpbLink)
-> Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbLink -> Maybe ByteString
_RpbLink'tag (\ RpbLink
x__ Maybe ByteString
y__ -> RpbLink
x__ {_RpbLink'tag :: Maybe ByteString
_RpbLink'tag = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbLink "maybe'tag" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'tag"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbLink
-> f RpbLink
fieldOf Proxy# "maybe'tag"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbLink -> f RpbLink)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbLink
-> f RpbLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbLink -> Maybe ByteString)
-> (RpbLink -> Maybe ByteString -> RpbLink)
-> Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbLink -> Maybe ByteString
_RpbLink'tag (\ RpbLink
x__ Maybe ByteString
y__ -> RpbLink
x__ {_RpbLink'tag :: Maybe ByteString
_RpbLink'tag = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbLink where
  messageName :: Proxy RpbLink -> Text
messageName Proxy RpbLink
_ = String -> Text
Data.Text.pack String
"RpbLink"
  packedMessageDescriptor :: Proxy RpbLink -> ByteString
packedMessageDescriptor Proxy RpbLink
_
    = ByteString
"\n\
      \\aRpbLink\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \SOH(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \SOH(\fR\ETXkey\DC2\DLE\n\
      \\ETXtag\CAN\ETX \SOH(\fR\ETXtag"
  packedFileDescriptor :: Proxy RpbLink -> ByteString
packedFileDescriptor Proxy RpbLink
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbLink)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbLink
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbLink ByteString
-> FieldDescriptor RpbLink
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbLink ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbLink
        key__field_descriptor :: FieldDescriptor RpbLink
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbLink ByteString
-> FieldDescriptor RpbLink
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbLink ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key")) ::
              Data.ProtoLens.FieldDescriptor RpbLink
        tag__field_descriptor :: FieldDescriptor RpbLink
tag__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbLink ByteString
-> FieldDescriptor RpbLink
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"tag"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbLink RpbLink (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbLink ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'tag" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'tag")) ::
              Data.ProtoLens.FieldDescriptor RpbLink
      in
        [(Tag, FieldDescriptor RpbLink)]
-> Map Tag (FieldDescriptor RpbLink)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbLink
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbLink
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbLink
tag__field_descriptor)]
  unknownFields :: LensLike' f RpbLink FieldSet
unknownFields
    = (RpbLink -> FieldSet)
-> (RpbLink -> FieldSet -> RpbLink) -> Lens' RpbLink FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbLink -> FieldSet
_RpbLink'_unknownFields
        (\ RpbLink
x__ FieldSet
y__ -> RpbLink
x__ {_RpbLink'_unknownFields :: FieldSet
_RpbLink'_unknownFields = FieldSet
y__})
  defMessage :: RpbLink
defMessage
    = RpbLink'_constructor :: Maybe ByteString
-> Maybe ByteString -> Maybe ByteString -> FieldSet -> RpbLink
RpbLink'_constructor
        {_RpbLink'bucket :: Maybe ByteString
_RpbLink'bucket = Maybe ByteString
forall a. Maybe a
Prelude.Nothing, _RpbLink'key :: Maybe ByteString
_RpbLink'key = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbLink'tag :: Maybe ByteString
_RpbLink'tag = Maybe ByteString
forall a. Maybe a
Prelude.Nothing, _RpbLink'_unknownFields :: FieldSet
_RpbLink'_unknownFields = []}
  parseMessage :: Parser RpbLink
parseMessage
    = let
        loop :: RpbLink -> Data.ProtoLens.Encoding.Bytes.Parser RpbLink
        loop :: RpbLink -> Parser RpbLink
loop RpbLink
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]))))
                      RpbLink -> Parser RpbLink
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbLink RpbLink FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbLink -> RpbLink
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 RpbLink RpbLink FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbLink
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
"bucket"
                                RpbLink -> Parser RpbLink
loop (Setter RpbLink RpbLink ByteString ByteString
-> ByteString -> RpbLink -> RpbLink
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbLink
x)
                        Word64
18
                          -> 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
"key"
                                RpbLink -> Parser RpbLink
loop (Setter RpbLink RpbLink ByteString ByteString
-> ByteString -> RpbLink -> RpbLink
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbLink
x)
                        Word64
26
                          -> 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
"tag"
                                RpbLink -> Parser RpbLink
loop (Setter RpbLink RpbLink ByteString ByteString
-> ByteString -> RpbLink -> RpbLink
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "tag" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"tag") ByteString
y RpbLink
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbLink -> Parser RpbLink
loop
                                  (Setter RpbLink RpbLink FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbLink -> RpbLink
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 RpbLink RpbLink FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbLink
x)
      in
        Parser RpbLink -> String -> Parser RpbLink
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbLink -> Parser RpbLink
loop RpbLink
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbLink"
  buildMessage :: RpbLink -> Builder
buildMessage
    = \ RpbLink
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe ByteString)
  RpbLink
  RpbLink
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbLink -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'bucket") RpbLink
_x
              of
                Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just ByteString
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbLink
  RpbLink
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbLink -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key") RpbLink
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbLink
  RpbLink
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbLink -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'tag" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'tag") RpbLink
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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 RpbLink RpbLink FieldSet FieldSet
-> RpbLink -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbLink RpbLink FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbLink
_x))))
instance Control.DeepSeq.NFData RpbLink where
  rnf :: RpbLink -> ()
rnf
    = \ RpbLink
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbLink -> FieldSet
_RpbLink'_unknownFields RpbLink
x__)
             (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbLink -> Maybe ByteString
_RpbLink'bucket RpbLink
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbLink -> Maybe ByteString
_RpbLink'key RpbLink
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbLink -> Maybe ByteString
_RpbLink'tag RpbLink
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbListBucketsReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbListBucketsReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.stream' @:: Lens' RpbListBucketsReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'stream' @:: Lens' RpbListBucketsReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbListBucketsReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbListBucketsReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbListBucketsReq
  = RpbListBucketsReq'_constructor {RpbListBucketsReq -> Maybe Word32
_RpbListBucketsReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                                    RpbListBucketsReq -> Maybe Bool
_RpbListBucketsReq'stream :: !(Prelude.Maybe Prelude.Bool),
                                    RpbListBucketsReq -> Maybe ByteString
_RpbListBucketsReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbListBucketsReq -> FieldSet
_RpbListBucketsReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbListBucketsReq -> RpbListBucketsReq -> Bool
(RpbListBucketsReq -> RpbListBucketsReq -> Bool)
-> (RpbListBucketsReq -> RpbListBucketsReq -> Bool)
-> Eq RpbListBucketsReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
$c/= :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
== :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
$c== :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
Prelude.Eq, Eq RpbListBucketsReq
Eq RpbListBucketsReq
-> (RpbListBucketsReq -> RpbListBucketsReq -> Ordering)
-> (RpbListBucketsReq -> RpbListBucketsReq -> Bool)
-> (RpbListBucketsReq -> RpbListBucketsReq -> Bool)
-> (RpbListBucketsReq -> RpbListBucketsReq -> Bool)
-> (RpbListBucketsReq -> RpbListBucketsReq -> Bool)
-> (RpbListBucketsReq -> RpbListBucketsReq -> RpbListBucketsReq)
-> (RpbListBucketsReq -> RpbListBucketsReq -> RpbListBucketsReq)
-> Ord RpbListBucketsReq
RpbListBucketsReq -> RpbListBucketsReq -> Bool
RpbListBucketsReq -> RpbListBucketsReq -> Ordering
RpbListBucketsReq -> RpbListBucketsReq -> RpbListBucketsReq
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 :: RpbListBucketsReq -> RpbListBucketsReq -> RpbListBucketsReq
$cmin :: RpbListBucketsReq -> RpbListBucketsReq -> RpbListBucketsReq
max :: RpbListBucketsReq -> RpbListBucketsReq -> RpbListBucketsReq
$cmax :: RpbListBucketsReq -> RpbListBucketsReq -> RpbListBucketsReq
>= :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
$c>= :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
> :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
$c> :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
<= :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
$c<= :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
< :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
$c< :: RpbListBucketsReq -> RpbListBucketsReq -> Bool
compare :: RpbListBucketsReq -> RpbListBucketsReq -> Ordering
$ccompare :: RpbListBucketsReq -> RpbListBucketsReq -> Ordering
$cp1Ord :: Eq RpbListBucketsReq
Prelude.Ord)
instance Prelude.Show RpbListBucketsReq where
  showsPrec :: Int -> RpbListBucketsReq -> ShowS
showsPrec Int
_ RpbListBucketsReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbListBucketsReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbListBucketsReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbListBucketsReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> RpbListBucketsReq -> f RpbListBucketsReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbListBucketsReq -> f RpbListBucketsReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbListBucketsReq
-> f RpbListBucketsReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsReq -> Maybe Word32)
-> (RpbListBucketsReq -> Maybe Word32 -> RpbListBucketsReq)
-> Lens
     RpbListBucketsReq RpbListBucketsReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsReq -> Maybe Word32
_RpbListBucketsReq'timeout
           (\ RpbListBucketsReq
x__ Maybe Word32
y__ -> RpbListBucketsReq
x__ {_RpbListBucketsReq'timeout :: Maybe Word32
_RpbListBucketsReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbListBucketsReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbListBucketsReq
-> f RpbListBucketsReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbListBucketsReq -> f RpbListBucketsReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbListBucketsReq
-> f RpbListBucketsReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsReq -> Maybe Word32)
-> (RpbListBucketsReq -> Maybe Word32 -> RpbListBucketsReq)
-> Lens
     RpbListBucketsReq RpbListBucketsReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsReq -> Maybe Word32
_RpbListBucketsReq'timeout
           (\ RpbListBucketsReq
x__ Maybe Word32
y__ -> RpbListBucketsReq
x__ {_RpbListBucketsReq'timeout :: Maybe Word32
_RpbListBucketsReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbListBucketsReq "stream" Prelude.Bool where
  fieldOf :: Proxy# "stream"
-> (Bool -> f Bool) -> RpbListBucketsReq -> f RpbListBucketsReq
fieldOf Proxy# "stream"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbListBucketsReq -> f RpbListBucketsReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbListBucketsReq
-> f RpbListBucketsReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsReq -> Maybe Bool)
-> (RpbListBucketsReq -> Maybe Bool -> RpbListBucketsReq)
-> Lens
     RpbListBucketsReq RpbListBucketsReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsReq -> Maybe Bool
_RpbListBucketsReq'stream
           (\ RpbListBucketsReq
x__ Maybe Bool
y__ -> RpbListBucketsReq
x__ {_RpbListBucketsReq'stream :: Maybe Bool
_RpbListBucketsReq'stream = 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 RpbListBucketsReq "maybe'stream" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'stream"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbListBucketsReq
-> f RpbListBucketsReq
fieldOf Proxy# "maybe'stream"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbListBucketsReq -> f RpbListBucketsReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbListBucketsReq
-> f RpbListBucketsReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsReq -> Maybe Bool)
-> (RpbListBucketsReq -> Maybe Bool -> RpbListBucketsReq)
-> Lens
     RpbListBucketsReq RpbListBucketsReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsReq -> Maybe Bool
_RpbListBucketsReq'stream
           (\ RpbListBucketsReq
x__ Maybe Bool
y__ -> RpbListBucketsReq
x__ {_RpbListBucketsReq'stream :: Maybe Bool
_RpbListBucketsReq'stream = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbListBucketsReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbListBucketsReq
-> f RpbListBucketsReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbListBucketsReq -> f RpbListBucketsReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbListBucketsReq
-> f RpbListBucketsReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsReq -> Maybe ByteString)
-> (RpbListBucketsReq -> Maybe ByteString -> RpbListBucketsReq)
-> Lens
     RpbListBucketsReq
     RpbListBucketsReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsReq -> Maybe ByteString
_RpbListBucketsReq'type'
           (\ RpbListBucketsReq
x__ Maybe ByteString
y__ -> RpbListBucketsReq
x__ {_RpbListBucketsReq'type' :: Maybe ByteString
_RpbListBucketsReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbListBucketsReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbListBucketsReq
-> f RpbListBucketsReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbListBucketsReq -> f RpbListBucketsReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbListBucketsReq
-> f RpbListBucketsReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsReq -> Maybe ByteString)
-> (RpbListBucketsReq -> Maybe ByteString -> RpbListBucketsReq)
-> Lens
     RpbListBucketsReq
     RpbListBucketsReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsReq -> Maybe ByteString
_RpbListBucketsReq'type'
           (\ RpbListBucketsReq
x__ Maybe ByteString
y__ -> RpbListBucketsReq
x__ {_RpbListBucketsReq'type' :: Maybe ByteString
_RpbListBucketsReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbListBucketsReq where
  messageName :: Proxy RpbListBucketsReq -> Text
messageName Proxy RpbListBucketsReq
_ = String -> Text
Data.Text.pack String
"RpbListBucketsReq"
  packedMessageDescriptor :: Proxy RpbListBucketsReq -> ByteString
packedMessageDescriptor Proxy RpbListBucketsReq
_
    = ByteString
"\n\
      \\DC1RpbListBucketsReq\DC2\CAN\n\
      \\atimeout\CAN\SOH \SOH(\rR\atimeout\DC2\SYN\n\
      \\ACKstream\CAN\STX \SOH(\bR\ACKstream\DC2\DC2\n\
      \\EOTtype\CAN\ETX \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbListBucketsReq -> ByteString
packedFileDescriptor Proxy RpbListBucketsReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbListBucketsReq)
fieldsByTag
    = let
        timeout__field_descriptor :: FieldDescriptor RpbListBucketsReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbListBucketsReq Word32
-> FieldDescriptor RpbListBucketsReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbListBucketsReq RpbListBucketsReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbListBucketsReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbListBucketsReq
        stream__field_descriptor :: FieldDescriptor RpbListBucketsReq
stream__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbListBucketsReq Bool
-> FieldDescriptor RpbListBucketsReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"stream"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbListBucketsReq RpbListBucketsReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbListBucketsReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'stream")) ::
              Data.ProtoLens.FieldDescriptor RpbListBucketsReq
        type'__field_descriptor :: FieldDescriptor RpbListBucketsReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbListBucketsReq ByteString
-> FieldDescriptor RpbListBucketsReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbListBucketsReq
  RpbListBucketsReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbListBucketsReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbListBucketsReq
      in
        [(Tag, FieldDescriptor RpbListBucketsReq)]
-> Map Tag (FieldDescriptor RpbListBucketsReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbListBucketsReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbListBucketsReq
stream__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbListBucketsReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbListBucketsReq FieldSet
unknownFields
    = (RpbListBucketsReq -> FieldSet)
-> (RpbListBucketsReq -> FieldSet -> RpbListBucketsReq)
-> Lens' RpbListBucketsReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbListBucketsReq -> FieldSet
_RpbListBucketsReq'_unknownFields
        (\ RpbListBucketsReq
x__ FieldSet
y__ -> RpbListBucketsReq
x__ {_RpbListBucketsReq'_unknownFields :: FieldSet
_RpbListBucketsReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbListBucketsReq
defMessage
    = RpbListBucketsReq'_constructor :: Maybe Word32
-> Maybe Bool -> Maybe ByteString -> FieldSet -> RpbListBucketsReq
RpbListBucketsReq'_constructor
        {_RpbListBucketsReq'timeout :: Maybe Word32
_RpbListBucketsReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbListBucketsReq'stream :: Maybe Bool
_RpbListBucketsReq'stream = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbListBucketsReq'type' :: Maybe ByteString
_RpbListBucketsReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbListBucketsReq'_unknownFields :: FieldSet
_RpbListBucketsReq'_unknownFields = []}
  parseMessage :: Parser RpbListBucketsReq
parseMessage
    = let
        loop ::
          RpbListBucketsReq
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbListBucketsReq
        loop :: RpbListBucketsReq -> Parser RpbListBucketsReq
loop RpbListBucketsReq
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]))))
                      RpbListBucketsReq -> Parser RpbListBucketsReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbListBucketsReq RpbListBucketsReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbListBucketsReq -> RpbListBucketsReq
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 RpbListBucketsReq RpbListBucketsReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbListBucketsReq
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
"timeout"
                                RpbListBucketsReq -> Parser RpbListBucketsReq
loop (Setter RpbListBucketsReq RpbListBucketsReq Word32 Word32
-> Word32 -> RpbListBucketsReq -> RpbListBucketsReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbListBucketsReq
x)
                        Word64
16
                          -> 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
"stream"
                                RpbListBucketsReq -> Parser RpbListBucketsReq
loop (Setter RpbListBucketsReq RpbListBucketsReq Bool Bool
-> Bool -> RpbListBucketsReq -> RpbListBucketsReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"stream") Bool
y RpbListBucketsReq
x)
                        Word64
26
                          -> 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
"type"
                                RpbListBucketsReq -> Parser RpbListBucketsReq
loop (Setter RpbListBucketsReq RpbListBucketsReq ByteString ByteString
-> ByteString -> RpbListBucketsReq -> RpbListBucketsReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbListBucketsReq
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbListBucketsReq -> Parser RpbListBucketsReq
loop
                                  (Setter RpbListBucketsReq RpbListBucketsReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbListBucketsReq -> RpbListBucketsReq
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 RpbListBucketsReq RpbListBucketsReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbListBucketsReq
x)
      in
        Parser RpbListBucketsReq -> String -> Parser RpbListBucketsReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbListBucketsReq -> Parser RpbListBucketsReq
loop RpbListBucketsReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbListBucketsReq"
  buildMessage :: RpbListBucketsReq -> Builder
buildMessage
    = \ RpbListBucketsReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Word32)
  RpbListBucketsReq
  RpbListBucketsReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbListBucketsReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") RpbListBucketsReq
_x
              of
                Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Word32
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Bool)
  RpbListBucketsReq
  RpbListBucketsReq
  (Maybe Bool)
  (Maybe Bool)
-> RpbListBucketsReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'stream") RpbListBucketsReq
_x
                 of
                   Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Bool
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbListBucketsReq
  RpbListBucketsReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbListBucketsReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbListBucketsReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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 RpbListBucketsReq RpbListBucketsReq FieldSet FieldSet
-> RpbListBucketsReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbListBucketsReq RpbListBucketsReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbListBucketsReq
_x))))
instance Control.DeepSeq.NFData RpbListBucketsReq where
  rnf :: RpbListBucketsReq -> ()
rnf
    = \ RpbListBucketsReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbListBucketsReq -> FieldSet
_RpbListBucketsReq'_unknownFields RpbListBucketsReq
x__)
             (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbListBucketsReq -> Maybe Word32
_RpbListBucketsReq'timeout RpbListBucketsReq
x__)
                (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbListBucketsReq -> Maybe Bool
_RpbListBucketsReq'stream RpbListBucketsReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbListBucketsReq -> Maybe ByteString
_RpbListBucketsReq'type' RpbListBucketsReq
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.buckets' @:: Lens' RpbListBucketsResp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'buckets' @:: Lens' RpbListBucketsResp (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.done' @:: Lens' RpbListBucketsResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' RpbListBucketsResp (Prelude.Maybe Prelude.Bool)@ -}
data RpbListBucketsResp
  = RpbListBucketsResp'_constructor {RpbListBucketsResp -> Vector ByteString
_RpbListBucketsResp'buckets :: !(Data.Vector.Vector Data.ByteString.ByteString),
                                     RpbListBucketsResp -> Maybe Bool
_RpbListBucketsResp'done :: !(Prelude.Maybe Prelude.Bool),
                                     RpbListBucketsResp -> FieldSet
_RpbListBucketsResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbListBucketsResp -> RpbListBucketsResp -> Bool
(RpbListBucketsResp -> RpbListBucketsResp -> Bool)
-> (RpbListBucketsResp -> RpbListBucketsResp -> Bool)
-> Eq RpbListBucketsResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
$c/= :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
== :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
$c== :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
Prelude.Eq, Eq RpbListBucketsResp
Eq RpbListBucketsResp
-> (RpbListBucketsResp -> RpbListBucketsResp -> Ordering)
-> (RpbListBucketsResp -> RpbListBucketsResp -> Bool)
-> (RpbListBucketsResp -> RpbListBucketsResp -> Bool)
-> (RpbListBucketsResp -> RpbListBucketsResp -> Bool)
-> (RpbListBucketsResp -> RpbListBucketsResp -> Bool)
-> (RpbListBucketsResp -> RpbListBucketsResp -> RpbListBucketsResp)
-> (RpbListBucketsResp -> RpbListBucketsResp -> RpbListBucketsResp)
-> Ord RpbListBucketsResp
RpbListBucketsResp -> RpbListBucketsResp -> Bool
RpbListBucketsResp -> RpbListBucketsResp -> Ordering
RpbListBucketsResp -> RpbListBucketsResp -> RpbListBucketsResp
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 :: RpbListBucketsResp -> RpbListBucketsResp -> RpbListBucketsResp
$cmin :: RpbListBucketsResp -> RpbListBucketsResp -> RpbListBucketsResp
max :: RpbListBucketsResp -> RpbListBucketsResp -> RpbListBucketsResp
$cmax :: RpbListBucketsResp -> RpbListBucketsResp -> RpbListBucketsResp
>= :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
$c>= :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
> :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
$c> :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
<= :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
$c<= :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
< :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
$c< :: RpbListBucketsResp -> RpbListBucketsResp -> Bool
compare :: RpbListBucketsResp -> RpbListBucketsResp -> Ordering
$ccompare :: RpbListBucketsResp -> RpbListBucketsResp -> Ordering
$cp1Ord :: Eq RpbListBucketsResp
Prelude.Ord)
instance Prelude.Show RpbListBucketsResp where
  showsPrec :: Int -> RpbListBucketsResp -> ShowS
showsPrec Int
_ RpbListBucketsResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbListBucketsResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbListBucketsResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbListBucketsResp "buckets" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "buckets"
-> ([ByteString] -> f [ByteString])
-> RpbListBucketsResp
-> f RpbListBucketsResp
fieldOf Proxy# "buckets"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbListBucketsResp -> f RpbListBucketsResp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> RpbListBucketsResp
-> f RpbListBucketsResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsResp -> Vector ByteString)
-> (RpbListBucketsResp -> Vector ByteString -> RpbListBucketsResp)
-> Lens
     RpbListBucketsResp
     RpbListBucketsResp
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsResp -> Vector ByteString
_RpbListBucketsResp'buckets
           (\ RpbListBucketsResp
x__ Vector ByteString
y__ -> RpbListBucketsResp
x__ {_RpbListBucketsResp'buckets :: Vector ByteString
_RpbListBucketsResp'buckets = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField RpbListBucketsResp "vec'buckets" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'buckets"
-> (Vector ByteString -> f (Vector ByteString))
-> RpbListBucketsResp
-> f RpbListBucketsResp
fieldOf Proxy# "vec'buckets"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbListBucketsResp -> f RpbListBucketsResp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> RpbListBucketsResp
-> f RpbListBucketsResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsResp -> Vector ByteString)
-> (RpbListBucketsResp -> Vector ByteString -> RpbListBucketsResp)
-> Lens
     RpbListBucketsResp
     RpbListBucketsResp
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsResp -> Vector ByteString
_RpbListBucketsResp'buckets
           (\ RpbListBucketsResp
x__ Vector ByteString
y__ -> RpbListBucketsResp
x__ {_RpbListBucketsResp'buckets :: Vector ByteString
_RpbListBucketsResp'buckets = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbListBucketsResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done"
-> (Bool -> f Bool) -> RpbListBucketsResp -> f RpbListBucketsResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbListBucketsResp -> f RpbListBucketsResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbListBucketsResp
-> f RpbListBucketsResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsResp -> Maybe Bool)
-> (RpbListBucketsResp -> Maybe Bool -> RpbListBucketsResp)
-> Lens
     RpbListBucketsResp RpbListBucketsResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsResp -> Maybe Bool
_RpbListBucketsResp'done
           (\ RpbListBucketsResp
x__ Maybe Bool
y__ -> RpbListBucketsResp
x__ {_RpbListBucketsResp'done :: Maybe Bool
_RpbListBucketsResp'done = 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 RpbListBucketsResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbListBucketsResp
-> f RpbListBucketsResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbListBucketsResp -> f RpbListBucketsResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbListBucketsResp
-> f RpbListBucketsResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListBucketsResp -> Maybe Bool)
-> (RpbListBucketsResp -> Maybe Bool -> RpbListBucketsResp)
-> Lens
     RpbListBucketsResp RpbListBucketsResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListBucketsResp -> Maybe Bool
_RpbListBucketsResp'done
           (\ RpbListBucketsResp
x__ Maybe Bool
y__ -> RpbListBucketsResp
x__ {_RpbListBucketsResp'done :: Maybe Bool
_RpbListBucketsResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbListBucketsResp where
  messageName :: Proxy RpbListBucketsResp -> Text
messageName Proxy RpbListBucketsResp
_ = String -> Text
Data.Text.pack String
"RpbListBucketsResp"
  packedMessageDescriptor :: Proxy RpbListBucketsResp -> ByteString
packedMessageDescriptor Proxy RpbListBucketsResp
_
    = ByteString
"\n\
      \\DC2RpbListBucketsResp\DC2\CAN\n\
      \\abuckets\CAN\SOH \ETX(\fR\abuckets\DC2\DC2\n\
      \\EOTdone\CAN\STX \SOH(\bR\EOTdone"
  packedFileDescriptor :: Proxy RpbListBucketsResp -> ByteString
packedFileDescriptor Proxy RpbListBucketsResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbListBucketsResp)
fieldsByTag
    = let
        buckets__field_descriptor :: FieldDescriptor RpbListBucketsResp
buckets__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbListBucketsResp ByteString
-> FieldDescriptor RpbListBucketsResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"buckets"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' RpbListBucketsResp [ByteString]
-> FieldAccessor RpbListBucketsResp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "buckets" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"buckets")) ::
              Data.ProtoLens.FieldDescriptor RpbListBucketsResp
        done__field_descriptor :: FieldDescriptor RpbListBucketsResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbListBucketsResp Bool
-> FieldDescriptor RpbListBucketsResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens
  RpbListBucketsResp RpbListBucketsResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbListBucketsResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor RpbListBucketsResp
      in
        [(Tag, FieldDescriptor RpbListBucketsResp)]
-> Map Tag (FieldDescriptor RpbListBucketsResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbListBucketsResp
buckets__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbListBucketsResp
done__field_descriptor)]
  unknownFields :: LensLike' f RpbListBucketsResp FieldSet
unknownFields
    = (RpbListBucketsResp -> FieldSet)
-> (RpbListBucketsResp -> FieldSet -> RpbListBucketsResp)
-> Lens' RpbListBucketsResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbListBucketsResp -> FieldSet
_RpbListBucketsResp'_unknownFields
        (\ RpbListBucketsResp
x__ FieldSet
y__ -> RpbListBucketsResp
x__ {_RpbListBucketsResp'_unknownFields :: FieldSet
_RpbListBucketsResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbListBucketsResp
defMessage
    = RpbListBucketsResp'_constructor :: Vector ByteString -> Maybe Bool -> FieldSet -> RpbListBucketsResp
RpbListBucketsResp'_constructor
        {_RpbListBucketsResp'buckets :: Vector ByteString
_RpbListBucketsResp'buckets = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbListBucketsResp'done :: Maybe Bool
_RpbListBucketsResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbListBucketsResp'_unknownFields :: FieldSet
_RpbListBucketsResp'_unknownFields = []}
  parseMessage :: Parser RpbListBucketsResp
parseMessage
    = let
        loop ::
          RpbListBucketsResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbListBucketsResp
        loop :: RpbListBucketsResp
-> Growing Vector RealWorld ByteString -> Parser RpbListBucketsResp
loop RpbListBucketsResp
x Growing Vector RealWorld ByteString
mutable'buckets
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'buckets <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'buckets)
                      (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]))))
                      RpbListBucketsResp -> Parser RpbListBucketsResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbListBucketsResp RpbListBucketsResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbListBucketsResp
-> RpbListBucketsResp
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 RpbListBucketsResp RpbListBucketsResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbListBucketsResp
  RpbListBucketsResp
  (Vector ByteString)
  (Vector ByteString)
-> Vector ByteString -> RpbListBucketsResp -> RpbListBucketsResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'buckets" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'buckets") Vector ByteString
frozen'buckets RpbListBucketsResp
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
"buckets"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'buckets ByteString
y)
                                RpbListBucketsResp
-> Growing Vector RealWorld ByteString -> Parser RpbListBucketsResp
loop RpbListBucketsResp
x Growing Vector RealWorld ByteString
v
                        Word64
16
                          -> 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
"done"
                                RpbListBucketsResp
-> Growing Vector RealWorld ByteString -> Parser RpbListBucketsResp
loop
                                  (Setter RpbListBucketsResp RpbListBucketsResp Bool Bool
-> Bool -> RpbListBucketsResp -> RpbListBucketsResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y RpbListBucketsResp
x)
                                  Growing Vector RealWorld ByteString
mutable'buckets
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbListBucketsResp
-> Growing Vector RealWorld ByteString -> Parser RpbListBucketsResp
loop
                                  (Setter RpbListBucketsResp RpbListBucketsResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbListBucketsResp
-> RpbListBucketsResp
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 RpbListBucketsResp RpbListBucketsResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbListBucketsResp
x)
                                  Growing Vector RealWorld ByteString
mutable'buckets
      in
        Parser RpbListBucketsResp -> String -> Parser RpbListBucketsResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'buckets <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbListBucketsResp
-> Growing Vector RealWorld ByteString -> Parser RpbListBucketsResp
loop RpbListBucketsResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld ByteString
mutable'buckets)
          String
"RpbListBucketsResp"
  buildMessage :: RpbListBucketsResp -> Builder
buildMessage
    = \ RpbListBucketsResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ ByteString
_v
                   -> 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))
                (FoldLike
  (Vector ByteString)
  RpbListBucketsResp
  RpbListBucketsResp
  (Vector ByteString)
  (Vector ByteString)
-> RpbListBucketsResp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'buckets" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'buckets") RpbListBucketsResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Bool)
  RpbListBucketsResp
  RpbListBucketsResp
  (Maybe Bool)
  (Maybe Bool)
-> RpbListBucketsResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") RpbListBucketsResp
_x
                 of
                   Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Bool
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike
  FieldSet RpbListBucketsResp RpbListBucketsResp FieldSet FieldSet
-> RpbListBucketsResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbListBucketsResp RpbListBucketsResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbListBucketsResp
_x)))
instance Control.DeepSeq.NFData RpbListBucketsResp where
  rnf :: RpbListBucketsResp -> ()
rnf
    = \ RpbListBucketsResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbListBucketsResp -> FieldSet
_RpbListBucketsResp'_unknownFields RpbListBucketsResp
x__)
             (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbListBucketsResp -> Vector ByteString
_RpbListBucketsResp'buckets RpbListBucketsResp
x__)
                (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbListBucketsResp -> Maybe Bool
_RpbListBucketsResp'done RpbListBucketsResp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbListKeysReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbListKeysReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbListKeysReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbListKeysReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbListKeysReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbListKeysReq
  = RpbListKeysReq'_constructor {RpbListKeysReq -> ByteString
_RpbListKeysReq'bucket :: !Data.ByteString.ByteString,
                                 RpbListKeysReq -> Maybe Word32
_RpbListKeysReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                                 RpbListKeysReq -> Maybe ByteString
_RpbListKeysReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                 RpbListKeysReq -> FieldSet
_RpbListKeysReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbListKeysReq -> RpbListKeysReq -> Bool
(RpbListKeysReq -> RpbListKeysReq -> Bool)
-> (RpbListKeysReq -> RpbListKeysReq -> Bool) -> Eq RpbListKeysReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbListKeysReq -> RpbListKeysReq -> Bool
$c/= :: RpbListKeysReq -> RpbListKeysReq -> Bool
== :: RpbListKeysReq -> RpbListKeysReq -> Bool
$c== :: RpbListKeysReq -> RpbListKeysReq -> Bool
Prelude.Eq, Eq RpbListKeysReq
Eq RpbListKeysReq
-> (RpbListKeysReq -> RpbListKeysReq -> Ordering)
-> (RpbListKeysReq -> RpbListKeysReq -> Bool)
-> (RpbListKeysReq -> RpbListKeysReq -> Bool)
-> (RpbListKeysReq -> RpbListKeysReq -> Bool)
-> (RpbListKeysReq -> RpbListKeysReq -> Bool)
-> (RpbListKeysReq -> RpbListKeysReq -> RpbListKeysReq)
-> (RpbListKeysReq -> RpbListKeysReq -> RpbListKeysReq)
-> Ord RpbListKeysReq
RpbListKeysReq -> RpbListKeysReq -> Bool
RpbListKeysReq -> RpbListKeysReq -> Ordering
RpbListKeysReq -> RpbListKeysReq -> RpbListKeysReq
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 :: RpbListKeysReq -> RpbListKeysReq -> RpbListKeysReq
$cmin :: RpbListKeysReq -> RpbListKeysReq -> RpbListKeysReq
max :: RpbListKeysReq -> RpbListKeysReq -> RpbListKeysReq
$cmax :: RpbListKeysReq -> RpbListKeysReq -> RpbListKeysReq
>= :: RpbListKeysReq -> RpbListKeysReq -> Bool
$c>= :: RpbListKeysReq -> RpbListKeysReq -> Bool
> :: RpbListKeysReq -> RpbListKeysReq -> Bool
$c> :: RpbListKeysReq -> RpbListKeysReq -> Bool
<= :: RpbListKeysReq -> RpbListKeysReq -> Bool
$c<= :: RpbListKeysReq -> RpbListKeysReq -> Bool
< :: RpbListKeysReq -> RpbListKeysReq -> Bool
$c< :: RpbListKeysReq -> RpbListKeysReq -> Bool
compare :: RpbListKeysReq -> RpbListKeysReq -> Ordering
$ccompare :: RpbListKeysReq -> RpbListKeysReq -> Ordering
$cp1Ord :: Eq RpbListKeysReq
Prelude.Ord)
instance Prelude.Show RpbListKeysReq where
  showsPrec :: Int -> RpbListKeysReq -> ShowS
showsPrec Int
_ RpbListKeysReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbListKeysReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbListKeysReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbListKeysReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbListKeysReq
-> f RpbListKeysReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbListKeysReq -> f RpbListKeysReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbListKeysReq
-> f RpbListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysReq -> ByteString)
-> (RpbListKeysReq -> ByteString -> RpbListKeysReq)
-> Lens RpbListKeysReq RpbListKeysReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysReq -> ByteString
_RpbListKeysReq'bucket
           (\ RpbListKeysReq
x__ ByteString
y__ -> RpbListKeysReq
x__ {_RpbListKeysReq'bucket :: ByteString
_RpbListKeysReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbListKeysReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> RpbListKeysReq -> f RpbListKeysReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbListKeysReq -> f RpbListKeysReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbListKeysReq
-> f RpbListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysReq -> Maybe Word32)
-> (RpbListKeysReq -> Maybe Word32 -> RpbListKeysReq)
-> Lens RpbListKeysReq RpbListKeysReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysReq -> Maybe Word32
_RpbListKeysReq'timeout
           (\ RpbListKeysReq
x__ Maybe Word32
y__ -> RpbListKeysReq
x__ {_RpbListKeysReq'timeout :: Maybe Word32
_RpbListKeysReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbListKeysReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbListKeysReq
-> f RpbListKeysReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbListKeysReq -> f RpbListKeysReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbListKeysReq
-> f RpbListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysReq -> Maybe Word32)
-> (RpbListKeysReq -> Maybe Word32 -> RpbListKeysReq)
-> Lens RpbListKeysReq RpbListKeysReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysReq -> Maybe Word32
_RpbListKeysReq'timeout
           (\ RpbListKeysReq
x__ Maybe Word32
y__ -> RpbListKeysReq
x__ {_RpbListKeysReq'timeout :: Maybe Word32
_RpbListKeysReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbListKeysReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbListKeysReq
-> f RpbListKeysReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbListKeysReq -> f RpbListKeysReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbListKeysReq
-> f RpbListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysReq -> Maybe ByteString)
-> (RpbListKeysReq -> Maybe ByteString -> RpbListKeysReq)
-> Lens
     RpbListKeysReq RpbListKeysReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysReq -> Maybe ByteString
_RpbListKeysReq'type'
           (\ RpbListKeysReq
x__ Maybe ByteString
y__ -> RpbListKeysReq
x__ {_RpbListKeysReq'type' :: Maybe ByteString
_RpbListKeysReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbListKeysReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbListKeysReq
-> f RpbListKeysReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbListKeysReq -> f RpbListKeysReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbListKeysReq
-> f RpbListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysReq -> Maybe ByteString)
-> (RpbListKeysReq -> Maybe ByteString -> RpbListKeysReq)
-> Lens
     RpbListKeysReq RpbListKeysReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysReq -> Maybe ByteString
_RpbListKeysReq'type'
           (\ RpbListKeysReq
x__ Maybe ByteString
y__ -> RpbListKeysReq
x__ {_RpbListKeysReq'type' :: Maybe ByteString
_RpbListKeysReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbListKeysReq where
  messageName :: Proxy RpbListKeysReq -> Text
messageName Proxy RpbListKeysReq
_ = String -> Text
Data.Text.pack String
"RpbListKeysReq"
  packedMessageDescriptor :: Proxy RpbListKeysReq -> ByteString
packedMessageDescriptor Proxy RpbListKeysReq
_
    = ByteString
"\n\
      \\SORpbListKeysReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\CAN\n\
      \\atimeout\CAN\STX \SOH(\rR\atimeout\DC2\DC2\n\
      \\EOTtype\CAN\ETX \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbListKeysReq -> ByteString
packedFileDescriptor Proxy RpbListKeysReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbListKeysReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbListKeysReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbListKeysReq ByteString
-> FieldDescriptor RpbListKeysReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbListKeysReq RpbListKeysReq ByteString ByteString
-> FieldAccessor RpbListKeysReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbListKeysReq
        timeout__field_descriptor :: FieldDescriptor RpbListKeysReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbListKeysReq Word32
-> FieldDescriptor RpbListKeysReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbListKeysReq RpbListKeysReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbListKeysReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbListKeysReq
        type'__field_descriptor :: FieldDescriptor RpbListKeysReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbListKeysReq ByteString
-> FieldDescriptor RpbListKeysReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbListKeysReq RpbListKeysReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbListKeysReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbListKeysReq
      in
        [(Tag, FieldDescriptor RpbListKeysReq)]
-> Map Tag (FieldDescriptor RpbListKeysReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbListKeysReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbListKeysReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbListKeysReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbListKeysReq FieldSet
unknownFields
    = (RpbListKeysReq -> FieldSet)
-> (RpbListKeysReq -> FieldSet -> RpbListKeysReq)
-> Lens' RpbListKeysReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbListKeysReq -> FieldSet
_RpbListKeysReq'_unknownFields
        (\ RpbListKeysReq
x__ FieldSet
y__ -> RpbListKeysReq
x__ {_RpbListKeysReq'_unknownFields :: FieldSet
_RpbListKeysReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbListKeysReq
defMessage
    = RpbListKeysReq'_constructor :: ByteString
-> Maybe Word32 -> Maybe ByteString -> FieldSet -> RpbListKeysReq
RpbListKeysReq'_constructor
        {_RpbListKeysReq'bucket :: ByteString
_RpbListKeysReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbListKeysReq'timeout :: Maybe Word32
_RpbListKeysReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbListKeysReq'type' :: Maybe ByteString
_RpbListKeysReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbListKeysReq'_unknownFields :: FieldSet
_RpbListKeysReq'_unknownFields = []}
  parseMessage :: Parser RpbListKeysReq
parseMessage
    = let
        loop ::
          RpbListKeysReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbListKeysReq
        loop :: RpbListKeysReq -> Bool -> Parser RpbListKeysReq
loop RpbListKeysReq
x Bool
required'bucket
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbListKeysReq -> Parser RpbListKeysReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbListKeysReq RpbListKeysReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbListKeysReq -> RpbListKeysReq
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 RpbListKeysReq RpbListKeysReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbListKeysReq
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
"bucket"
                                RpbListKeysReq -> Bool -> Parser RpbListKeysReq
loop
                                  (Setter RpbListKeysReq RpbListKeysReq ByteString ByteString
-> ByteString -> RpbListKeysReq -> RpbListKeysReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbListKeysReq
x)
                                  Bool
Prelude.False
                        Word64
16
                          -> 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
"timeout"
                                RpbListKeysReq -> Bool -> Parser RpbListKeysReq
loop
                                  (Setter RpbListKeysReq RpbListKeysReq Word32 Word32
-> Word32 -> RpbListKeysReq -> RpbListKeysReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbListKeysReq
x)
                                  Bool
required'bucket
                        Word64
26
                          -> 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
"type"
                                RpbListKeysReq -> Bool -> Parser RpbListKeysReq
loop
                                  (Setter RpbListKeysReq RpbListKeysReq ByteString ByteString
-> ByteString -> RpbListKeysReq -> RpbListKeysReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbListKeysReq
x)
                                  Bool
required'bucket
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbListKeysReq -> Bool -> Parser RpbListKeysReq
loop
                                  (Setter RpbListKeysReq RpbListKeysReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbListKeysReq -> RpbListKeysReq
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 RpbListKeysReq RpbListKeysReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbListKeysReq
x)
                                  Bool
required'bucket
      in
        Parser RpbListKeysReq -> String -> Parser RpbListKeysReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbListKeysReq -> Bool -> Parser RpbListKeysReq
loop RpbListKeysReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"RpbListKeysReq"
  buildMessage :: RpbListKeysReq -> Builder
buildMessage
    = \ RpbListKeysReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbListKeysReq RpbListKeysReq ByteString ByteString
-> RpbListKeysReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbListKeysReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Word32)
  RpbListKeysReq
  RpbListKeysReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbListKeysReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") RpbListKeysReq
_x
                 of
                   Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Word32
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbListKeysReq
  RpbListKeysReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbListKeysReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbListKeysReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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 RpbListKeysReq RpbListKeysReq FieldSet FieldSet
-> RpbListKeysReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbListKeysReq RpbListKeysReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbListKeysReq
_x))))
instance Control.DeepSeq.NFData RpbListKeysReq where
  rnf :: RpbListKeysReq -> ()
rnf
    = \ RpbListKeysReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbListKeysReq -> FieldSet
_RpbListKeysReq'_unknownFields RpbListKeysReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbListKeysReq -> ByteString
_RpbListKeysReq'bucket RpbListKeysReq
x__)
                (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbListKeysReq -> Maybe Word32
_RpbListKeysReq'timeout RpbListKeysReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbListKeysReq -> Maybe ByteString
_RpbListKeysReq'type' RpbListKeysReq
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.keys' @:: Lens' RpbListKeysResp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'keys' @:: Lens' RpbListKeysResp (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.done' @:: Lens' RpbListKeysResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' RpbListKeysResp (Prelude.Maybe Prelude.Bool)@ -}
data RpbListKeysResp
  = RpbListKeysResp'_constructor {RpbListKeysResp -> Vector ByteString
_RpbListKeysResp'keys :: !(Data.Vector.Vector Data.ByteString.ByteString),
                                  RpbListKeysResp -> Maybe Bool
_RpbListKeysResp'done :: !(Prelude.Maybe Prelude.Bool),
                                  RpbListKeysResp -> FieldSet
_RpbListKeysResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbListKeysResp -> RpbListKeysResp -> Bool
(RpbListKeysResp -> RpbListKeysResp -> Bool)
-> (RpbListKeysResp -> RpbListKeysResp -> Bool)
-> Eq RpbListKeysResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbListKeysResp -> RpbListKeysResp -> Bool
$c/= :: RpbListKeysResp -> RpbListKeysResp -> Bool
== :: RpbListKeysResp -> RpbListKeysResp -> Bool
$c== :: RpbListKeysResp -> RpbListKeysResp -> Bool
Prelude.Eq, Eq RpbListKeysResp
Eq RpbListKeysResp
-> (RpbListKeysResp -> RpbListKeysResp -> Ordering)
-> (RpbListKeysResp -> RpbListKeysResp -> Bool)
-> (RpbListKeysResp -> RpbListKeysResp -> Bool)
-> (RpbListKeysResp -> RpbListKeysResp -> Bool)
-> (RpbListKeysResp -> RpbListKeysResp -> Bool)
-> (RpbListKeysResp -> RpbListKeysResp -> RpbListKeysResp)
-> (RpbListKeysResp -> RpbListKeysResp -> RpbListKeysResp)
-> Ord RpbListKeysResp
RpbListKeysResp -> RpbListKeysResp -> Bool
RpbListKeysResp -> RpbListKeysResp -> Ordering
RpbListKeysResp -> RpbListKeysResp -> RpbListKeysResp
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 :: RpbListKeysResp -> RpbListKeysResp -> RpbListKeysResp
$cmin :: RpbListKeysResp -> RpbListKeysResp -> RpbListKeysResp
max :: RpbListKeysResp -> RpbListKeysResp -> RpbListKeysResp
$cmax :: RpbListKeysResp -> RpbListKeysResp -> RpbListKeysResp
>= :: RpbListKeysResp -> RpbListKeysResp -> Bool
$c>= :: RpbListKeysResp -> RpbListKeysResp -> Bool
> :: RpbListKeysResp -> RpbListKeysResp -> Bool
$c> :: RpbListKeysResp -> RpbListKeysResp -> Bool
<= :: RpbListKeysResp -> RpbListKeysResp -> Bool
$c<= :: RpbListKeysResp -> RpbListKeysResp -> Bool
< :: RpbListKeysResp -> RpbListKeysResp -> Bool
$c< :: RpbListKeysResp -> RpbListKeysResp -> Bool
compare :: RpbListKeysResp -> RpbListKeysResp -> Ordering
$ccompare :: RpbListKeysResp -> RpbListKeysResp -> Ordering
$cp1Ord :: Eq RpbListKeysResp
Prelude.Ord)
instance Prelude.Show RpbListKeysResp where
  showsPrec :: Int -> RpbListKeysResp -> ShowS
showsPrec Int
_ RpbListKeysResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbListKeysResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbListKeysResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbListKeysResp "keys" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "keys"
-> ([ByteString] -> f [ByteString])
-> RpbListKeysResp
-> f RpbListKeysResp
fieldOf Proxy# "keys"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbListKeysResp -> f RpbListKeysResp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> RpbListKeysResp
-> f RpbListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysResp -> Vector ByteString)
-> (RpbListKeysResp -> Vector ByteString -> RpbListKeysResp)
-> Lens
     RpbListKeysResp
     RpbListKeysResp
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysResp -> Vector ByteString
_RpbListKeysResp'keys
           (\ RpbListKeysResp
x__ Vector ByteString
y__ -> RpbListKeysResp
x__ {_RpbListKeysResp'keys :: Vector ByteString
_RpbListKeysResp'keys = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField RpbListKeysResp "vec'keys" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'keys"
-> (Vector ByteString -> f (Vector ByteString))
-> RpbListKeysResp
-> f RpbListKeysResp
fieldOf Proxy# "vec'keys"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbListKeysResp -> f RpbListKeysResp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> RpbListKeysResp
-> f RpbListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysResp -> Vector ByteString)
-> (RpbListKeysResp -> Vector ByteString -> RpbListKeysResp)
-> Lens
     RpbListKeysResp
     RpbListKeysResp
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysResp -> Vector ByteString
_RpbListKeysResp'keys
           (\ RpbListKeysResp
x__ Vector ByteString
y__ -> RpbListKeysResp
x__ {_RpbListKeysResp'keys :: Vector ByteString
_RpbListKeysResp'keys = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbListKeysResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done"
-> (Bool -> f Bool) -> RpbListKeysResp -> f RpbListKeysResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbListKeysResp -> f RpbListKeysResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbListKeysResp
-> f RpbListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysResp -> Maybe Bool)
-> (RpbListKeysResp -> Maybe Bool -> RpbListKeysResp)
-> Lens RpbListKeysResp RpbListKeysResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysResp -> Maybe Bool
_RpbListKeysResp'done
           (\ RpbListKeysResp
x__ Maybe Bool
y__ -> RpbListKeysResp
x__ {_RpbListKeysResp'done :: Maybe Bool
_RpbListKeysResp'done = 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 RpbListKeysResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbListKeysResp
-> f RpbListKeysResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbListKeysResp -> f RpbListKeysResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbListKeysResp
-> f RpbListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbListKeysResp -> Maybe Bool)
-> (RpbListKeysResp -> Maybe Bool -> RpbListKeysResp)
-> Lens RpbListKeysResp RpbListKeysResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbListKeysResp -> Maybe Bool
_RpbListKeysResp'done
           (\ RpbListKeysResp
x__ Maybe Bool
y__ -> RpbListKeysResp
x__ {_RpbListKeysResp'done :: Maybe Bool
_RpbListKeysResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbListKeysResp where
  messageName :: Proxy RpbListKeysResp -> Text
messageName Proxy RpbListKeysResp
_ = String -> Text
Data.Text.pack String
"RpbListKeysResp"
  packedMessageDescriptor :: Proxy RpbListKeysResp -> ByteString
packedMessageDescriptor Proxy RpbListKeysResp
_
    = ByteString
"\n\
      \\SIRpbListKeysResp\DC2\DC2\n\
      \\EOTkeys\CAN\SOH \ETX(\fR\EOTkeys\DC2\DC2\n\
      \\EOTdone\CAN\STX \SOH(\bR\EOTdone"
  packedFileDescriptor :: Proxy RpbListKeysResp -> ByteString
packedFileDescriptor Proxy RpbListKeysResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbListKeysResp)
fieldsByTag
    = let
        keys__field_descriptor :: FieldDescriptor RpbListKeysResp
keys__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbListKeysResp ByteString
-> FieldDescriptor RpbListKeysResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"keys"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' RpbListKeysResp [ByteString]
-> FieldAccessor RpbListKeysResp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"keys")) ::
              Data.ProtoLens.FieldDescriptor RpbListKeysResp
        done__field_descriptor :: FieldDescriptor RpbListKeysResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbListKeysResp Bool
-> FieldDescriptor RpbListKeysResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbListKeysResp RpbListKeysResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbListKeysResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor RpbListKeysResp
      in
        [(Tag, FieldDescriptor RpbListKeysResp)]
-> Map Tag (FieldDescriptor RpbListKeysResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbListKeysResp
keys__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbListKeysResp
done__field_descriptor)]
  unknownFields :: LensLike' f RpbListKeysResp FieldSet
unknownFields
    = (RpbListKeysResp -> FieldSet)
-> (RpbListKeysResp -> FieldSet -> RpbListKeysResp)
-> Lens' RpbListKeysResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbListKeysResp -> FieldSet
_RpbListKeysResp'_unknownFields
        (\ RpbListKeysResp
x__ FieldSet
y__ -> RpbListKeysResp
x__ {_RpbListKeysResp'_unknownFields :: FieldSet
_RpbListKeysResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbListKeysResp
defMessage
    = RpbListKeysResp'_constructor :: Vector ByteString -> Maybe Bool -> FieldSet -> RpbListKeysResp
RpbListKeysResp'_constructor
        {_RpbListKeysResp'keys :: Vector ByteString
_RpbListKeysResp'keys = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbListKeysResp'done :: Maybe Bool
_RpbListKeysResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbListKeysResp'_unknownFields :: FieldSet
_RpbListKeysResp'_unknownFields = []}
  parseMessage :: Parser RpbListKeysResp
parseMessage
    = let
        loop ::
          RpbListKeysResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbListKeysResp
        loop :: RpbListKeysResp
-> Growing Vector RealWorld ByteString -> Parser RpbListKeysResp
loop RpbListKeysResp
x Growing Vector RealWorld ByteString
mutable'keys
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'keys <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'keys)
                      (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]))))
                      RpbListKeysResp -> Parser RpbListKeysResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbListKeysResp RpbListKeysResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbListKeysResp -> RpbListKeysResp
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 RpbListKeysResp RpbListKeysResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbListKeysResp
  RpbListKeysResp
  (Vector ByteString)
  (Vector ByteString)
-> Vector ByteString -> RpbListKeysResp -> RpbListKeysResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'keys") Vector ByteString
frozen'keys RpbListKeysResp
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
"keys"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'keys ByteString
y)
                                RpbListKeysResp
-> Growing Vector RealWorld ByteString -> Parser RpbListKeysResp
loop RpbListKeysResp
x Growing Vector RealWorld ByteString
v
                        Word64
16
                          -> 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
"done"
                                RpbListKeysResp
-> Growing Vector RealWorld ByteString -> Parser RpbListKeysResp
loop
                                  (Setter RpbListKeysResp RpbListKeysResp Bool Bool
-> Bool -> RpbListKeysResp -> RpbListKeysResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y RpbListKeysResp
x)
                                  Growing Vector RealWorld ByteString
mutable'keys
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbListKeysResp
-> Growing Vector RealWorld ByteString -> Parser RpbListKeysResp
loop
                                  (Setter RpbListKeysResp RpbListKeysResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbListKeysResp -> RpbListKeysResp
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 RpbListKeysResp RpbListKeysResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbListKeysResp
x)
                                  Growing Vector RealWorld ByteString
mutable'keys
      in
        Parser RpbListKeysResp -> String -> Parser RpbListKeysResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'keys <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbListKeysResp
-> Growing Vector RealWorld ByteString -> Parser RpbListKeysResp
loop RpbListKeysResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld ByteString
mutable'keys)
          String
"RpbListKeysResp"
  buildMessage :: RpbListKeysResp -> Builder
buildMessage
    = \ RpbListKeysResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ ByteString
_v
                   -> 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))
                (FoldLike
  (Vector ByteString)
  RpbListKeysResp
  RpbListKeysResp
  (Vector ByteString)
  (Vector ByteString)
-> RpbListKeysResp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'keys") RpbListKeysResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Bool)
  RpbListKeysResp
  RpbListKeysResp
  (Maybe Bool)
  (Maybe Bool)
-> RpbListKeysResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") RpbListKeysResp
_x
                 of
                   Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Bool
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet RpbListKeysResp RpbListKeysResp FieldSet FieldSet
-> RpbListKeysResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbListKeysResp RpbListKeysResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbListKeysResp
_x)))
instance Control.DeepSeq.NFData RpbListKeysResp where
  rnf :: RpbListKeysResp -> ()
rnf
    = \ RpbListKeysResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbListKeysResp -> FieldSet
_RpbListKeysResp'_unknownFields RpbListKeysResp
x__)
             (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbListKeysResp -> Vector ByteString
_RpbListKeysResp'keys RpbListKeysResp
x__)
                (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbListKeysResp -> Maybe Bool
_RpbListKeysResp'done RpbListKeysResp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.request' @:: Lens' RpbMapRedReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.contentType' @:: Lens' RpbMapRedReq Data.ByteString.ByteString@ -}
data RpbMapRedReq
  = RpbMapRedReq'_constructor {RpbMapRedReq -> ByteString
_RpbMapRedReq'request :: !Data.ByteString.ByteString,
                               RpbMapRedReq -> ByteString
_RpbMapRedReq'contentType :: !Data.ByteString.ByteString,
                               RpbMapRedReq -> FieldSet
_RpbMapRedReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbMapRedReq -> RpbMapRedReq -> Bool
(RpbMapRedReq -> RpbMapRedReq -> Bool)
-> (RpbMapRedReq -> RpbMapRedReq -> Bool) -> Eq RpbMapRedReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbMapRedReq -> RpbMapRedReq -> Bool
$c/= :: RpbMapRedReq -> RpbMapRedReq -> Bool
== :: RpbMapRedReq -> RpbMapRedReq -> Bool
$c== :: RpbMapRedReq -> RpbMapRedReq -> Bool
Prelude.Eq, Eq RpbMapRedReq
Eq RpbMapRedReq
-> (RpbMapRedReq -> RpbMapRedReq -> Ordering)
-> (RpbMapRedReq -> RpbMapRedReq -> Bool)
-> (RpbMapRedReq -> RpbMapRedReq -> Bool)
-> (RpbMapRedReq -> RpbMapRedReq -> Bool)
-> (RpbMapRedReq -> RpbMapRedReq -> Bool)
-> (RpbMapRedReq -> RpbMapRedReq -> RpbMapRedReq)
-> (RpbMapRedReq -> RpbMapRedReq -> RpbMapRedReq)
-> Ord RpbMapRedReq
RpbMapRedReq -> RpbMapRedReq -> Bool
RpbMapRedReq -> RpbMapRedReq -> Ordering
RpbMapRedReq -> RpbMapRedReq -> RpbMapRedReq
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 :: RpbMapRedReq -> RpbMapRedReq -> RpbMapRedReq
$cmin :: RpbMapRedReq -> RpbMapRedReq -> RpbMapRedReq
max :: RpbMapRedReq -> RpbMapRedReq -> RpbMapRedReq
$cmax :: RpbMapRedReq -> RpbMapRedReq -> RpbMapRedReq
>= :: RpbMapRedReq -> RpbMapRedReq -> Bool
$c>= :: RpbMapRedReq -> RpbMapRedReq -> Bool
> :: RpbMapRedReq -> RpbMapRedReq -> Bool
$c> :: RpbMapRedReq -> RpbMapRedReq -> Bool
<= :: RpbMapRedReq -> RpbMapRedReq -> Bool
$c<= :: RpbMapRedReq -> RpbMapRedReq -> Bool
< :: RpbMapRedReq -> RpbMapRedReq -> Bool
$c< :: RpbMapRedReq -> RpbMapRedReq -> Bool
compare :: RpbMapRedReq -> RpbMapRedReq -> Ordering
$ccompare :: RpbMapRedReq -> RpbMapRedReq -> Ordering
$cp1Ord :: Eq RpbMapRedReq
Prelude.Ord)
instance Prelude.Show RpbMapRedReq where
  showsPrec :: Int -> RpbMapRedReq -> ShowS
showsPrec Int
_ RpbMapRedReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbMapRedReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbMapRedReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbMapRedReq "request" Data.ByteString.ByteString where
  fieldOf :: Proxy# "request"
-> (ByteString -> f ByteString) -> RpbMapRedReq -> f RpbMapRedReq
fieldOf Proxy# "request"
_
    = ((ByteString -> f ByteString) -> RpbMapRedReq -> f RpbMapRedReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbMapRedReq
-> f RpbMapRedReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedReq -> ByteString)
-> (RpbMapRedReq -> ByteString -> RpbMapRedReq)
-> Lens RpbMapRedReq RpbMapRedReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedReq -> ByteString
_RpbMapRedReq'request
           (\ RpbMapRedReq
x__ ByteString
y__ -> RpbMapRedReq
x__ {_RpbMapRedReq'request :: ByteString
_RpbMapRedReq'request = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbMapRedReq "contentType" Data.ByteString.ByteString where
  fieldOf :: Proxy# "contentType"
-> (ByteString -> f ByteString) -> RpbMapRedReq -> f RpbMapRedReq
fieldOf Proxy# "contentType"
_
    = ((ByteString -> f ByteString) -> RpbMapRedReq -> f RpbMapRedReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbMapRedReq
-> f RpbMapRedReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedReq -> ByteString)
-> (RpbMapRedReq -> ByteString -> RpbMapRedReq)
-> Lens RpbMapRedReq RpbMapRedReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedReq -> ByteString
_RpbMapRedReq'contentType
           (\ RpbMapRedReq
x__ ByteString
y__ -> RpbMapRedReq
x__ {_RpbMapRedReq'contentType :: ByteString
_RpbMapRedReq'contentType = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbMapRedReq where
  messageName :: Proxy RpbMapRedReq -> Text
messageName Proxy RpbMapRedReq
_ = String -> Text
Data.Text.pack String
"RpbMapRedReq"
  packedMessageDescriptor :: Proxy RpbMapRedReq -> ByteString
packedMessageDescriptor Proxy RpbMapRedReq
_
    = ByteString
"\n\
      \\fRpbMapRedReq\DC2\CAN\n\
      \\arequest\CAN\SOH \STX(\fR\arequest\DC2!\n\
      \\fcontent_type\CAN\STX \STX(\fR\vcontentType"
  packedFileDescriptor :: Proxy RpbMapRedReq -> ByteString
packedFileDescriptor Proxy RpbMapRedReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbMapRedReq)
fieldsByTag
    = let
        request__field_descriptor :: FieldDescriptor RpbMapRedReq
request__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbMapRedReq ByteString
-> FieldDescriptor RpbMapRedReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"request"
              (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 RpbMapRedReq RpbMapRedReq ByteString ByteString
-> FieldAccessor RpbMapRedReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "request" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"request")) ::
              Data.ProtoLens.FieldDescriptor RpbMapRedReq
        contentType__field_descriptor :: FieldDescriptor RpbMapRedReq
contentType__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbMapRedReq ByteString
-> FieldDescriptor RpbMapRedReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"content_type"
              (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 RpbMapRedReq RpbMapRedReq ByteString ByteString
-> FieldAccessor RpbMapRedReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "contentType" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"contentType")) ::
              Data.ProtoLens.FieldDescriptor RpbMapRedReq
      in
        [(Tag, FieldDescriptor RpbMapRedReq)]
-> Map Tag (FieldDescriptor RpbMapRedReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbMapRedReq
request__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbMapRedReq
contentType__field_descriptor)]
  unknownFields :: LensLike' f RpbMapRedReq FieldSet
unknownFields
    = (RpbMapRedReq -> FieldSet)
-> (RpbMapRedReq -> FieldSet -> RpbMapRedReq)
-> Lens' RpbMapRedReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbMapRedReq -> FieldSet
_RpbMapRedReq'_unknownFields
        (\ RpbMapRedReq
x__ FieldSet
y__ -> RpbMapRedReq
x__ {_RpbMapRedReq'_unknownFields :: FieldSet
_RpbMapRedReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbMapRedReq
defMessage
    = RpbMapRedReq'_constructor :: ByteString -> ByteString -> FieldSet -> RpbMapRedReq
RpbMapRedReq'_constructor
        {_RpbMapRedReq'request :: ByteString
_RpbMapRedReq'request = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbMapRedReq'contentType :: ByteString
_RpbMapRedReq'contentType = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbMapRedReq'_unknownFields :: FieldSet
_RpbMapRedReq'_unknownFields = []}
  parseMessage :: Parser RpbMapRedReq
parseMessage
    = let
        loop ::
          RpbMapRedReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbMapRedReq
        loop :: RpbMapRedReq -> Bool -> Bool -> Parser RpbMapRedReq
loop RpbMapRedReq
x Bool
required'contentType Bool
required'request
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'contentType then (:) String
"content_type" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'request then (:) String
"request" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbMapRedReq -> Parser RpbMapRedReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbMapRedReq RpbMapRedReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbMapRedReq -> RpbMapRedReq
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 RpbMapRedReq RpbMapRedReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbMapRedReq
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
"request"
                                RpbMapRedReq -> Bool -> Bool -> Parser RpbMapRedReq
loop
                                  (Setter RpbMapRedReq RpbMapRedReq ByteString ByteString
-> ByteString -> RpbMapRedReq -> RpbMapRedReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "request" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"request") ByteString
y RpbMapRedReq
x)
                                  Bool
required'contentType
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"content_type"
                                RpbMapRedReq -> Bool -> Bool -> Parser RpbMapRedReq
loop
                                  (Setter RpbMapRedReq RpbMapRedReq ByteString ByteString
-> ByteString -> RpbMapRedReq -> RpbMapRedReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "contentType" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"contentType") ByteString
y RpbMapRedReq
x)
                                  Bool
Prelude.False
                                  Bool
required'request
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbMapRedReq -> Bool -> Bool -> Parser RpbMapRedReq
loop
                                  (Setter RpbMapRedReq RpbMapRedReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbMapRedReq -> RpbMapRedReq
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 RpbMapRedReq RpbMapRedReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbMapRedReq
x)
                                  Bool
required'contentType
                                  Bool
required'request
      in
        Parser RpbMapRedReq -> String -> Parser RpbMapRedReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbMapRedReq -> Bool -> Bool -> Parser RpbMapRedReq
loop RpbMapRedReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbMapRedReq"
  buildMessage :: RpbMapRedReq -> Builder
buildMessage
    = \ RpbMapRedReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbMapRedReq RpbMapRedReq ByteString ByteString
-> RpbMapRedReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "request" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"request") RpbMapRedReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike ByteString RpbMapRedReq RpbMapRedReq ByteString ByteString
-> RpbMapRedReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                         (forall s a (f :: * -> *).
(HasField s "contentType" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"contentType") RpbMapRedReq
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet RpbMapRedReq RpbMapRedReq FieldSet FieldSet
-> RpbMapRedReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbMapRedReq RpbMapRedReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbMapRedReq
_x)))
instance Control.DeepSeq.NFData RpbMapRedReq where
  rnf :: RpbMapRedReq -> ()
rnf
    = \ RpbMapRedReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbMapRedReq -> FieldSet
_RpbMapRedReq'_unknownFields RpbMapRedReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbMapRedReq -> ByteString
_RpbMapRedReq'request RpbMapRedReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbMapRedReq -> ByteString
_RpbMapRedReq'contentType RpbMapRedReq
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.phase' @:: Lens' RpbMapRedResp Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'phase' @:: Lens' RpbMapRedResp (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.response' @:: Lens' RpbMapRedResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'response' @:: Lens' RpbMapRedResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.done' @:: Lens' RpbMapRedResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' RpbMapRedResp (Prelude.Maybe Prelude.Bool)@ -}
data RpbMapRedResp
  = RpbMapRedResp'_constructor {RpbMapRedResp -> Maybe Word32
_RpbMapRedResp'phase :: !(Prelude.Maybe Data.Word.Word32),
                                RpbMapRedResp -> Maybe ByteString
_RpbMapRedResp'response :: !(Prelude.Maybe Data.ByteString.ByteString),
                                RpbMapRedResp -> Maybe Bool
_RpbMapRedResp'done :: !(Prelude.Maybe Prelude.Bool),
                                RpbMapRedResp -> FieldSet
_RpbMapRedResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbMapRedResp -> RpbMapRedResp -> Bool
(RpbMapRedResp -> RpbMapRedResp -> Bool)
-> (RpbMapRedResp -> RpbMapRedResp -> Bool) -> Eq RpbMapRedResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbMapRedResp -> RpbMapRedResp -> Bool
$c/= :: RpbMapRedResp -> RpbMapRedResp -> Bool
== :: RpbMapRedResp -> RpbMapRedResp -> Bool
$c== :: RpbMapRedResp -> RpbMapRedResp -> Bool
Prelude.Eq, Eq RpbMapRedResp
Eq RpbMapRedResp
-> (RpbMapRedResp -> RpbMapRedResp -> Ordering)
-> (RpbMapRedResp -> RpbMapRedResp -> Bool)
-> (RpbMapRedResp -> RpbMapRedResp -> Bool)
-> (RpbMapRedResp -> RpbMapRedResp -> Bool)
-> (RpbMapRedResp -> RpbMapRedResp -> Bool)
-> (RpbMapRedResp -> RpbMapRedResp -> RpbMapRedResp)
-> (RpbMapRedResp -> RpbMapRedResp -> RpbMapRedResp)
-> Ord RpbMapRedResp
RpbMapRedResp -> RpbMapRedResp -> Bool
RpbMapRedResp -> RpbMapRedResp -> Ordering
RpbMapRedResp -> RpbMapRedResp -> RpbMapRedResp
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 :: RpbMapRedResp -> RpbMapRedResp -> RpbMapRedResp
$cmin :: RpbMapRedResp -> RpbMapRedResp -> RpbMapRedResp
max :: RpbMapRedResp -> RpbMapRedResp -> RpbMapRedResp
$cmax :: RpbMapRedResp -> RpbMapRedResp -> RpbMapRedResp
>= :: RpbMapRedResp -> RpbMapRedResp -> Bool
$c>= :: RpbMapRedResp -> RpbMapRedResp -> Bool
> :: RpbMapRedResp -> RpbMapRedResp -> Bool
$c> :: RpbMapRedResp -> RpbMapRedResp -> Bool
<= :: RpbMapRedResp -> RpbMapRedResp -> Bool
$c<= :: RpbMapRedResp -> RpbMapRedResp -> Bool
< :: RpbMapRedResp -> RpbMapRedResp -> Bool
$c< :: RpbMapRedResp -> RpbMapRedResp -> Bool
compare :: RpbMapRedResp -> RpbMapRedResp -> Ordering
$ccompare :: RpbMapRedResp -> RpbMapRedResp -> Ordering
$cp1Ord :: Eq RpbMapRedResp
Prelude.Ord)
instance Prelude.Show RpbMapRedResp where
  showsPrec :: Int -> RpbMapRedResp -> ShowS
showsPrec Int
_ RpbMapRedResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbMapRedResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbMapRedResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbMapRedResp "phase" Data.Word.Word32 where
  fieldOf :: Proxy# "phase"
-> (Word32 -> f Word32) -> RpbMapRedResp -> f RpbMapRedResp
fieldOf Proxy# "phase"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbMapRedResp -> f RpbMapRedResp)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbMapRedResp
-> f RpbMapRedResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedResp -> Maybe Word32)
-> (RpbMapRedResp -> Maybe Word32 -> RpbMapRedResp)
-> Lens RpbMapRedResp RpbMapRedResp (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedResp -> Maybe Word32
_RpbMapRedResp'phase
           (\ RpbMapRedResp
x__ Maybe Word32
y__ -> RpbMapRedResp
x__ {_RpbMapRedResp'phase :: Maybe Word32
_RpbMapRedResp'phase = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbMapRedResp "maybe'phase" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'phase"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbMapRedResp
-> f RpbMapRedResp
fieldOf Proxy# "maybe'phase"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbMapRedResp -> f RpbMapRedResp)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbMapRedResp
-> f RpbMapRedResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedResp -> Maybe Word32)
-> (RpbMapRedResp -> Maybe Word32 -> RpbMapRedResp)
-> Lens RpbMapRedResp RpbMapRedResp (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedResp -> Maybe Word32
_RpbMapRedResp'phase
           (\ RpbMapRedResp
x__ Maybe Word32
y__ -> RpbMapRedResp
x__ {_RpbMapRedResp'phase :: Maybe Word32
_RpbMapRedResp'phase = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbMapRedResp "response" Data.ByteString.ByteString where
  fieldOf :: Proxy# "response"
-> (ByteString -> f ByteString) -> RpbMapRedResp -> f RpbMapRedResp
fieldOf Proxy# "response"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbMapRedResp -> f RpbMapRedResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbMapRedResp
-> f RpbMapRedResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedResp -> Maybe ByteString)
-> (RpbMapRedResp -> Maybe ByteString -> RpbMapRedResp)
-> Lens
     RpbMapRedResp RpbMapRedResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedResp -> Maybe ByteString
_RpbMapRedResp'response
           (\ RpbMapRedResp
x__ Maybe ByteString
y__ -> RpbMapRedResp
x__ {_RpbMapRedResp'response :: Maybe ByteString
_RpbMapRedResp'response = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbMapRedResp "maybe'response" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'response"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbMapRedResp
-> f RpbMapRedResp
fieldOf Proxy# "maybe'response"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbMapRedResp -> f RpbMapRedResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbMapRedResp
-> f RpbMapRedResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedResp -> Maybe ByteString)
-> (RpbMapRedResp -> Maybe ByteString -> RpbMapRedResp)
-> Lens
     RpbMapRedResp RpbMapRedResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedResp -> Maybe ByteString
_RpbMapRedResp'response
           (\ RpbMapRedResp
x__ Maybe ByteString
y__ -> RpbMapRedResp
x__ {_RpbMapRedResp'response :: Maybe ByteString
_RpbMapRedResp'response = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbMapRedResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done"
-> (Bool -> f Bool) -> RpbMapRedResp -> f RpbMapRedResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbMapRedResp -> f RpbMapRedResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbMapRedResp
-> f RpbMapRedResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedResp -> Maybe Bool)
-> (RpbMapRedResp -> Maybe Bool -> RpbMapRedResp)
-> Lens RpbMapRedResp RpbMapRedResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedResp -> Maybe Bool
_RpbMapRedResp'done (\ RpbMapRedResp
x__ Maybe Bool
y__ -> RpbMapRedResp
x__ {_RpbMapRedResp'done :: Maybe Bool
_RpbMapRedResp'done = 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 RpbMapRedResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool))
-> RpbMapRedResp
-> f RpbMapRedResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> RpbMapRedResp -> f RpbMapRedResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbMapRedResp
-> f RpbMapRedResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbMapRedResp -> Maybe Bool)
-> (RpbMapRedResp -> Maybe Bool -> RpbMapRedResp)
-> Lens RpbMapRedResp RpbMapRedResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbMapRedResp -> Maybe Bool
_RpbMapRedResp'done (\ RpbMapRedResp
x__ Maybe Bool
y__ -> RpbMapRedResp
x__ {_RpbMapRedResp'done :: Maybe Bool
_RpbMapRedResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbMapRedResp where
  messageName :: Proxy RpbMapRedResp -> Text
messageName Proxy RpbMapRedResp
_ = String -> Text
Data.Text.pack String
"RpbMapRedResp"
  packedMessageDescriptor :: Proxy RpbMapRedResp -> ByteString
packedMessageDescriptor Proxy RpbMapRedResp
_
    = ByteString
"\n\
      \\rRpbMapRedResp\DC2\DC4\n\
      \\ENQphase\CAN\SOH \SOH(\rR\ENQphase\DC2\SUB\n\
      \\bresponse\CAN\STX \SOH(\fR\bresponse\DC2\DC2\n\
      \\EOTdone\CAN\ETX \SOH(\bR\EOTdone"
  packedFileDescriptor :: Proxy RpbMapRedResp -> ByteString
packedFileDescriptor Proxy RpbMapRedResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbMapRedResp)
fieldsByTag
    = let
        phase__field_descriptor :: FieldDescriptor RpbMapRedResp
phase__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbMapRedResp Word32
-> FieldDescriptor RpbMapRedResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"phase"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbMapRedResp RpbMapRedResp (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbMapRedResp Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'phase" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'phase")) ::
              Data.ProtoLens.FieldDescriptor RpbMapRedResp
        response__field_descriptor :: FieldDescriptor RpbMapRedResp
response__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbMapRedResp ByteString
-> FieldDescriptor RpbMapRedResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"response"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbMapRedResp RpbMapRedResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbMapRedResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'response" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'response")) ::
              Data.ProtoLens.FieldDescriptor RpbMapRedResp
        done__field_descriptor :: FieldDescriptor RpbMapRedResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbMapRedResp Bool
-> FieldDescriptor RpbMapRedResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbMapRedResp RpbMapRedResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbMapRedResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor RpbMapRedResp
      in
        [(Tag, FieldDescriptor RpbMapRedResp)]
-> Map Tag (FieldDescriptor RpbMapRedResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbMapRedResp
phase__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbMapRedResp
response__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbMapRedResp
done__field_descriptor)]
  unknownFields :: LensLike' f RpbMapRedResp FieldSet
unknownFields
    = (RpbMapRedResp -> FieldSet)
-> (RpbMapRedResp -> FieldSet -> RpbMapRedResp)
-> Lens' RpbMapRedResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbMapRedResp -> FieldSet
_RpbMapRedResp'_unknownFields
        (\ RpbMapRedResp
x__ FieldSet
y__ -> RpbMapRedResp
x__ {_RpbMapRedResp'_unknownFields :: FieldSet
_RpbMapRedResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbMapRedResp
defMessage
    = RpbMapRedResp'_constructor :: Maybe Word32
-> Maybe ByteString -> Maybe Bool -> FieldSet -> RpbMapRedResp
RpbMapRedResp'_constructor
        {_RpbMapRedResp'phase :: Maybe Word32
_RpbMapRedResp'phase = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbMapRedResp'response :: Maybe ByteString
_RpbMapRedResp'response = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbMapRedResp'done :: Maybe Bool
_RpbMapRedResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbMapRedResp'_unknownFields :: FieldSet
_RpbMapRedResp'_unknownFields = []}
  parseMessage :: Parser RpbMapRedResp
parseMessage
    = let
        loop ::
          RpbMapRedResp -> Data.ProtoLens.Encoding.Bytes.Parser RpbMapRedResp
        loop :: RpbMapRedResp -> Parser RpbMapRedResp
loop RpbMapRedResp
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]))))
                      RpbMapRedResp -> Parser RpbMapRedResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbMapRedResp RpbMapRedResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbMapRedResp -> RpbMapRedResp
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 RpbMapRedResp RpbMapRedResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbMapRedResp
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
"phase"
                                RpbMapRedResp -> Parser RpbMapRedResp
loop (Setter RpbMapRedResp RpbMapRedResp Word32 Word32
-> Word32 -> RpbMapRedResp -> RpbMapRedResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "phase" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"phase") Word32
y RpbMapRedResp
x)
                        Word64
18
                          -> 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
"response"
                                RpbMapRedResp -> Parser RpbMapRedResp
loop
                                  (Setter RpbMapRedResp RpbMapRedResp ByteString ByteString
-> ByteString -> RpbMapRedResp -> RpbMapRedResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "response" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"response") ByteString
y RpbMapRedResp
x)
                        Word64
24
                          -> 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
"done"
                                RpbMapRedResp -> Parser RpbMapRedResp
loop (Setter RpbMapRedResp RpbMapRedResp Bool Bool
-> Bool -> RpbMapRedResp -> RpbMapRedResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y RpbMapRedResp
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbMapRedResp -> Parser RpbMapRedResp
loop
                                  (Setter RpbMapRedResp RpbMapRedResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbMapRedResp -> RpbMapRedResp
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 RpbMapRedResp RpbMapRedResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbMapRedResp
x)
      in
        Parser RpbMapRedResp -> String -> Parser RpbMapRedResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbMapRedResp -> Parser RpbMapRedResp
loop RpbMapRedResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbMapRedResp"
  buildMessage :: RpbMapRedResp -> Builder
buildMessage
    = \ RpbMapRedResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe Word32)
  RpbMapRedResp
  RpbMapRedResp
  (Maybe Word32)
  (Maybe Word32)
-> RpbMapRedResp -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'phase" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'phase") RpbMapRedResp
_x
              of
                Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just Word32
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbMapRedResp
  RpbMapRedResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbMapRedResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'response" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'response") RpbMapRedResp
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Bool) RpbMapRedResp RpbMapRedResp (Maybe Bool) (Maybe Bool)
-> RpbMapRedResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") RpbMapRedResp
_x
                    of
                      Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Bool
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike FieldSet RpbMapRedResp RpbMapRedResp FieldSet FieldSet
-> RpbMapRedResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbMapRedResp RpbMapRedResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbMapRedResp
_x))))
instance Control.DeepSeq.NFData RpbMapRedResp where
  rnf :: RpbMapRedResp -> ()
rnf
    = \ RpbMapRedResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbMapRedResp -> FieldSet
_RpbMapRedResp'_unknownFields RpbMapRedResp
x__)
             (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbMapRedResp -> Maybe Word32
_RpbMapRedResp'phase RpbMapRedResp
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbMapRedResp -> Maybe ByteString
_RpbMapRedResp'response RpbMapRedResp
x__)
                   (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbMapRedResp -> Maybe Bool
_RpbMapRedResp'done RpbMapRedResp
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.module'' @:: Lens' RpbModFun Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.function' @:: Lens' RpbModFun Data.ByteString.ByteString@ -}
data RpbModFun
  = RpbModFun'_constructor {RpbModFun -> ByteString
_RpbModFun'module' :: !Data.ByteString.ByteString,
                            RpbModFun -> ByteString
_RpbModFun'function :: !Data.ByteString.ByteString,
                            RpbModFun -> FieldSet
_RpbModFun'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbModFun -> RpbModFun -> Bool
(RpbModFun -> RpbModFun -> Bool)
-> (RpbModFun -> RpbModFun -> Bool) -> Eq RpbModFun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbModFun -> RpbModFun -> Bool
$c/= :: RpbModFun -> RpbModFun -> Bool
== :: RpbModFun -> RpbModFun -> Bool
$c== :: RpbModFun -> RpbModFun -> Bool
Prelude.Eq, Eq RpbModFun
Eq RpbModFun
-> (RpbModFun -> RpbModFun -> Ordering)
-> (RpbModFun -> RpbModFun -> Bool)
-> (RpbModFun -> RpbModFun -> Bool)
-> (RpbModFun -> RpbModFun -> Bool)
-> (RpbModFun -> RpbModFun -> Bool)
-> (RpbModFun -> RpbModFun -> RpbModFun)
-> (RpbModFun -> RpbModFun -> RpbModFun)
-> Ord RpbModFun
RpbModFun -> RpbModFun -> Bool
RpbModFun -> RpbModFun -> Ordering
RpbModFun -> RpbModFun -> RpbModFun
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 :: RpbModFun -> RpbModFun -> RpbModFun
$cmin :: RpbModFun -> RpbModFun -> RpbModFun
max :: RpbModFun -> RpbModFun -> RpbModFun
$cmax :: RpbModFun -> RpbModFun -> RpbModFun
>= :: RpbModFun -> RpbModFun -> Bool
$c>= :: RpbModFun -> RpbModFun -> Bool
> :: RpbModFun -> RpbModFun -> Bool
$c> :: RpbModFun -> RpbModFun -> Bool
<= :: RpbModFun -> RpbModFun -> Bool
$c<= :: RpbModFun -> RpbModFun -> Bool
< :: RpbModFun -> RpbModFun -> Bool
$c< :: RpbModFun -> RpbModFun -> Bool
compare :: RpbModFun -> RpbModFun -> Ordering
$ccompare :: RpbModFun -> RpbModFun -> Ordering
$cp1Ord :: Eq RpbModFun
Prelude.Ord)
instance Prelude.Show RpbModFun where
  showsPrec :: Int -> RpbModFun -> ShowS
showsPrec Int
_ RpbModFun
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbModFun -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbModFun
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbModFun "module'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "module'"
-> (ByteString -> f ByteString) -> RpbModFun -> f RpbModFun
fieldOf Proxy# "module'"
_
    = ((ByteString -> f ByteString) -> RpbModFun -> f RpbModFun)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbModFun
-> f RpbModFun
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbModFun -> ByteString)
-> (RpbModFun -> ByteString -> RpbModFun)
-> Lens RpbModFun RpbModFun ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbModFun -> ByteString
_RpbModFun'module' (\ RpbModFun
x__ ByteString
y__ -> RpbModFun
x__ {_RpbModFun'module' :: ByteString
_RpbModFun'module' = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbModFun "function" Data.ByteString.ByteString where
  fieldOf :: Proxy# "function"
-> (ByteString -> f ByteString) -> RpbModFun -> f RpbModFun
fieldOf Proxy# "function"
_
    = ((ByteString -> f ByteString) -> RpbModFun -> f RpbModFun)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbModFun
-> f RpbModFun
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbModFun -> ByteString)
-> (RpbModFun -> ByteString -> RpbModFun)
-> Lens RpbModFun RpbModFun ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbModFun -> ByteString
_RpbModFun'function (\ RpbModFun
x__ ByteString
y__ -> RpbModFun
x__ {_RpbModFun'function :: ByteString
_RpbModFun'function = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbModFun where
  messageName :: Proxy RpbModFun -> Text
messageName Proxy RpbModFun
_ = String -> Text
Data.Text.pack String
"RpbModFun"
  packedMessageDescriptor :: Proxy RpbModFun -> ByteString
packedMessageDescriptor Proxy RpbModFun
_
    = ByteString
"\n\
      \\tRpbModFun\DC2\SYN\n\
      \\ACKmodule\CAN\SOH \STX(\fR\ACKmodule\DC2\SUB\n\
      \\bfunction\CAN\STX \STX(\fR\bfunction"
  packedFileDescriptor :: Proxy RpbModFun -> ByteString
packedFileDescriptor Proxy RpbModFun
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbModFun)
fieldsByTag
    = let
        module'__field_descriptor :: FieldDescriptor RpbModFun
module'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbModFun ByteString
-> FieldDescriptor RpbModFun
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"module"
              (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 RpbModFun RpbModFun ByteString ByteString
-> FieldAccessor RpbModFun ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "module'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"module'")) ::
              Data.ProtoLens.FieldDescriptor RpbModFun
        function__field_descriptor :: FieldDescriptor RpbModFun
function__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbModFun ByteString
-> FieldDescriptor RpbModFun
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"function"
              (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 RpbModFun RpbModFun ByteString ByteString
-> FieldAccessor RpbModFun ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "function" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"function")) ::
              Data.ProtoLens.FieldDescriptor RpbModFun
      in
        [(Tag, FieldDescriptor RpbModFun)]
-> Map Tag (FieldDescriptor RpbModFun)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbModFun
module'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbModFun
function__field_descriptor)]
  unknownFields :: LensLike' f RpbModFun FieldSet
unknownFields
    = (RpbModFun -> FieldSet)
-> (RpbModFun -> FieldSet -> RpbModFun) -> Lens' RpbModFun FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbModFun -> FieldSet
_RpbModFun'_unknownFields
        (\ RpbModFun
x__ FieldSet
y__ -> RpbModFun
x__ {_RpbModFun'_unknownFields :: FieldSet
_RpbModFun'_unknownFields = FieldSet
y__})
  defMessage :: RpbModFun
defMessage
    = RpbModFun'_constructor :: ByteString -> ByteString -> FieldSet -> RpbModFun
RpbModFun'_constructor
        {_RpbModFun'module' :: ByteString
_RpbModFun'module' = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbModFun'function :: ByteString
_RpbModFun'function = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbModFun'_unknownFields :: FieldSet
_RpbModFun'_unknownFields = []}
  parseMessage :: Parser RpbModFun
parseMessage
    = let
        loop ::
          RpbModFun
          -> Prelude.Bool
             -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser RpbModFun
        loop :: RpbModFun -> Bool -> Bool -> Parser RpbModFun
loop RpbModFun
x Bool
required'function Bool
required'module'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'function then (:) String
"function" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'module' then (:) String
"module" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbModFun -> Parser RpbModFun
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbModFun RpbModFun FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbModFun -> RpbModFun
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 RpbModFun RpbModFun FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbModFun
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
"module"
                                RpbModFun -> Bool -> Bool -> Parser RpbModFun
loop
                                  (Setter RpbModFun RpbModFun ByteString ByteString
-> ByteString -> RpbModFun -> RpbModFun
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "module'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"module'") ByteString
y RpbModFun
x)
                                  Bool
required'function
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"function"
                                RpbModFun -> Bool -> Bool -> Parser RpbModFun
loop
                                  (Setter RpbModFun RpbModFun ByteString ByteString
-> ByteString -> RpbModFun -> RpbModFun
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "function" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"function") ByteString
y RpbModFun
x)
                                  Bool
Prelude.False
                                  Bool
required'module'
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbModFun -> Bool -> Bool -> Parser RpbModFun
loop
                                  (Setter RpbModFun RpbModFun FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbModFun -> RpbModFun
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 RpbModFun RpbModFun FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbModFun
x)
                                  Bool
required'function
                                  Bool
required'module'
      in
        Parser RpbModFun -> String -> Parser RpbModFun
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbModFun -> Bool -> Bool -> Parser RpbModFun
loop RpbModFun
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbModFun"
  buildMessage :: RpbModFun -> Builder
buildMessage
    = \ RpbModFun
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbModFun RpbModFun ByteString ByteString
-> RpbModFun -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "module'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"module'") RpbModFun
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike ByteString RpbModFun RpbModFun ByteString ByteString
-> RpbModFun -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "function" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"function") RpbModFun
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet RpbModFun RpbModFun FieldSet FieldSet
-> RpbModFun -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbModFun RpbModFun FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbModFun
_x)))
instance Control.DeepSeq.NFData RpbModFun where
  rnf :: RpbModFun -> ()
rnf
    = \ RpbModFun
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbModFun -> FieldSet
_RpbModFun'_unknownFields RpbModFun
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbModFun -> ByteString
_RpbModFun'module' RpbModFun
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbModFun -> ByteString
_RpbModFun'function RpbModFun
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.key' @:: Lens' RpbPair Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.value' @:: Lens' RpbPair Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'value' @:: Lens' RpbPair (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbPair
  = RpbPair'_constructor {RpbPair -> ByteString
_RpbPair'key :: !Data.ByteString.ByteString,
                          RpbPair -> Maybe ByteString
_RpbPair'value :: !(Prelude.Maybe Data.ByteString.ByteString),
                          RpbPair -> FieldSet
_RpbPair'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbPair -> RpbPair -> Bool
(RpbPair -> RpbPair -> Bool)
-> (RpbPair -> RpbPair -> Bool) -> Eq RpbPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbPair -> RpbPair -> Bool
$c/= :: RpbPair -> RpbPair -> Bool
== :: RpbPair -> RpbPair -> Bool
$c== :: RpbPair -> RpbPair -> Bool
Prelude.Eq, Eq RpbPair
Eq RpbPair
-> (RpbPair -> RpbPair -> Ordering)
-> (RpbPair -> RpbPair -> Bool)
-> (RpbPair -> RpbPair -> Bool)
-> (RpbPair -> RpbPair -> Bool)
-> (RpbPair -> RpbPair -> Bool)
-> (RpbPair -> RpbPair -> RpbPair)
-> (RpbPair -> RpbPair -> RpbPair)
-> Ord RpbPair
RpbPair -> RpbPair -> Bool
RpbPair -> RpbPair -> Ordering
RpbPair -> RpbPair -> RpbPair
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 :: RpbPair -> RpbPair -> RpbPair
$cmin :: RpbPair -> RpbPair -> RpbPair
max :: RpbPair -> RpbPair -> RpbPair
$cmax :: RpbPair -> RpbPair -> RpbPair
>= :: RpbPair -> RpbPair -> Bool
$c>= :: RpbPair -> RpbPair -> Bool
> :: RpbPair -> RpbPair -> Bool
$c> :: RpbPair -> RpbPair -> Bool
<= :: RpbPair -> RpbPair -> Bool
$c<= :: RpbPair -> RpbPair -> Bool
< :: RpbPair -> RpbPair -> Bool
$c< :: RpbPair -> RpbPair -> Bool
compare :: RpbPair -> RpbPair -> Ordering
$ccompare :: RpbPair -> RpbPair -> Ordering
$cp1Ord :: Eq RpbPair
Prelude.Ord)
instance Prelude.Show RpbPair where
  showsPrec :: Int -> RpbPair -> ShowS
showsPrec Int
_ RpbPair
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbPair -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbPair
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbPair "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> RpbPair -> f RpbPair
fieldOf Proxy# "key"
_
    = ((ByteString -> f ByteString) -> RpbPair -> f RpbPair)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbPair
-> f RpbPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPair -> ByteString)
-> (RpbPair -> ByteString -> RpbPair)
-> Lens RpbPair RpbPair ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPair -> ByteString
_RpbPair'key (\ RpbPair
x__ ByteString
y__ -> RpbPair
x__ {_RpbPair'key :: ByteString
_RpbPair'key = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPair "value" Data.ByteString.ByteString where
  fieldOf :: Proxy# "value"
-> (ByteString -> f ByteString) -> RpbPair -> f RpbPair
fieldOf Proxy# "value"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPair -> f RpbPair)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbPair
-> f RpbPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPair -> Maybe ByteString)
-> (RpbPair -> Maybe ByteString -> RpbPair)
-> Lens RpbPair RpbPair (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPair -> Maybe ByteString
_RpbPair'value (\ RpbPair
x__ Maybe ByteString
y__ -> RpbPair
x__ {_RpbPair'value :: Maybe ByteString
_RpbPair'value = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPair "maybe'value" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'value"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPair
-> f RpbPair
fieldOf Proxy# "maybe'value"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPair -> f RpbPair)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPair
-> f RpbPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPair -> Maybe ByteString)
-> (RpbPair -> Maybe ByteString -> RpbPair)
-> Lens RpbPair RpbPair (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPair -> Maybe ByteString
_RpbPair'value (\ RpbPair
x__ Maybe ByteString
y__ -> RpbPair
x__ {_RpbPair'value :: Maybe ByteString
_RpbPair'value = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbPair where
  messageName :: Proxy RpbPair -> Text
messageName Proxy RpbPair
_ = String -> Text
Data.Text.pack String
"RpbPair"
  packedMessageDescriptor :: Proxy RpbPair -> ByteString
packedMessageDescriptor Proxy RpbPair
_
    = ByteString
"\n\
      \\aRpbPair\DC2\DLE\n\
      \\ETXkey\CAN\SOH \STX(\fR\ETXkey\DC2\DC4\n\
      \\ENQvalue\CAN\STX \SOH(\fR\ENQvalue"
  packedFileDescriptor :: Proxy RpbPair -> ByteString
packedFileDescriptor Proxy RpbPair
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbPair)
fieldsByTag
    = let
        key__field_descriptor :: FieldDescriptor RpbPair
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPair ByteString
-> FieldDescriptor RpbPair
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (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 RpbPair RpbPair ByteString ByteString
-> FieldAccessor RpbPair ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor RpbPair
        value__field_descriptor :: FieldDescriptor RpbPair
value__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPair ByteString
-> FieldDescriptor RpbPair
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbPair RpbPair (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbPair ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value")) ::
              Data.ProtoLens.FieldDescriptor RpbPair
      in
        [(Tag, FieldDescriptor RpbPair)]
-> Map Tag (FieldDescriptor RpbPair)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbPair
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbPair
value__field_descriptor)]
  unknownFields :: LensLike' f RpbPair FieldSet
unknownFields
    = (RpbPair -> FieldSet)
-> (RpbPair -> FieldSet -> RpbPair) -> Lens' RpbPair FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbPair -> FieldSet
_RpbPair'_unknownFields
        (\ RpbPair
x__ FieldSet
y__ -> RpbPair
x__ {_RpbPair'_unknownFields :: FieldSet
_RpbPair'_unknownFields = FieldSet
y__})
  defMessage :: RpbPair
defMessage
    = RpbPair'_constructor :: ByteString -> Maybe ByteString -> FieldSet -> RpbPair
RpbPair'_constructor
        {_RpbPair'key :: ByteString
_RpbPair'key = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbPair'value :: Maybe ByteString
_RpbPair'value = Maybe ByteString
forall a. Maybe a
Prelude.Nothing, _RpbPair'_unknownFields :: FieldSet
_RpbPair'_unknownFields = []}
  parseMessage :: Parser RpbPair
parseMessage
    = let
        loop ::
          RpbPair
          -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser RpbPair
        loop :: RpbPair -> Bool -> Parser RpbPair
loop RpbPair
x Bool
required'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'key then (:) String
"key" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbPair -> Parser RpbPair
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbPair RpbPair FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPair -> RpbPair
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 RpbPair RpbPair FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbPair
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
"key"
                                RpbPair -> Bool -> Parser RpbPair
loop
                                  (Setter RpbPair RpbPair ByteString ByteString
-> ByteString -> RpbPair -> RpbPair
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbPair
x)
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"value"
                                RpbPair -> Bool -> Parser RpbPair
loop
                                  (Setter RpbPair RpbPair ByteString ByteString
-> ByteString -> RpbPair -> RpbPair
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") ByteString
y RpbPair
x)
                                  Bool
required'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbPair -> Bool -> Parser RpbPair
loop
                                  (Setter RpbPair RpbPair FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPair -> RpbPair
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 RpbPair RpbPair FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbPair
x)
                                  Bool
required'key
      in
        Parser RpbPair -> String -> Parser RpbPair
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbPair -> Bool -> Parser RpbPair
loop RpbPair
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"RpbPair"
  buildMessage :: RpbPair -> Builder
buildMessage
    = \ RpbPair
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbPair RpbPair ByteString ByteString
-> RpbPair -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") RpbPair
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbPair
  RpbPair
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbPair -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value") RpbPair
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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 RpbPair RpbPair FieldSet FieldSet
-> RpbPair -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbPair RpbPair FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbPair
_x)))
instance Control.DeepSeq.NFData RpbPair where
  rnf :: RpbPair -> ()
rnf
    = \ RpbPair
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbPair -> FieldSet
_RpbPair'_unknownFields RpbPair
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbPair -> ByteString
_RpbPair'key RpbPair
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbPair -> Maybe ByteString
_RpbPair'value RpbPair
x__) ()))
{- | Fields :
      -}
data RpbPingReq
  = RpbPingReq'_constructor {RpbPingReq -> FieldSet
_RpbPingReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbPingReq -> RpbPingReq -> Bool
(RpbPingReq -> RpbPingReq -> Bool)
-> (RpbPingReq -> RpbPingReq -> Bool) -> Eq RpbPingReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbPingReq -> RpbPingReq -> Bool
$c/= :: RpbPingReq -> RpbPingReq -> Bool
== :: RpbPingReq -> RpbPingReq -> Bool
$c== :: RpbPingReq -> RpbPingReq -> Bool
Prelude.Eq, Eq RpbPingReq
Eq RpbPingReq
-> (RpbPingReq -> RpbPingReq -> Ordering)
-> (RpbPingReq -> RpbPingReq -> Bool)
-> (RpbPingReq -> RpbPingReq -> Bool)
-> (RpbPingReq -> RpbPingReq -> Bool)
-> (RpbPingReq -> RpbPingReq -> Bool)
-> (RpbPingReq -> RpbPingReq -> RpbPingReq)
-> (RpbPingReq -> RpbPingReq -> RpbPingReq)
-> Ord RpbPingReq
RpbPingReq -> RpbPingReq -> Bool
RpbPingReq -> RpbPingReq -> Ordering
RpbPingReq -> RpbPingReq -> RpbPingReq
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 :: RpbPingReq -> RpbPingReq -> RpbPingReq
$cmin :: RpbPingReq -> RpbPingReq -> RpbPingReq
max :: RpbPingReq -> RpbPingReq -> RpbPingReq
$cmax :: RpbPingReq -> RpbPingReq -> RpbPingReq
>= :: RpbPingReq -> RpbPingReq -> Bool
$c>= :: RpbPingReq -> RpbPingReq -> Bool
> :: RpbPingReq -> RpbPingReq -> Bool
$c> :: RpbPingReq -> RpbPingReq -> Bool
<= :: RpbPingReq -> RpbPingReq -> Bool
$c<= :: RpbPingReq -> RpbPingReq -> Bool
< :: RpbPingReq -> RpbPingReq -> Bool
$c< :: RpbPingReq -> RpbPingReq -> Bool
compare :: RpbPingReq -> RpbPingReq -> Ordering
$ccompare :: RpbPingReq -> RpbPingReq -> Ordering
$cp1Ord :: Eq RpbPingReq
Prelude.Ord)
instance Prelude.Show RpbPingReq where
  showsPrec :: Int -> RpbPingReq -> ShowS
showsPrec Int
_ RpbPingReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbPingReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbPingReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbPingReq where
  messageName :: Proxy RpbPingReq -> Text
messageName Proxy RpbPingReq
_ = String -> Text
Data.Text.pack String
"RpbPingReq"
  packedMessageDescriptor :: Proxy RpbPingReq -> ByteString
packedMessageDescriptor Proxy RpbPingReq
_
    = ByteString
"\n\
      \\n\
      \RpbPingReq"
  packedFileDescriptor :: Proxy RpbPingReq -> ByteString
packedFileDescriptor Proxy RpbPingReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbPingReq)
fieldsByTag = let in [(Tag, FieldDescriptor RpbPingReq)]
-> Map Tag (FieldDescriptor RpbPingReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbPingReq FieldSet
unknownFields
    = (RpbPingReq -> FieldSet)
-> (RpbPingReq -> FieldSet -> RpbPingReq)
-> Lens' RpbPingReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbPingReq -> FieldSet
_RpbPingReq'_unknownFields
        (\ RpbPingReq
x__ FieldSet
y__ -> RpbPingReq
x__ {_RpbPingReq'_unknownFields :: FieldSet
_RpbPingReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbPingReq
defMessage
    = RpbPingReq'_constructor :: FieldSet -> RpbPingReq
RpbPingReq'_constructor {_RpbPingReq'_unknownFields :: FieldSet
_RpbPingReq'_unknownFields = []}
  parseMessage :: Parser RpbPingReq
parseMessage
    = let
        loop ::
          RpbPingReq -> Data.ProtoLens.Encoding.Bytes.Parser RpbPingReq
        loop :: RpbPingReq -> Parser RpbPingReq
loop RpbPingReq
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]))))
                      RpbPingReq -> Parser RpbPingReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbPingReq RpbPingReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPingReq -> RpbPingReq
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 RpbPingReq RpbPingReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbPingReq
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbPingReq -> Parser RpbPingReq
loop
                                  (Setter RpbPingReq RpbPingReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPingReq -> RpbPingReq
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 RpbPingReq RpbPingReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbPingReq
x) }
      in
        Parser RpbPingReq -> String -> Parser RpbPingReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbPingReq -> Parser RpbPingReq
loop RpbPingReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbPingReq"
  buildMessage :: RpbPingReq -> Builder
buildMessage
    = \ RpbPingReq
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike FieldSet RpbPingReq RpbPingReq FieldSet FieldSet
-> RpbPingReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbPingReq RpbPingReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbPingReq
_x)
instance Control.DeepSeq.NFData RpbPingReq where
  rnf :: RpbPingReq -> ()
rnf
    = \ RpbPingReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbPingReq -> FieldSet
_RpbPingReq'_unknownFields RpbPingReq
x__) ()
{- | Fields :
      -}
data RpbPingResp
  = RpbPingResp'_constructor {RpbPingResp -> FieldSet
_RpbPingResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbPingResp -> RpbPingResp -> Bool
(RpbPingResp -> RpbPingResp -> Bool)
-> (RpbPingResp -> RpbPingResp -> Bool) -> Eq RpbPingResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbPingResp -> RpbPingResp -> Bool
$c/= :: RpbPingResp -> RpbPingResp -> Bool
== :: RpbPingResp -> RpbPingResp -> Bool
$c== :: RpbPingResp -> RpbPingResp -> Bool
Prelude.Eq, Eq RpbPingResp
Eq RpbPingResp
-> (RpbPingResp -> RpbPingResp -> Ordering)
-> (RpbPingResp -> RpbPingResp -> Bool)
-> (RpbPingResp -> RpbPingResp -> Bool)
-> (RpbPingResp -> RpbPingResp -> Bool)
-> (RpbPingResp -> RpbPingResp -> Bool)
-> (RpbPingResp -> RpbPingResp -> RpbPingResp)
-> (RpbPingResp -> RpbPingResp -> RpbPingResp)
-> Ord RpbPingResp
RpbPingResp -> RpbPingResp -> Bool
RpbPingResp -> RpbPingResp -> Ordering
RpbPingResp -> RpbPingResp -> RpbPingResp
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 :: RpbPingResp -> RpbPingResp -> RpbPingResp
$cmin :: RpbPingResp -> RpbPingResp -> RpbPingResp
max :: RpbPingResp -> RpbPingResp -> RpbPingResp
$cmax :: RpbPingResp -> RpbPingResp -> RpbPingResp
>= :: RpbPingResp -> RpbPingResp -> Bool
$c>= :: RpbPingResp -> RpbPingResp -> Bool
> :: RpbPingResp -> RpbPingResp -> Bool
$c> :: RpbPingResp -> RpbPingResp -> Bool
<= :: RpbPingResp -> RpbPingResp -> Bool
$c<= :: RpbPingResp -> RpbPingResp -> Bool
< :: RpbPingResp -> RpbPingResp -> Bool
$c< :: RpbPingResp -> RpbPingResp -> Bool
compare :: RpbPingResp -> RpbPingResp -> Ordering
$ccompare :: RpbPingResp -> RpbPingResp -> Ordering
$cp1Ord :: Eq RpbPingResp
Prelude.Ord)
instance Prelude.Show RpbPingResp where
  showsPrec :: Int -> RpbPingResp -> ShowS
showsPrec Int
_ RpbPingResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbPingResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbPingResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbPingResp where
  messageName :: Proxy RpbPingResp -> Text
messageName Proxy RpbPingResp
_ = String -> Text
Data.Text.pack String
"RpbPingResp"
  packedMessageDescriptor :: Proxy RpbPingResp -> ByteString
packedMessageDescriptor Proxy RpbPingResp
_
    = ByteString
"\n\
      \\vRpbPingResp"
  packedFileDescriptor :: Proxy RpbPingResp -> ByteString
packedFileDescriptor Proxy RpbPingResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbPingResp)
fieldsByTag = let in [(Tag, FieldDescriptor RpbPingResp)]
-> Map Tag (FieldDescriptor RpbPingResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbPingResp FieldSet
unknownFields
    = (RpbPingResp -> FieldSet)
-> (RpbPingResp -> FieldSet -> RpbPingResp)
-> Lens' RpbPingResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbPingResp -> FieldSet
_RpbPingResp'_unknownFields
        (\ RpbPingResp
x__ FieldSet
y__ -> RpbPingResp
x__ {_RpbPingResp'_unknownFields :: FieldSet
_RpbPingResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbPingResp
defMessage
    = RpbPingResp'_constructor :: FieldSet -> RpbPingResp
RpbPingResp'_constructor {_RpbPingResp'_unknownFields :: FieldSet
_RpbPingResp'_unknownFields = []}
  parseMessage :: Parser RpbPingResp
parseMessage
    = let
        loop ::
          RpbPingResp -> Data.ProtoLens.Encoding.Bytes.Parser RpbPingResp
        loop :: RpbPingResp -> Parser RpbPingResp
loop RpbPingResp
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]))))
                      RpbPingResp -> Parser RpbPingResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbPingResp RpbPingResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPingResp -> RpbPingResp
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 RpbPingResp RpbPingResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbPingResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbPingResp -> Parser RpbPingResp
loop
                                  (Setter RpbPingResp RpbPingResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPingResp -> RpbPingResp
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 RpbPingResp RpbPingResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbPingResp
x) }
      in
        Parser RpbPingResp -> String -> Parser RpbPingResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbPingResp -> Parser RpbPingResp
loop RpbPingResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbPingResp"
  buildMessage :: RpbPingResp -> Builder
buildMessage
    = \ RpbPingResp
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike FieldSet RpbPingResp RpbPingResp FieldSet FieldSet
-> RpbPingResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbPingResp RpbPingResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbPingResp
_x)
instance Control.DeepSeq.NFData RpbPingResp where
  rnf :: RpbPingResp -> ()
rnf
    = \ RpbPingResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbPingResp -> FieldSet
_RpbPingResp'_unknownFields RpbPingResp
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbPutReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbPutReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'key' @:: Lens' RpbPutReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.vclock' @:: Lens' RpbPutReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'vclock' @:: Lens' RpbPutReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.content' @:: Lens' RpbPutReq RpbContent@
         * 'Proto.Riak_Fields.w' @:: Lens' RpbPutReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'w' @:: Lens' RpbPutReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.dw' @:: Lens' RpbPutReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'dw' @:: Lens' RpbPutReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.returnBody' @:: Lens' RpbPutReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'returnBody' @:: Lens' RpbPutReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.pw' @:: Lens' RpbPutReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'pw' @:: Lens' RpbPutReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.ifNotModified' @:: Lens' RpbPutReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'ifNotModified' @:: Lens' RpbPutReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.ifNoneMatch' @:: Lens' RpbPutReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'ifNoneMatch' @:: Lens' RpbPutReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.returnHead' @:: Lens' RpbPutReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'returnHead' @:: Lens' RpbPutReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbPutReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbPutReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.asis' @:: Lens' RpbPutReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'asis' @:: Lens' RpbPutReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.sloppyQuorum' @:: Lens' RpbPutReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'sloppyQuorum' @:: Lens' RpbPutReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.nVal' @:: Lens' RpbPutReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'nVal' @:: Lens' RpbPutReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbPutReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbPutReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbPutReq
  = RpbPutReq'_constructor {RpbPutReq -> ByteString
_RpbPutReq'bucket :: !Data.ByteString.ByteString,
                            RpbPutReq -> Maybe ByteString
_RpbPutReq'key :: !(Prelude.Maybe Data.ByteString.ByteString),
                            RpbPutReq -> Maybe ByteString
_RpbPutReq'vclock :: !(Prelude.Maybe Data.ByteString.ByteString),
                            RpbPutReq -> RpbContent
_RpbPutReq'content :: !RpbContent,
                            RpbPutReq -> Maybe Word32
_RpbPutReq'w :: !(Prelude.Maybe Data.Word.Word32),
                            RpbPutReq -> Maybe Word32
_RpbPutReq'dw :: !(Prelude.Maybe Data.Word.Word32),
                            RpbPutReq -> Maybe Bool
_RpbPutReq'returnBody :: !(Prelude.Maybe Prelude.Bool),
                            RpbPutReq -> Maybe Word32
_RpbPutReq'pw :: !(Prelude.Maybe Data.Word.Word32),
                            RpbPutReq -> Maybe Bool
_RpbPutReq'ifNotModified :: !(Prelude.Maybe Prelude.Bool),
                            RpbPutReq -> Maybe Bool
_RpbPutReq'ifNoneMatch :: !(Prelude.Maybe Prelude.Bool),
                            RpbPutReq -> Maybe Bool
_RpbPutReq'returnHead :: !(Prelude.Maybe Prelude.Bool),
                            RpbPutReq -> Maybe Word32
_RpbPutReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                            RpbPutReq -> Maybe Bool
_RpbPutReq'asis :: !(Prelude.Maybe Prelude.Bool),
                            RpbPutReq -> Maybe Bool
_RpbPutReq'sloppyQuorum :: !(Prelude.Maybe Prelude.Bool),
                            RpbPutReq -> Maybe Word32
_RpbPutReq'nVal :: !(Prelude.Maybe Data.Word.Word32),
                            RpbPutReq -> Maybe ByteString
_RpbPutReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                            RpbPutReq -> FieldSet
_RpbPutReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbPutReq -> RpbPutReq -> Bool
(RpbPutReq -> RpbPutReq -> Bool)
-> (RpbPutReq -> RpbPutReq -> Bool) -> Eq RpbPutReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbPutReq -> RpbPutReq -> Bool
$c/= :: RpbPutReq -> RpbPutReq -> Bool
== :: RpbPutReq -> RpbPutReq -> Bool
$c== :: RpbPutReq -> RpbPutReq -> Bool
Prelude.Eq, Eq RpbPutReq
Eq RpbPutReq
-> (RpbPutReq -> RpbPutReq -> Ordering)
-> (RpbPutReq -> RpbPutReq -> Bool)
-> (RpbPutReq -> RpbPutReq -> Bool)
-> (RpbPutReq -> RpbPutReq -> Bool)
-> (RpbPutReq -> RpbPutReq -> Bool)
-> (RpbPutReq -> RpbPutReq -> RpbPutReq)
-> (RpbPutReq -> RpbPutReq -> RpbPutReq)
-> Ord RpbPutReq
RpbPutReq -> RpbPutReq -> Bool
RpbPutReq -> RpbPutReq -> Ordering
RpbPutReq -> RpbPutReq -> RpbPutReq
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 :: RpbPutReq -> RpbPutReq -> RpbPutReq
$cmin :: RpbPutReq -> RpbPutReq -> RpbPutReq
max :: RpbPutReq -> RpbPutReq -> RpbPutReq
$cmax :: RpbPutReq -> RpbPutReq -> RpbPutReq
>= :: RpbPutReq -> RpbPutReq -> Bool
$c>= :: RpbPutReq -> RpbPutReq -> Bool
> :: RpbPutReq -> RpbPutReq -> Bool
$c> :: RpbPutReq -> RpbPutReq -> Bool
<= :: RpbPutReq -> RpbPutReq -> Bool
$c<= :: RpbPutReq -> RpbPutReq -> Bool
< :: RpbPutReq -> RpbPutReq -> Bool
$c< :: RpbPutReq -> RpbPutReq -> Bool
compare :: RpbPutReq -> RpbPutReq -> Ordering
$ccompare :: RpbPutReq -> RpbPutReq -> Ordering
$cp1Ord :: Eq RpbPutReq
Prelude.Ord)
instance Prelude.Show RpbPutReq where
  showsPrec :: Int -> RpbPutReq -> ShowS
showsPrec Int
_ RpbPutReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbPutReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbPutReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbPutReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString) -> RpbPutReq -> f RpbPutReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> ByteString)
-> (RpbPutReq -> ByteString -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> ByteString
_RpbPutReq'bucket (\ RpbPutReq
x__ ByteString
y__ -> RpbPutReq
x__ {_RpbPutReq'bucket :: ByteString
_RpbPutReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutReq -> f RpbPutReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe ByteString)
-> (RpbPutReq -> Maybe ByteString -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe ByteString
_RpbPutReq'key (\ RpbPutReq
x__ Maybe ByteString
y__ -> RpbPutReq
x__ {_RpbPutReq'key :: Maybe ByteString
_RpbPutReq'key = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'key" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'key"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutReq
-> f RpbPutReq
fieldOf Proxy# "maybe'key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutReq -> f RpbPutReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe ByteString)
-> (RpbPutReq -> Maybe ByteString -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe ByteString
_RpbPutReq'key (\ RpbPutReq
x__ Maybe ByteString
y__ -> RpbPutReq
x__ {_RpbPutReq'key :: Maybe ByteString
_RpbPutReq'key = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "vclock" Data.ByteString.ByteString where
  fieldOf :: Proxy# "vclock"
-> (ByteString -> f ByteString) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutReq -> f RpbPutReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe ByteString)
-> (RpbPutReq -> Maybe ByteString -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe ByteString
_RpbPutReq'vclock (\ RpbPutReq
x__ Maybe ByteString
y__ -> RpbPutReq
x__ {_RpbPutReq'vclock :: Maybe ByteString
_RpbPutReq'vclock = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'vclock" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'vclock"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutReq
-> f RpbPutReq
fieldOf Proxy# "maybe'vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutReq -> f RpbPutReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe ByteString)
-> (RpbPutReq -> Maybe ByteString -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe ByteString
_RpbPutReq'vclock (\ RpbPutReq
x__ Maybe ByteString
y__ -> RpbPutReq
x__ {_RpbPutReq'vclock :: Maybe ByteString
_RpbPutReq'vclock = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "content" RpbContent where
  fieldOf :: Proxy# "content"
-> (RpbContent -> f RpbContent) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "content"
_
    = ((RpbContent -> f RpbContent) -> RpbPutReq -> f RpbPutReq)
-> ((RpbContent -> f RpbContent) -> RpbContent -> f RpbContent)
-> (RpbContent -> f RpbContent)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> RpbContent)
-> (RpbPutReq -> RpbContent -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq RpbContent RpbContent
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> RpbContent
_RpbPutReq'content (\ RpbPutReq
x__ RpbContent
y__ -> RpbPutReq
x__ {_RpbPutReq'content :: RpbContent
_RpbPutReq'content = RpbContent
y__}))
        (RpbContent -> f RpbContent) -> RpbContent -> f RpbContent
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "w" Data.Word.Word32 where
  fieldOf :: Proxy# "w" -> (Word32 -> f Word32) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "w"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'w (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'w :: Maybe Word32
_RpbPutReq'w = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'w" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'w"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'w"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'w (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'w :: Maybe Word32
_RpbPutReq'w = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "dw" Data.Word.Word32 where
  fieldOf :: Proxy# "dw" -> (Word32 -> f Word32) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "dw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'dw (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'dw :: Maybe Word32
_RpbPutReq'dw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'dw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'dw"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'dw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'dw (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'dw :: Maybe Word32
_RpbPutReq'dw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "returnBody" Prelude.Bool where
  fieldOf :: Proxy# "returnBody" -> (Bool -> f Bool) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "returnBody"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'returnBody
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'returnBody :: Maybe Bool
_RpbPutReq'returnBody = 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 RpbPutReq "maybe'returnBody" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'returnBody"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'returnBody"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'returnBody
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'returnBody :: Maybe Bool
_RpbPutReq'returnBody = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "pw" Data.Word.Word32 where
  fieldOf :: Proxy# "pw" -> (Word32 -> f Word32) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "pw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'pw (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'pw :: Maybe Word32
_RpbPutReq'pw = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'pw" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'pw"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'pw"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'pw (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'pw :: Maybe Word32
_RpbPutReq'pw = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "ifNotModified" Prelude.Bool where
  fieldOf :: Proxy# "ifNotModified"
-> (Bool -> f Bool) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "ifNotModified"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'ifNotModified
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'ifNotModified :: Maybe Bool
_RpbPutReq'ifNotModified = 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 RpbPutReq "maybe'ifNotModified" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'ifNotModified"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'ifNotModified"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'ifNotModified
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'ifNotModified :: Maybe Bool
_RpbPutReq'ifNotModified = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "ifNoneMatch" Prelude.Bool where
  fieldOf :: Proxy# "ifNoneMatch"
-> (Bool -> f Bool) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "ifNoneMatch"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'ifNoneMatch
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'ifNoneMatch :: Maybe Bool
_RpbPutReq'ifNoneMatch = 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 RpbPutReq "maybe'ifNoneMatch" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'ifNoneMatch"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'ifNoneMatch"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'ifNoneMatch
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'ifNoneMatch :: Maybe Bool
_RpbPutReq'ifNoneMatch = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "returnHead" Prelude.Bool where
  fieldOf :: Proxy# "returnHead" -> (Bool -> f Bool) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "returnHead"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'returnHead
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'returnHead :: Maybe Bool
_RpbPutReq'returnHead = 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 RpbPutReq "maybe'returnHead" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'returnHead"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'returnHead"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'returnHead
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'returnHead :: Maybe Bool
_RpbPutReq'returnHead = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'timeout (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'timeout :: Maybe Word32
_RpbPutReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'timeout (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'timeout :: Maybe Word32
_RpbPutReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "asis" Prelude.Bool where
  fieldOf :: Proxy# "asis" -> (Bool -> f Bool) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "asis"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'asis (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'asis :: Maybe Bool
_RpbPutReq'asis = 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 RpbPutReq "maybe'asis" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'asis"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'asis"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'asis (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'asis :: Maybe Bool
_RpbPutReq'asis = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "sloppyQuorum" Prelude.Bool where
  fieldOf :: Proxy# "sloppyQuorum"
-> (Bool -> f Bool) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'sloppyQuorum
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'sloppyQuorum :: Maybe Bool
_RpbPutReq'sloppyQuorum = 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 RpbPutReq "maybe'sloppyQuorum" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'sloppyQuorum"
-> (Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'sloppyQuorum"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Bool)
-> (RpbPutReq -> Maybe Bool -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Bool
_RpbPutReq'sloppyQuorum
           (\ RpbPutReq
x__ Maybe Bool
y__ -> RpbPutReq
x__ {_RpbPutReq'sloppyQuorum :: Maybe Bool
_RpbPutReq'sloppyQuorum = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "nVal" Data.Word.Word32 where
  fieldOf :: Proxy# "nVal" -> (Word32 -> f Word32) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'nVal (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'nVal :: Maybe Word32
_RpbPutReq'nVal = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'nVal" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'nVal"
-> (Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "maybe'nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> RpbPutReq -> f RpbPutReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe Word32)
-> (RpbPutReq -> Maybe Word32 -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe Word32
_RpbPutReq'nVal (\ RpbPutReq
x__ Maybe Word32
y__ -> RpbPutReq
x__ {_RpbPutReq'nVal :: Maybe Word32
_RpbPutReq'nVal = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString) -> RpbPutReq -> f RpbPutReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutReq -> f RpbPutReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe ByteString)
-> (RpbPutReq -> Maybe ByteString -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe ByteString
_RpbPutReq'type' (\ RpbPutReq
x__ Maybe ByteString
y__ -> RpbPutReq
x__ {_RpbPutReq'type' :: Maybe ByteString
_RpbPutReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutReq
-> f RpbPutReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutReq -> f RpbPutReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutReq
-> f RpbPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutReq -> Maybe ByteString)
-> (RpbPutReq -> Maybe ByteString -> RpbPutReq)
-> Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutReq -> Maybe ByteString
_RpbPutReq'type' (\ RpbPutReq
x__ Maybe ByteString
y__ -> RpbPutReq
x__ {_RpbPutReq'type' :: Maybe ByteString
_RpbPutReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbPutReq where
  messageName :: Proxy RpbPutReq -> Text
messageName Proxy RpbPutReq
_ = String -> Text
Data.Text.pack String
"RpbPutReq"
  packedMessageDescriptor :: Proxy RpbPutReq -> ByteString
packedMessageDescriptor Proxy RpbPutReq
_
    = ByteString
"\n\
      \\tRpbPutReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
      \\ETXkey\CAN\STX \SOH(\fR\ETXkey\DC2\SYN\n\
      \\ACKvclock\CAN\ETX \SOH(\fR\ACKvclock\DC2%\n\
      \\acontent\CAN\EOT \STX(\v2\v.RpbContentR\acontent\DC2\f\n\
      \\SOHw\CAN\ENQ \SOH(\rR\SOHw\DC2\SO\n\
      \\STXdw\CAN\ACK \SOH(\rR\STXdw\DC2\US\n\
      \\vreturn_body\CAN\a \SOH(\bR\n\
      \returnBody\DC2\SO\n\
      \\STXpw\CAN\b \SOH(\rR\STXpw\DC2&\n\
      \\SIif_not_modified\CAN\t \SOH(\bR\rifNotModified\DC2\"\n\
      \\rif_none_match\CAN\n\
      \ \SOH(\bR\vifNoneMatch\DC2\US\n\
      \\vreturn_head\CAN\v \SOH(\bR\n\
      \returnHead\DC2\CAN\n\
      \\atimeout\CAN\f \SOH(\rR\atimeout\DC2\DC2\n\
      \\EOTasis\CAN\r \SOH(\bR\EOTasis\DC2#\n\
      \\rsloppy_quorum\CAN\SO \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
      \\ENQn_val\CAN\SI \SOH(\rR\EOTnVal\DC2\DC2\n\
      \\EOTtype\CAN\DLE \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbPutReq -> ByteString
packedFileDescriptor Proxy RpbPutReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbPutReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbPutReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPutReq ByteString
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbPutReq RpbPutReq ByteString ByteString
-> FieldAccessor RpbPutReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        key__field_descriptor :: FieldDescriptor RpbPutReq
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPutReq ByteString
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbPutReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        vclock__field_descriptor :: FieldDescriptor RpbPutReq
vclock__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPutReq ByteString
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"vclock"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbPutReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        content__field_descriptor :: FieldDescriptor RpbPutReq
content__field_descriptor
          = String
-> FieldTypeDescriptor RpbContent
-> FieldAccessor RpbPutReq RpbContent
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"content"
              (MessageOrGroup -> FieldTypeDescriptor RpbContent
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbContent)
              (WireDefault RpbContent
-> Lens RpbPutReq RpbPutReq RpbContent RpbContent
-> FieldAccessor RpbPutReq RpbContent
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbContent
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"content")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        w__field_descriptor :: FieldDescriptor RpbPutReq
w__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbPutReq Word32
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"w"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbPutReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        dw__field_descriptor :: FieldDescriptor RpbPutReq
dw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbPutReq Word32
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"dw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbPutReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        returnBody__field_descriptor :: FieldDescriptor RpbPutReq
returnBody__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbPutReq Bool
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"return_body"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbPutReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnBody")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        pw__field_descriptor :: FieldDescriptor RpbPutReq
pw__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbPutReq Word32
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"pw"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbPutReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        ifNotModified__field_descriptor :: FieldDescriptor RpbPutReq
ifNotModified__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbPutReq Bool
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"if_not_modified"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbPutReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'ifNotModified" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ifNotModified")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        ifNoneMatch__field_descriptor :: FieldDescriptor RpbPutReq
ifNoneMatch__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbPutReq Bool
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"if_none_match"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbPutReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'ifNoneMatch" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ifNoneMatch")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        returnHead__field_descriptor :: FieldDescriptor RpbPutReq
returnHead__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbPutReq Bool
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"return_head"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbPutReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'returnHead" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnHead")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        timeout__field_descriptor :: FieldDescriptor RpbPutReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbPutReq Word32
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbPutReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        asis__field_descriptor :: FieldDescriptor RpbPutReq
asis__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbPutReq Bool
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"asis"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbPutReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'asis" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'asis")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        sloppyQuorum__field_descriptor :: FieldDescriptor RpbPutReq
sloppyQuorum__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor RpbPutReq Bool
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"sloppy_quorum"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor RpbPutReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sloppyQuorum")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        nVal__field_descriptor :: FieldDescriptor RpbPutReq
nVal__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbPutReq Word32
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"n_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)
              (Lens RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbPutReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
        type'__field_descriptor :: FieldDescriptor RpbPutReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPutReq ByteString
-> FieldDescriptor RpbPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbPutReq RpbPutReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbPutReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbPutReq
      in
        [(Tag, FieldDescriptor RpbPutReq)]
-> Map Tag (FieldDescriptor RpbPutReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbPutReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbPutReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbPutReq
vclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbPutReq
content__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbPutReq
w__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbPutReq
dw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbPutReq
returnBody__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbPutReq
pw__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbPutReq
ifNotModified__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbPutReq
ifNoneMatch__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
11, FieldDescriptor RpbPutReq
returnHead__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
12, FieldDescriptor RpbPutReq
timeout__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
13, FieldDescriptor RpbPutReq
asis__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
14, FieldDescriptor RpbPutReq
sloppyQuorum__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
15, FieldDescriptor RpbPutReq
nVal__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
16, FieldDescriptor RpbPutReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbPutReq FieldSet
unknownFields
    = (RpbPutReq -> FieldSet)
-> (RpbPutReq -> FieldSet -> RpbPutReq) -> Lens' RpbPutReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbPutReq -> FieldSet
_RpbPutReq'_unknownFields
        (\ RpbPutReq
x__ FieldSet
y__ -> RpbPutReq
x__ {_RpbPutReq'_unknownFields :: FieldSet
_RpbPutReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbPutReq
defMessage
    = RpbPutReq'_constructor :: ByteString
-> Maybe ByteString
-> Maybe ByteString
-> RpbContent
-> Maybe Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Maybe Word32
-> Maybe ByteString
-> FieldSet
-> RpbPutReq
RpbPutReq'_constructor
        {_RpbPutReq'bucket :: ByteString
_RpbPutReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbPutReq'key :: Maybe ByteString
_RpbPutReq'key = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'vclock :: Maybe ByteString
_RpbPutReq'vclock = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'content :: RpbContent
_RpbPutReq'content = RpbContent
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbPutReq'w :: Maybe Word32
_RpbPutReq'w = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _RpbPutReq'dw :: Maybe Word32
_RpbPutReq'dw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'returnBody :: Maybe Bool
_RpbPutReq'returnBody = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'pw :: Maybe Word32
_RpbPutReq'pw = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'ifNotModified :: Maybe Bool
_RpbPutReq'ifNotModified = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'ifNoneMatch :: Maybe Bool
_RpbPutReq'ifNoneMatch = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'returnHead :: Maybe Bool
_RpbPutReq'returnHead = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'timeout :: Maybe Word32
_RpbPutReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'asis :: Maybe Bool
_RpbPutReq'asis = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'sloppyQuorum :: Maybe Bool
_RpbPutReq'sloppyQuorum = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'nVal :: Maybe Word32
_RpbPutReq'nVal = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbPutReq'type' :: Maybe ByteString
_RpbPutReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing, _RpbPutReq'_unknownFields :: FieldSet
_RpbPutReq'_unknownFields = []}
  parseMessage :: Parser RpbPutReq
parseMessage
    = let
        loop ::
          RpbPutReq
          -> Prelude.Bool
             -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser RpbPutReq
        loop :: RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop RpbPutReq
x Bool
required'bucket Bool
required'content
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'content then (:) String
"content" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbPutReq -> Parser RpbPutReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbPutReq RpbPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPutReq -> RpbPutReq
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 RpbPutReq RpbPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbPutReq
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
"bucket"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq ByteString ByteString
-> ByteString -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbPutReq
x)
                                  Bool
Prelude.False
                                  Bool
required'content
                        Word64
18
                          -> 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
"key"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq ByteString ByteString
-> ByteString -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
26
                          -> 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
"vclock"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq ByteString ByteString
-> ByteString -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vclock") ByteString
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
34
                          -> do RpbContent
y <- Parser RpbContent -> String -> Parser RpbContent
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbContent -> Parser RpbContent
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 RpbContent
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"content"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq RpbContent RpbContent
-> RpbContent -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"content") RpbContent
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
40
                          -> 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
"w"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Word32 Word32
-> Word32 -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"w") Word32
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
48
                          -> 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
"dw"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Word32 Word32
-> Word32 -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"dw") Word32
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
56
                          -> 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
"return_body"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Bool Bool
-> Bool -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"returnBody") Bool
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
64
                          -> 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
"pw"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Word32 Word32
-> Word32 -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"pw") Word32
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
72
                          -> 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
"if_not_modified"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Bool Bool
-> Bool -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "ifNotModified" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ifNotModified") Bool
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
80
                          -> 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
"if_none_match"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Bool Bool
-> Bool -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "ifNoneMatch" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ifNoneMatch") Bool
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
88
                          -> 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
"return_head"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Bool Bool
-> Bool -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "returnHead" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"returnHead") Bool
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
96
                          -> 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
"timeout"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Word32 Word32
-> Word32 -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
104
                          -> 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
"asis"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Bool Bool
-> Bool -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "asis" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"asis") Bool
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
112
                          -> 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
"sloppy_quorum"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Bool Bool
-> Bool -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"sloppyQuorum") Bool
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
120
                          -> 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
"n_val"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq Word32 Word32
-> Word32 -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nVal") Word32
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
130
                          -> 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
"type"
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq ByteString ByteString
-> ByteString -> RpbPutReq -> RpbPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop
                                  (Setter RpbPutReq RpbPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPutReq -> RpbPutReq
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 RpbPutReq RpbPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbPutReq
x)
                                  Bool
required'bucket
                                  Bool
required'content
      in
        Parser RpbPutReq -> String -> Parser RpbPutReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbPutReq -> Bool -> Bool -> Parser RpbPutReq
loop RpbPutReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbPutReq"
  buildMessage :: RpbPutReq -> Builder
buildMessage
    = \ RpbPutReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString RpbPutReq RpbPutReq ByteString ByteString
-> RpbPutReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbPutReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbPutReq
  RpbPutReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbPutReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key") RpbPutReq
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbPutReq
  RpbPutReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbPutReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock") RpbPutReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                         ((ByteString -> Builder)
-> (RpbContent -> ByteString) -> RpbContent -> 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))
                            RpbContent -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                            (FoldLike RpbContent RpbPutReq RpbPutReq RpbContent RpbContent
-> RpbPutReq -> RpbContent
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"content") RpbPutReq
_x)))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe Word32) RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> RpbPutReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'w" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'w") RpbPutReq
_x
                          of
                            Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Word32
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                                   ((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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe Word32) RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> RpbPutReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'dw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'dw") RpbPutReq
_x
                             of
                               Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just Word32
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
48)
                                      ((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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike (Maybe Bool) RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> RpbPutReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                      (forall s a (f :: * -> *).
(HasField s "maybe'returnBody" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnBody") RpbPutReq
_x
                                of
                                  Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just Bool
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
56)
                                         ((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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe Word32) RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> RpbPutReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'pw" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'pw") RpbPutReq
_x
                                   of
                                     Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just Word32
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
64)
                                            ((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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (case
                                          FoldLike (Maybe Bool) RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> RpbPutReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                            (forall s a (f :: * -> *).
(HasField s "maybe'ifNotModified" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ifNotModified") RpbPutReq
_x
                                      of
                                        Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                        (Prelude.Just Bool
_v)
                                          -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
72)
                                               ((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))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike (Maybe Bool) RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> RpbPutReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'ifNoneMatch" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'ifNoneMatch") RpbPutReq
_x
                                         of
                                           Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just Bool
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
80)
                                                  ((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))
                                        (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                           (case
                                                FoldLike (Maybe Bool) RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> RpbPutReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                  (forall s a (f :: * -> *).
(HasField s "maybe'returnHead" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'returnHead")
                                                  RpbPutReq
_x
                                            of
                                              Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                              (Prelude.Just Bool
_v)
                                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
88)
                                                     ((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))
                                           (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                              (case
                                                   FoldLike
  (Maybe Word32) RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> RpbPutReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                     (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")
                                                     RpbPutReq
_x
                                               of
                                                 Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                 (Prelude.Just Word32
_v)
                                                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
96)
                                                        ((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))
                                              (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                 (case
                                                      FoldLike (Maybe Bool) RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> RpbPutReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                        (forall s a (f :: * -> *).
(HasField s "maybe'asis" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'asis")
                                                        RpbPutReq
_x
                                                  of
                                                    Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                    (Prelude.Just Bool
_v)
                                                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                              Word64
104)
                                                           ((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))
                                                 (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                    (case
                                                         FoldLike (Maybe Bool) RpbPutReq RpbPutReq (Maybe Bool) (Maybe Bool)
-> RpbPutReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                           (forall s a (f :: * -> *).
(HasField s "maybe'sloppyQuorum" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                              @"maybe'sloppyQuorum")
                                                           RpbPutReq
_x
                                                     of
                                                       Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                       (Prelude.Just Bool
_v)
                                                         -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                              (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                 Word64
112)
                                                              ((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))
                                                    (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                       (case
                                                            FoldLike
  (Maybe Word32) RpbPutReq RpbPutReq (Maybe Word32) (Maybe Word32)
-> RpbPutReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                              (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                 @"maybe'nVal")
                                                              RpbPutReq
_x
                                                        of
                                                          Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                          (Prelude.Just Word32
_v)
                                                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                    Word64
120)
                                                                 ((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))
                                                       (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                          (case
                                                               FoldLike
  (Maybe ByteString)
  RpbPutReq
  RpbPutReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbPutReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field
                                                                    @"maybe'type'")
                                                                 RpbPutReq
_x
                                                           of
                                                             Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                                             (Prelude.Just ByteString
_v)
                                                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                                                       Word64
130)
                                                                    ((\ 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 RpbPutReq RpbPutReq FieldSet FieldSet
-> RpbPutReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                                                FoldLike FieldSet RpbPutReq RpbPutReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields
                                                                RpbPutReq
_x)))))))))))))))))
instance Control.DeepSeq.NFData RpbPutReq where
  rnf :: RpbPutReq -> ()
rnf
    = \ RpbPutReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbPutReq -> FieldSet
_RpbPutReq'_unknownFields RpbPutReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbPutReq -> ByteString
_RpbPutReq'bucket RpbPutReq
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbPutReq -> Maybe ByteString
_RpbPutReq'key RpbPutReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbPutReq -> Maybe ByteString
_RpbPutReq'vclock RpbPutReq
x__)
                      (RpbContent -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbPutReq -> RpbContent
_RpbPutReq'content RpbPutReq
x__)
                         (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbPutReq -> Maybe Word32
_RpbPutReq'w RpbPutReq
x__)
                            (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbPutReq -> Maybe Word32
_RpbPutReq'dw RpbPutReq
x__)
                               (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbPutReq -> Maybe Bool
_RpbPutReq'returnBody RpbPutReq
x__)
                                  (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbPutReq -> Maybe Word32
_RpbPutReq'pw RpbPutReq
x__)
                                     (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbPutReq -> Maybe Bool
_RpbPutReq'ifNotModified RpbPutReq
x__)
                                        (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbPutReq -> Maybe Bool
_RpbPutReq'ifNoneMatch RpbPutReq
x__)
                                           (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                              (RpbPutReq -> Maybe Bool
_RpbPutReq'returnHead RpbPutReq
x__)
                                              (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                 (RpbPutReq -> Maybe Word32
_RpbPutReq'timeout RpbPutReq
x__)
                                                 (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                    (RpbPutReq -> Maybe Bool
_RpbPutReq'asis RpbPutReq
x__)
                                                    (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                       (RpbPutReq -> Maybe Bool
_RpbPutReq'sloppyQuorum RpbPutReq
x__)
                                                       (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                          (RpbPutReq -> Maybe Word32
_RpbPutReq'nVal RpbPutReq
x__)
                                                          (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                                             (RpbPutReq -> Maybe ByteString
_RpbPutReq'type' RpbPutReq
x__)
                                                             ()))))))))))))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.content' @:: Lens' RpbPutResp [RpbContent]@
         * 'Proto.Riak_Fields.vec'content' @:: Lens' RpbPutResp (Data.Vector.Vector RpbContent)@
         * 'Proto.Riak_Fields.vclock' @:: Lens' RpbPutResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'vclock' @:: Lens' RpbPutResp (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.key' @:: Lens' RpbPutResp Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'key' @:: Lens' RpbPutResp (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbPutResp
  = RpbPutResp'_constructor {RpbPutResp -> Vector RpbContent
_RpbPutResp'content :: !(Data.Vector.Vector RpbContent),
                             RpbPutResp -> Maybe ByteString
_RpbPutResp'vclock :: !(Prelude.Maybe Data.ByteString.ByteString),
                             RpbPutResp -> Maybe ByteString
_RpbPutResp'key :: !(Prelude.Maybe Data.ByteString.ByteString),
                             RpbPutResp -> FieldSet
_RpbPutResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbPutResp -> RpbPutResp -> Bool
(RpbPutResp -> RpbPutResp -> Bool)
-> (RpbPutResp -> RpbPutResp -> Bool) -> Eq RpbPutResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbPutResp -> RpbPutResp -> Bool
$c/= :: RpbPutResp -> RpbPutResp -> Bool
== :: RpbPutResp -> RpbPutResp -> Bool
$c== :: RpbPutResp -> RpbPutResp -> Bool
Prelude.Eq, Eq RpbPutResp
Eq RpbPutResp
-> (RpbPutResp -> RpbPutResp -> Ordering)
-> (RpbPutResp -> RpbPutResp -> Bool)
-> (RpbPutResp -> RpbPutResp -> Bool)
-> (RpbPutResp -> RpbPutResp -> Bool)
-> (RpbPutResp -> RpbPutResp -> Bool)
-> (RpbPutResp -> RpbPutResp -> RpbPutResp)
-> (RpbPutResp -> RpbPutResp -> RpbPutResp)
-> Ord RpbPutResp
RpbPutResp -> RpbPutResp -> Bool
RpbPutResp -> RpbPutResp -> Ordering
RpbPutResp -> RpbPutResp -> RpbPutResp
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 :: RpbPutResp -> RpbPutResp -> RpbPutResp
$cmin :: RpbPutResp -> RpbPutResp -> RpbPutResp
max :: RpbPutResp -> RpbPutResp -> RpbPutResp
$cmax :: RpbPutResp -> RpbPutResp -> RpbPutResp
>= :: RpbPutResp -> RpbPutResp -> Bool
$c>= :: RpbPutResp -> RpbPutResp -> Bool
> :: RpbPutResp -> RpbPutResp -> Bool
$c> :: RpbPutResp -> RpbPutResp -> Bool
<= :: RpbPutResp -> RpbPutResp -> Bool
$c<= :: RpbPutResp -> RpbPutResp -> Bool
< :: RpbPutResp -> RpbPutResp -> Bool
$c< :: RpbPutResp -> RpbPutResp -> Bool
compare :: RpbPutResp -> RpbPutResp -> Ordering
$ccompare :: RpbPutResp -> RpbPutResp -> Ordering
$cp1Ord :: Eq RpbPutResp
Prelude.Ord)
instance Prelude.Show RpbPutResp where
  showsPrec :: Int -> RpbPutResp -> ShowS
showsPrec Int
_ RpbPutResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbPutResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbPutResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbPutResp "content" [RpbContent] where
  fieldOf :: Proxy# "content"
-> ([RpbContent] -> f [RpbContent]) -> RpbPutResp -> f RpbPutResp
fieldOf Proxy# "content"
_
    = ((Vector RpbContent -> f (Vector RpbContent))
 -> RpbPutResp -> f RpbPutResp)
-> (([RpbContent] -> f [RpbContent])
    -> Vector RpbContent -> f (Vector RpbContent))
-> ([RpbContent] -> f [RpbContent])
-> RpbPutResp
-> f RpbPutResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutResp -> Vector RpbContent)
-> (RpbPutResp -> Vector RpbContent -> RpbPutResp)
-> Lens
     RpbPutResp RpbPutResp (Vector RpbContent) (Vector RpbContent)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutResp -> Vector RpbContent
_RpbPutResp'content (\ RpbPutResp
x__ Vector RpbContent
y__ -> RpbPutResp
x__ {_RpbPutResp'content :: Vector RpbContent
_RpbPutResp'content = Vector RpbContent
y__}))
        ((Vector RpbContent -> [RpbContent])
-> (Vector RpbContent -> [RpbContent] -> Vector RpbContent)
-> Lens
     (Vector RpbContent) (Vector RpbContent) [RpbContent] [RpbContent]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbContent -> [RpbContent]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbContent
_ [RpbContent]
y__ -> [RpbContent] -> Vector RpbContent
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbContent]
y__))
instance Data.ProtoLens.Field.HasField RpbPutResp "vec'content" (Data.Vector.Vector RpbContent) where
  fieldOf :: Proxy# "vec'content"
-> (Vector RpbContent -> f (Vector RpbContent))
-> RpbPutResp
-> f RpbPutResp
fieldOf Proxy# "vec'content"
_
    = ((Vector RpbContent -> f (Vector RpbContent))
 -> RpbPutResp -> f RpbPutResp)
-> ((Vector RpbContent -> f (Vector RpbContent))
    -> Vector RpbContent -> f (Vector RpbContent))
-> (Vector RpbContent -> f (Vector RpbContent))
-> RpbPutResp
-> f RpbPutResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutResp -> Vector RpbContent)
-> (RpbPutResp -> Vector RpbContent -> RpbPutResp)
-> Lens
     RpbPutResp RpbPutResp (Vector RpbContent) (Vector RpbContent)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutResp -> Vector RpbContent
_RpbPutResp'content (\ RpbPutResp
x__ Vector RpbContent
y__ -> RpbPutResp
x__ {_RpbPutResp'content :: Vector RpbContent
_RpbPutResp'content = Vector RpbContent
y__}))
        (Vector RpbContent -> f (Vector RpbContent))
-> Vector RpbContent -> f (Vector RpbContent)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutResp "vclock" Data.ByteString.ByteString where
  fieldOf :: Proxy# "vclock"
-> (ByteString -> f ByteString) -> RpbPutResp -> f RpbPutResp
fieldOf Proxy# "vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutResp -> f RpbPutResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbPutResp
-> f RpbPutResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutResp -> Maybe ByteString)
-> (RpbPutResp -> Maybe ByteString -> RpbPutResp)
-> Lens RpbPutResp RpbPutResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutResp -> Maybe ByteString
_RpbPutResp'vclock (\ RpbPutResp
x__ Maybe ByteString
y__ -> RpbPutResp
x__ {_RpbPutResp'vclock :: Maybe ByteString
_RpbPutResp'vclock = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutResp "maybe'vclock" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'vclock"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutResp
-> f RpbPutResp
fieldOf Proxy# "maybe'vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutResp -> f RpbPutResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutResp
-> f RpbPutResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutResp -> Maybe ByteString)
-> (RpbPutResp -> Maybe ByteString -> RpbPutResp)
-> Lens RpbPutResp RpbPutResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutResp -> Maybe ByteString
_RpbPutResp'vclock (\ RpbPutResp
x__ Maybe ByteString
y__ -> RpbPutResp
x__ {_RpbPutResp'vclock :: Maybe ByteString
_RpbPutResp'vclock = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbPutResp "key" Data.ByteString.ByteString where
  fieldOf :: Proxy# "key"
-> (ByteString -> f ByteString) -> RpbPutResp -> f RpbPutResp
fieldOf Proxy# "key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutResp -> f RpbPutResp)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbPutResp
-> f RpbPutResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutResp -> Maybe ByteString)
-> (RpbPutResp -> Maybe ByteString -> RpbPutResp)
-> Lens RpbPutResp RpbPutResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutResp -> Maybe ByteString
_RpbPutResp'key (\ RpbPutResp
x__ Maybe ByteString
y__ -> RpbPutResp
x__ {_RpbPutResp'key :: Maybe ByteString
_RpbPutResp'key = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbPutResp "maybe'key" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'key"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutResp
-> f RpbPutResp
fieldOf Proxy# "maybe'key"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbPutResp -> f RpbPutResp)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbPutResp
-> f RpbPutResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbPutResp -> Maybe ByteString)
-> (RpbPutResp -> Maybe ByteString -> RpbPutResp)
-> Lens RpbPutResp RpbPutResp (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbPutResp -> Maybe ByteString
_RpbPutResp'key (\ RpbPutResp
x__ Maybe ByteString
y__ -> RpbPutResp
x__ {_RpbPutResp'key :: Maybe ByteString
_RpbPutResp'key = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbPutResp where
  messageName :: Proxy RpbPutResp -> Text
messageName Proxy RpbPutResp
_ = String -> Text
Data.Text.pack String
"RpbPutResp"
  packedMessageDescriptor :: Proxy RpbPutResp -> ByteString
packedMessageDescriptor Proxy RpbPutResp
_
    = ByteString
"\n\
      \\n\
      \RpbPutResp\DC2%\n\
      \\acontent\CAN\SOH \ETX(\v2\v.RpbContentR\acontent\DC2\SYN\n\
      \\ACKvclock\CAN\STX \SOH(\fR\ACKvclock\DC2\DLE\n\
      \\ETXkey\CAN\ETX \SOH(\fR\ETXkey"
  packedFileDescriptor :: Proxy RpbPutResp -> ByteString
packedFileDescriptor Proxy RpbPutResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbPutResp)
fieldsByTag
    = let
        content__field_descriptor :: FieldDescriptor RpbPutResp
content__field_descriptor
          = String
-> FieldTypeDescriptor RpbContent
-> FieldAccessor RpbPutResp RpbContent
-> FieldDescriptor RpbPutResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"content"
              (MessageOrGroup -> FieldTypeDescriptor RpbContent
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbContent)
              (Packing
-> Lens' RpbPutResp [RpbContent]
-> FieldAccessor RpbPutResp RpbContent
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"content")) ::
              Data.ProtoLens.FieldDescriptor RpbPutResp
        vclock__field_descriptor :: FieldDescriptor RpbPutResp
vclock__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPutResp ByteString
-> FieldDescriptor RpbPutResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"vclock"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbPutResp RpbPutResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbPutResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock")) ::
              Data.ProtoLens.FieldDescriptor RpbPutResp
        key__field_descriptor :: FieldDescriptor RpbPutResp
key__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbPutResp ByteString
-> FieldDescriptor RpbPutResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens RpbPutResp RpbPutResp (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor RpbPutResp ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key")) ::
              Data.ProtoLens.FieldDescriptor RpbPutResp
      in
        [(Tag, FieldDescriptor RpbPutResp)]
-> Map Tag (FieldDescriptor RpbPutResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbPutResp
content__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbPutResp
vclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbPutResp
key__field_descriptor)]
  unknownFields :: LensLike' f RpbPutResp FieldSet
unknownFields
    = (RpbPutResp -> FieldSet)
-> (RpbPutResp -> FieldSet -> RpbPutResp)
-> Lens' RpbPutResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbPutResp -> FieldSet
_RpbPutResp'_unknownFields
        (\ RpbPutResp
x__ FieldSet
y__ -> RpbPutResp
x__ {_RpbPutResp'_unknownFields :: FieldSet
_RpbPutResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbPutResp
defMessage
    = RpbPutResp'_constructor :: Vector RpbContent
-> Maybe ByteString -> Maybe ByteString -> FieldSet -> RpbPutResp
RpbPutResp'_constructor
        {_RpbPutResp'content :: Vector RpbContent
_RpbPutResp'content = Vector RpbContent
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbPutResp'vclock :: Maybe ByteString
_RpbPutResp'vclock = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbPutResp'key :: Maybe ByteString
_RpbPutResp'key = Maybe ByteString
forall a. Maybe a
Prelude.Nothing, _RpbPutResp'_unknownFields :: FieldSet
_RpbPutResp'_unknownFields = []}
  parseMessage :: Parser RpbPutResp
parseMessage
    = let
        loop ::
          RpbPutResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbContent
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbPutResp
        loop :: RpbPutResp
-> Growing Vector RealWorld RpbContent -> Parser RpbPutResp
loop RpbPutResp
x Growing Vector RealWorld RpbContent
mutable'content
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbContent
frozen'content <- IO (Vector RpbContent) -> Parser (Vector RpbContent)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) RpbContent -> IO (Vector RpbContent)
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 RpbContent
Growing Vector (PrimState IO) RpbContent
mutable'content)
                      (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]))))
                      RpbPutResp -> Parser RpbPutResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbPutResp RpbPutResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPutResp -> RpbPutResp
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 RpbPutResp RpbPutResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbPutResp RpbPutResp (Vector RpbContent) (Vector RpbContent)
-> Vector RpbContent -> RpbPutResp -> RpbPutResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'content") Vector RpbContent
frozen'content RpbPutResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbContent
y <- Parser RpbContent -> String -> Parser RpbContent
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbContent -> Parser RpbContent
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 RpbContent
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"content"
                                Growing Vector RealWorld RpbContent
v <- IO (Growing Vector RealWorld RpbContent)
-> Parser (Growing Vector RealWorld RpbContent)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbContent
-> RpbContent -> IO (Growing Vector (PrimState IO) RpbContent)
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 RpbContent
Growing Vector (PrimState IO) RpbContent
mutable'content RpbContent
y)
                                RpbPutResp
-> Growing Vector RealWorld RpbContent -> Parser RpbPutResp
loop RpbPutResp
x Growing Vector RealWorld RpbContent
v
                        Word64
18
                          -> 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
"vclock"
                                RpbPutResp
-> Growing Vector RealWorld RpbContent -> Parser RpbPutResp
loop
                                  (Setter RpbPutResp RpbPutResp ByteString ByteString
-> ByteString -> RpbPutResp -> RpbPutResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vclock") ByteString
y RpbPutResp
x)
                                  Growing Vector RealWorld RpbContent
mutable'content
                        Word64
26
                          -> 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
"key"
                                RpbPutResp
-> Growing Vector RealWorld RpbContent -> Parser RpbPutResp
loop
                                  (Setter RpbPutResp RpbPutResp ByteString ByteString
-> ByteString -> RpbPutResp -> RpbPutResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") ByteString
y RpbPutResp
x)
                                  Growing Vector RealWorld RpbContent
mutable'content
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbPutResp
-> Growing Vector RealWorld RpbContent -> Parser RpbPutResp
loop
                                  (Setter RpbPutResp RpbPutResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbPutResp -> RpbPutResp
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 RpbPutResp RpbPutResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbPutResp
x)
                                  Growing Vector RealWorld RpbContent
mutable'content
      in
        Parser RpbPutResp -> String -> Parser RpbPutResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbContent
mutable'content <- IO (Growing Vector RealWorld RpbContent)
-> Parser (Growing Vector RealWorld RpbContent)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld RpbContent)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbPutResp
-> Growing Vector RealWorld RpbContent -> Parser RpbPutResp
loop RpbPutResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbContent
mutable'content)
          String
"RpbPutResp"
  buildMessage :: RpbPutResp -> Builder
buildMessage
    = \ RpbPutResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbContent -> Builder) -> Vector RpbContent -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbContent
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbContent -> ByteString) -> RpbContent -> 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))
                           RpbContent -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbContent
_v))
                (FoldLike
  (Vector RpbContent)
  RpbPutResp
  RpbPutResp
  (Vector RpbContent)
  (Vector RpbContent)
-> RpbPutResp -> Vector RpbContent
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'content") RpbPutResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbPutResp
  RpbPutResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbPutResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock") RpbPutResp
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbPutResp
  RpbPutResp
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbPutResp -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'key") RpbPutResp
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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 RpbPutResp RpbPutResp FieldSet FieldSet
-> RpbPutResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbPutResp RpbPutResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbPutResp
_x))))
instance Control.DeepSeq.NFData RpbPutResp where
  rnf :: RpbPutResp -> ()
rnf
    = \ RpbPutResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbPutResp -> FieldSet
_RpbPutResp'_unknownFields RpbPutResp
x__)
             (Vector RpbContent -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbPutResp -> Vector RpbContent
_RpbPutResp'content RpbPutResp
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbPutResp -> Maybe ByteString
_RpbPutResp'vclock RpbPutResp
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbPutResp -> Maybe ByteString
_RpbPutResp'key RpbPutResp
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbResetBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbResetBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbResetBucketReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbResetBucketReq
  = RpbResetBucketReq'_constructor {RpbResetBucketReq -> ByteString
_RpbResetBucketReq'bucket :: !Data.ByteString.ByteString,
                                    RpbResetBucketReq -> Maybe ByteString
_RpbResetBucketReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbResetBucketReq -> FieldSet
_RpbResetBucketReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbResetBucketReq -> RpbResetBucketReq -> Bool
(RpbResetBucketReq -> RpbResetBucketReq -> Bool)
-> (RpbResetBucketReq -> RpbResetBucketReq -> Bool)
-> Eq RpbResetBucketReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
$c/= :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
== :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
$c== :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
Prelude.Eq, Eq RpbResetBucketReq
Eq RpbResetBucketReq
-> (RpbResetBucketReq -> RpbResetBucketReq -> Ordering)
-> (RpbResetBucketReq -> RpbResetBucketReq -> Bool)
-> (RpbResetBucketReq -> RpbResetBucketReq -> Bool)
-> (RpbResetBucketReq -> RpbResetBucketReq -> Bool)
-> (RpbResetBucketReq -> RpbResetBucketReq -> Bool)
-> (RpbResetBucketReq -> RpbResetBucketReq -> RpbResetBucketReq)
-> (RpbResetBucketReq -> RpbResetBucketReq -> RpbResetBucketReq)
-> Ord RpbResetBucketReq
RpbResetBucketReq -> RpbResetBucketReq -> Bool
RpbResetBucketReq -> RpbResetBucketReq -> Ordering
RpbResetBucketReq -> RpbResetBucketReq -> RpbResetBucketReq
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 :: RpbResetBucketReq -> RpbResetBucketReq -> RpbResetBucketReq
$cmin :: RpbResetBucketReq -> RpbResetBucketReq -> RpbResetBucketReq
max :: RpbResetBucketReq -> RpbResetBucketReq -> RpbResetBucketReq
$cmax :: RpbResetBucketReq -> RpbResetBucketReq -> RpbResetBucketReq
>= :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
$c>= :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
> :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
$c> :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
<= :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
$c<= :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
< :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
$c< :: RpbResetBucketReq -> RpbResetBucketReq -> Bool
compare :: RpbResetBucketReq -> RpbResetBucketReq -> Ordering
$ccompare :: RpbResetBucketReq -> RpbResetBucketReq -> Ordering
$cp1Ord :: Eq RpbResetBucketReq
Prelude.Ord)
instance Prelude.Show RpbResetBucketReq where
  showsPrec :: Int -> RpbResetBucketReq -> ShowS
showsPrec Int
_ RpbResetBucketReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbResetBucketReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbResetBucketReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbResetBucketReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbResetBucketReq
-> f RpbResetBucketReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbResetBucketReq -> f RpbResetBucketReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbResetBucketReq
-> f RpbResetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbResetBucketReq -> ByteString)
-> (RpbResetBucketReq -> ByteString -> RpbResetBucketReq)
-> Lens RpbResetBucketReq RpbResetBucketReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbResetBucketReq -> ByteString
_RpbResetBucketReq'bucket
           (\ RpbResetBucketReq
x__ ByteString
y__ -> RpbResetBucketReq
x__ {_RpbResetBucketReq'bucket :: ByteString
_RpbResetBucketReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbResetBucketReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbResetBucketReq
-> f RpbResetBucketReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbResetBucketReq -> f RpbResetBucketReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbResetBucketReq
-> f RpbResetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbResetBucketReq -> Maybe ByteString)
-> (RpbResetBucketReq -> Maybe ByteString -> RpbResetBucketReq)
-> Lens
     RpbResetBucketReq
     RpbResetBucketReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbResetBucketReq -> Maybe ByteString
_RpbResetBucketReq'type'
           (\ RpbResetBucketReq
x__ Maybe ByteString
y__ -> RpbResetBucketReq
x__ {_RpbResetBucketReq'type' :: Maybe ByteString
_RpbResetBucketReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbResetBucketReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbResetBucketReq
-> f RpbResetBucketReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbResetBucketReq -> f RpbResetBucketReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbResetBucketReq
-> f RpbResetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbResetBucketReq -> Maybe ByteString)
-> (RpbResetBucketReq -> Maybe ByteString -> RpbResetBucketReq)
-> Lens
     RpbResetBucketReq
     RpbResetBucketReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbResetBucketReq -> Maybe ByteString
_RpbResetBucketReq'type'
           (\ RpbResetBucketReq
x__ Maybe ByteString
y__ -> RpbResetBucketReq
x__ {_RpbResetBucketReq'type' :: Maybe ByteString
_RpbResetBucketReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbResetBucketReq where
  messageName :: Proxy RpbResetBucketReq -> Text
messageName Proxy RpbResetBucketReq
_ = String -> Text
Data.Text.pack String
"RpbResetBucketReq"
  packedMessageDescriptor :: Proxy RpbResetBucketReq -> ByteString
packedMessageDescriptor Proxy RpbResetBucketReq
_
    = ByteString
"\n\
      \\DC1RpbResetBucketReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DC2\n\
      \\EOTtype\CAN\STX \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbResetBucketReq -> ByteString
packedFileDescriptor Proxy RpbResetBucketReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbResetBucketReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbResetBucketReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbResetBucketReq ByteString
-> FieldDescriptor RpbResetBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbResetBucketReq RpbResetBucketReq ByteString ByteString
-> FieldAccessor RpbResetBucketReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbResetBucketReq
        type'__field_descriptor :: FieldDescriptor RpbResetBucketReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbResetBucketReq ByteString
-> FieldDescriptor RpbResetBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbResetBucketReq
  RpbResetBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbResetBucketReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbResetBucketReq
      in
        [(Tag, FieldDescriptor RpbResetBucketReq)]
-> Map Tag (FieldDescriptor RpbResetBucketReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbResetBucketReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbResetBucketReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbResetBucketReq FieldSet
unknownFields
    = (RpbResetBucketReq -> FieldSet)
-> (RpbResetBucketReq -> FieldSet -> RpbResetBucketReq)
-> Lens' RpbResetBucketReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbResetBucketReq -> FieldSet
_RpbResetBucketReq'_unknownFields
        (\ RpbResetBucketReq
x__ FieldSet
y__ -> RpbResetBucketReq
x__ {_RpbResetBucketReq'_unknownFields :: FieldSet
_RpbResetBucketReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbResetBucketReq
defMessage
    = RpbResetBucketReq'_constructor :: ByteString -> Maybe ByteString -> FieldSet -> RpbResetBucketReq
RpbResetBucketReq'_constructor
        {_RpbResetBucketReq'bucket :: ByteString
_RpbResetBucketReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbResetBucketReq'type' :: Maybe ByteString
_RpbResetBucketReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbResetBucketReq'_unknownFields :: FieldSet
_RpbResetBucketReq'_unknownFields = []}
  parseMessage :: Parser RpbResetBucketReq
parseMessage
    = let
        loop ::
          RpbResetBucketReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbResetBucketReq
        loop :: RpbResetBucketReq -> Bool -> Parser RpbResetBucketReq
loop RpbResetBucketReq
x Bool
required'bucket
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbResetBucketReq -> Parser RpbResetBucketReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbResetBucketReq RpbResetBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbResetBucketReq -> RpbResetBucketReq
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 RpbResetBucketReq RpbResetBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbResetBucketReq
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
"bucket"
                                RpbResetBucketReq -> Bool -> Parser RpbResetBucketReq
loop
                                  (Setter RpbResetBucketReq RpbResetBucketReq ByteString ByteString
-> ByteString -> RpbResetBucketReq -> RpbResetBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbResetBucketReq
x)
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"type"
                                RpbResetBucketReq -> Bool -> Parser RpbResetBucketReq
loop
                                  (Setter RpbResetBucketReq RpbResetBucketReq ByteString ByteString
-> ByteString -> RpbResetBucketReq -> RpbResetBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbResetBucketReq
x)
                                  Bool
required'bucket
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbResetBucketReq -> Bool -> Parser RpbResetBucketReq
loop
                                  (Setter RpbResetBucketReq RpbResetBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbResetBucketReq -> RpbResetBucketReq
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 RpbResetBucketReq RpbResetBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbResetBucketReq
x)
                                  Bool
required'bucket
      in
        Parser RpbResetBucketReq -> String -> Parser RpbResetBucketReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbResetBucketReq -> Bool -> Parser RpbResetBucketReq
loop RpbResetBucketReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbResetBucketReq"
  buildMessage :: RpbResetBucketReq -> Builder
buildMessage
    = \ RpbResetBucketReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbResetBucketReq
  RpbResetBucketReq
  ByteString
  ByteString
-> RpbResetBucketReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbResetBucketReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbResetBucketReq
  RpbResetBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbResetBucketReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbResetBucketReq
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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 RpbResetBucketReq RpbResetBucketReq FieldSet FieldSet
-> RpbResetBucketReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbResetBucketReq RpbResetBucketReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbResetBucketReq
_x)))
instance Control.DeepSeq.NFData RpbResetBucketReq where
  rnf :: RpbResetBucketReq -> ()
rnf
    = \ RpbResetBucketReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbResetBucketReq -> FieldSet
_RpbResetBucketReq'_unknownFields RpbResetBucketReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbResetBucketReq -> ByteString
_RpbResetBucketReq'bucket RpbResetBucketReq
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbResetBucketReq -> Maybe ByteString
_RpbResetBucketReq'type' RpbResetBucketReq
x__) ()))
{- | Fields :
      -}
data RpbResetBucketResp
  = RpbResetBucketResp'_constructor {RpbResetBucketResp -> FieldSet
_RpbResetBucketResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbResetBucketResp -> RpbResetBucketResp -> Bool
(RpbResetBucketResp -> RpbResetBucketResp -> Bool)
-> (RpbResetBucketResp -> RpbResetBucketResp -> Bool)
-> Eq RpbResetBucketResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
$c/= :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
== :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
$c== :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
Prelude.Eq, Eq RpbResetBucketResp
Eq RpbResetBucketResp
-> (RpbResetBucketResp -> RpbResetBucketResp -> Ordering)
-> (RpbResetBucketResp -> RpbResetBucketResp -> Bool)
-> (RpbResetBucketResp -> RpbResetBucketResp -> Bool)
-> (RpbResetBucketResp -> RpbResetBucketResp -> Bool)
-> (RpbResetBucketResp -> RpbResetBucketResp -> Bool)
-> (RpbResetBucketResp -> RpbResetBucketResp -> RpbResetBucketResp)
-> (RpbResetBucketResp -> RpbResetBucketResp -> RpbResetBucketResp)
-> Ord RpbResetBucketResp
RpbResetBucketResp -> RpbResetBucketResp -> Bool
RpbResetBucketResp -> RpbResetBucketResp -> Ordering
RpbResetBucketResp -> RpbResetBucketResp -> RpbResetBucketResp
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 :: RpbResetBucketResp -> RpbResetBucketResp -> RpbResetBucketResp
$cmin :: RpbResetBucketResp -> RpbResetBucketResp -> RpbResetBucketResp
max :: RpbResetBucketResp -> RpbResetBucketResp -> RpbResetBucketResp
$cmax :: RpbResetBucketResp -> RpbResetBucketResp -> RpbResetBucketResp
>= :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
$c>= :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
> :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
$c> :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
<= :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
$c<= :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
< :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
$c< :: RpbResetBucketResp -> RpbResetBucketResp -> Bool
compare :: RpbResetBucketResp -> RpbResetBucketResp -> Ordering
$ccompare :: RpbResetBucketResp -> RpbResetBucketResp -> Ordering
$cp1Ord :: Eq RpbResetBucketResp
Prelude.Ord)
instance Prelude.Show RpbResetBucketResp where
  showsPrec :: Int -> RpbResetBucketResp -> ShowS
showsPrec Int
_ RpbResetBucketResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbResetBucketResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbResetBucketResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbResetBucketResp where
  messageName :: Proxy RpbResetBucketResp -> Text
messageName Proxy RpbResetBucketResp
_ = String -> Text
Data.Text.pack String
"RpbResetBucketResp"
  packedMessageDescriptor :: Proxy RpbResetBucketResp -> ByteString
packedMessageDescriptor Proxy RpbResetBucketResp
_
    = ByteString
"\n\
      \\DC2RpbResetBucketResp"
  packedFileDescriptor :: Proxy RpbResetBucketResp -> ByteString
packedFileDescriptor Proxy RpbResetBucketResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbResetBucketResp)
fieldsByTag = let in [(Tag, FieldDescriptor RpbResetBucketResp)]
-> Map Tag (FieldDescriptor RpbResetBucketResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbResetBucketResp FieldSet
unknownFields
    = (RpbResetBucketResp -> FieldSet)
-> (RpbResetBucketResp -> FieldSet -> RpbResetBucketResp)
-> Lens' RpbResetBucketResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbResetBucketResp -> FieldSet
_RpbResetBucketResp'_unknownFields
        (\ RpbResetBucketResp
x__ FieldSet
y__ -> RpbResetBucketResp
x__ {_RpbResetBucketResp'_unknownFields :: FieldSet
_RpbResetBucketResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbResetBucketResp
defMessage
    = RpbResetBucketResp'_constructor :: FieldSet -> RpbResetBucketResp
RpbResetBucketResp'_constructor
        {_RpbResetBucketResp'_unknownFields :: FieldSet
_RpbResetBucketResp'_unknownFields = []}
  parseMessage :: Parser RpbResetBucketResp
parseMessage
    = let
        loop ::
          RpbResetBucketResp
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbResetBucketResp
        loop :: RpbResetBucketResp -> Parser RpbResetBucketResp
loop RpbResetBucketResp
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]))))
                      RpbResetBucketResp -> Parser RpbResetBucketResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbResetBucketResp RpbResetBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbResetBucketResp
-> RpbResetBucketResp
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 RpbResetBucketResp RpbResetBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbResetBucketResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbResetBucketResp -> Parser RpbResetBucketResp
loop
                                  (Setter RpbResetBucketResp RpbResetBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbResetBucketResp
-> RpbResetBucketResp
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 RpbResetBucketResp RpbResetBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbResetBucketResp
x) }
      in
        Parser RpbResetBucketResp -> String -> Parser RpbResetBucketResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbResetBucketResp -> Parser RpbResetBucketResp
loop RpbResetBucketResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbResetBucketResp"
  buildMessage :: RpbResetBucketResp -> Builder
buildMessage
    = \ RpbResetBucketResp
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike
  FieldSet RpbResetBucketResp RpbResetBucketResp FieldSet FieldSet
-> RpbResetBucketResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbResetBucketResp RpbResetBucketResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbResetBucketResp
_x)
instance Control.DeepSeq.NFData RpbResetBucketResp where
  rnf :: RpbResetBucketResp -> ()
rnf
    = \ RpbResetBucketResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbResetBucketResp -> FieldSet
_RpbResetBucketResp'_unknownFields RpbResetBucketResp
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.fields' @:: Lens' RpbSearchDoc [RpbPair]@
         * 'Proto.Riak_Fields.vec'fields' @:: Lens' RpbSearchDoc (Data.Vector.Vector RpbPair)@ -}
data RpbSearchDoc
  = RpbSearchDoc'_constructor {RpbSearchDoc -> Vector RpbPair
_RpbSearchDoc'fields :: !(Data.Vector.Vector RpbPair),
                               RpbSearchDoc -> FieldSet
_RpbSearchDoc'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbSearchDoc -> RpbSearchDoc -> Bool
(RpbSearchDoc -> RpbSearchDoc -> Bool)
-> (RpbSearchDoc -> RpbSearchDoc -> Bool) -> Eq RpbSearchDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbSearchDoc -> RpbSearchDoc -> Bool
$c/= :: RpbSearchDoc -> RpbSearchDoc -> Bool
== :: RpbSearchDoc -> RpbSearchDoc -> Bool
$c== :: RpbSearchDoc -> RpbSearchDoc -> Bool
Prelude.Eq, Eq RpbSearchDoc
Eq RpbSearchDoc
-> (RpbSearchDoc -> RpbSearchDoc -> Ordering)
-> (RpbSearchDoc -> RpbSearchDoc -> Bool)
-> (RpbSearchDoc -> RpbSearchDoc -> Bool)
-> (RpbSearchDoc -> RpbSearchDoc -> Bool)
-> (RpbSearchDoc -> RpbSearchDoc -> Bool)
-> (RpbSearchDoc -> RpbSearchDoc -> RpbSearchDoc)
-> (RpbSearchDoc -> RpbSearchDoc -> RpbSearchDoc)
-> Ord RpbSearchDoc
RpbSearchDoc -> RpbSearchDoc -> Bool
RpbSearchDoc -> RpbSearchDoc -> Ordering
RpbSearchDoc -> RpbSearchDoc -> RpbSearchDoc
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 :: RpbSearchDoc -> RpbSearchDoc -> RpbSearchDoc
$cmin :: RpbSearchDoc -> RpbSearchDoc -> RpbSearchDoc
max :: RpbSearchDoc -> RpbSearchDoc -> RpbSearchDoc
$cmax :: RpbSearchDoc -> RpbSearchDoc -> RpbSearchDoc
>= :: RpbSearchDoc -> RpbSearchDoc -> Bool
$c>= :: RpbSearchDoc -> RpbSearchDoc -> Bool
> :: RpbSearchDoc -> RpbSearchDoc -> Bool
$c> :: RpbSearchDoc -> RpbSearchDoc -> Bool
<= :: RpbSearchDoc -> RpbSearchDoc -> Bool
$c<= :: RpbSearchDoc -> RpbSearchDoc -> Bool
< :: RpbSearchDoc -> RpbSearchDoc -> Bool
$c< :: RpbSearchDoc -> RpbSearchDoc -> Bool
compare :: RpbSearchDoc -> RpbSearchDoc -> Ordering
$ccompare :: RpbSearchDoc -> RpbSearchDoc -> Ordering
$cp1Ord :: Eq RpbSearchDoc
Prelude.Ord)
instance Prelude.Show RpbSearchDoc where
  showsPrec :: Int -> RpbSearchDoc -> ShowS
showsPrec Int
_ RpbSearchDoc
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbSearchDoc -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbSearchDoc
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbSearchDoc "fields" [RpbPair] where
  fieldOf :: Proxy# "fields"
-> ([RpbPair] -> f [RpbPair]) -> RpbSearchDoc -> f RpbSearchDoc
fieldOf Proxy# "fields"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbSearchDoc -> f RpbSearchDoc)
-> (([RpbPair] -> f [RpbPair])
    -> Vector RpbPair -> f (Vector RpbPair))
-> ([RpbPair] -> f [RpbPair])
-> RpbSearchDoc
-> f RpbSearchDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchDoc -> Vector RpbPair)
-> (RpbSearchDoc -> Vector RpbPair -> RpbSearchDoc)
-> Lens RpbSearchDoc RpbSearchDoc (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchDoc -> Vector RpbPair
_RpbSearchDoc'fields
           (\ RpbSearchDoc
x__ Vector RpbPair
y__ -> RpbSearchDoc
x__ {_RpbSearchDoc'fields :: Vector RpbPair
_RpbSearchDoc'fields = Vector RpbPair
y__}))
        ((Vector RpbPair -> [RpbPair])
-> (Vector RpbPair -> [RpbPair] -> Vector RpbPair)
-> Lens (Vector RpbPair) (Vector RpbPair) [RpbPair] [RpbPair]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbPair -> [RpbPair]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbPair
_ [RpbPair]
y__ -> [RpbPair] -> Vector RpbPair
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbPair]
y__))
instance Data.ProtoLens.Field.HasField RpbSearchDoc "vec'fields" (Data.Vector.Vector RpbPair) where
  fieldOf :: Proxy# "vec'fields"
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbSearchDoc
-> f RpbSearchDoc
fieldOf Proxy# "vec'fields"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> RpbSearchDoc -> f RpbSearchDoc)
-> ((Vector RpbPair -> f (Vector RpbPair))
    -> Vector RpbPair -> f (Vector RpbPair))
-> (Vector RpbPair -> f (Vector RpbPair))
-> RpbSearchDoc
-> f RpbSearchDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchDoc -> Vector RpbPair)
-> (RpbSearchDoc -> Vector RpbPair -> RpbSearchDoc)
-> Lens RpbSearchDoc RpbSearchDoc (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchDoc -> Vector RpbPair
_RpbSearchDoc'fields
           (\ RpbSearchDoc
x__ Vector RpbPair
y__ -> RpbSearchDoc
x__ {_RpbSearchDoc'fields :: Vector RpbPair
_RpbSearchDoc'fields = Vector RpbPair
y__}))
        (Vector RpbPair -> f (Vector RpbPair))
-> Vector RpbPair -> f (Vector RpbPair)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbSearchDoc where
  messageName :: Proxy RpbSearchDoc -> Text
messageName Proxy RpbSearchDoc
_ = String -> Text
Data.Text.pack String
"RpbSearchDoc"
  packedMessageDescriptor :: Proxy RpbSearchDoc -> ByteString
packedMessageDescriptor Proxy RpbSearchDoc
_
    = ByteString
"\n\
      \\fRpbSearchDoc\DC2 \n\
      \\ACKfields\CAN\SOH \ETX(\v2\b.RpbPairR\ACKfields"
  packedFileDescriptor :: Proxy RpbSearchDoc -> ByteString
packedFileDescriptor Proxy RpbSearchDoc
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbSearchDoc)
fieldsByTag
    = let
        fields__field_descriptor :: FieldDescriptor RpbSearchDoc
fields__field_descriptor
          = String
-> FieldTypeDescriptor RpbPair
-> FieldAccessor RpbSearchDoc RpbPair
-> FieldDescriptor RpbSearchDoc
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"fields"
              (MessageOrGroup -> FieldTypeDescriptor RpbPair
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbPair)
              (Packing
-> Lens' RpbSearchDoc [RpbPair]
-> FieldAccessor RpbSearchDoc RpbPair
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "fields" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"fields")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchDoc
      in
        [(Tag, FieldDescriptor RpbSearchDoc)]
-> Map Tag (FieldDescriptor RpbSearchDoc)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbSearchDoc
fields__field_descriptor)]
  unknownFields :: LensLike' f RpbSearchDoc FieldSet
unknownFields
    = (RpbSearchDoc -> FieldSet)
-> (RpbSearchDoc -> FieldSet -> RpbSearchDoc)
-> Lens' RpbSearchDoc FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbSearchDoc -> FieldSet
_RpbSearchDoc'_unknownFields
        (\ RpbSearchDoc
x__ FieldSet
y__ -> RpbSearchDoc
x__ {_RpbSearchDoc'_unknownFields :: FieldSet
_RpbSearchDoc'_unknownFields = FieldSet
y__})
  defMessage :: RpbSearchDoc
defMessage
    = RpbSearchDoc'_constructor :: Vector RpbPair -> FieldSet -> RpbSearchDoc
RpbSearchDoc'_constructor
        {_RpbSearchDoc'fields :: Vector RpbPair
_RpbSearchDoc'fields = Vector RpbPair
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbSearchDoc'_unknownFields :: FieldSet
_RpbSearchDoc'_unknownFields = []}
  parseMessage :: Parser RpbSearchDoc
parseMessage
    = let
        loop ::
          RpbSearchDoc
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbPair
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbSearchDoc
        loop :: RpbSearchDoc
-> Growing Vector RealWorld RpbPair -> Parser RpbSearchDoc
loop RpbSearchDoc
x Growing Vector RealWorld RpbPair
mutable'fields
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbPair
frozen'fields <- IO (Vector RpbPair) -> Parser (Vector RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                         (Growing Vector (PrimState IO) RpbPair -> IO (Vector RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'fields)
                      (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]))))
                      RpbSearchDoc -> Parser RpbSearchDoc
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbSearchDoc RpbSearchDoc FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSearchDoc -> RpbSearchDoc
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 RpbSearchDoc RpbSearchDoc FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter RpbSearchDoc RpbSearchDoc (Vector RpbPair) (Vector RpbPair)
-> Vector RpbPair -> RpbSearchDoc -> RpbSearchDoc
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'fields" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'fields") Vector RpbPair
frozen'fields RpbSearchDoc
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbPair
y <- Parser RpbPair -> String -> Parser RpbPair
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbPair -> Parser RpbPair
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 RpbPair
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"fields"
                                Growing Vector RealWorld RpbPair
v <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbPair
-> RpbPair -> IO (Growing Vector (PrimState IO) RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'fields RpbPair
y)
                                RpbSearchDoc
-> Growing Vector RealWorld RpbPair -> Parser RpbSearchDoc
loop RpbSearchDoc
x Growing Vector RealWorld RpbPair
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbSearchDoc
-> Growing Vector RealWorld RpbPair -> Parser RpbSearchDoc
loop
                                  (Setter RpbSearchDoc RpbSearchDoc FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSearchDoc -> RpbSearchDoc
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 RpbSearchDoc RpbSearchDoc FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbSearchDoc
x)
                                  Growing Vector RealWorld RpbPair
mutable'fields
      in
        Parser RpbSearchDoc -> String -> Parser RpbSearchDoc
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbPair
mutable'fields <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                  IO (Growing Vector RealWorld RpbPair)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbSearchDoc
-> Growing Vector RealWorld RpbPair -> Parser RpbSearchDoc
loop RpbSearchDoc
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbPair
mutable'fields)
          String
"RpbSearchDoc"
  buildMessage :: RpbSearchDoc -> Builder
buildMessage
    = \ RpbSearchDoc
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbPair -> Builder) -> Vector RpbPair -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbPair
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbPair -> ByteString) -> RpbPair -> 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))
                           RpbPair -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbPair
_v))
                (FoldLike
  (Vector RpbPair)
  RpbSearchDoc
  RpbSearchDoc
  (Vector RpbPair)
  (Vector RpbPair)
-> RpbSearchDoc -> Vector RpbPair
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'fields" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'fields") RpbSearchDoc
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet RpbSearchDoc RpbSearchDoc FieldSet FieldSet
-> RpbSearchDoc -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbSearchDoc RpbSearchDoc FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbSearchDoc
_x))
instance Control.DeepSeq.NFData RpbSearchDoc where
  rnf :: RpbSearchDoc -> ()
rnf
    = \ RpbSearchDoc
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbSearchDoc -> FieldSet
_RpbSearchDoc'_unknownFields RpbSearchDoc
x__)
             (Vector RpbPair -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbSearchDoc -> Vector RpbPair
_RpbSearchDoc'fields RpbSearchDoc
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.q' @:: Lens' RpbSearchQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.index' @:: Lens' RpbSearchQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.rows' @:: Lens' RpbSearchQueryReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'rows' @:: Lens' RpbSearchQueryReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.start' @:: Lens' RpbSearchQueryReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'start' @:: Lens' RpbSearchQueryReq (Prelude.Maybe Data.Word.Word32)@
         * 'Proto.Riak_Fields.sort' @:: Lens' RpbSearchQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'sort' @:: Lens' RpbSearchQueryReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.filter' @:: Lens' RpbSearchQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'filter' @:: Lens' RpbSearchQueryReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.df' @:: Lens' RpbSearchQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'df' @:: Lens' RpbSearchQueryReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.op' @:: Lens' RpbSearchQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'op' @:: Lens' RpbSearchQueryReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.fl' @:: Lens' RpbSearchQueryReq [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'fl' @:: Lens' RpbSearchQueryReq (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.presort' @:: Lens' RpbSearchQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'presort' @:: Lens' RpbSearchQueryReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbSearchQueryReq
  = RpbSearchQueryReq'_constructor {RpbSearchQueryReq -> ByteString
_RpbSearchQueryReq'q :: !Data.ByteString.ByteString,
                                    RpbSearchQueryReq -> ByteString
_RpbSearchQueryReq'index :: !Data.ByteString.ByteString,
                                    RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'rows :: !(Prelude.Maybe Data.Word.Word32),
                                    RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'start :: !(Prelude.Maybe Data.Word.Word32),
                                    RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'sort :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'filter :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'df :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'op :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbSearchQueryReq -> Vector ByteString
_RpbSearchQueryReq'fl :: !(Data.Vector.Vector Data.ByteString.ByteString),
                                    RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'presort :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbSearchQueryReq -> FieldSet
_RpbSearchQueryReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
(RpbSearchQueryReq -> RpbSearchQueryReq -> Bool)
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> Bool)
-> Eq RpbSearchQueryReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
$c/= :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
== :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
$c== :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
Prelude.Eq, Eq RpbSearchQueryReq
Eq RpbSearchQueryReq
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> Ordering)
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> Bool)
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> Bool)
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> Bool)
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> Bool)
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> RpbSearchQueryReq)
-> (RpbSearchQueryReq -> RpbSearchQueryReq -> RpbSearchQueryReq)
-> Ord RpbSearchQueryReq
RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
RpbSearchQueryReq -> RpbSearchQueryReq -> Ordering
RpbSearchQueryReq -> RpbSearchQueryReq -> RpbSearchQueryReq
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 :: RpbSearchQueryReq -> RpbSearchQueryReq -> RpbSearchQueryReq
$cmin :: RpbSearchQueryReq -> RpbSearchQueryReq -> RpbSearchQueryReq
max :: RpbSearchQueryReq -> RpbSearchQueryReq -> RpbSearchQueryReq
$cmax :: RpbSearchQueryReq -> RpbSearchQueryReq -> RpbSearchQueryReq
>= :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
$c>= :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
> :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
$c> :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
<= :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
$c<= :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
< :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
$c< :: RpbSearchQueryReq -> RpbSearchQueryReq -> Bool
compare :: RpbSearchQueryReq -> RpbSearchQueryReq -> Ordering
$ccompare :: RpbSearchQueryReq -> RpbSearchQueryReq -> Ordering
$cp1Ord :: Eq RpbSearchQueryReq
Prelude.Ord)
instance Prelude.Show RpbSearchQueryReq where
  showsPrec :: Int -> RpbSearchQueryReq -> ShowS
showsPrec Int
_ RpbSearchQueryReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbSearchQueryReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbSearchQueryReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "q" Data.ByteString.ByteString where
  fieldOf :: Proxy# "q"
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "q"
_
    = ((ByteString -> f ByteString)
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> ByteString)
-> (RpbSearchQueryReq -> ByteString -> RpbSearchQueryReq)
-> Lens RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> ByteString
_RpbSearchQueryReq'q
           (\ RpbSearchQueryReq
x__ ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'q :: ByteString
_RpbSearchQueryReq'q = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "index" Data.ByteString.ByteString where
  fieldOf :: Proxy# "index"
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "index"
_
    = ((ByteString -> f ByteString)
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> ByteString)
-> (RpbSearchQueryReq -> ByteString -> RpbSearchQueryReq)
-> Lens RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> ByteString
_RpbSearchQueryReq'index
           (\ RpbSearchQueryReq
x__ ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'index :: ByteString
_RpbSearchQueryReq'index = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "rows" Data.Word.Word32 where
  fieldOf :: Proxy# "rows"
-> (Word32 -> f Word32) -> RpbSearchQueryReq -> f RpbSearchQueryReq
fieldOf Proxy# "rows"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe Word32)
-> (RpbSearchQueryReq -> Maybe Word32 -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq RpbSearchQueryReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'rows
           (\ RpbSearchQueryReq
x__ Maybe Word32
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'rows :: Maybe Word32
_RpbSearchQueryReq'rows = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "maybe'rows" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'rows"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "maybe'rows"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe Word32)
-> (RpbSearchQueryReq -> Maybe Word32 -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq RpbSearchQueryReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'rows
           (\ RpbSearchQueryReq
x__ Maybe Word32
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'rows :: Maybe Word32
_RpbSearchQueryReq'rows = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "start" Data.Word.Word32 where
  fieldOf :: Proxy# "start"
-> (Word32 -> f Word32) -> RpbSearchQueryReq -> f RpbSearchQueryReq
fieldOf Proxy# "start"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe Word32)
-> (RpbSearchQueryReq -> Maybe Word32 -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq RpbSearchQueryReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'start
           (\ RpbSearchQueryReq
x__ Maybe Word32
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'start :: Maybe Word32
_RpbSearchQueryReq'start = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "maybe'start" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'start"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "maybe'start"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe Word32)
-> (RpbSearchQueryReq -> Maybe Word32 -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq RpbSearchQueryReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'start
           (\ RpbSearchQueryReq
x__ Maybe Word32
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'start :: Maybe Word32
_RpbSearchQueryReq'start = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "sort" Data.ByteString.ByteString where
  fieldOf :: Proxy# "sort"
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "sort"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'sort
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'sort :: Maybe ByteString
_RpbSearchQueryReq'sort = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "maybe'sort" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'sort"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "maybe'sort"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'sort
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'sort :: Maybe ByteString
_RpbSearchQueryReq'sort = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "filter" Data.ByteString.ByteString where
  fieldOf :: Proxy# "filter"
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "filter"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'filter
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'filter :: Maybe ByteString
_RpbSearchQueryReq'filter = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "maybe'filter" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'filter"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "maybe'filter"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'filter
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'filter :: Maybe ByteString
_RpbSearchQueryReq'filter = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "df" Data.ByteString.ByteString where
  fieldOf :: Proxy# "df"
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "df"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'df
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'df :: Maybe ByteString
_RpbSearchQueryReq'df = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "maybe'df" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'df"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "maybe'df"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'df
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'df :: Maybe ByteString
_RpbSearchQueryReq'df = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "op" Data.ByteString.ByteString where
  fieldOf :: Proxy# "op"
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "op"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'op
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'op :: Maybe ByteString
_RpbSearchQueryReq'op = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "maybe'op" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'op"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "maybe'op"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'op
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'op :: Maybe ByteString
_RpbSearchQueryReq'op = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "fl" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "fl"
-> ([ByteString] -> f [ByteString])
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "fl"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Vector ByteString)
-> (RpbSearchQueryReq -> Vector ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Vector ByteString
_RpbSearchQueryReq'fl
           (\ RpbSearchQueryReq
x__ Vector ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'fl :: Vector ByteString
_RpbSearchQueryReq'fl = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "vec'fl" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'fl"
-> (Vector ByteString -> f (Vector ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "vec'fl"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Vector ByteString)
-> (RpbSearchQueryReq -> Vector ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Vector ByteString)
     (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Vector ByteString
_RpbSearchQueryReq'fl
           (\ RpbSearchQueryReq
x__ Vector ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'fl :: Vector ByteString
_RpbSearchQueryReq'fl = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "presort" Data.ByteString.ByteString where
  fieldOf :: Proxy# "presort"
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "presort"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'presort
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'presort :: Maybe ByteString
_RpbSearchQueryReq'presort = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryReq "maybe'presort" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'presort"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
fieldOf Proxy# "maybe'presort"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSearchQueryReq -> f RpbSearchQueryReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSearchQueryReq
-> f RpbSearchQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryReq -> Maybe ByteString)
-> (RpbSearchQueryReq -> Maybe ByteString -> RpbSearchQueryReq)
-> Lens
     RpbSearchQueryReq
     RpbSearchQueryReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'presort
           (\ RpbSearchQueryReq
x__ Maybe ByteString
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'presort :: Maybe ByteString
_RpbSearchQueryReq'presort = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbSearchQueryReq where
  messageName :: Proxy RpbSearchQueryReq -> Text
messageName Proxy RpbSearchQueryReq
_ = String -> Text
Data.Text.pack String
"RpbSearchQueryReq"
  packedMessageDescriptor :: Proxy RpbSearchQueryReq -> ByteString
packedMessageDescriptor Proxy RpbSearchQueryReq
_
    = ByteString
"\n\
      \\DC1RpbSearchQueryReq\DC2\f\n\
      \\SOHq\CAN\SOH \STX(\fR\SOHq\DC2\DC4\n\
      \\ENQindex\CAN\STX \STX(\fR\ENQindex\DC2\DC2\n\
      \\EOTrows\CAN\ETX \SOH(\rR\EOTrows\DC2\DC4\n\
      \\ENQstart\CAN\EOT \SOH(\rR\ENQstart\DC2\DC2\n\
      \\EOTsort\CAN\ENQ \SOH(\fR\EOTsort\DC2\SYN\n\
      \\ACKfilter\CAN\ACK \SOH(\fR\ACKfilter\DC2\SO\n\
      \\STXdf\CAN\a \SOH(\fR\STXdf\DC2\SO\n\
      \\STXop\CAN\b \SOH(\fR\STXop\DC2\SO\n\
      \\STXfl\CAN\t \ETX(\fR\STXfl\DC2\CAN\n\
      \\apresort\CAN\n\
      \ \SOH(\fR\apresort"
  packedFileDescriptor :: Proxy RpbSearchQueryReq -> ByteString
packedFileDescriptor Proxy RpbSearchQueryReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbSearchQueryReq)
fieldsByTag
    = let
        q__field_descriptor :: FieldDescriptor RpbSearchQueryReq
q__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"q"
              (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 RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "q" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"q")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        index__field_descriptor :: FieldDescriptor RpbSearchQueryReq
index__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"index"
              (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 RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        rows__field_descriptor :: FieldDescriptor RpbSearchQueryReq
rows__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbSearchQueryReq Word32
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"rows"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbSearchQueryReq RpbSearchQueryReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbSearchQueryReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rows")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        start__field_descriptor :: FieldDescriptor RpbSearchQueryReq
start__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbSearchQueryReq Word32
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"start"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbSearchQueryReq RpbSearchQueryReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbSearchQueryReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'start" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'start")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        sort__field_descriptor :: FieldDescriptor RpbSearchQueryReq
sort__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"sort"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbSearchQueryReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'sort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sort")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        filter__field_descriptor :: FieldDescriptor RpbSearchQueryReq
filter__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"filter"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbSearchQueryReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'filter" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'filter")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        df__field_descriptor :: FieldDescriptor RpbSearchQueryReq
df__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"df"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbSearchQueryReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'df" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'df")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        op__field_descriptor :: FieldDescriptor RpbSearchQueryReq
op__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"op"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbSearchQueryReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'op" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'op")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        fl__field_descriptor :: FieldDescriptor RpbSearchQueryReq
fl__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"fl"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' RpbSearchQueryReq [ByteString]
-> FieldAccessor RpbSearchQueryReq ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "fl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"fl")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
        presort__field_descriptor :: FieldDescriptor RpbSearchQueryReq
presort__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSearchQueryReq ByteString
-> FieldDescriptor RpbSearchQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"presort"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbSearchQueryReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'presort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'presort")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryReq
      in
        [(Tag, FieldDescriptor RpbSearchQueryReq)]
-> Map Tag (FieldDescriptor RpbSearchQueryReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbSearchQueryReq
q__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbSearchQueryReq
index__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbSearchQueryReq
rows__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor RpbSearchQueryReq
start__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor RpbSearchQueryReq
sort__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor RpbSearchQueryReq
filter__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor RpbSearchQueryReq
df__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
8, FieldDescriptor RpbSearchQueryReq
op__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
9, FieldDescriptor RpbSearchQueryReq
fl__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
10, FieldDescriptor RpbSearchQueryReq
presort__field_descriptor)]
  unknownFields :: LensLike' f RpbSearchQueryReq FieldSet
unknownFields
    = (RpbSearchQueryReq -> FieldSet)
-> (RpbSearchQueryReq -> FieldSet -> RpbSearchQueryReq)
-> Lens' RpbSearchQueryReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbSearchQueryReq -> FieldSet
_RpbSearchQueryReq'_unknownFields
        (\ RpbSearchQueryReq
x__ FieldSet
y__ -> RpbSearchQueryReq
x__ {_RpbSearchQueryReq'_unknownFields :: FieldSet
_RpbSearchQueryReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbSearchQueryReq
defMessage
    = RpbSearchQueryReq'_constructor :: ByteString
-> ByteString
-> Maybe Word32
-> Maybe Word32
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Vector ByteString
-> Maybe ByteString
-> FieldSet
-> RpbSearchQueryReq
RpbSearchQueryReq'_constructor
        {_RpbSearchQueryReq'q :: ByteString
_RpbSearchQueryReq'q = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbSearchQueryReq'index :: ByteString
_RpbSearchQueryReq'index = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbSearchQueryReq'rows :: Maybe Word32
_RpbSearchQueryReq'rows = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryReq'start :: Maybe Word32
_RpbSearchQueryReq'start = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryReq'sort :: Maybe ByteString
_RpbSearchQueryReq'sort = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryReq'filter :: Maybe ByteString
_RpbSearchQueryReq'filter = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryReq'df :: Maybe ByteString
_RpbSearchQueryReq'df = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryReq'op :: Maybe ByteString
_RpbSearchQueryReq'op = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryReq'fl :: Vector ByteString
_RpbSearchQueryReq'fl = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbSearchQueryReq'presort :: Maybe ByteString
_RpbSearchQueryReq'presort = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryReq'_unknownFields :: FieldSet
_RpbSearchQueryReq'_unknownFields = []}
  parseMessage :: Parser RpbSearchQueryReq
parseMessage
    = let
        loop ::
          RpbSearchQueryReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
                   -> Data.ProtoLens.Encoding.Bytes.Parser RpbSearchQueryReq
        loop :: RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop RpbSearchQueryReq
x Bool
required'index Bool
required'q Growing Vector RealWorld ByteString
mutable'fl
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'fl <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                     (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'fl)
                      (let
                         missing :: [String]
missing
                           = (if Bool
required'index then (:) String
"index" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'q then (:) String
"q" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbSearchQueryReq -> Parser RpbSearchQueryReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbSearchQueryReq RpbSearchQueryReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSearchQueryReq -> RpbSearchQueryReq
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 RpbSearchQueryReq RpbSearchQueryReq FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Vector ByteString)
  (Vector ByteString)
-> Vector ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'fl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'fl") Vector ByteString
frozen'fl RpbSearchQueryReq
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
"q"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "q" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"q") ByteString
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
Prelude.False
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
18
                          -> 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
"index"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index") ByteString
y RpbSearchQueryReq
x)
                                  Bool
Prelude.False
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
24
                          -> 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
"rows"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq Word32 Word32
-> Word32 -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rows") Word32
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
32
                          -> 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
"start"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq Word32 Word32
-> Word32 -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "start" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"start") Word32
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
42
                          -> 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
"sort"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "sort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"sort") ByteString
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
50
                          -> 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
"filter"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "filter" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"filter") ByteString
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
58
                          -> 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
"df"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "df" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"df") ByteString
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
66
                          -> 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
"op"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "op" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"op") ByteString
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
74
                          -> 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
"fl"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'fl ByteString
y)
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop RpbSearchQueryReq
x Bool
required'index Bool
required'q Growing Vector RealWorld ByteString
v
                        Word64
82
                          -> 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
"presort"
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq ByteString ByteString
-> ByteString -> RpbSearchQueryReq -> RpbSearchQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "presort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"presort") ByteString
y RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                                  (Setter RpbSearchQueryReq RpbSearchQueryReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSearchQueryReq -> RpbSearchQueryReq
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 RpbSearchQueryReq RpbSearchQueryReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbSearchQueryReq
x)
                                  Bool
required'index
                                  Bool
required'q
                                  Growing Vector RealWorld ByteString
mutable'fl
      in
        Parser RpbSearchQueryReq -> String -> Parser RpbSearchQueryReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'fl <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                              IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbSearchQueryReq
-> Bool
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser RpbSearchQueryReq
loop
                RpbSearchQueryReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Growing Vector RealWorld ByteString
mutable'fl)
          String
"RpbSearchQueryReq"
  buildMessage :: RpbSearchQueryReq -> Builder
buildMessage
    = \ RpbSearchQueryReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbSearchQueryReq
  RpbSearchQueryReq
  ByteString
  ByteString
-> RpbSearchQueryReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "q" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"q") RpbSearchQueryReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString
  RpbSearchQueryReq
  RpbSearchQueryReq
  ByteString
  ByteString
-> RpbSearchQueryReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index") RpbSearchQueryReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbSearchQueryReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'rows") RpbSearchQueryReq
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Word32)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbSearchQueryReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'start" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'start") RpbSearchQueryReq
_x
                       of
                         Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Word32
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike
  (Maybe ByteString)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbSearchQueryReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'sort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sort") RpbSearchQueryReq
_x
                          of
                            Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just ByteString
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                                   ((\ 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))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (case
                                 FoldLike
  (Maybe ByteString)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbSearchQueryReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'filter" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'filter") RpbSearchQueryReq
_x
                             of
                               Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                               (Prelude.Just ByteString
_v)
                                 -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                                      ((\ 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))
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (case
                                    FoldLike
  (Maybe ByteString)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbSearchQueryReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'df" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'df") RpbSearchQueryReq
_x
                                of
                                  Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                  (Prelude.Just ByteString
_v)
                                    -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
58)
                                         ((\ 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))
                               (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (case
                                       FoldLike
  (Maybe ByteString)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbSearchQueryReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'op" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'op") RpbSearchQueryReq
_x
                                   of
                                     Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                     (Prelude.Just ByteString
_v)
                                       -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
66)
                                            ((\ 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))
                                  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                                        (\ ByteString
_v
                                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
74)
                                                ((\ 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))
                                        (FoldLike
  (Vector ByteString)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Vector ByteString)
  (Vector ByteString)
-> RpbSearchQueryReq -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                           (forall s a (f :: * -> *).
(HasField s "vec'fl" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'fl") RpbSearchQueryReq
_x))
                                     (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                        (case
                                             FoldLike
  (Maybe ByteString)
  RpbSearchQueryReq
  RpbSearchQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbSearchQueryReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                               (forall s a (f :: * -> *).
(HasField s "maybe'presort" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'presort") RpbSearchQueryReq
_x
                                         of
                                           Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                                           (Prelude.Just ByteString
_v)
                                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
82)
                                                  ((\ 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 RpbSearchQueryReq RpbSearchQueryReq FieldSet FieldSet
-> RpbSearchQueryReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                              FoldLike
  FieldSet RpbSearchQueryReq RpbSearchQueryReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbSearchQueryReq
_x)))))))))))
instance Control.DeepSeq.NFData RpbSearchQueryReq where
  rnf :: RpbSearchQueryReq -> ()
rnf
    = \ RpbSearchQueryReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbSearchQueryReq -> FieldSet
_RpbSearchQueryReq'_unknownFields RpbSearchQueryReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbSearchQueryReq -> ByteString
_RpbSearchQueryReq'q RpbSearchQueryReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbSearchQueryReq -> ByteString
_RpbSearchQueryReq'index RpbSearchQueryReq
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'rows RpbSearchQueryReq
x__)
                      (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (RpbSearchQueryReq -> Maybe Word32
_RpbSearchQueryReq'start RpbSearchQueryReq
x__)
                         (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'sort RpbSearchQueryReq
x__)
                            (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                               (RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'filter RpbSearchQueryReq
x__)
                               (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                  (RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'df RpbSearchQueryReq
x__)
                                  (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                     (RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'op RpbSearchQueryReq
x__)
                                     (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                        (RpbSearchQueryReq -> Vector ByteString
_RpbSearchQueryReq'fl RpbSearchQueryReq
x__)
                                        (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                                           (RpbSearchQueryReq -> Maybe ByteString
_RpbSearchQueryReq'presort RpbSearchQueryReq
x__) ()))))))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.docs' @:: Lens' RpbSearchQueryResp [RpbSearchDoc]@
         * 'Proto.Riak_Fields.vec'docs' @:: Lens' RpbSearchQueryResp (Data.Vector.Vector RpbSearchDoc)@
         * 'Proto.Riak_Fields.maxScore' @:: Lens' RpbSearchQueryResp Prelude.Float@
         * 'Proto.Riak_Fields.maybe'maxScore' @:: Lens' RpbSearchQueryResp (Prelude.Maybe Prelude.Float)@
         * 'Proto.Riak_Fields.numFound' @:: Lens' RpbSearchQueryResp Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'numFound' @:: Lens' RpbSearchQueryResp (Prelude.Maybe Data.Word.Word32)@ -}
data RpbSearchQueryResp
  = RpbSearchQueryResp'_constructor {RpbSearchQueryResp -> Vector RpbSearchDoc
_RpbSearchQueryResp'docs :: !(Data.Vector.Vector RpbSearchDoc),
                                     RpbSearchQueryResp -> Maybe Float
_RpbSearchQueryResp'maxScore :: !(Prelude.Maybe Prelude.Float),
                                     RpbSearchQueryResp -> Maybe Word32
_RpbSearchQueryResp'numFound :: !(Prelude.Maybe Data.Word.Word32),
                                     RpbSearchQueryResp -> FieldSet
_RpbSearchQueryResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
(RpbSearchQueryResp -> RpbSearchQueryResp -> Bool)
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> Bool)
-> Eq RpbSearchQueryResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
$c/= :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
== :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
$c== :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
Prelude.Eq, Eq RpbSearchQueryResp
Eq RpbSearchQueryResp
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> Ordering)
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> Bool)
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> Bool)
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> Bool)
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> Bool)
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> RpbSearchQueryResp)
-> (RpbSearchQueryResp -> RpbSearchQueryResp -> RpbSearchQueryResp)
-> Ord RpbSearchQueryResp
RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
RpbSearchQueryResp -> RpbSearchQueryResp -> Ordering
RpbSearchQueryResp -> RpbSearchQueryResp -> RpbSearchQueryResp
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 :: RpbSearchQueryResp -> RpbSearchQueryResp -> RpbSearchQueryResp
$cmin :: RpbSearchQueryResp -> RpbSearchQueryResp -> RpbSearchQueryResp
max :: RpbSearchQueryResp -> RpbSearchQueryResp -> RpbSearchQueryResp
$cmax :: RpbSearchQueryResp -> RpbSearchQueryResp -> RpbSearchQueryResp
>= :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
$c>= :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
> :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
$c> :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
<= :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
$c<= :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
< :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
$c< :: RpbSearchQueryResp -> RpbSearchQueryResp -> Bool
compare :: RpbSearchQueryResp -> RpbSearchQueryResp -> Ordering
$ccompare :: RpbSearchQueryResp -> RpbSearchQueryResp -> Ordering
$cp1Ord :: Eq RpbSearchQueryResp
Prelude.Ord)
instance Prelude.Show RpbSearchQueryResp where
  showsPrec :: Int -> RpbSearchQueryResp -> ShowS
showsPrec Int
_ RpbSearchQueryResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbSearchQueryResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbSearchQueryResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbSearchQueryResp "docs" [RpbSearchDoc] where
  fieldOf :: Proxy# "docs"
-> ([RpbSearchDoc] -> f [RpbSearchDoc])
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
fieldOf Proxy# "docs"
_
    = ((Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
 -> RpbSearchQueryResp -> f RpbSearchQueryResp)
-> (([RpbSearchDoc] -> f [RpbSearchDoc])
    -> Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
-> ([RpbSearchDoc] -> f [RpbSearchDoc])
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryResp -> Vector RpbSearchDoc)
-> (RpbSearchQueryResp
    -> Vector RpbSearchDoc -> RpbSearchQueryResp)
-> Lens
     RpbSearchQueryResp
     RpbSearchQueryResp
     (Vector RpbSearchDoc)
     (Vector RpbSearchDoc)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryResp -> Vector RpbSearchDoc
_RpbSearchQueryResp'docs
           (\ RpbSearchQueryResp
x__ Vector RpbSearchDoc
y__ -> RpbSearchQueryResp
x__ {_RpbSearchQueryResp'docs :: Vector RpbSearchDoc
_RpbSearchQueryResp'docs = Vector RpbSearchDoc
y__}))
        ((Vector RpbSearchDoc -> [RpbSearchDoc])
-> (Vector RpbSearchDoc -> [RpbSearchDoc] -> Vector RpbSearchDoc)
-> Lens
     (Vector RpbSearchDoc)
     (Vector RpbSearchDoc)
     [RpbSearchDoc]
     [RpbSearchDoc]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbSearchDoc -> [RpbSearchDoc]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbSearchDoc
_ [RpbSearchDoc]
y__ -> [RpbSearchDoc] -> Vector RpbSearchDoc
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbSearchDoc]
y__))
instance Data.ProtoLens.Field.HasField RpbSearchQueryResp "vec'docs" (Data.Vector.Vector RpbSearchDoc) where
  fieldOf :: Proxy# "vec'docs"
-> (Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
fieldOf Proxy# "vec'docs"
_
    = ((Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
 -> RpbSearchQueryResp -> f RpbSearchQueryResp)
-> ((Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
    -> Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
-> (Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryResp -> Vector RpbSearchDoc)
-> (RpbSearchQueryResp
    -> Vector RpbSearchDoc -> RpbSearchQueryResp)
-> Lens
     RpbSearchQueryResp
     RpbSearchQueryResp
     (Vector RpbSearchDoc)
     (Vector RpbSearchDoc)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryResp -> Vector RpbSearchDoc
_RpbSearchQueryResp'docs
           (\ RpbSearchQueryResp
x__ Vector RpbSearchDoc
y__ -> RpbSearchQueryResp
x__ {_RpbSearchQueryResp'docs :: Vector RpbSearchDoc
_RpbSearchQueryResp'docs = Vector RpbSearchDoc
y__}))
        (Vector RpbSearchDoc -> f (Vector RpbSearchDoc))
-> Vector RpbSearchDoc -> f (Vector RpbSearchDoc)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryResp "maxScore" Prelude.Float where
  fieldOf :: Proxy# "maxScore"
-> (Float -> f Float) -> RpbSearchQueryResp -> f RpbSearchQueryResp
fieldOf Proxy# "maxScore"
_
    = ((Maybe Float -> f (Maybe Float))
 -> RpbSearchQueryResp -> f RpbSearchQueryResp)
-> ((Float -> f Float) -> Maybe Float -> f (Maybe Float))
-> (Float -> f Float)
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryResp -> Maybe Float)
-> (RpbSearchQueryResp -> Maybe Float -> RpbSearchQueryResp)
-> Lens
     RpbSearchQueryResp RpbSearchQueryResp (Maybe Float) (Maybe Float)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryResp -> Maybe Float
_RpbSearchQueryResp'maxScore
           (\ RpbSearchQueryResp
x__ Maybe Float
y__ -> RpbSearchQueryResp
x__ {_RpbSearchQueryResp'maxScore :: Maybe Float
_RpbSearchQueryResp'maxScore = Maybe Float
y__}))
        (Float -> Lens' (Maybe Float) Float
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Float
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryResp "maybe'maxScore" (Prelude.Maybe Prelude.Float) where
  fieldOf :: Proxy# "maybe'maxScore"
-> (Maybe Float -> f (Maybe Float))
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
fieldOf Proxy# "maybe'maxScore"
_
    = ((Maybe Float -> f (Maybe Float))
 -> RpbSearchQueryResp -> f RpbSearchQueryResp)
-> ((Maybe Float -> f (Maybe Float))
    -> Maybe Float -> f (Maybe Float))
-> (Maybe Float -> f (Maybe Float))
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryResp -> Maybe Float)
-> (RpbSearchQueryResp -> Maybe Float -> RpbSearchQueryResp)
-> Lens
     RpbSearchQueryResp RpbSearchQueryResp (Maybe Float) (Maybe Float)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryResp -> Maybe Float
_RpbSearchQueryResp'maxScore
           (\ RpbSearchQueryResp
x__ Maybe Float
y__ -> RpbSearchQueryResp
x__ {_RpbSearchQueryResp'maxScore :: Maybe Float
_RpbSearchQueryResp'maxScore = Maybe Float
y__}))
        (Maybe Float -> f (Maybe Float)) -> Maybe Float -> f (Maybe Float)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSearchQueryResp "numFound" Data.Word.Word32 where
  fieldOf :: Proxy# "numFound"
-> (Word32 -> f Word32)
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
fieldOf Proxy# "numFound"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbSearchQueryResp -> f RpbSearchQueryResp)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryResp -> Maybe Word32)
-> (RpbSearchQueryResp -> Maybe Word32 -> RpbSearchQueryResp)
-> Lens
     RpbSearchQueryResp RpbSearchQueryResp (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryResp -> Maybe Word32
_RpbSearchQueryResp'numFound
           (\ RpbSearchQueryResp
x__ Maybe Word32
y__ -> RpbSearchQueryResp
x__ {_RpbSearchQueryResp'numFound :: Maybe Word32
_RpbSearchQueryResp'numFound = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSearchQueryResp "maybe'numFound" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'numFound"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
fieldOf Proxy# "maybe'numFound"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbSearchQueryResp -> f RpbSearchQueryResp)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbSearchQueryResp
-> f RpbSearchQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSearchQueryResp -> Maybe Word32)
-> (RpbSearchQueryResp -> Maybe Word32 -> RpbSearchQueryResp)
-> Lens
     RpbSearchQueryResp RpbSearchQueryResp (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSearchQueryResp -> Maybe Word32
_RpbSearchQueryResp'numFound
           (\ RpbSearchQueryResp
x__ Maybe Word32
y__ -> RpbSearchQueryResp
x__ {_RpbSearchQueryResp'numFound :: Maybe Word32
_RpbSearchQueryResp'numFound = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbSearchQueryResp where
  messageName :: Proxy RpbSearchQueryResp -> Text
messageName Proxy RpbSearchQueryResp
_ = String -> Text
Data.Text.pack String
"RpbSearchQueryResp"
  packedMessageDescriptor :: Proxy RpbSearchQueryResp -> ByteString
packedMessageDescriptor Proxy RpbSearchQueryResp
_
    = ByteString
"\n\
      \\DC2RpbSearchQueryResp\DC2!\n\
      \\EOTdocs\CAN\SOH \ETX(\v2\r.RpbSearchDocR\EOTdocs\DC2\ESC\n\
      \\tmax_score\CAN\STX \SOH(\STXR\bmaxScore\DC2\ESC\n\
      \\tnum_found\CAN\ETX \SOH(\rR\bnumFound"
  packedFileDescriptor :: Proxy RpbSearchQueryResp -> ByteString
packedFileDescriptor Proxy RpbSearchQueryResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbSearchQueryResp)
fieldsByTag
    = let
        docs__field_descriptor :: FieldDescriptor RpbSearchQueryResp
docs__field_descriptor
          = String
-> FieldTypeDescriptor RpbSearchDoc
-> FieldAccessor RpbSearchQueryResp RpbSearchDoc
-> FieldDescriptor RpbSearchQueryResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"docs"
              (MessageOrGroup -> FieldTypeDescriptor RpbSearchDoc
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbSearchDoc)
              (Packing
-> Lens' RpbSearchQueryResp [RpbSearchDoc]
-> FieldAccessor RpbSearchQueryResp RpbSearchDoc
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "docs" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"docs")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryResp
        maxScore__field_descriptor :: FieldDescriptor RpbSearchQueryResp
maxScore__field_descriptor
          = String
-> FieldTypeDescriptor Float
-> FieldAccessor RpbSearchQueryResp Float
-> FieldDescriptor RpbSearchQueryResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"max_score"
              (ScalarField Float -> FieldTypeDescriptor Float
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Float
Data.ProtoLens.FloatField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Float)
              (Lens
  RpbSearchQueryResp RpbSearchQueryResp (Maybe Float) (Maybe Float)
-> FieldAccessor RpbSearchQueryResp Float
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'maxScore" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'maxScore")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryResp
        numFound__field_descriptor :: FieldDescriptor RpbSearchQueryResp
numFound__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbSearchQueryResp Word32
-> FieldDescriptor RpbSearchQueryResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"num_found"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbSearchQueryResp RpbSearchQueryResp (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbSearchQueryResp Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'numFound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'numFound")) ::
              Data.ProtoLens.FieldDescriptor RpbSearchQueryResp
      in
        [(Tag, FieldDescriptor RpbSearchQueryResp)]
-> Map Tag (FieldDescriptor RpbSearchQueryResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbSearchQueryResp
docs__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbSearchQueryResp
maxScore__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbSearchQueryResp
numFound__field_descriptor)]
  unknownFields :: LensLike' f RpbSearchQueryResp FieldSet
unknownFields
    = (RpbSearchQueryResp -> FieldSet)
-> (RpbSearchQueryResp -> FieldSet -> RpbSearchQueryResp)
-> Lens' RpbSearchQueryResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbSearchQueryResp -> FieldSet
_RpbSearchQueryResp'_unknownFields
        (\ RpbSearchQueryResp
x__ FieldSet
y__ -> RpbSearchQueryResp
x__ {_RpbSearchQueryResp'_unknownFields :: FieldSet
_RpbSearchQueryResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbSearchQueryResp
defMessage
    = RpbSearchQueryResp'_constructor :: Vector RpbSearchDoc
-> Maybe Float -> Maybe Word32 -> FieldSet -> RpbSearchQueryResp
RpbSearchQueryResp'_constructor
        {_RpbSearchQueryResp'docs :: Vector RpbSearchDoc
_RpbSearchQueryResp'docs = Vector RpbSearchDoc
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbSearchQueryResp'maxScore :: Maybe Float
_RpbSearchQueryResp'maxScore = Maybe Float
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryResp'numFound :: Maybe Word32
_RpbSearchQueryResp'numFound = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbSearchQueryResp'_unknownFields :: FieldSet
_RpbSearchQueryResp'_unknownFields = []}
  parseMessage :: Parser RpbSearchQueryResp
parseMessage
    = let
        loop ::
          RpbSearchQueryResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbSearchDoc
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbSearchQueryResp
        loop :: RpbSearchQueryResp
-> Growing Vector RealWorld RpbSearchDoc
-> Parser RpbSearchQueryResp
loop RpbSearchQueryResp
x Growing Vector RealWorld RpbSearchDoc
mutable'docs
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbSearchDoc
frozen'docs <- IO (Vector RpbSearchDoc) -> Parser (Vector RpbSearchDoc)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbSearchDoc
-> IO (Vector RpbSearchDoc)
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 RpbSearchDoc
Growing Vector (PrimState IO) RpbSearchDoc
mutable'docs)
                      (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]))))
                      RpbSearchQueryResp -> Parser RpbSearchQueryResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbSearchQueryResp RpbSearchQueryResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbSearchQueryResp
-> RpbSearchQueryResp
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 RpbSearchQueryResp RpbSearchQueryResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbSearchQueryResp
  RpbSearchQueryResp
  (Vector RpbSearchDoc)
  (Vector RpbSearchDoc)
-> Vector RpbSearchDoc -> RpbSearchQueryResp -> RpbSearchQueryResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'docs" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'docs") Vector RpbSearchDoc
frozen'docs RpbSearchQueryResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbSearchDoc
y <- Parser RpbSearchDoc -> String -> Parser RpbSearchDoc
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbSearchDoc -> Parser RpbSearchDoc
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 RpbSearchDoc
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"docs"
                                Growing Vector RealWorld RpbSearchDoc
v <- IO (Growing Vector RealWorld RpbSearchDoc)
-> Parser (Growing Vector RealWorld RpbSearchDoc)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbSearchDoc
-> RpbSearchDoc -> IO (Growing Vector (PrimState IO) RpbSearchDoc)
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 RpbSearchDoc
Growing Vector (PrimState IO) RpbSearchDoc
mutable'docs RpbSearchDoc
y)
                                RpbSearchQueryResp
-> Growing Vector RealWorld RpbSearchDoc
-> Parser RpbSearchQueryResp
loop RpbSearchQueryResp
x Growing Vector RealWorld RpbSearchDoc
v
                        Word64
21
                          -> do Float
y <- Parser Float -> String -> Parser Float
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word32 -> Float) -> Parser Word32 -> Parser Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word32 -> Float
Data.ProtoLens.Encoding.Bytes.wordToFloat
                                          Parser Word32
Data.ProtoLens.Encoding.Bytes.getFixed32)
                                       String
"max_score"
                                RpbSearchQueryResp
-> Growing Vector RealWorld RpbSearchDoc
-> Parser RpbSearchQueryResp
loop
                                  (Setter RpbSearchQueryResp RpbSearchQueryResp Float Float
-> Float -> RpbSearchQueryResp -> RpbSearchQueryResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "maxScore" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maxScore") Float
y RpbSearchQueryResp
x)
                                  Growing Vector RealWorld RpbSearchDoc
mutable'docs
                        Word64
24
                          -> 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
"num_found"
                                RpbSearchQueryResp
-> Growing Vector RealWorld RpbSearchDoc
-> Parser RpbSearchQueryResp
loop
                                  (Setter RpbSearchQueryResp RpbSearchQueryResp Word32 Word32
-> Word32 -> RpbSearchQueryResp -> RpbSearchQueryResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "numFound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"numFound") Word32
y RpbSearchQueryResp
x)
                                  Growing Vector RealWorld RpbSearchDoc
mutable'docs
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbSearchQueryResp
-> Growing Vector RealWorld RpbSearchDoc
-> Parser RpbSearchQueryResp
loop
                                  (Setter RpbSearchQueryResp RpbSearchQueryResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbSearchQueryResp
-> RpbSearchQueryResp
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 RpbSearchQueryResp RpbSearchQueryResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbSearchQueryResp
x)
                                  Growing Vector RealWorld RpbSearchDoc
mutable'docs
      in
        Parser RpbSearchQueryResp -> String -> Parser RpbSearchQueryResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbSearchDoc
mutable'docs <- IO (Growing Vector RealWorld RpbSearchDoc)
-> Parser (Growing Vector RealWorld RpbSearchDoc)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld RpbSearchDoc)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbSearchQueryResp
-> Growing Vector RealWorld RpbSearchDoc
-> Parser RpbSearchQueryResp
loop RpbSearchQueryResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbSearchDoc
mutable'docs)
          String
"RpbSearchQueryResp"
  buildMessage :: RpbSearchQueryResp -> Builder
buildMessage
    = \ RpbSearchQueryResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbSearchDoc -> Builder) -> Vector RpbSearchDoc -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbSearchDoc
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbSearchDoc -> ByteString) -> RpbSearchDoc -> 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))
                           RpbSearchDoc -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbSearchDoc
_v))
                (FoldLike
  (Vector RpbSearchDoc)
  RpbSearchQueryResp
  RpbSearchQueryResp
  (Vector RpbSearchDoc)
  (Vector RpbSearchDoc)
-> RpbSearchQueryResp -> Vector RpbSearchDoc
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'docs" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'docs") RpbSearchQueryResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Float)
  RpbSearchQueryResp
  RpbSearchQueryResp
  (Maybe Float)
  (Maybe Float)
-> RpbSearchQueryResp -> Maybe Float
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'maxScore" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'maxScore") RpbSearchQueryResp
_x
                 of
                   Maybe Float
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Float
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
21)
                          ((Word32 -> Builder) -> (Float -> Word32) -> Float -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             Word32 -> Builder
Data.ProtoLens.Encoding.Bytes.putFixed32
                             Float -> Word32
Data.ProtoLens.Encoding.Bytes.floatToWord
                             Float
_v))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32)
  RpbSearchQueryResp
  RpbSearchQueryResp
  (Maybe Word32)
  (Maybe Word32)
-> RpbSearchQueryResp -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'numFound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'numFound") RpbSearchQueryResp
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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 RpbSearchQueryResp RpbSearchQueryResp FieldSet FieldSet
-> RpbSearchQueryResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbSearchQueryResp RpbSearchQueryResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbSearchQueryResp
_x))))
instance Control.DeepSeq.NFData RpbSearchQueryResp where
  rnf :: RpbSearchQueryResp -> ()
rnf
    = \ RpbSearchQueryResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbSearchQueryResp -> FieldSet
_RpbSearchQueryResp'_unknownFields RpbSearchQueryResp
x__)
             (Vector RpbSearchDoc -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbSearchQueryResp -> Vector RpbSearchDoc
_RpbSearchQueryResp'docs RpbSearchQueryResp
x__)
                (Maybe Float -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbSearchQueryResp -> Maybe Float
_RpbSearchQueryResp'maxScore RpbSearchQueryResp
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbSearchQueryResp -> Maybe Word32
_RpbSearchQueryResp'numFound RpbSearchQueryResp
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.bucket' @:: Lens' RpbSetBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.props' @:: Lens' RpbSetBucketReq RpbBucketProps@
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbSetBucketReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'type'' @:: Lens' RpbSetBucketReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbSetBucketReq
  = RpbSetBucketReq'_constructor {RpbSetBucketReq -> ByteString
_RpbSetBucketReq'bucket :: !Data.ByteString.ByteString,
                                  RpbSetBucketReq -> RpbBucketProps
_RpbSetBucketReq'props :: !RpbBucketProps,
                                  RpbSetBucketReq -> Maybe ByteString
_RpbSetBucketReq'type' :: !(Prelude.Maybe Data.ByteString.ByteString),
                                  RpbSetBucketReq -> FieldSet
_RpbSetBucketReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbSetBucketReq -> RpbSetBucketReq -> Bool
(RpbSetBucketReq -> RpbSetBucketReq -> Bool)
-> (RpbSetBucketReq -> RpbSetBucketReq -> Bool)
-> Eq RpbSetBucketReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
$c/= :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
== :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
$c== :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
Prelude.Eq, Eq RpbSetBucketReq
Eq RpbSetBucketReq
-> (RpbSetBucketReq -> RpbSetBucketReq -> Ordering)
-> (RpbSetBucketReq -> RpbSetBucketReq -> Bool)
-> (RpbSetBucketReq -> RpbSetBucketReq -> Bool)
-> (RpbSetBucketReq -> RpbSetBucketReq -> Bool)
-> (RpbSetBucketReq -> RpbSetBucketReq -> Bool)
-> (RpbSetBucketReq -> RpbSetBucketReq -> RpbSetBucketReq)
-> (RpbSetBucketReq -> RpbSetBucketReq -> RpbSetBucketReq)
-> Ord RpbSetBucketReq
RpbSetBucketReq -> RpbSetBucketReq -> Bool
RpbSetBucketReq -> RpbSetBucketReq -> Ordering
RpbSetBucketReq -> RpbSetBucketReq -> RpbSetBucketReq
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 :: RpbSetBucketReq -> RpbSetBucketReq -> RpbSetBucketReq
$cmin :: RpbSetBucketReq -> RpbSetBucketReq -> RpbSetBucketReq
max :: RpbSetBucketReq -> RpbSetBucketReq -> RpbSetBucketReq
$cmax :: RpbSetBucketReq -> RpbSetBucketReq -> RpbSetBucketReq
>= :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
$c>= :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
> :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
$c> :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
<= :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
$c<= :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
< :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
$c< :: RpbSetBucketReq -> RpbSetBucketReq -> Bool
compare :: RpbSetBucketReq -> RpbSetBucketReq -> Ordering
$ccompare :: RpbSetBucketReq -> RpbSetBucketReq -> Ordering
$cp1Ord :: Eq RpbSetBucketReq
Prelude.Ord)
instance Prelude.Show RpbSetBucketReq where
  showsPrec :: Int -> RpbSetBucketReq -> ShowS
showsPrec Int
_ RpbSetBucketReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbSetBucketReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbSetBucketReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbSetBucketReq "bucket" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bucket"
-> (ByteString -> f ByteString)
-> RpbSetBucketReq
-> f RpbSetBucketReq
fieldOf Proxy# "bucket"
_
    = ((ByteString -> f ByteString)
 -> RpbSetBucketReq -> f RpbSetBucketReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbSetBucketReq
-> f RpbSetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSetBucketReq -> ByteString)
-> (RpbSetBucketReq -> ByteString -> RpbSetBucketReq)
-> Lens RpbSetBucketReq RpbSetBucketReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSetBucketReq -> ByteString
_RpbSetBucketReq'bucket
           (\ RpbSetBucketReq
x__ ByteString
y__ -> RpbSetBucketReq
x__ {_RpbSetBucketReq'bucket :: ByteString
_RpbSetBucketReq'bucket = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSetBucketReq "props" RpbBucketProps where
  fieldOf :: Proxy# "props"
-> (RpbBucketProps -> f RpbBucketProps)
-> RpbSetBucketReq
-> f RpbSetBucketReq
fieldOf Proxy# "props"
_
    = ((RpbBucketProps -> f RpbBucketProps)
 -> RpbSetBucketReq -> f RpbSetBucketReq)
-> ((RpbBucketProps -> f RpbBucketProps)
    -> RpbBucketProps -> f RpbBucketProps)
-> (RpbBucketProps -> f RpbBucketProps)
-> RpbSetBucketReq
-> f RpbSetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSetBucketReq -> RpbBucketProps)
-> (RpbSetBucketReq -> RpbBucketProps -> RpbSetBucketReq)
-> Lens
     RpbSetBucketReq RpbSetBucketReq RpbBucketProps RpbBucketProps
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSetBucketReq -> RpbBucketProps
_RpbSetBucketReq'props
           (\ RpbSetBucketReq
x__ RpbBucketProps
y__ -> RpbSetBucketReq
x__ {_RpbSetBucketReq'props :: RpbBucketProps
_RpbSetBucketReq'props = RpbBucketProps
y__}))
        (RpbBucketProps -> f RpbBucketProps)
-> RpbBucketProps -> f RpbBucketProps
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSetBucketReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbSetBucketReq
-> f RpbSetBucketReq
fieldOf Proxy# "type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSetBucketReq -> f RpbSetBucketReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbSetBucketReq
-> f RpbSetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSetBucketReq -> Maybe ByteString)
-> (RpbSetBucketReq -> Maybe ByteString -> RpbSetBucketReq)
-> Lens
     RpbSetBucketReq
     RpbSetBucketReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSetBucketReq -> Maybe ByteString
_RpbSetBucketReq'type'
           (\ RpbSetBucketReq
x__ Maybe ByteString
y__ -> RpbSetBucketReq
x__ {_RpbSetBucketReq'type' :: Maybe ByteString
_RpbSetBucketReq'type' = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbSetBucketReq "maybe'type'" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'type'"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSetBucketReq
-> f RpbSetBucketReq
fieldOf Proxy# "maybe'type'"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbSetBucketReq -> f RpbSetBucketReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbSetBucketReq
-> f RpbSetBucketReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSetBucketReq -> Maybe ByteString)
-> (RpbSetBucketReq -> Maybe ByteString -> RpbSetBucketReq)
-> Lens
     RpbSetBucketReq
     RpbSetBucketReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSetBucketReq -> Maybe ByteString
_RpbSetBucketReq'type'
           (\ RpbSetBucketReq
x__ Maybe ByteString
y__ -> RpbSetBucketReq
x__ {_RpbSetBucketReq'type' :: Maybe ByteString
_RpbSetBucketReq'type' = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbSetBucketReq where
  messageName :: Proxy RpbSetBucketReq -> Text
messageName Proxy RpbSetBucketReq
_ = String -> Text
Data.Text.pack String
"RpbSetBucketReq"
  packedMessageDescriptor :: Proxy RpbSetBucketReq -> ByteString
packedMessageDescriptor Proxy RpbSetBucketReq
_
    = ByteString
"\n\
      \\SIRpbSetBucketReq\DC2\SYN\n\
      \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2%\n\
      \\ENQprops\CAN\STX \STX(\v2\SI.RpbBucketPropsR\ENQprops\DC2\DC2\n\
      \\EOTtype\CAN\ETX \SOH(\fR\EOTtype"
  packedFileDescriptor :: Proxy RpbSetBucketReq -> ByteString
packedFileDescriptor Proxy RpbSetBucketReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbSetBucketReq)
fieldsByTag
    = let
        bucket__field_descriptor :: FieldDescriptor RpbSetBucketReq
bucket__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSetBucketReq ByteString
-> FieldDescriptor RpbSetBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bucket"
              (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 RpbSetBucketReq RpbSetBucketReq ByteString ByteString
-> FieldAccessor RpbSetBucketReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket")) ::
              Data.ProtoLens.FieldDescriptor RpbSetBucketReq
        props__field_descriptor :: FieldDescriptor RpbSetBucketReq
props__field_descriptor
          = String
-> FieldTypeDescriptor RpbBucketProps
-> FieldAccessor RpbSetBucketReq RpbBucketProps
-> FieldDescriptor RpbSetBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"props"
              (MessageOrGroup -> FieldTypeDescriptor RpbBucketProps
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbBucketProps)
              (WireDefault RpbBucketProps
-> Lens
     RpbSetBucketReq RpbSetBucketReq RpbBucketProps RpbBucketProps
-> FieldAccessor RpbSetBucketReq RpbBucketProps
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbBucketProps
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props")) ::
              Data.ProtoLens.FieldDescriptor RpbSetBucketReq
        type'__field_descriptor :: FieldDescriptor RpbSetBucketReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSetBucketReq ByteString
-> FieldDescriptor RpbSetBucketReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbSetBucketReq
  RpbSetBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbSetBucketReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'")) ::
              Data.ProtoLens.FieldDescriptor RpbSetBucketReq
      in
        [(Tag, FieldDescriptor RpbSetBucketReq)]
-> Map Tag (FieldDescriptor RpbSetBucketReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbSetBucketReq
bucket__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbSetBucketReq
props__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbSetBucketReq
type'__field_descriptor)]
  unknownFields :: LensLike' f RpbSetBucketReq FieldSet
unknownFields
    = (RpbSetBucketReq -> FieldSet)
-> (RpbSetBucketReq -> FieldSet -> RpbSetBucketReq)
-> Lens' RpbSetBucketReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbSetBucketReq -> FieldSet
_RpbSetBucketReq'_unknownFields
        (\ RpbSetBucketReq
x__ FieldSet
y__ -> RpbSetBucketReq
x__ {_RpbSetBucketReq'_unknownFields :: FieldSet
_RpbSetBucketReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbSetBucketReq
defMessage
    = RpbSetBucketReq'_constructor :: ByteString
-> RpbBucketProps
-> Maybe ByteString
-> FieldSet
-> RpbSetBucketReq
RpbSetBucketReq'_constructor
        {_RpbSetBucketReq'bucket :: ByteString
_RpbSetBucketReq'bucket = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbSetBucketReq'props :: RpbBucketProps
_RpbSetBucketReq'props = RpbBucketProps
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbSetBucketReq'type' :: Maybe ByteString
_RpbSetBucketReq'type' = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbSetBucketReq'_unknownFields :: FieldSet
_RpbSetBucketReq'_unknownFields = []}
  parseMessage :: Parser RpbSetBucketReq
parseMessage
    = let
        loop ::
          RpbSetBucketReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbSetBucketReq
        loop :: RpbSetBucketReq -> Bool -> Bool -> Parser RpbSetBucketReq
loop RpbSetBucketReq
x Bool
required'bucket Bool
required'props
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'bucket then (:) String
"bucket" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'props then (:) String
"props" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbSetBucketReq -> Parser RpbSetBucketReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbSetBucketReq RpbSetBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSetBucketReq -> RpbSetBucketReq
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 RpbSetBucketReq RpbSetBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbSetBucketReq
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
"bucket"
                                RpbSetBucketReq -> Bool -> Bool -> Parser RpbSetBucketReq
loop
                                  (Setter RpbSetBucketReq RpbSetBucketReq ByteString ByteString
-> ByteString -> RpbSetBucketReq -> RpbSetBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") ByteString
y RpbSetBucketReq
x)
                                  Bool
Prelude.False
                                  Bool
required'props
                        Word64
18
                          -> do RpbBucketProps
y <- Parser RpbBucketProps -> String -> Parser RpbBucketProps
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbBucketProps -> Parser RpbBucketProps
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 RpbBucketProps
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"props"
                                RpbSetBucketReq -> Bool -> Bool -> Parser RpbSetBucketReq
loop
                                  (Setter
  RpbSetBucketReq RpbSetBucketReq RpbBucketProps RpbBucketProps
-> RpbBucketProps -> RpbSetBucketReq -> RpbSetBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props") RpbBucketProps
y RpbSetBucketReq
x)
                                  Bool
required'bucket
                                  Bool
Prelude.False
                        Word64
26
                          -> 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
"type"
                                RpbSetBucketReq -> Bool -> Bool -> Parser RpbSetBucketReq
loop
                                  (Setter RpbSetBucketReq RpbSetBucketReq ByteString ByteString
-> ByteString -> RpbSetBucketReq -> RpbSetBucketReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbSetBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'props
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbSetBucketReq -> Bool -> Bool -> Parser RpbSetBucketReq
loop
                                  (Setter RpbSetBucketReq RpbSetBucketReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSetBucketReq -> RpbSetBucketReq
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 RpbSetBucketReq RpbSetBucketReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbSetBucketReq
x)
                                  Bool
required'bucket
                                  Bool
required'props
      in
        Parser RpbSetBucketReq -> String -> Parser RpbSetBucketReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbSetBucketReq -> Bool -> Bool -> Parser RpbSetBucketReq
loop RpbSetBucketReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbSetBucketReq"
  buildMessage :: RpbSetBucketReq -> Builder
buildMessage
    = \ RpbSetBucketReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbSetBucketReq RpbSetBucketReq ByteString ByteString
-> RpbSetBucketReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "bucket" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bucket") RpbSetBucketReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((ByteString -> Builder)
-> (RpbBucketProps -> ByteString) -> RpbBucketProps -> 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))
                      RpbBucketProps -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                      (FoldLike
  RpbBucketProps
  RpbSetBucketReq
  RpbSetBucketReq
  RpbBucketProps
  RpbBucketProps
-> RpbSetBucketReq -> RpbBucketProps
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props") RpbSetBucketReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  RpbSetBucketReq
  RpbSetBucketReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbSetBucketReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'type'") RpbSetBucketReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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 RpbSetBucketReq RpbSetBucketReq FieldSet FieldSet
-> RpbSetBucketReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet RpbSetBucketReq RpbSetBucketReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbSetBucketReq
_x))))
instance Control.DeepSeq.NFData RpbSetBucketReq where
  rnf :: RpbSetBucketReq -> ()
rnf
    = \ RpbSetBucketReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbSetBucketReq -> FieldSet
_RpbSetBucketReq'_unknownFields RpbSetBucketReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbSetBucketReq -> ByteString
_RpbSetBucketReq'bucket RpbSetBucketReq
x__)
                (RpbBucketProps -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbSetBucketReq -> RpbBucketProps
_RpbSetBucketReq'props RpbSetBucketReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbSetBucketReq -> Maybe ByteString
_RpbSetBucketReq'type' RpbSetBucketReq
x__) ())))
{- | Fields :
      -}
data RpbSetBucketResp
  = RpbSetBucketResp'_constructor {RpbSetBucketResp -> FieldSet
_RpbSetBucketResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbSetBucketResp -> RpbSetBucketResp -> Bool
(RpbSetBucketResp -> RpbSetBucketResp -> Bool)
-> (RpbSetBucketResp -> RpbSetBucketResp -> Bool)
-> Eq RpbSetBucketResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
$c/= :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
== :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
$c== :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
Prelude.Eq, Eq RpbSetBucketResp
Eq RpbSetBucketResp
-> (RpbSetBucketResp -> RpbSetBucketResp -> Ordering)
-> (RpbSetBucketResp -> RpbSetBucketResp -> Bool)
-> (RpbSetBucketResp -> RpbSetBucketResp -> Bool)
-> (RpbSetBucketResp -> RpbSetBucketResp -> Bool)
-> (RpbSetBucketResp -> RpbSetBucketResp -> Bool)
-> (RpbSetBucketResp -> RpbSetBucketResp -> RpbSetBucketResp)
-> (RpbSetBucketResp -> RpbSetBucketResp -> RpbSetBucketResp)
-> Ord RpbSetBucketResp
RpbSetBucketResp -> RpbSetBucketResp -> Bool
RpbSetBucketResp -> RpbSetBucketResp -> Ordering
RpbSetBucketResp -> RpbSetBucketResp -> RpbSetBucketResp
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 :: RpbSetBucketResp -> RpbSetBucketResp -> RpbSetBucketResp
$cmin :: RpbSetBucketResp -> RpbSetBucketResp -> RpbSetBucketResp
max :: RpbSetBucketResp -> RpbSetBucketResp -> RpbSetBucketResp
$cmax :: RpbSetBucketResp -> RpbSetBucketResp -> RpbSetBucketResp
>= :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
$c>= :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
> :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
$c> :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
<= :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
$c<= :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
< :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
$c< :: RpbSetBucketResp -> RpbSetBucketResp -> Bool
compare :: RpbSetBucketResp -> RpbSetBucketResp -> Ordering
$ccompare :: RpbSetBucketResp -> RpbSetBucketResp -> Ordering
$cp1Ord :: Eq RpbSetBucketResp
Prelude.Ord)
instance Prelude.Show RpbSetBucketResp where
  showsPrec :: Int -> RpbSetBucketResp -> ShowS
showsPrec Int
_ RpbSetBucketResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbSetBucketResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbSetBucketResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message RpbSetBucketResp where
  messageName :: Proxy RpbSetBucketResp -> Text
messageName Proxy RpbSetBucketResp
_ = String -> Text
Data.Text.pack String
"RpbSetBucketResp"
  packedMessageDescriptor :: Proxy RpbSetBucketResp -> ByteString
packedMessageDescriptor Proxy RpbSetBucketResp
_
    = ByteString
"\n\
      \\DLERpbSetBucketResp"
  packedFileDescriptor :: Proxy RpbSetBucketResp -> ByteString
packedFileDescriptor Proxy RpbSetBucketResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbSetBucketResp)
fieldsByTag = let in [(Tag, FieldDescriptor RpbSetBucketResp)]
-> Map Tag (FieldDescriptor RpbSetBucketResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f RpbSetBucketResp FieldSet
unknownFields
    = (RpbSetBucketResp -> FieldSet)
-> (RpbSetBucketResp -> FieldSet -> RpbSetBucketResp)
-> Lens' RpbSetBucketResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbSetBucketResp -> FieldSet
_RpbSetBucketResp'_unknownFields
        (\ RpbSetBucketResp
x__ FieldSet
y__ -> RpbSetBucketResp
x__ {_RpbSetBucketResp'_unknownFields :: FieldSet
_RpbSetBucketResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbSetBucketResp
defMessage
    = RpbSetBucketResp'_constructor :: FieldSet -> RpbSetBucketResp
RpbSetBucketResp'_constructor
        {_RpbSetBucketResp'_unknownFields :: FieldSet
_RpbSetBucketResp'_unknownFields = []}
  parseMessage :: Parser RpbSetBucketResp
parseMessage
    = let
        loop ::
          RpbSetBucketResp
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbSetBucketResp
        loop :: RpbSetBucketResp -> Parser RpbSetBucketResp
loop RpbSetBucketResp
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]))))
                      RpbSetBucketResp -> Parser RpbSetBucketResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbSetBucketResp RpbSetBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSetBucketResp -> RpbSetBucketResp
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 RpbSetBucketResp RpbSetBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbSetBucketResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbSetBucketResp -> Parser RpbSetBucketResp
loop
                                  (Setter RpbSetBucketResp RpbSetBucketResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSetBucketResp -> RpbSetBucketResp
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 RpbSetBucketResp RpbSetBucketResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbSetBucketResp
x) }
      in
        Parser RpbSetBucketResp -> String -> Parser RpbSetBucketResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbSetBucketResp -> Parser RpbSetBucketResp
loop RpbSetBucketResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbSetBucketResp"
  buildMessage :: RpbSetBucketResp -> Builder
buildMessage
    = \ RpbSetBucketResp
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike
  FieldSet RpbSetBucketResp RpbSetBucketResp FieldSet FieldSet
-> RpbSetBucketResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbSetBucketResp RpbSetBucketResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbSetBucketResp
_x)
instance Control.DeepSeq.NFData RpbSetBucketResp where
  rnf :: RpbSetBucketResp -> ()
rnf
    = \ RpbSetBucketResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbSetBucketResp -> FieldSet
_RpbSetBucketResp'_unknownFields RpbSetBucketResp
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.type'' @:: Lens' RpbSetBucketTypeReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.props' @:: Lens' RpbSetBucketTypeReq RpbBucketProps@ -}
data RpbSetBucketTypeReq
  = RpbSetBucketTypeReq'_constructor {RpbSetBucketTypeReq -> ByteString
_RpbSetBucketTypeReq'type' :: !Data.ByteString.ByteString,
                                      RpbSetBucketTypeReq -> RpbBucketProps
_RpbSetBucketTypeReq'props :: !RpbBucketProps,
                                      RpbSetBucketTypeReq -> FieldSet
_RpbSetBucketTypeReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
(RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool)
-> (RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool)
-> Eq RpbSetBucketTypeReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
$c/= :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
== :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
$c== :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
Prelude.Eq, Eq RpbSetBucketTypeReq
Eq RpbSetBucketTypeReq
-> (RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Ordering)
-> (RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool)
-> (RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool)
-> (RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool)
-> (RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool)
-> (RpbSetBucketTypeReq
    -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq)
-> (RpbSetBucketTypeReq
    -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq)
-> Ord RpbSetBucketTypeReq
RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Ordering
RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq
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 :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq
$cmin :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq
max :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq
$cmax :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq
>= :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
$c>= :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
> :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
$c> :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
<= :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
$c<= :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
< :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
$c< :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Bool
compare :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Ordering
$ccompare :: RpbSetBucketTypeReq -> RpbSetBucketTypeReq -> Ordering
$cp1Ord :: Eq RpbSetBucketTypeReq
Prelude.Ord)
instance Prelude.Show RpbSetBucketTypeReq where
  showsPrec :: Int -> RpbSetBucketTypeReq -> ShowS
showsPrec Int
_ RpbSetBucketTypeReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbSetBucketTypeReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbSetBucketTypeReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbSetBucketTypeReq "type'" Data.ByteString.ByteString where
  fieldOf :: Proxy# "type'"
-> (ByteString -> f ByteString)
-> RpbSetBucketTypeReq
-> f RpbSetBucketTypeReq
fieldOf Proxy# "type'"
_
    = ((ByteString -> f ByteString)
 -> RpbSetBucketTypeReq -> f RpbSetBucketTypeReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbSetBucketTypeReq
-> f RpbSetBucketTypeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSetBucketTypeReq -> ByteString)
-> (RpbSetBucketTypeReq -> ByteString -> RpbSetBucketTypeReq)
-> Lens
     RpbSetBucketTypeReq RpbSetBucketTypeReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSetBucketTypeReq -> ByteString
_RpbSetBucketTypeReq'type'
           (\ RpbSetBucketTypeReq
x__ ByteString
y__ -> RpbSetBucketTypeReq
x__ {_RpbSetBucketTypeReq'type' :: ByteString
_RpbSetBucketTypeReq'type' = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbSetBucketTypeReq "props" RpbBucketProps where
  fieldOf :: Proxy# "props"
-> (RpbBucketProps -> f RpbBucketProps)
-> RpbSetBucketTypeReq
-> f RpbSetBucketTypeReq
fieldOf Proxy# "props"
_
    = ((RpbBucketProps -> f RpbBucketProps)
 -> RpbSetBucketTypeReq -> f RpbSetBucketTypeReq)
-> ((RpbBucketProps -> f RpbBucketProps)
    -> RpbBucketProps -> f RpbBucketProps)
-> (RpbBucketProps -> f RpbBucketProps)
-> RpbSetBucketTypeReq
-> f RpbSetBucketTypeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSetBucketTypeReq -> RpbBucketProps)
-> (RpbSetBucketTypeReq -> RpbBucketProps -> RpbSetBucketTypeReq)
-> Lens
     RpbSetBucketTypeReq
     RpbSetBucketTypeReq
     RpbBucketProps
     RpbBucketProps
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSetBucketTypeReq -> RpbBucketProps
_RpbSetBucketTypeReq'props
           (\ RpbSetBucketTypeReq
x__ RpbBucketProps
y__ -> RpbSetBucketTypeReq
x__ {_RpbSetBucketTypeReq'props :: RpbBucketProps
_RpbSetBucketTypeReq'props = RpbBucketProps
y__}))
        (RpbBucketProps -> f RpbBucketProps)
-> RpbBucketProps -> f RpbBucketProps
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbSetBucketTypeReq where
  messageName :: Proxy RpbSetBucketTypeReq -> Text
messageName Proxy RpbSetBucketTypeReq
_ = String -> Text
Data.Text.pack String
"RpbSetBucketTypeReq"
  packedMessageDescriptor :: Proxy RpbSetBucketTypeReq -> ByteString
packedMessageDescriptor Proxy RpbSetBucketTypeReq
_
    = ByteString
"\n\
      \\DC3RpbSetBucketTypeReq\DC2\DC2\n\
      \\EOTtype\CAN\SOH \STX(\fR\EOTtype\DC2%\n\
      \\ENQprops\CAN\STX \STX(\v2\SI.RpbBucketPropsR\ENQprops"
  packedFileDescriptor :: Proxy RpbSetBucketTypeReq -> ByteString
packedFileDescriptor Proxy RpbSetBucketTypeReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbSetBucketTypeReq)
fieldsByTag
    = let
        type'__field_descriptor :: FieldDescriptor RpbSetBucketTypeReq
type'__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSetBucketTypeReq ByteString
-> FieldDescriptor RpbSetBucketTypeReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (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
     RpbSetBucketTypeReq RpbSetBucketTypeReq ByteString ByteString
-> FieldAccessor RpbSetBucketTypeReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'")) ::
              Data.ProtoLens.FieldDescriptor RpbSetBucketTypeReq
        props__field_descriptor :: FieldDescriptor RpbSetBucketTypeReq
props__field_descriptor
          = String
-> FieldTypeDescriptor RpbBucketProps
-> FieldAccessor RpbSetBucketTypeReq RpbBucketProps
-> FieldDescriptor RpbSetBucketTypeReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"props"
              (MessageOrGroup -> FieldTypeDescriptor RpbBucketProps
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbBucketProps)
              (WireDefault RpbBucketProps
-> Lens
     RpbSetBucketTypeReq
     RpbSetBucketTypeReq
     RpbBucketProps
     RpbBucketProps
-> FieldAccessor RpbSetBucketTypeReq RpbBucketProps
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbBucketProps
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props")) ::
              Data.ProtoLens.FieldDescriptor RpbSetBucketTypeReq
      in
        [(Tag, FieldDescriptor RpbSetBucketTypeReq)]
-> Map Tag (FieldDescriptor RpbSetBucketTypeReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbSetBucketTypeReq
type'__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbSetBucketTypeReq
props__field_descriptor)]
  unknownFields :: LensLike' f RpbSetBucketTypeReq FieldSet
unknownFields
    = (RpbSetBucketTypeReq -> FieldSet)
-> (RpbSetBucketTypeReq -> FieldSet -> RpbSetBucketTypeReq)
-> Lens' RpbSetBucketTypeReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbSetBucketTypeReq -> FieldSet
_RpbSetBucketTypeReq'_unknownFields
        (\ RpbSetBucketTypeReq
x__ FieldSet
y__ -> RpbSetBucketTypeReq
x__ {_RpbSetBucketTypeReq'_unknownFields :: FieldSet
_RpbSetBucketTypeReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbSetBucketTypeReq
defMessage
    = RpbSetBucketTypeReq'_constructor :: ByteString -> RpbBucketProps -> FieldSet -> RpbSetBucketTypeReq
RpbSetBucketTypeReq'_constructor
        {_RpbSetBucketTypeReq'type' :: ByteString
_RpbSetBucketTypeReq'type' = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbSetBucketTypeReq'props :: RpbBucketProps
_RpbSetBucketTypeReq'props = RpbBucketProps
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbSetBucketTypeReq'_unknownFields :: FieldSet
_RpbSetBucketTypeReq'_unknownFields = []}
  parseMessage :: Parser RpbSetBucketTypeReq
parseMessage
    = let
        loop ::
          RpbSetBucketTypeReq
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser RpbSetBucketTypeReq
        loop :: RpbSetBucketTypeReq -> Bool -> Bool -> Parser RpbSetBucketTypeReq
loop RpbSetBucketTypeReq
x Bool
required'props Bool
required'type'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'props then (:) String
"props" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'type' then (:) String
"type" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbSetBucketTypeReq -> Parser RpbSetBucketTypeReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbSetBucketTypeReq RpbSetBucketTypeReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbSetBucketTypeReq
-> RpbSetBucketTypeReq
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 RpbSetBucketTypeReq RpbSetBucketTypeReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbSetBucketTypeReq
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
"type"
                                RpbSetBucketTypeReq -> Bool -> Bool -> Parser RpbSetBucketTypeReq
loop
                                  (Setter
  RpbSetBucketTypeReq RpbSetBucketTypeReq ByteString ByteString
-> ByteString -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") ByteString
y RpbSetBucketTypeReq
x)
                                  Bool
required'props
                                  Bool
Prelude.False
                        Word64
18
                          -> do RpbBucketProps
y <- Parser RpbBucketProps -> String -> Parser RpbBucketProps
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbBucketProps -> Parser RpbBucketProps
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 RpbBucketProps
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"props"
                                RpbSetBucketTypeReq -> Bool -> Bool -> Parser RpbSetBucketTypeReq
loop
                                  (Setter
  RpbSetBucketTypeReq
  RpbSetBucketTypeReq
  RpbBucketProps
  RpbBucketProps
-> RpbBucketProps -> RpbSetBucketTypeReq -> RpbSetBucketTypeReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props") RpbBucketProps
y RpbSetBucketTypeReq
x)
                                  Bool
Prelude.False
                                  Bool
required'type'
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbSetBucketTypeReq -> Bool -> Bool -> Parser RpbSetBucketTypeReq
loop
                                  (Setter RpbSetBucketTypeReq RpbSetBucketTypeReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbSetBucketTypeReq
-> RpbSetBucketTypeReq
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 RpbSetBucketTypeReq RpbSetBucketTypeReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbSetBucketTypeReq
x)
                                  Bool
required'props
                                  Bool
required'type'
      in
        Parser RpbSetBucketTypeReq -> String -> Parser RpbSetBucketTypeReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbSetBucketTypeReq -> Bool -> Bool -> Parser RpbSetBucketTypeReq
loop RpbSetBucketTypeReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"RpbSetBucketTypeReq"
  buildMessage :: RpbSetBucketTypeReq -> Builder
buildMessage
    = \ RpbSetBucketTypeReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbSetBucketTypeReq
  RpbSetBucketTypeReq
  ByteString
  ByteString
-> RpbSetBucketTypeReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") RpbSetBucketTypeReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((ByteString -> Builder)
-> (RpbBucketProps -> ByteString) -> RpbBucketProps -> 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))
                      RpbBucketProps -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                      (FoldLike
  RpbBucketProps
  RpbSetBucketTypeReq
  RpbSetBucketTypeReq
  RpbBucketProps
  RpbBucketProps
-> RpbSetBucketTypeReq -> RpbBucketProps
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "props" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"props") RpbSetBucketTypeReq
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike
  FieldSet RpbSetBucketTypeReq RpbSetBucketTypeReq FieldSet FieldSet
-> RpbSetBucketTypeReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbSetBucketTypeReq RpbSetBucketTypeReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbSetBucketTypeReq
_x)))
instance Control.DeepSeq.NFData RpbSetBucketTypeReq where
  rnf :: RpbSetBucketTypeReq -> ()
rnf
    = \ RpbSetBucketTypeReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbSetBucketTypeReq -> FieldSet
_RpbSetBucketTypeReq'_unknownFields RpbSetBucketTypeReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbSetBucketTypeReq -> ByteString
_RpbSetBucketTypeReq'type' RpbSetBucketTypeReq
x__)
                (RpbBucketProps -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbSetBucketTypeReq -> RpbBucketProps
_RpbSetBucketTypeReq'props RpbSetBucketTypeReq
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.clientId' @:: Lens' RpbSetClientIdReq Data.ByteString.ByteString@ -}
data RpbSetClientIdReq
  = RpbSetClientIdReq'_constructor {RpbSetClientIdReq -> ByteString
_RpbSetClientIdReq'clientId :: !Data.ByteString.ByteString,
                                    RpbSetClientIdReq -> FieldSet
_RpbSetClientIdReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
(RpbSetClientIdReq -> RpbSetClientIdReq -> Bool)
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> Bool)
-> Eq RpbSetClientIdReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
$c/= :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
== :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
$c== :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
Prelude.Eq, Eq RpbSetClientIdReq
Eq RpbSetClientIdReq
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> Ordering)
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> Bool)
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> Bool)
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> Bool)
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> Bool)
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> RpbSetClientIdReq)
-> (RpbSetClientIdReq -> RpbSetClientIdReq -> RpbSetClientIdReq)
-> Ord RpbSetClientIdReq
RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
RpbSetClientIdReq -> RpbSetClientIdReq -> Ordering
RpbSetClientIdReq -> RpbSetClientIdReq -> RpbSetClientIdReq
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 :: RpbSetClientIdReq -> RpbSetClientIdReq -> RpbSetClientIdReq
$cmin :: RpbSetClientIdReq -> RpbSetClientIdReq -> RpbSetClientIdReq
max :: RpbSetClientIdReq -> RpbSetClientIdReq -> RpbSetClientIdReq
$cmax :: RpbSetClientIdReq -> RpbSetClientIdReq -> RpbSetClientIdReq
>= :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
$c>= :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
> :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
$c> :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
<= :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
$c<= :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
< :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
$c< :: RpbSetClientIdReq -> RpbSetClientIdReq -> Bool
compare :: RpbSetClientIdReq -> RpbSetClientIdReq -> Ordering
$ccompare :: RpbSetClientIdReq -> RpbSetClientIdReq -> Ordering
$cp1Ord :: Eq RpbSetClientIdReq
Prelude.Ord)
instance Prelude.Show RpbSetClientIdReq where
  showsPrec :: Int -> RpbSetClientIdReq -> ShowS
showsPrec Int
_ RpbSetClientIdReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbSetClientIdReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbSetClientIdReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbSetClientIdReq "clientId" Data.ByteString.ByteString where
  fieldOf :: Proxy# "clientId"
-> (ByteString -> f ByteString)
-> RpbSetClientIdReq
-> f RpbSetClientIdReq
fieldOf Proxy# "clientId"
_
    = ((ByteString -> f ByteString)
 -> RpbSetClientIdReq -> f RpbSetClientIdReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbSetClientIdReq
-> f RpbSetClientIdReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbSetClientIdReq -> ByteString)
-> (RpbSetClientIdReq -> ByteString -> RpbSetClientIdReq)
-> Lens RpbSetClientIdReq RpbSetClientIdReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbSetClientIdReq -> ByteString
_RpbSetClientIdReq'clientId
           (\ RpbSetClientIdReq
x__ ByteString
y__ -> RpbSetClientIdReq
x__ {_RpbSetClientIdReq'clientId :: ByteString
_RpbSetClientIdReq'clientId = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbSetClientIdReq where
  messageName :: Proxy RpbSetClientIdReq -> Text
messageName Proxy RpbSetClientIdReq
_ = String -> Text
Data.Text.pack String
"RpbSetClientIdReq"
  packedMessageDescriptor :: Proxy RpbSetClientIdReq -> ByteString
packedMessageDescriptor Proxy RpbSetClientIdReq
_
    = ByteString
"\n\
      \\DC1RpbSetClientIdReq\DC2\ESC\n\
      \\tclient_id\CAN\SOH \STX(\fR\bclientId"
  packedFileDescriptor :: Proxy RpbSetClientIdReq -> ByteString
packedFileDescriptor Proxy RpbSetClientIdReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbSetClientIdReq)
fieldsByTag
    = let
        clientId__field_descriptor :: FieldDescriptor RpbSetClientIdReq
clientId__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbSetClientIdReq ByteString
-> FieldDescriptor RpbSetClientIdReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"client_id"
              (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 RpbSetClientIdReq RpbSetClientIdReq ByteString ByteString
-> FieldAccessor RpbSetClientIdReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "clientId" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"clientId")) ::
              Data.ProtoLens.FieldDescriptor RpbSetClientIdReq
      in
        [(Tag, FieldDescriptor RpbSetClientIdReq)]
-> Map Tag (FieldDescriptor RpbSetClientIdReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbSetClientIdReq
clientId__field_descriptor)]
  unknownFields :: LensLike' f RpbSetClientIdReq FieldSet
unknownFields
    = (RpbSetClientIdReq -> FieldSet)
-> (RpbSetClientIdReq -> FieldSet -> RpbSetClientIdReq)
-> Lens' RpbSetClientIdReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbSetClientIdReq -> FieldSet
_RpbSetClientIdReq'_unknownFields
        (\ RpbSetClientIdReq
x__ FieldSet
y__ -> RpbSetClientIdReq
x__ {_RpbSetClientIdReq'_unknownFields :: FieldSet
_RpbSetClientIdReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbSetClientIdReq
defMessage
    = RpbSetClientIdReq'_constructor :: ByteString -> FieldSet -> RpbSetClientIdReq
RpbSetClientIdReq'_constructor
        {_RpbSetClientIdReq'clientId :: ByteString
_RpbSetClientIdReq'clientId = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbSetClientIdReq'_unknownFields :: FieldSet
_RpbSetClientIdReq'_unknownFields = []}
  parseMessage :: Parser RpbSetClientIdReq
parseMessage
    = let
        loop ::
          RpbSetClientIdReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbSetClientIdReq
        loop :: RpbSetClientIdReq -> Bool -> Parser RpbSetClientIdReq
loop RpbSetClientIdReq
x Bool
required'clientId
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'clientId then (:) String
"client_id" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbSetClientIdReq -> Parser RpbSetClientIdReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbSetClientIdReq RpbSetClientIdReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSetClientIdReq -> RpbSetClientIdReq
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 RpbSetClientIdReq RpbSetClientIdReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbSetClientIdReq
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
"client_id"
                                RpbSetClientIdReq -> Bool -> Parser RpbSetClientIdReq
loop
                                  (Setter RpbSetClientIdReq RpbSetClientIdReq ByteString ByteString
-> ByteString -> RpbSetClientIdReq -> RpbSetClientIdReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "clientId" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"clientId") ByteString
y RpbSetClientIdReq
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbSetClientIdReq -> Bool -> Parser RpbSetClientIdReq
loop
                                  (Setter RpbSetClientIdReq RpbSetClientIdReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbSetClientIdReq -> RpbSetClientIdReq
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 RpbSetClientIdReq RpbSetClientIdReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbSetClientIdReq
x)
                                  Bool
required'clientId
      in
        Parser RpbSetClientIdReq -> String -> Parser RpbSetClientIdReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbSetClientIdReq -> Bool -> Parser RpbSetClientIdReq
loop RpbSetClientIdReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbSetClientIdReq"
  buildMessage :: RpbSetClientIdReq -> Builder
buildMessage
    = \ RpbSetClientIdReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbSetClientIdReq
  RpbSetClientIdReq
  ByteString
  ByteString
-> RpbSetClientIdReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "clientId" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"clientId") RpbSetClientIdReq
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet RpbSetClientIdReq RpbSetClientIdReq FieldSet FieldSet
-> RpbSetClientIdReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbSetClientIdReq RpbSetClientIdReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbSetClientIdReq
_x))
instance Control.DeepSeq.NFData RpbSetClientIdReq where
  rnf :: RpbSetClientIdReq -> ()
rnf
    = \ RpbSetClientIdReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbSetClientIdReq -> FieldSet
_RpbSetClientIdReq'_unknownFields RpbSetClientIdReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbSetClientIdReq -> ByteString
_RpbSetClientIdReq'clientId RpbSetClientIdReq
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.name' @:: Lens' RpbYokozunaIndex Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.schema' @:: Lens' RpbYokozunaIndex Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'schema' @:: Lens' RpbYokozunaIndex (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.nVal' @:: Lens' RpbYokozunaIndex Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'nVal' @:: Lens' RpbYokozunaIndex (Prelude.Maybe Data.Word.Word32)@ -}
data RpbYokozunaIndex
  = RpbYokozunaIndex'_constructor {RpbYokozunaIndex -> ByteString
_RpbYokozunaIndex'name :: !Data.ByteString.ByteString,
                                   RpbYokozunaIndex -> Maybe ByteString
_RpbYokozunaIndex'schema :: !(Prelude.Maybe Data.ByteString.ByteString),
                                   RpbYokozunaIndex -> Maybe Word32
_RpbYokozunaIndex'nVal :: !(Prelude.Maybe Data.Word.Word32),
                                   RpbYokozunaIndex -> FieldSet
_RpbYokozunaIndex'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
(RpbYokozunaIndex -> RpbYokozunaIndex -> Bool)
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> Bool)
-> Eq RpbYokozunaIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
$c/= :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
== :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
$c== :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
Prelude.Eq, Eq RpbYokozunaIndex
Eq RpbYokozunaIndex
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> Ordering)
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> Bool)
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> Bool)
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> Bool)
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> Bool)
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> RpbYokozunaIndex)
-> (RpbYokozunaIndex -> RpbYokozunaIndex -> RpbYokozunaIndex)
-> Ord RpbYokozunaIndex
RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
RpbYokozunaIndex -> RpbYokozunaIndex -> Ordering
RpbYokozunaIndex -> RpbYokozunaIndex -> RpbYokozunaIndex
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 :: RpbYokozunaIndex -> RpbYokozunaIndex -> RpbYokozunaIndex
$cmin :: RpbYokozunaIndex -> RpbYokozunaIndex -> RpbYokozunaIndex
max :: RpbYokozunaIndex -> RpbYokozunaIndex -> RpbYokozunaIndex
$cmax :: RpbYokozunaIndex -> RpbYokozunaIndex -> RpbYokozunaIndex
>= :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
$c>= :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
> :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
$c> :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
<= :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
$c<= :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
< :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
$c< :: RpbYokozunaIndex -> RpbYokozunaIndex -> Bool
compare :: RpbYokozunaIndex -> RpbYokozunaIndex -> Ordering
$ccompare :: RpbYokozunaIndex -> RpbYokozunaIndex -> Ordering
$cp1Ord :: Eq RpbYokozunaIndex
Prelude.Ord)
instance Prelude.Show RpbYokozunaIndex where
  showsPrec :: Int -> RpbYokozunaIndex -> ShowS
showsPrec Int
_ RpbYokozunaIndex
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaIndex -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaIndex
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaIndex "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString)
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
fieldOf Proxy# "name"
_
    = ((ByteString -> f ByteString)
 -> RpbYokozunaIndex -> f RpbYokozunaIndex)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndex -> ByteString)
-> (RpbYokozunaIndex -> ByteString -> RpbYokozunaIndex)
-> Lens RpbYokozunaIndex RpbYokozunaIndex ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndex -> ByteString
_RpbYokozunaIndex'name
           (\ RpbYokozunaIndex
x__ ByteString
y__ -> RpbYokozunaIndex
x__ {_RpbYokozunaIndex'name :: ByteString
_RpbYokozunaIndex'name = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbYokozunaIndex "schema" Data.ByteString.ByteString where
  fieldOf :: Proxy# "schema"
-> (ByteString -> f ByteString)
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
fieldOf Proxy# "schema"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbYokozunaIndex -> f RpbYokozunaIndex)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndex -> Maybe ByteString)
-> (RpbYokozunaIndex -> Maybe ByteString -> RpbYokozunaIndex)
-> Lens
     RpbYokozunaIndex
     RpbYokozunaIndex
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndex -> Maybe ByteString
_RpbYokozunaIndex'schema
           (\ RpbYokozunaIndex
x__ Maybe ByteString
y__ -> RpbYokozunaIndex
x__ {_RpbYokozunaIndex'schema :: Maybe ByteString
_RpbYokozunaIndex'schema = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbYokozunaIndex "maybe'schema" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'schema"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
fieldOf Proxy# "maybe'schema"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbYokozunaIndex -> f RpbYokozunaIndex)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndex -> Maybe ByteString)
-> (RpbYokozunaIndex -> Maybe ByteString -> RpbYokozunaIndex)
-> Lens
     RpbYokozunaIndex
     RpbYokozunaIndex
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndex -> Maybe ByteString
_RpbYokozunaIndex'schema
           (\ RpbYokozunaIndex
x__ Maybe ByteString
y__ -> RpbYokozunaIndex
x__ {_RpbYokozunaIndex'schema :: Maybe ByteString
_RpbYokozunaIndex'schema = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbYokozunaIndex "nVal" Data.Word.Word32 where
  fieldOf :: Proxy# "nVal"
-> (Word32 -> f Word32) -> RpbYokozunaIndex -> f RpbYokozunaIndex
fieldOf Proxy# "nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbYokozunaIndex -> f RpbYokozunaIndex)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndex -> Maybe Word32)
-> (RpbYokozunaIndex -> Maybe Word32 -> RpbYokozunaIndex)
-> Lens
     RpbYokozunaIndex RpbYokozunaIndex (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndex -> Maybe Word32
_RpbYokozunaIndex'nVal
           (\ RpbYokozunaIndex
x__ Maybe Word32
y__ -> RpbYokozunaIndex
x__ {_RpbYokozunaIndex'nVal :: Maybe Word32
_RpbYokozunaIndex'nVal = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbYokozunaIndex "maybe'nVal" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'nVal"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
fieldOf Proxy# "maybe'nVal"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbYokozunaIndex -> f RpbYokozunaIndex)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbYokozunaIndex
-> f RpbYokozunaIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndex -> Maybe Word32)
-> (RpbYokozunaIndex -> Maybe Word32 -> RpbYokozunaIndex)
-> Lens
     RpbYokozunaIndex RpbYokozunaIndex (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndex -> Maybe Word32
_RpbYokozunaIndex'nVal
           (\ RpbYokozunaIndex
x__ Maybe Word32
y__ -> RpbYokozunaIndex
x__ {_RpbYokozunaIndex'nVal :: Maybe Word32
_RpbYokozunaIndex'nVal = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaIndex where
  messageName :: Proxy RpbYokozunaIndex -> Text
messageName Proxy RpbYokozunaIndex
_ = String -> Text
Data.Text.pack String
"RpbYokozunaIndex"
  packedMessageDescriptor :: Proxy RpbYokozunaIndex -> ByteString
packedMessageDescriptor Proxy RpbYokozunaIndex
_
    = ByteString
"\n\
      \\DLERpbYokozunaIndex\DC2\DC2\n\
      \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2\SYN\n\
      \\ACKschema\CAN\STX \SOH(\fR\ACKschema\DC2\DC3\n\
      \\ENQn_val\CAN\ETX \SOH(\rR\EOTnVal"
  packedFileDescriptor :: Proxy RpbYokozunaIndex -> ByteString
packedFileDescriptor Proxy RpbYokozunaIndex
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaIndex)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor RpbYokozunaIndex
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbYokozunaIndex ByteString
-> FieldDescriptor RpbYokozunaIndex
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (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 RpbYokozunaIndex RpbYokozunaIndex ByteString ByteString
-> FieldAccessor RpbYokozunaIndex ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndex
        schema__field_descriptor :: FieldDescriptor RpbYokozunaIndex
schema__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbYokozunaIndex ByteString
-> FieldDescriptor RpbYokozunaIndex
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"schema"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbYokozunaIndex
  RpbYokozunaIndex
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbYokozunaIndex ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'schema")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndex
        nVal__field_descriptor :: FieldDescriptor RpbYokozunaIndex
nVal__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbYokozunaIndex Word32
-> FieldDescriptor RpbYokozunaIndex
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"n_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)
              (Lens
  RpbYokozunaIndex RpbYokozunaIndex (Maybe Word32) (Maybe Word32)
-> FieldAccessor RpbYokozunaIndex Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndex
      in
        [(Tag, FieldDescriptor RpbYokozunaIndex)]
-> Map Tag (FieldDescriptor RpbYokozunaIndex)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaIndex
name__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbYokozunaIndex
schema__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor RpbYokozunaIndex
nVal__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaIndex FieldSet
unknownFields
    = (RpbYokozunaIndex -> FieldSet)
-> (RpbYokozunaIndex -> FieldSet -> RpbYokozunaIndex)
-> Lens' RpbYokozunaIndex FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaIndex -> FieldSet
_RpbYokozunaIndex'_unknownFields
        (\ RpbYokozunaIndex
x__ FieldSet
y__ -> RpbYokozunaIndex
x__ {_RpbYokozunaIndex'_unknownFields :: FieldSet
_RpbYokozunaIndex'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaIndex
defMessage
    = RpbYokozunaIndex'_constructor :: ByteString
-> Maybe ByteString -> Maybe Word32 -> FieldSet -> RpbYokozunaIndex
RpbYokozunaIndex'_constructor
        {_RpbYokozunaIndex'name :: ByteString
_RpbYokozunaIndex'name = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbYokozunaIndex'schema :: Maybe ByteString
_RpbYokozunaIndex'schema = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbYokozunaIndex'nVal :: Maybe Word32
_RpbYokozunaIndex'nVal = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbYokozunaIndex'_unknownFields :: FieldSet
_RpbYokozunaIndex'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaIndex
parseMessage
    = let
        loop ::
          RpbYokozunaIndex
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaIndex
        loop :: RpbYokozunaIndex -> Bool -> Parser RpbYokozunaIndex
loop RpbYokozunaIndex
x Bool
required'name
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'name then (:) String
"name" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbYokozunaIndex -> Parser RpbYokozunaIndex
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbYokozunaIndex RpbYokozunaIndex FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbYokozunaIndex -> RpbYokozunaIndex
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 RpbYokozunaIndex RpbYokozunaIndex FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaIndex
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
"name"
                                RpbYokozunaIndex -> Bool -> Parser RpbYokozunaIndex
loop
                                  (Setter RpbYokozunaIndex RpbYokozunaIndex ByteString ByteString
-> ByteString -> RpbYokozunaIndex -> RpbYokozunaIndex
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y RpbYokozunaIndex
x)
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"schema"
                                RpbYokozunaIndex -> Bool -> Parser RpbYokozunaIndex
loop
                                  (Setter RpbYokozunaIndex RpbYokozunaIndex ByteString ByteString
-> ByteString -> RpbYokozunaIndex -> RpbYokozunaIndex
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"schema") ByteString
y RpbYokozunaIndex
x)
                                  Bool
required'name
                        Word64
24
                          -> 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
"n_val"
                                RpbYokozunaIndex -> Bool -> Parser RpbYokozunaIndex
loop
                                  (Setter RpbYokozunaIndex RpbYokozunaIndex Word32 Word32
-> Word32 -> RpbYokozunaIndex -> RpbYokozunaIndex
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"nVal") Word32
y RpbYokozunaIndex
x)
                                  Bool
required'name
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaIndex -> Bool -> Parser RpbYokozunaIndex
loop
                                  (Setter RpbYokozunaIndex RpbYokozunaIndex FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbYokozunaIndex -> RpbYokozunaIndex
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 RpbYokozunaIndex RpbYokozunaIndex FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaIndex
x)
                                  Bool
required'name
      in
        Parser RpbYokozunaIndex -> String -> Parser RpbYokozunaIndex
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaIndex -> Bool -> Parser RpbYokozunaIndex
loop RpbYokozunaIndex
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"RpbYokozunaIndex"
  buildMessage :: RpbYokozunaIndex -> Builder
buildMessage
    = \ RpbYokozunaIndex
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString RpbYokozunaIndex RpbYokozunaIndex ByteString ByteString
-> RpbYokozunaIndex -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") RpbYokozunaIndex
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbYokozunaIndex
  RpbYokozunaIndex
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbYokozunaIndex -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'schema") RpbYokozunaIndex
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32)
  RpbYokozunaIndex
  RpbYokozunaIndex
  (Maybe Word32)
  (Maybe Word32)
-> RpbYokozunaIndex -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'nVal" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'nVal") RpbYokozunaIndex
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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 RpbYokozunaIndex RpbYokozunaIndex FieldSet FieldSet
-> RpbYokozunaIndex -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbYokozunaIndex RpbYokozunaIndex FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaIndex
_x))))
instance Control.DeepSeq.NFData RpbYokozunaIndex where
  rnf :: RpbYokozunaIndex -> ()
rnf
    = \ RpbYokozunaIndex
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaIndex -> FieldSet
_RpbYokozunaIndex'_unknownFields RpbYokozunaIndex
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbYokozunaIndex -> ByteString
_RpbYokozunaIndex'name RpbYokozunaIndex
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (RpbYokozunaIndex -> Maybe ByteString
_RpbYokozunaIndex'schema RpbYokozunaIndex
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaIndex -> Maybe Word32
_RpbYokozunaIndex'nVal RpbYokozunaIndex
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.name' @:: Lens' RpbYokozunaIndexDeleteReq Data.ByteString.ByteString@ -}
data RpbYokozunaIndexDeleteReq
  = RpbYokozunaIndexDeleteReq'_constructor {RpbYokozunaIndexDeleteReq -> ByteString
_RpbYokozunaIndexDeleteReq'name :: !Data.ByteString.ByteString,
                                            RpbYokozunaIndexDeleteReq -> FieldSet
_RpbYokozunaIndexDeleteReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
(RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool)
-> (RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool)
-> Eq RpbYokozunaIndexDeleteReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
$c/= :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
== :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
$c== :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
Prelude.Eq, Eq RpbYokozunaIndexDeleteReq
Eq RpbYokozunaIndexDeleteReq
-> (RpbYokozunaIndexDeleteReq
    -> RpbYokozunaIndexDeleteReq -> Ordering)
-> (RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool)
-> (RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool)
-> (RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool)
-> (RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool)
-> (RpbYokozunaIndexDeleteReq
    -> RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq)
-> (RpbYokozunaIndexDeleteReq
    -> RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq)
-> Ord RpbYokozunaIndexDeleteReq
RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Ordering
RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq
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 :: RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq
$cmin :: RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq
max :: RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq
$cmax :: RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq
>= :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
$c>= :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
> :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
$c> :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
<= :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
$c<= :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
< :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
$c< :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Bool
compare :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Ordering
$ccompare :: RpbYokozunaIndexDeleteReq -> RpbYokozunaIndexDeleteReq -> Ordering
$cp1Ord :: Eq RpbYokozunaIndexDeleteReq
Prelude.Ord)
instance Prelude.Show RpbYokozunaIndexDeleteReq where
  showsPrec :: Int -> RpbYokozunaIndexDeleteReq -> ShowS
showsPrec Int
_ RpbYokozunaIndexDeleteReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaIndexDeleteReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaIndexDeleteReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexDeleteReq "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString)
-> RpbYokozunaIndexDeleteReq
-> f RpbYokozunaIndexDeleteReq
fieldOf Proxy# "name"
_
    = ((ByteString -> f ByteString)
 -> RpbYokozunaIndexDeleteReq -> f RpbYokozunaIndexDeleteReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbYokozunaIndexDeleteReq
-> f RpbYokozunaIndexDeleteReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexDeleteReq -> ByteString)
-> (RpbYokozunaIndexDeleteReq
    -> ByteString -> RpbYokozunaIndexDeleteReq)
-> Lens
     RpbYokozunaIndexDeleteReq
     RpbYokozunaIndexDeleteReq
     ByteString
     ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexDeleteReq -> ByteString
_RpbYokozunaIndexDeleteReq'name
           (\ RpbYokozunaIndexDeleteReq
x__ ByteString
y__ -> RpbYokozunaIndexDeleteReq
x__ {_RpbYokozunaIndexDeleteReq'name :: ByteString
_RpbYokozunaIndexDeleteReq'name = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaIndexDeleteReq where
  messageName :: Proxy RpbYokozunaIndexDeleteReq -> Text
messageName Proxy RpbYokozunaIndexDeleteReq
_ = String -> Text
Data.Text.pack String
"RpbYokozunaIndexDeleteReq"
  packedMessageDescriptor :: Proxy RpbYokozunaIndexDeleteReq -> ByteString
packedMessageDescriptor Proxy RpbYokozunaIndexDeleteReq
_
    = ByteString
"\n\
      \\EMRpbYokozunaIndexDeleteReq\DC2\DC2\n\
      \\EOTname\CAN\SOH \STX(\fR\EOTname"
  packedFileDescriptor :: Proxy RpbYokozunaIndexDeleteReq -> ByteString
packedFileDescriptor Proxy RpbYokozunaIndexDeleteReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaIndexDeleteReq)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor RpbYokozunaIndexDeleteReq
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbYokozunaIndexDeleteReq ByteString
-> FieldDescriptor RpbYokozunaIndexDeleteReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (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
     RpbYokozunaIndexDeleteReq
     RpbYokozunaIndexDeleteReq
     ByteString
     ByteString
-> FieldAccessor RpbYokozunaIndexDeleteReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndexDeleteReq
      in
        [(Tag, FieldDescriptor RpbYokozunaIndexDeleteReq)]
-> Map Tag (FieldDescriptor RpbYokozunaIndexDeleteReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaIndexDeleteReq
name__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaIndexDeleteReq FieldSet
unknownFields
    = (RpbYokozunaIndexDeleteReq -> FieldSet)
-> (RpbYokozunaIndexDeleteReq
    -> FieldSet -> RpbYokozunaIndexDeleteReq)
-> Lens' RpbYokozunaIndexDeleteReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaIndexDeleteReq -> FieldSet
_RpbYokozunaIndexDeleteReq'_unknownFields
        (\ RpbYokozunaIndexDeleteReq
x__ FieldSet
y__
           -> RpbYokozunaIndexDeleteReq
x__ {_RpbYokozunaIndexDeleteReq'_unknownFields :: FieldSet
_RpbYokozunaIndexDeleteReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaIndexDeleteReq
defMessage
    = RpbYokozunaIndexDeleteReq'_constructor :: ByteString -> FieldSet -> RpbYokozunaIndexDeleteReq
RpbYokozunaIndexDeleteReq'_constructor
        {_RpbYokozunaIndexDeleteReq'name :: ByteString
_RpbYokozunaIndexDeleteReq'name = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbYokozunaIndexDeleteReq'_unknownFields :: FieldSet
_RpbYokozunaIndexDeleteReq'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaIndexDeleteReq
parseMessage
    = let
        loop ::
          RpbYokozunaIndexDeleteReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaIndexDeleteReq
        loop :: RpbYokozunaIndexDeleteReq
-> Bool -> Parser RpbYokozunaIndexDeleteReq
loop RpbYokozunaIndexDeleteReq
x Bool
required'name
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'name then (:) String
"name" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbYokozunaIndexDeleteReq -> Parser RpbYokozunaIndexDeleteReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  FieldSet
  FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq
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
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  FieldSet
  FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaIndexDeleteReq
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
"name"
                                RpbYokozunaIndexDeleteReq
-> Bool -> Parser RpbYokozunaIndexDeleteReq
loop
                                  (Setter
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  ByteString
  ByteString
-> ByteString
-> RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y RpbYokozunaIndexDeleteReq
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaIndexDeleteReq
-> Bool -> Parser RpbYokozunaIndexDeleteReq
loop
                                  (Setter
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  FieldSet
  FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexDeleteReq
-> RpbYokozunaIndexDeleteReq
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
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  FieldSet
  FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaIndexDeleteReq
x)
                                  Bool
required'name
      in
        Parser RpbYokozunaIndexDeleteReq
-> String -> Parser RpbYokozunaIndexDeleteReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaIndexDeleteReq
-> Bool -> Parser RpbYokozunaIndexDeleteReq
loop RpbYokozunaIndexDeleteReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbYokozunaIndexDeleteReq"
  buildMessage :: RpbYokozunaIndexDeleteReq -> Builder
buildMessage
    = \ RpbYokozunaIndexDeleteReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  ByteString
  ByteString
-> RpbYokozunaIndexDeleteReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") RpbYokozunaIndexDeleteReq
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  FieldSet
  FieldSet
-> RpbYokozunaIndexDeleteReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbYokozunaIndexDeleteReq
  RpbYokozunaIndexDeleteReq
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaIndexDeleteReq
_x))
instance Control.DeepSeq.NFData RpbYokozunaIndexDeleteReq where
  rnf :: RpbYokozunaIndexDeleteReq -> ()
rnf
    = \ RpbYokozunaIndexDeleteReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaIndexDeleteReq -> FieldSet
_RpbYokozunaIndexDeleteReq'_unknownFields RpbYokozunaIndexDeleteReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaIndexDeleteReq -> ByteString
_RpbYokozunaIndexDeleteReq'name RpbYokozunaIndexDeleteReq
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.name' @:: Lens' RpbYokozunaIndexGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'name' @:: Lens' RpbYokozunaIndexGetReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbYokozunaIndexGetReq
  = RpbYokozunaIndexGetReq'_constructor {RpbYokozunaIndexGetReq -> Maybe ByteString
_RpbYokozunaIndexGetReq'name :: !(Prelude.Maybe Data.ByteString.ByteString),
                                         RpbYokozunaIndexGetReq -> FieldSet
_RpbYokozunaIndexGetReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
(RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool)
-> (RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool)
-> Eq RpbYokozunaIndexGetReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
$c/= :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
== :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
$c== :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
Prelude.Eq, Eq RpbYokozunaIndexGetReq
Eq RpbYokozunaIndexGetReq
-> (RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Ordering)
-> (RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool)
-> (RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool)
-> (RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool)
-> (RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool)
-> (RpbYokozunaIndexGetReq
    -> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq)
-> (RpbYokozunaIndexGetReq
    -> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq)
-> Ord RpbYokozunaIndexGetReq
RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Ordering
RpbYokozunaIndexGetReq
-> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq
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 :: RpbYokozunaIndexGetReq
-> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq
$cmin :: RpbYokozunaIndexGetReq
-> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq
max :: RpbYokozunaIndexGetReq
-> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq
$cmax :: RpbYokozunaIndexGetReq
-> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq
>= :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
$c>= :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
> :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
$c> :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
<= :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
$c<= :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
< :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
$c< :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Bool
compare :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Ordering
$ccompare :: RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq -> Ordering
$cp1Ord :: Eq RpbYokozunaIndexGetReq
Prelude.Ord)
instance Prelude.Show RpbYokozunaIndexGetReq where
  showsPrec :: Int -> RpbYokozunaIndexGetReq -> ShowS
showsPrec Int
_ RpbYokozunaIndexGetReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaIndexGetReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaIndexGetReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexGetReq "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString)
-> RpbYokozunaIndexGetReq
-> f RpbYokozunaIndexGetReq
fieldOf Proxy# "name"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbYokozunaIndexGetReq -> f RpbYokozunaIndexGetReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbYokozunaIndexGetReq
-> f RpbYokozunaIndexGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexGetReq -> Maybe ByteString)
-> (RpbYokozunaIndexGetReq
    -> Maybe ByteString -> RpbYokozunaIndexGetReq)
-> Lens
     RpbYokozunaIndexGetReq
     RpbYokozunaIndexGetReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexGetReq -> Maybe ByteString
_RpbYokozunaIndexGetReq'name
           (\ RpbYokozunaIndexGetReq
x__ Maybe ByteString
y__ -> RpbYokozunaIndexGetReq
x__ {_RpbYokozunaIndexGetReq'name :: Maybe ByteString
_RpbYokozunaIndexGetReq'name = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexGetReq "maybe'name" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'name"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbYokozunaIndexGetReq
-> f RpbYokozunaIndexGetReq
fieldOf Proxy# "maybe'name"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbYokozunaIndexGetReq -> f RpbYokozunaIndexGetReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbYokozunaIndexGetReq
-> f RpbYokozunaIndexGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexGetReq -> Maybe ByteString)
-> (RpbYokozunaIndexGetReq
    -> Maybe ByteString -> RpbYokozunaIndexGetReq)
-> Lens
     RpbYokozunaIndexGetReq
     RpbYokozunaIndexGetReq
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexGetReq -> Maybe ByteString
_RpbYokozunaIndexGetReq'name
           (\ RpbYokozunaIndexGetReq
x__ Maybe ByteString
y__ -> RpbYokozunaIndexGetReq
x__ {_RpbYokozunaIndexGetReq'name :: Maybe ByteString
_RpbYokozunaIndexGetReq'name = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaIndexGetReq where
  messageName :: Proxy RpbYokozunaIndexGetReq -> Text
messageName Proxy RpbYokozunaIndexGetReq
_ = String -> Text
Data.Text.pack String
"RpbYokozunaIndexGetReq"
  packedMessageDescriptor :: Proxy RpbYokozunaIndexGetReq -> ByteString
packedMessageDescriptor Proxy RpbYokozunaIndexGetReq
_
    = ByteString
"\n\
      \\SYNRpbYokozunaIndexGetReq\DC2\DC2\n\
      \\EOTname\CAN\SOH \SOH(\fR\EOTname"
  packedFileDescriptor :: Proxy RpbYokozunaIndexGetReq -> ByteString
packedFileDescriptor Proxy RpbYokozunaIndexGetReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaIndexGetReq)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor RpbYokozunaIndexGetReq
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbYokozunaIndexGetReq ByteString
-> FieldDescriptor RpbYokozunaIndexGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbYokozunaIndexGetReq
  RpbYokozunaIndexGetReq
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbYokozunaIndexGetReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'name")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndexGetReq
      in
        [(Tag, FieldDescriptor RpbYokozunaIndexGetReq)]
-> Map Tag (FieldDescriptor RpbYokozunaIndexGetReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaIndexGetReq
name__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaIndexGetReq FieldSet
unknownFields
    = (RpbYokozunaIndexGetReq -> FieldSet)
-> (RpbYokozunaIndexGetReq -> FieldSet -> RpbYokozunaIndexGetReq)
-> Lens' RpbYokozunaIndexGetReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaIndexGetReq -> FieldSet
_RpbYokozunaIndexGetReq'_unknownFields
        (\ RpbYokozunaIndexGetReq
x__ FieldSet
y__ -> RpbYokozunaIndexGetReq
x__ {_RpbYokozunaIndexGetReq'_unknownFields :: FieldSet
_RpbYokozunaIndexGetReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaIndexGetReq
defMessage
    = RpbYokozunaIndexGetReq'_constructor :: Maybe ByteString -> FieldSet -> RpbYokozunaIndexGetReq
RpbYokozunaIndexGetReq'_constructor
        {_RpbYokozunaIndexGetReq'name :: Maybe ByteString
_RpbYokozunaIndexGetReq'name = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbYokozunaIndexGetReq'_unknownFields :: FieldSet
_RpbYokozunaIndexGetReq'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaIndexGetReq
parseMessage
    = let
        loop ::
          RpbYokozunaIndexGetReq
          -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaIndexGetReq
        loop :: RpbYokozunaIndexGetReq -> Parser RpbYokozunaIndexGetReq
loop RpbYokozunaIndexGetReq
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]))))
                      RpbYokozunaIndexGetReq -> Parser RpbYokozunaIndexGetReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbYokozunaIndexGetReq RpbYokozunaIndexGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexGetReq
-> RpbYokozunaIndexGetReq
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
  RpbYokozunaIndexGetReq RpbYokozunaIndexGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaIndexGetReq
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
"name"
                                RpbYokozunaIndexGetReq -> Parser RpbYokozunaIndexGetReq
loop (Setter
  RpbYokozunaIndexGetReq RpbYokozunaIndexGetReq ByteString ByteString
-> ByteString -> RpbYokozunaIndexGetReq -> RpbYokozunaIndexGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y RpbYokozunaIndexGetReq
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaIndexGetReq -> Parser RpbYokozunaIndexGetReq
loop
                                  (Setter
  RpbYokozunaIndexGetReq RpbYokozunaIndexGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexGetReq
-> RpbYokozunaIndexGetReq
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
  RpbYokozunaIndexGetReq RpbYokozunaIndexGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaIndexGetReq
x)
      in
        Parser RpbYokozunaIndexGetReq
-> String -> Parser RpbYokozunaIndexGetReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaIndexGetReq -> Parser RpbYokozunaIndexGetReq
loop RpbYokozunaIndexGetReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"RpbYokozunaIndexGetReq"
  buildMessage :: RpbYokozunaIndexGetReq -> Builder
buildMessage
    = \ RpbYokozunaIndexGetReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe ByteString)
  RpbYokozunaIndexGetReq
  RpbYokozunaIndexGetReq
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbYokozunaIndexGetReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'name") RpbYokozunaIndexGetReq
_x
              of
                Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just ByteString
_v)
                  -> 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
  RpbYokozunaIndexGetReq
  RpbYokozunaIndexGetReq
  FieldSet
  FieldSet
-> RpbYokozunaIndexGetReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbYokozunaIndexGetReq
  RpbYokozunaIndexGetReq
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaIndexGetReq
_x))
instance Control.DeepSeq.NFData RpbYokozunaIndexGetReq where
  rnf :: RpbYokozunaIndexGetReq -> ()
rnf
    = \ RpbYokozunaIndexGetReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaIndexGetReq -> FieldSet
_RpbYokozunaIndexGetReq'_unknownFields RpbYokozunaIndexGetReq
x__)
             (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaIndexGetReq -> Maybe ByteString
_RpbYokozunaIndexGetReq'name RpbYokozunaIndexGetReq
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.index' @:: Lens' RpbYokozunaIndexGetResp [RpbYokozunaIndex]@
         * 'Proto.Riak_Fields.vec'index' @:: Lens' RpbYokozunaIndexGetResp (Data.Vector.Vector RpbYokozunaIndex)@ -}
data RpbYokozunaIndexGetResp
  = RpbYokozunaIndexGetResp'_constructor {RpbYokozunaIndexGetResp -> Vector RpbYokozunaIndex
_RpbYokozunaIndexGetResp'index :: !(Data.Vector.Vector RpbYokozunaIndex),
                                          RpbYokozunaIndexGetResp -> FieldSet
_RpbYokozunaIndexGetResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
(RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool)
-> (RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool)
-> Eq RpbYokozunaIndexGetResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
$c/= :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
== :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
$c== :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
Prelude.Eq, Eq RpbYokozunaIndexGetResp
Eq RpbYokozunaIndexGetResp
-> (RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Ordering)
-> (RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool)
-> (RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool)
-> (RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool)
-> (RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool)
-> (RpbYokozunaIndexGetResp
    -> RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp)
-> (RpbYokozunaIndexGetResp
    -> RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp)
-> Ord RpbYokozunaIndexGetResp
RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Ordering
RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp
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 :: RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp
$cmin :: RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp
max :: RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp
$cmax :: RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp
>= :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
$c>= :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
> :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
$c> :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
<= :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
$c<= :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
< :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
$c< :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Bool
compare :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Ordering
$ccompare :: RpbYokozunaIndexGetResp -> RpbYokozunaIndexGetResp -> Ordering
$cp1Ord :: Eq RpbYokozunaIndexGetResp
Prelude.Ord)
instance Prelude.Show RpbYokozunaIndexGetResp where
  showsPrec :: Int -> RpbYokozunaIndexGetResp -> ShowS
showsPrec Int
_ RpbYokozunaIndexGetResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaIndexGetResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaIndexGetResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexGetResp "index" [RpbYokozunaIndex] where
  fieldOf :: Proxy# "index"
-> ([RpbYokozunaIndex] -> f [RpbYokozunaIndex])
-> RpbYokozunaIndexGetResp
-> f RpbYokozunaIndexGetResp
fieldOf Proxy# "index"
_
    = ((Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
 -> RpbYokozunaIndexGetResp -> f RpbYokozunaIndexGetResp)
-> (([RpbYokozunaIndex] -> f [RpbYokozunaIndex])
    -> Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
-> ([RpbYokozunaIndex] -> f [RpbYokozunaIndex])
-> RpbYokozunaIndexGetResp
-> f RpbYokozunaIndexGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexGetResp -> Vector RpbYokozunaIndex)
-> (RpbYokozunaIndexGetResp
    -> Vector RpbYokozunaIndex -> RpbYokozunaIndexGetResp)
-> Lens
     RpbYokozunaIndexGetResp
     RpbYokozunaIndexGetResp
     (Vector RpbYokozunaIndex)
     (Vector RpbYokozunaIndex)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexGetResp -> Vector RpbYokozunaIndex
_RpbYokozunaIndexGetResp'index
           (\ RpbYokozunaIndexGetResp
x__ Vector RpbYokozunaIndex
y__ -> RpbYokozunaIndexGetResp
x__ {_RpbYokozunaIndexGetResp'index :: Vector RpbYokozunaIndex
_RpbYokozunaIndexGetResp'index = Vector RpbYokozunaIndex
y__}))
        ((Vector RpbYokozunaIndex -> [RpbYokozunaIndex])
-> (Vector RpbYokozunaIndex
    -> [RpbYokozunaIndex] -> Vector RpbYokozunaIndex)
-> Lens
     (Vector RpbYokozunaIndex)
     (Vector RpbYokozunaIndex)
     [RpbYokozunaIndex]
     [RpbYokozunaIndex]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbYokozunaIndex -> [RpbYokozunaIndex]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbYokozunaIndex
_ [RpbYokozunaIndex]
y__ -> [RpbYokozunaIndex] -> Vector RpbYokozunaIndex
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbYokozunaIndex]
y__))
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexGetResp "vec'index" (Data.Vector.Vector RpbYokozunaIndex) where
  fieldOf :: Proxy# "vec'index"
-> (Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
-> RpbYokozunaIndexGetResp
-> f RpbYokozunaIndexGetResp
fieldOf Proxy# "vec'index"
_
    = ((Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
 -> RpbYokozunaIndexGetResp -> f RpbYokozunaIndexGetResp)
-> ((Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
    -> Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
-> (Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
-> RpbYokozunaIndexGetResp
-> f RpbYokozunaIndexGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexGetResp -> Vector RpbYokozunaIndex)
-> (RpbYokozunaIndexGetResp
    -> Vector RpbYokozunaIndex -> RpbYokozunaIndexGetResp)
-> Lens
     RpbYokozunaIndexGetResp
     RpbYokozunaIndexGetResp
     (Vector RpbYokozunaIndex)
     (Vector RpbYokozunaIndex)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexGetResp -> Vector RpbYokozunaIndex
_RpbYokozunaIndexGetResp'index
           (\ RpbYokozunaIndexGetResp
x__ Vector RpbYokozunaIndex
y__ -> RpbYokozunaIndexGetResp
x__ {_RpbYokozunaIndexGetResp'index :: Vector RpbYokozunaIndex
_RpbYokozunaIndexGetResp'index = Vector RpbYokozunaIndex
y__}))
        (Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex))
-> Vector RpbYokozunaIndex -> f (Vector RpbYokozunaIndex)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaIndexGetResp where
  messageName :: Proxy RpbYokozunaIndexGetResp -> Text
messageName Proxy RpbYokozunaIndexGetResp
_ = String -> Text
Data.Text.pack String
"RpbYokozunaIndexGetResp"
  packedMessageDescriptor :: Proxy RpbYokozunaIndexGetResp -> ByteString
packedMessageDescriptor Proxy RpbYokozunaIndexGetResp
_
    = ByteString
"\n\
      \\ETBRpbYokozunaIndexGetResp\DC2'\n\
      \\ENQindex\CAN\SOH \ETX(\v2\DC1.RpbYokozunaIndexR\ENQindex"
  packedFileDescriptor :: Proxy RpbYokozunaIndexGetResp -> ByteString
packedFileDescriptor Proxy RpbYokozunaIndexGetResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaIndexGetResp)
fieldsByTag
    = let
        index__field_descriptor :: FieldDescriptor RpbYokozunaIndexGetResp
index__field_descriptor
          = String
-> FieldTypeDescriptor RpbYokozunaIndex
-> FieldAccessor RpbYokozunaIndexGetResp RpbYokozunaIndex
-> FieldDescriptor RpbYokozunaIndexGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"index"
              (MessageOrGroup -> FieldTypeDescriptor RpbYokozunaIndex
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbYokozunaIndex)
              (Packing
-> Lens' RpbYokozunaIndexGetResp [RpbYokozunaIndex]
-> FieldAccessor RpbYokozunaIndexGetResp RpbYokozunaIndex
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndexGetResp
      in
        [(Tag, FieldDescriptor RpbYokozunaIndexGetResp)]
-> Map Tag (FieldDescriptor RpbYokozunaIndexGetResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaIndexGetResp
index__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaIndexGetResp FieldSet
unknownFields
    = (RpbYokozunaIndexGetResp -> FieldSet)
-> (RpbYokozunaIndexGetResp -> FieldSet -> RpbYokozunaIndexGetResp)
-> Lens' RpbYokozunaIndexGetResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaIndexGetResp -> FieldSet
_RpbYokozunaIndexGetResp'_unknownFields
        (\ RpbYokozunaIndexGetResp
x__ FieldSet
y__ -> RpbYokozunaIndexGetResp
x__ {_RpbYokozunaIndexGetResp'_unknownFields :: FieldSet
_RpbYokozunaIndexGetResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaIndexGetResp
defMessage
    = RpbYokozunaIndexGetResp'_constructor :: Vector RpbYokozunaIndex -> FieldSet -> RpbYokozunaIndexGetResp
RpbYokozunaIndexGetResp'_constructor
        {_RpbYokozunaIndexGetResp'index :: Vector RpbYokozunaIndex
_RpbYokozunaIndexGetResp'index = Vector RpbYokozunaIndex
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _RpbYokozunaIndexGetResp'_unknownFields :: FieldSet
_RpbYokozunaIndexGetResp'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaIndexGetResp
parseMessage
    = let
        loop ::
          RpbYokozunaIndexGetResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbYokozunaIndex
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaIndexGetResp
        loop :: RpbYokozunaIndexGetResp
-> Growing Vector RealWorld RpbYokozunaIndex
-> Parser RpbYokozunaIndexGetResp
loop RpbYokozunaIndexGetResp
x Growing Vector RealWorld RpbYokozunaIndex
mutable'index
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbYokozunaIndex
frozen'index <- IO (Vector RpbYokozunaIndex) -> Parser (Vector RpbYokozunaIndex)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                        (Growing Vector (PrimState IO) RpbYokozunaIndex
-> IO (Vector RpbYokozunaIndex)
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 RpbYokozunaIndex
Growing Vector (PrimState IO) RpbYokozunaIndex
mutable'index)
                      (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]))))
                      RpbYokozunaIndexGetResp -> Parser RpbYokozunaIndexGetResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbYokozunaIndexGetResp RpbYokozunaIndexGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp
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
  RpbYokozunaIndexGetResp RpbYokozunaIndexGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  RpbYokozunaIndexGetResp
  RpbYokozunaIndexGetResp
  (Vector RpbYokozunaIndex)
  (Vector RpbYokozunaIndex)
-> Vector RpbYokozunaIndex
-> RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'index") Vector RpbYokozunaIndex
frozen'index RpbYokozunaIndexGetResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !RpbYokozunaIndex
y <- Parser RpbYokozunaIndex -> String -> Parser RpbYokozunaIndex
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbYokozunaIndex -> Parser RpbYokozunaIndex
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 RpbYokozunaIndex
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"index"
                                Growing Vector RealWorld RpbYokozunaIndex
v <- IO (Growing Vector RealWorld RpbYokozunaIndex)
-> Parser (Growing Vector RealWorld RpbYokozunaIndex)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbYokozunaIndex
-> RpbYokozunaIndex
-> IO (Growing Vector (PrimState IO) RpbYokozunaIndex)
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 RpbYokozunaIndex
Growing Vector (PrimState IO) RpbYokozunaIndex
mutable'index RpbYokozunaIndex
y)
                                RpbYokozunaIndexGetResp
-> Growing Vector RealWorld RpbYokozunaIndex
-> Parser RpbYokozunaIndexGetResp
loop RpbYokozunaIndexGetResp
x Growing Vector RealWorld RpbYokozunaIndex
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaIndexGetResp
-> Growing Vector RealWorld RpbYokozunaIndex
-> Parser RpbYokozunaIndexGetResp
loop
                                  (Setter
  RpbYokozunaIndexGetResp RpbYokozunaIndexGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexGetResp
-> RpbYokozunaIndexGetResp
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
  RpbYokozunaIndexGetResp RpbYokozunaIndexGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaIndexGetResp
x)
                                  Growing Vector RealWorld RpbYokozunaIndex
mutable'index
      in
        Parser RpbYokozunaIndexGetResp
-> String -> Parser RpbYokozunaIndexGetResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbYokozunaIndex
mutable'index <- IO (Growing Vector RealWorld RpbYokozunaIndex)
-> Parser (Growing Vector RealWorld RpbYokozunaIndex)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                 IO (Growing Vector RealWorld RpbYokozunaIndex)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              RpbYokozunaIndexGetResp
-> Growing Vector RealWorld RpbYokozunaIndex
-> Parser RpbYokozunaIndexGetResp
loop RpbYokozunaIndexGetResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld RpbYokozunaIndex
mutable'index)
          String
"RpbYokozunaIndexGetResp"
  buildMessage :: RpbYokozunaIndexGetResp -> Builder
buildMessage
    = \ RpbYokozunaIndexGetResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((RpbYokozunaIndex -> Builder) -> Vector RpbYokozunaIndex -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ RpbYokozunaIndex
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (RpbYokozunaIndex -> ByteString) -> RpbYokozunaIndex -> 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))
                           RpbYokozunaIndex -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           RpbYokozunaIndex
_v))
                (FoldLike
  (Vector RpbYokozunaIndex)
  RpbYokozunaIndexGetResp
  RpbYokozunaIndexGetResp
  (Vector RpbYokozunaIndex)
  (Vector RpbYokozunaIndex)
-> RpbYokozunaIndexGetResp -> Vector RpbYokozunaIndex
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'index") RpbYokozunaIndexGetResp
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RpbYokozunaIndexGetResp
  RpbYokozunaIndexGetResp
  FieldSet
  FieldSet
-> RpbYokozunaIndexGetResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbYokozunaIndexGetResp
  RpbYokozunaIndexGetResp
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaIndexGetResp
_x))
instance Control.DeepSeq.NFData RpbYokozunaIndexGetResp where
  rnf :: RpbYokozunaIndexGetResp -> ()
rnf
    = \ RpbYokozunaIndexGetResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaIndexGetResp -> FieldSet
_RpbYokozunaIndexGetResp'_unknownFields RpbYokozunaIndexGetResp
x__)
             (Vector RpbYokozunaIndex -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaIndexGetResp -> Vector RpbYokozunaIndex
_RpbYokozunaIndexGetResp'index RpbYokozunaIndexGetResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.index' @:: Lens' RpbYokozunaIndexPutReq RpbYokozunaIndex@
         * 'Proto.Riak_Fields.timeout' @:: Lens' RpbYokozunaIndexPutReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' RpbYokozunaIndexPutReq (Prelude.Maybe Data.Word.Word32)@ -}
data RpbYokozunaIndexPutReq
  = RpbYokozunaIndexPutReq'_constructor {RpbYokozunaIndexPutReq -> RpbYokozunaIndex
_RpbYokozunaIndexPutReq'index :: !RpbYokozunaIndex,
                                         RpbYokozunaIndexPutReq -> Maybe Word32
_RpbYokozunaIndexPutReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                                         RpbYokozunaIndexPutReq -> FieldSet
_RpbYokozunaIndexPutReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
(RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool)
-> (RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool)
-> Eq RpbYokozunaIndexPutReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
$c/= :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
== :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
$c== :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
Prelude.Eq, Eq RpbYokozunaIndexPutReq
Eq RpbYokozunaIndexPutReq
-> (RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Ordering)
-> (RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool)
-> (RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool)
-> (RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool)
-> (RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool)
-> (RpbYokozunaIndexPutReq
    -> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq)
-> (RpbYokozunaIndexPutReq
    -> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq)
-> Ord RpbYokozunaIndexPutReq
RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Ordering
RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq
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 :: RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq
$cmin :: RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq
max :: RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq
$cmax :: RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq
>= :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
$c>= :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
> :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
$c> :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
<= :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
$c<= :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
< :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
$c< :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Bool
compare :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Ordering
$ccompare :: RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq -> Ordering
$cp1Ord :: Eq RpbYokozunaIndexPutReq
Prelude.Ord)
instance Prelude.Show RpbYokozunaIndexPutReq where
  showsPrec :: Int -> RpbYokozunaIndexPutReq -> ShowS
showsPrec Int
_ RpbYokozunaIndexPutReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaIndexPutReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaIndexPutReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexPutReq "index" RpbYokozunaIndex where
  fieldOf :: Proxy# "index"
-> (RpbYokozunaIndex -> f RpbYokozunaIndex)
-> RpbYokozunaIndexPutReq
-> f RpbYokozunaIndexPutReq
fieldOf Proxy# "index"
_
    = ((RpbYokozunaIndex -> f RpbYokozunaIndex)
 -> RpbYokozunaIndexPutReq -> f RpbYokozunaIndexPutReq)
-> ((RpbYokozunaIndex -> f RpbYokozunaIndex)
    -> RpbYokozunaIndex -> f RpbYokozunaIndex)
-> (RpbYokozunaIndex -> f RpbYokozunaIndex)
-> RpbYokozunaIndexPutReq
-> f RpbYokozunaIndexPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexPutReq -> RpbYokozunaIndex)
-> (RpbYokozunaIndexPutReq
    -> RpbYokozunaIndex -> RpbYokozunaIndexPutReq)
-> Lens
     RpbYokozunaIndexPutReq
     RpbYokozunaIndexPutReq
     RpbYokozunaIndex
     RpbYokozunaIndex
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexPutReq -> RpbYokozunaIndex
_RpbYokozunaIndexPutReq'index
           (\ RpbYokozunaIndexPutReq
x__ RpbYokozunaIndex
y__ -> RpbYokozunaIndexPutReq
x__ {_RpbYokozunaIndexPutReq'index :: RpbYokozunaIndex
_RpbYokozunaIndexPutReq'index = RpbYokozunaIndex
y__}))
        (RpbYokozunaIndex -> f RpbYokozunaIndex)
-> RpbYokozunaIndex -> f RpbYokozunaIndex
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexPutReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32)
-> RpbYokozunaIndexPutReq
-> f RpbYokozunaIndexPutReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbYokozunaIndexPutReq -> f RpbYokozunaIndexPutReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> RpbYokozunaIndexPutReq
-> f RpbYokozunaIndexPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexPutReq -> Maybe Word32)
-> (RpbYokozunaIndexPutReq
    -> Maybe Word32 -> RpbYokozunaIndexPutReq)
-> Lens
     RpbYokozunaIndexPutReq
     RpbYokozunaIndexPutReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexPutReq -> Maybe Word32
_RpbYokozunaIndexPutReq'timeout
           (\ RpbYokozunaIndexPutReq
x__ Maybe Word32
y__ -> RpbYokozunaIndexPutReq
x__ {_RpbYokozunaIndexPutReq'timeout :: Maybe Word32
_RpbYokozunaIndexPutReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbYokozunaIndexPutReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbYokozunaIndexPutReq
-> f RpbYokozunaIndexPutReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> RpbYokozunaIndexPutReq -> f RpbYokozunaIndexPutReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> RpbYokozunaIndexPutReq
-> f RpbYokozunaIndexPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaIndexPutReq -> Maybe Word32)
-> (RpbYokozunaIndexPutReq
    -> Maybe Word32 -> RpbYokozunaIndexPutReq)
-> Lens
     RpbYokozunaIndexPutReq
     RpbYokozunaIndexPutReq
     (Maybe Word32)
     (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaIndexPutReq -> Maybe Word32
_RpbYokozunaIndexPutReq'timeout
           (\ RpbYokozunaIndexPutReq
x__ Maybe Word32
y__ -> RpbYokozunaIndexPutReq
x__ {_RpbYokozunaIndexPutReq'timeout :: Maybe Word32
_RpbYokozunaIndexPutReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaIndexPutReq where
  messageName :: Proxy RpbYokozunaIndexPutReq -> Text
messageName Proxy RpbYokozunaIndexPutReq
_ = String -> Text
Data.Text.pack String
"RpbYokozunaIndexPutReq"
  packedMessageDescriptor :: Proxy RpbYokozunaIndexPutReq -> ByteString
packedMessageDescriptor Proxy RpbYokozunaIndexPutReq
_
    = ByteString
"\n\
      \\SYNRpbYokozunaIndexPutReq\DC2'\n\
      \\ENQindex\CAN\SOH \STX(\v2\DC1.RpbYokozunaIndexR\ENQindex\DC2\CAN\n\
      \\atimeout\CAN\STX \SOH(\rR\atimeout"
  packedFileDescriptor :: Proxy RpbYokozunaIndexPutReq -> ByteString
packedFileDescriptor Proxy RpbYokozunaIndexPutReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaIndexPutReq)
fieldsByTag
    = let
        index__field_descriptor :: FieldDescriptor RpbYokozunaIndexPutReq
index__field_descriptor
          = String
-> FieldTypeDescriptor RpbYokozunaIndex
-> FieldAccessor RpbYokozunaIndexPutReq RpbYokozunaIndex
-> FieldDescriptor RpbYokozunaIndexPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"index"
              (MessageOrGroup -> FieldTypeDescriptor RpbYokozunaIndex
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbYokozunaIndex)
              (WireDefault RpbYokozunaIndex
-> Lens
     RpbYokozunaIndexPutReq
     RpbYokozunaIndexPutReq
     RpbYokozunaIndex
     RpbYokozunaIndex
-> FieldAccessor RpbYokozunaIndexPutReq RpbYokozunaIndex
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbYokozunaIndex
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndexPutReq
        timeout__field_descriptor :: FieldDescriptor RpbYokozunaIndexPutReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor RpbYokozunaIndexPutReq Word32
-> FieldDescriptor RpbYokozunaIndexPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens
  RpbYokozunaIndexPutReq
  RpbYokozunaIndexPutReq
  (Maybe Word32)
  (Maybe Word32)
-> FieldAccessor RpbYokozunaIndexPutReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaIndexPutReq
      in
        [(Tag, FieldDescriptor RpbYokozunaIndexPutReq)]
-> Map Tag (FieldDescriptor RpbYokozunaIndexPutReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaIndexPutReq
index__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbYokozunaIndexPutReq
timeout__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaIndexPutReq FieldSet
unknownFields
    = (RpbYokozunaIndexPutReq -> FieldSet)
-> (RpbYokozunaIndexPutReq -> FieldSet -> RpbYokozunaIndexPutReq)
-> Lens' RpbYokozunaIndexPutReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaIndexPutReq -> FieldSet
_RpbYokozunaIndexPutReq'_unknownFields
        (\ RpbYokozunaIndexPutReq
x__ FieldSet
y__ -> RpbYokozunaIndexPutReq
x__ {_RpbYokozunaIndexPutReq'_unknownFields :: FieldSet
_RpbYokozunaIndexPutReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaIndexPutReq
defMessage
    = RpbYokozunaIndexPutReq'_constructor :: RpbYokozunaIndex
-> Maybe Word32 -> FieldSet -> RpbYokozunaIndexPutReq
RpbYokozunaIndexPutReq'_constructor
        {_RpbYokozunaIndexPutReq'index :: RpbYokozunaIndex
_RpbYokozunaIndexPutReq'index = RpbYokozunaIndex
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbYokozunaIndexPutReq'timeout :: Maybe Word32
_RpbYokozunaIndexPutReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _RpbYokozunaIndexPutReq'_unknownFields :: FieldSet
_RpbYokozunaIndexPutReq'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaIndexPutReq
parseMessage
    = let
        loop ::
          RpbYokozunaIndexPutReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaIndexPutReq
        loop :: RpbYokozunaIndexPutReq -> Bool -> Parser RpbYokozunaIndexPutReq
loop RpbYokozunaIndexPutReq
x Bool
required'index
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'index then (:) String
"index" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbYokozunaIndexPutReq -> Parser RpbYokozunaIndexPutReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbYokozunaIndexPutReq RpbYokozunaIndexPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq
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
  RpbYokozunaIndexPutReq RpbYokozunaIndexPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaIndexPutReq
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do RpbYokozunaIndex
y <- Parser RpbYokozunaIndex -> String -> Parser RpbYokozunaIndex
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbYokozunaIndex -> Parser RpbYokozunaIndex
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 RpbYokozunaIndex
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"index"
                                RpbYokozunaIndexPutReq -> Bool -> Parser RpbYokozunaIndexPutReq
loop
                                  (Setter
  RpbYokozunaIndexPutReq
  RpbYokozunaIndexPutReq
  RpbYokozunaIndex
  RpbYokozunaIndex
-> RpbYokozunaIndex
-> RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index") RpbYokozunaIndex
y RpbYokozunaIndexPutReq
x)
                                  Bool
Prelude.False
                        Word64
16
                          -> 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
"timeout"
                                RpbYokozunaIndexPutReq -> Bool -> Parser RpbYokozunaIndexPutReq
loop
                                  (Setter RpbYokozunaIndexPutReq RpbYokozunaIndexPutReq Word32 Word32
-> Word32 -> RpbYokozunaIndexPutReq -> RpbYokozunaIndexPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y RpbYokozunaIndexPutReq
x)
                                  Bool
required'index
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaIndexPutReq -> Bool -> Parser RpbYokozunaIndexPutReq
loop
                                  (Setter
  RpbYokozunaIndexPutReq RpbYokozunaIndexPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaIndexPutReq
-> RpbYokozunaIndexPutReq
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
  RpbYokozunaIndexPutReq RpbYokozunaIndexPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaIndexPutReq
x)
                                  Bool
required'index
      in
        Parser RpbYokozunaIndexPutReq
-> String -> Parser RpbYokozunaIndexPutReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaIndexPutReq -> Bool -> Parser RpbYokozunaIndexPutReq
loop RpbYokozunaIndexPutReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbYokozunaIndexPutReq"
  buildMessage :: RpbYokozunaIndexPutReq -> Builder
buildMessage
    = \ RpbYokozunaIndexPutReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                ((ByteString -> Builder)
-> (RpbYokozunaIndex -> ByteString) -> RpbYokozunaIndex -> 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))
                   RpbYokozunaIndex -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                   (FoldLike
  RpbYokozunaIndex
  RpbYokozunaIndexPutReq
  RpbYokozunaIndexPutReq
  RpbYokozunaIndex
  RpbYokozunaIndex
-> RpbYokozunaIndexPutReq -> RpbYokozunaIndex
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "index" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"index") RpbYokozunaIndexPutReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Word32)
  RpbYokozunaIndexPutReq
  RpbYokozunaIndexPutReq
  (Maybe Word32)
  (Maybe Word32)
-> RpbYokozunaIndexPutReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") RpbYokozunaIndexPutReq
_x
                 of
                   Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Word32
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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
  RpbYokozunaIndexPutReq
  RpbYokozunaIndexPutReq
  FieldSet
  FieldSet
-> RpbYokozunaIndexPutReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbYokozunaIndexPutReq
  RpbYokozunaIndexPutReq
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaIndexPutReq
_x)))
instance Control.DeepSeq.NFData RpbYokozunaIndexPutReq where
  rnf :: RpbYokozunaIndexPutReq -> ()
rnf
    = \ RpbYokozunaIndexPutReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaIndexPutReq -> FieldSet
_RpbYokozunaIndexPutReq'_unknownFields RpbYokozunaIndexPutReq
x__)
             (RpbYokozunaIndex -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbYokozunaIndexPutReq -> RpbYokozunaIndex
_RpbYokozunaIndexPutReq'index RpbYokozunaIndexPutReq
x__)
                (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaIndexPutReq -> Maybe Word32
_RpbYokozunaIndexPutReq'timeout RpbYokozunaIndexPutReq
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.name' @:: Lens' RpbYokozunaSchema Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.content' @:: Lens' RpbYokozunaSchema Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'content' @:: Lens' RpbYokozunaSchema (Prelude.Maybe Data.ByteString.ByteString)@ -}
data RpbYokozunaSchema
  = RpbYokozunaSchema'_constructor {RpbYokozunaSchema -> ByteString
_RpbYokozunaSchema'name :: !Data.ByteString.ByteString,
                                    RpbYokozunaSchema -> Maybe ByteString
_RpbYokozunaSchema'content :: !(Prelude.Maybe Data.ByteString.ByteString),
                                    RpbYokozunaSchema -> FieldSet
_RpbYokozunaSchema'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
(RpbYokozunaSchema -> RpbYokozunaSchema -> Bool)
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> Bool)
-> Eq RpbYokozunaSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
$c/= :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
== :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
$c== :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
Prelude.Eq, Eq RpbYokozunaSchema
Eq RpbYokozunaSchema
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> Ordering)
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> Bool)
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> Bool)
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> Bool)
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> Bool)
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> RpbYokozunaSchema)
-> (RpbYokozunaSchema -> RpbYokozunaSchema -> RpbYokozunaSchema)
-> Ord RpbYokozunaSchema
RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
RpbYokozunaSchema -> RpbYokozunaSchema -> Ordering
RpbYokozunaSchema -> RpbYokozunaSchema -> RpbYokozunaSchema
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 :: RpbYokozunaSchema -> RpbYokozunaSchema -> RpbYokozunaSchema
$cmin :: RpbYokozunaSchema -> RpbYokozunaSchema -> RpbYokozunaSchema
max :: RpbYokozunaSchema -> RpbYokozunaSchema -> RpbYokozunaSchema
$cmax :: RpbYokozunaSchema -> RpbYokozunaSchema -> RpbYokozunaSchema
>= :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
$c>= :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
> :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
$c> :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
<= :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
$c<= :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
< :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
$c< :: RpbYokozunaSchema -> RpbYokozunaSchema -> Bool
compare :: RpbYokozunaSchema -> RpbYokozunaSchema -> Ordering
$ccompare :: RpbYokozunaSchema -> RpbYokozunaSchema -> Ordering
$cp1Ord :: Eq RpbYokozunaSchema
Prelude.Ord)
instance Prelude.Show RpbYokozunaSchema where
  showsPrec :: Int -> RpbYokozunaSchema -> ShowS
showsPrec Int
_ RpbYokozunaSchema
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaSchema -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaSchema
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaSchema "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString)
-> RpbYokozunaSchema
-> f RpbYokozunaSchema
fieldOf Proxy# "name"
_
    = ((ByteString -> f ByteString)
 -> RpbYokozunaSchema -> f RpbYokozunaSchema)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbYokozunaSchema
-> f RpbYokozunaSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaSchema -> ByteString)
-> (RpbYokozunaSchema -> ByteString -> RpbYokozunaSchema)
-> Lens RpbYokozunaSchema RpbYokozunaSchema ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaSchema -> ByteString
_RpbYokozunaSchema'name
           (\ RpbYokozunaSchema
x__ ByteString
y__ -> RpbYokozunaSchema
x__ {_RpbYokozunaSchema'name :: ByteString
_RpbYokozunaSchema'name = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField RpbYokozunaSchema "content" Data.ByteString.ByteString where
  fieldOf :: Proxy# "content"
-> (ByteString -> f ByteString)
-> RpbYokozunaSchema
-> f RpbYokozunaSchema
fieldOf Proxy# "content"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbYokozunaSchema -> f RpbYokozunaSchema)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> RpbYokozunaSchema
-> f RpbYokozunaSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaSchema -> Maybe ByteString)
-> (RpbYokozunaSchema -> Maybe ByteString -> RpbYokozunaSchema)
-> Lens
     RpbYokozunaSchema
     RpbYokozunaSchema
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaSchema -> Maybe ByteString
_RpbYokozunaSchema'content
           (\ RpbYokozunaSchema
x__ Maybe ByteString
y__ -> RpbYokozunaSchema
x__ {_RpbYokozunaSchema'content :: Maybe ByteString
_RpbYokozunaSchema'content = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField RpbYokozunaSchema "maybe'content" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'content"
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbYokozunaSchema
-> f RpbYokozunaSchema
fieldOf Proxy# "maybe'content"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> RpbYokozunaSchema -> f RpbYokozunaSchema)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> RpbYokozunaSchema
-> f RpbYokozunaSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaSchema -> Maybe ByteString)
-> (RpbYokozunaSchema -> Maybe ByteString -> RpbYokozunaSchema)
-> Lens
     RpbYokozunaSchema
     RpbYokozunaSchema
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaSchema -> Maybe ByteString
_RpbYokozunaSchema'content
           (\ RpbYokozunaSchema
x__ Maybe ByteString
y__ -> RpbYokozunaSchema
x__ {_RpbYokozunaSchema'content :: Maybe ByteString
_RpbYokozunaSchema'content = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaSchema where
  messageName :: Proxy RpbYokozunaSchema -> Text
messageName Proxy RpbYokozunaSchema
_ = String -> Text
Data.Text.pack String
"RpbYokozunaSchema"
  packedMessageDescriptor :: Proxy RpbYokozunaSchema -> ByteString
packedMessageDescriptor Proxy RpbYokozunaSchema
_
    = ByteString
"\n\
      \\DC1RpbYokozunaSchema\DC2\DC2\n\
      \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2\CAN\n\
      \\acontent\CAN\STX \SOH(\fR\acontent"
  packedFileDescriptor :: Proxy RpbYokozunaSchema -> ByteString
packedFileDescriptor Proxy RpbYokozunaSchema
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaSchema)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor RpbYokozunaSchema
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbYokozunaSchema ByteString
-> FieldDescriptor RpbYokozunaSchema
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (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 RpbYokozunaSchema RpbYokozunaSchema ByteString ByteString
-> FieldAccessor RpbYokozunaSchema ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaSchema
        content__field_descriptor :: FieldDescriptor RpbYokozunaSchema
content__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbYokozunaSchema ByteString
-> FieldDescriptor RpbYokozunaSchema
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"content"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  RpbYokozunaSchema
  RpbYokozunaSchema
  (Maybe ByteString)
  (Maybe ByteString)
-> FieldAccessor RpbYokozunaSchema ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'content")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaSchema
      in
        [(Tag, FieldDescriptor RpbYokozunaSchema)]
-> Map Tag (FieldDescriptor RpbYokozunaSchema)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaSchema
name__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor RpbYokozunaSchema
content__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaSchema FieldSet
unknownFields
    = (RpbYokozunaSchema -> FieldSet)
-> (RpbYokozunaSchema -> FieldSet -> RpbYokozunaSchema)
-> Lens' RpbYokozunaSchema FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaSchema -> FieldSet
_RpbYokozunaSchema'_unknownFields
        (\ RpbYokozunaSchema
x__ FieldSet
y__ -> RpbYokozunaSchema
x__ {_RpbYokozunaSchema'_unknownFields :: FieldSet
_RpbYokozunaSchema'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaSchema
defMessage
    = RpbYokozunaSchema'_constructor :: ByteString -> Maybe ByteString -> FieldSet -> RpbYokozunaSchema
RpbYokozunaSchema'_constructor
        {_RpbYokozunaSchema'name :: ByteString
_RpbYokozunaSchema'name = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbYokozunaSchema'content :: Maybe ByteString
_RpbYokozunaSchema'content = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _RpbYokozunaSchema'_unknownFields :: FieldSet
_RpbYokozunaSchema'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaSchema
parseMessage
    = let
        loop ::
          RpbYokozunaSchema
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaSchema
        loop :: RpbYokozunaSchema -> Bool -> Parser RpbYokozunaSchema
loop RpbYokozunaSchema
x Bool
required'name
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'name then (:) String
"name" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbYokozunaSchema -> Parser RpbYokozunaSchema
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter RpbYokozunaSchema RpbYokozunaSchema FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbYokozunaSchema -> RpbYokozunaSchema
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 RpbYokozunaSchema RpbYokozunaSchema FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaSchema
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
"name"
                                RpbYokozunaSchema -> Bool -> Parser RpbYokozunaSchema
loop
                                  (Setter RpbYokozunaSchema RpbYokozunaSchema ByteString ByteString
-> ByteString -> RpbYokozunaSchema -> RpbYokozunaSchema
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y RpbYokozunaSchema
x)
                                  Bool
Prelude.False
                        Word64
18
                          -> 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
"content"
                                RpbYokozunaSchema -> Bool -> Parser RpbYokozunaSchema
loop
                                  (Setter RpbYokozunaSchema RpbYokozunaSchema ByteString ByteString
-> ByteString -> RpbYokozunaSchema -> RpbYokozunaSchema
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"content") ByteString
y RpbYokozunaSchema
x)
                                  Bool
required'name
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaSchema -> Bool -> Parser RpbYokozunaSchema
loop
                                  (Setter RpbYokozunaSchema RpbYokozunaSchema FieldSet FieldSet
-> (FieldSet -> FieldSet) -> RpbYokozunaSchema -> RpbYokozunaSchema
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 RpbYokozunaSchema RpbYokozunaSchema FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaSchema
x)
                                  Bool
required'name
      in
        Parser RpbYokozunaSchema -> String -> Parser RpbYokozunaSchema
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaSchema -> Bool -> Parser RpbYokozunaSchema
loop RpbYokozunaSchema
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbYokozunaSchema"
  buildMessage :: RpbYokozunaSchema -> Builder
buildMessage
    = \ RpbYokozunaSchema
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbYokozunaSchema
  RpbYokozunaSchema
  ByteString
  ByteString
-> RpbYokozunaSchema -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") RpbYokozunaSchema
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe ByteString)
  RpbYokozunaSchema
  RpbYokozunaSchema
  (Maybe ByteString)
  (Maybe ByteString)
-> RpbYokozunaSchema -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'content" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'content") RpbYokozunaSchema
_x
                 of
                   Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just ByteString
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((\ 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 RpbYokozunaSchema RpbYokozunaSchema FieldSet FieldSet
-> RpbYokozunaSchema -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet RpbYokozunaSchema RpbYokozunaSchema FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaSchema
_x)))
instance Control.DeepSeq.NFData RpbYokozunaSchema where
  rnf :: RpbYokozunaSchema -> ()
rnf
    = \ RpbYokozunaSchema
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaSchema -> FieldSet
_RpbYokozunaSchema'_unknownFields RpbYokozunaSchema
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (RpbYokozunaSchema -> ByteString
_RpbYokozunaSchema'name RpbYokozunaSchema
x__)
                (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaSchema -> Maybe ByteString
_RpbYokozunaSchema'content RpbYokozunaSchema
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.name' @:: Lens' RpbYokozunaSchemaGetReq Data.ByteString.ByteString@ -}
data RpbYokozunaSchemaGetReq
  = RpbYokozunaSchemaGetReq'_constructor {RpbYokozunaSchemaGetReq -> ByteString
_RpbYokozunaSchemaGetReq'name :: !Data.ByteString.ByteString,
                                          RpbYokozunaSchemaGetReq -> FieldSet
_RpbYokozunaSchemaGetReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
(RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool)
-> (RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool)
-> Eq RpbYokozunaSchemaGetReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
$c/= :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
== :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
$c== :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
Prelude.Eq, Eq RpbYokozunaSchemaGetReq
Eq RpbYokozunaSchemaGetReq
-> (RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Ordering)
-> (RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool)
-> (RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool)
-> (RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool)
-> (RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool)
-> (RpbYokozunaSchemaGetReq
    -> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq)
-> (RpbYokozunaSchemaGetReq
    -> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq)
-> Ord RpbYokozunaSchemaGetReq
RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Ordering
RpbYokozunaSchemaGetReq
-> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq
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 :: RpbYokozunaSchemaGetReq
-> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq
$cmin :: RpbYokozunaSchemaGetReq
-> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq
max :: RpbYokozunaSchemaGetReq
-> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq
$cmax :: RpbYokozunaSchemaGetReq
-> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq
>= :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
$c>= :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
> :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
$c> :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
<= :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
$c<= :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
< :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
$c< :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Bool
compare :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Ordering
$ccompare :: RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq -> Ordering
$cp1Ord :: Eq RpbYokozunaSchemaGetReq
Prelude.Ord)
instance Prelude.Show RpbYokozunaSchemaGetReq where
  showsPrec :: Int -> RpbYokozunaSchemaGetReq -> ShowS
showsPrec Int
_ RpbYokozunaSchemaGetReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaSchemaGetReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaSchemaGetReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaSchemaGetReq "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString)
-> RpbYokozunaSchemaGetReq
-> f RpbYokozunaSchemaGetReq
fieldOf Proxy# "name"
_
    = ((ByteString -> f ByteString)
 -> RpbYokozunaSchemaGetReq -> f RpbYokozunaSchemaGetReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> RpbYokozunaSchemaGetReq
-> f RpbYokozunaSchemaGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaSchemaGetReq -> ByteString)
-> (RpbYokozunaSchemaGetReq
    -> ByteString -> RpbYokozunaSchemaGetReq)
-> Lens
     RpbYokozunaSchemaGetReq
     RpbYokozunaSchemaGetReq
     ByteString
     ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaSchemaGetReq -> ByteString
_RpbYokozunaSchemaGetReq'name
           (\ RpbYokozunaSchemaGetReq
x__ ByteString
y__ -> RpbYokozunaSchemaGetReq
x__ {_RpbYokozunaSchemaGetReq'name :: ByteString
_RpbYokozunaSchemaGetReq'name = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaSchemaGetReq where
  messageName :: Proxy RpbYokozunaSchemaGetReq -> Text
messageName Proxy RpbYokozunaSchemaGetReq
_ = String -> Text
Data.Text.pack String
"RpbYokozunaSchemaGetReq"
  packedMessageDescriptor :: Proxy RpbYokozunaSchemaGetReq -> ByteString
packedMessageDescriptor Proxy RpbYokozunaSchemaGetReq
_
    = ByteString
"\n\
      \\ETBRpbYokozunaSchemaGetReq\DC2\DC2\n\
      \\EOTname\CAN\SOH \STX(\fR\EOTname"
  packedFileDescriptor :: Proxy RpbYokozunaSchemaGetReq -> ByteString
packedFileDescriptor Proxy RpbYokozunaSchemaGetReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaSchemaGetReq)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor RpbYokozunaSchemaGetReq
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor RpbYokozunaSchemaGetReq ByteString
-> FieldDescriptor RpbYokozunaSchemaGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (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
     RpbYokozunaSchemaGetReq
     RpbYokozunaSchemaGetReq
     ByteString
     ByteString
-> FieldAccessor RpbYokozunaSchemaGetReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaSchemaGetReq
      in
        [(Tag, FieldDescriptor RpbYokozunaSchemaGetReq)]
-> Map Tag (FieldDescriptor RpbYokozunaSchemaGetReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaSchemaGetReq
name__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaSchemaGetReq FieldSet
unknownFields
    = (RpbYokozunaSchemaGetReq -> FieldSet)
-> (RpbYokozunaSchemaGetReq -> FieldSet -> RpbYokozunaSchemaGetReq)
-> Lens' RpbYokozunaSchemaGetReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaSchemaGetReq -> FieldSet
_RpbYokozunaSchemaGetReq'_unknownFields
        (\ RpbYokozunaSchemaGetReq
x__ FieldSet
y__ -> RpbYokozunaSchemaGetReq
x__ {_RpbYokozunaSchemaGetReq'_unknownFields :: FieldSet
_RpbYokozunaSchemaGetReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaSchemaGetReq
defMessage
    = RpbYokozunaSchemaGetReq'_constructor :: ByteString -> FieldSet -> RpbYokozunaSchemaGetReq
RpbYokozunaSchemaGetReq'_constructor
        {_RpbYokozunaSchemaGetReq'name :: ByteString
_RpbYokozunaSchemaGetReq'name = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _RpbYokozunaSchemaGetReq'_unknownFields :: FieldSet
_RpbYokozunaSchemaGetReq'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaSchemaGetReq
parseMessage
    = let
        loop ::
          RpbYokozunaSchemaGetReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaSchemaGetReq
        loop :: RpbYokozunaSchemaGetReq -> Bool -> Parser RpbYokozunaSchemaGetReq
loop RpbYokozunaSchemaGetReq
x Bool
required'name
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'name then (:) String
"name" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbYokozunaSchemaGetReq -> Parser RpbYokozunaSchemaGetReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbYokozunaSchemaGetReq RpbYokozunaSchemaGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaSchemaGetReq
-> RpbYokozunaSchemaGetReq
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
  RpbYokozunaSchemaGetReq RpbYokozunaSchemaGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaSchemaGetReq
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
"name"
                                RpbYokozunaSchemaGetReq -> Bool -> Parser RpbYokozunaSchemaGetReq
loop
                                  (Setter
  RpbYokozunaSchemaGetReq
  RpbYokozunaSchemaGetReq
  ByteString
  ByteString
-> ByteString -> RpbYokozunaSchemaGetReq -> RpbYokozunaSchemaGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y RpbYokozunaSchemaGetReq
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaSchemaGetReq -> Bool -> Parser RpbYokozunaSchemaGetReq
loop
                                  (Setter
  RpbYokozunaSchemaGetReq RpbYokozunaSchemaGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaSchemaGetReq
-> RpbYokozunaSchemaGetReq
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
  RpbYokozunaSchemaGetReq RpbYokozunaSchemaGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaSchemaGetReq
x)
                                  Bool
required'name
      in
        Parser RpbYokozunaSchemaGetReq
-> String -> Parser RpbYokozunaSchemaGetReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaSchemaGetReq -> Bool -> Parser RpbYokozunaSchemaGetReq
loop RpbYokozunaSchemaGetReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbYokozunaSchemaGetReq"
  buildMessage :: RpbYokozunaSchemaGetReq -> Builder
buildMessage
    = \ RpbYokozunaSchemaGetReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  RpbYokozunaSchemaGetReq
  RpbYokozunaSchemaGetReq
  ByteString
  ByteString
-> RpbYokozunaSchemaGetReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") RpbYokozunaSchemaGetReq
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RpbYokozunaSchemaGetReq
  RpbYokozunaSchemaGetReq
  FieldSet
  FieldSet
-> RpbYokozunaSchemaGetReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbYokozunaSchemaGetReq
  RpbYokozunaSchemaGetReq
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaSchemaGetReq
_x))
instance Control.DeepSeq.NFData RpbYokozunaSchemaGetReq where
  rnf :: RpbYokozunaSchemaGetReq -> ()
rnf
    = \ RpbYokozunaSchemaGetReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaSchemaGetReq -> FieldSet
_RpbYokozunaSchemaGetReq'_unknownFields RpbYokozunaSchemaGetReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaSchemaGetReq -> ByteString
_RpbYokozunaSchemaGetReq'name RpbYokozunaSchemaGetReq
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.schema' @:: Lens' RpbYokozunaSchemaGetResp RpbYokozunaSchema@ -}
data RpbYokozunaSchemaGetResp
  = RpbYokozunaSchemaGetResp'_constructor {RpbYokozunaSchemaGetResp -> RpbYokozunaSchema
_RpbYokozunaSchemaGetResp'schema :: !RpbYokozunaSchema,
                                           RpbYokozunaSchemaGetResp -> FieldSet
_RpbYokozunaSchemaGetResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
(RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool)
-> (RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool)
-> Eq RpbYokozunaSchemaGetResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
$c/= :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
== :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
$c== :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
Prelude.Eq, Eq RpbYokozunaSchemaGetResp
Eq RpbYokozunaSchemaGetResp
-> (RpbYokozunaSchemaGetResp
    -> RpbYokozunaSchemaGetResp -> Ordering)
-> (RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool)
-> (RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool)
-> (RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool)
-> (RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool)
-> (RpbYokozunaSchemaGetResp
    -> RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp)
-> (RpbYokozunaSchemaGetResp
    -> RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp)
-> Ord RpbYokozunaSchemaGetResp
RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Ordering
RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp
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 :: RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp
$cmin :: RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp
max :: RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp
$cmax :: RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp
>= :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
$c>= :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
> :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
$c> :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
<= :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
$c<= :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
< :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
$c< :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Bool
compare :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Ordering
$ccompare :: RpbYokozunaSchemaGetResp -> RpbYokozunaSchemaGetResp -> Ordering
$cp1Ord :: Eq RpbYokozunaSchemaGetResp
Prelude.Ord)
instance Prelude.Show RpbYokozunaSchemaGetResp where
  showsPrec :: Int -> RpbYokozunaSchemaGetResp -> ShowS
showsPrec Int
_ RpbYokozunaSchemaGetResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaSchemaGetResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaSchemaGetResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaSchemaGetResp "schema" RpbYokozunaSchema where
  fieldOf :: Proxy# "schema"
-> (RpbYokozunaSchema -> f RpbYokozunaSchema)
-> RpbYokozunaSchemaGetResp
-> f RpbYokozunaSchemaGetResp
fieldOf Proxy# "schema"
_
    = ((RpbYokozunaSchema -> f RpbYokozunaSchema)
 -> RpbYokozunaSchemaGetResp -> f RpbYokozunaSchemaGetResp)
-> ((RpbYokozunaSchema -> f RpbYokozunaSchema)
    -> RpbYokozunaSchema -> f RpbYokozunaSchema)
-> (RpbYokozunaSchema -> f RpbYokozunaSchema)
-> RpbYokozunaSchemaGetResp
-> f RpbYokozunaSchemaGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaSchemaGetResp -> RpbYokozunaSchema)
-> (RpbYokozunaSchemaGetResp
    -> RpbYokozunaSchema -> RpbYokozunaSchemaGetResp)
-> Lens
     RpbYokozunaSchemaGetResp
     RpbYokozunaSchemaGetResp
     RpbYokozunaSchema
     RpbYokozunaSchema
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaSchemaGetResp -> RpbYokozunaSchema
_RpbYokozunaSchemaGetResp'schema
           (\ RpbYokozunaSchemaGetResp
x__ RpbYokozunaSchema
y__ -> RpbYokozunaSchemaGetResp
x__ {_RpbYokozunaSchemaGetResp'schema :: RpbYokozunaSchema
_RpbYokozunaSchemaGetResp'schema = RpbYokozunaSchema
y__}))
        (RpbYokozunaSchema -> f RpbYokozunaSchema)
-> RpbYokozunaSchema -> f RpbYokozunaSchema
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaSchemaGetResp where
  messageName :: Proxy RpbYokozunaSchemaGetResp -> Text
messageName Proxy RpbYokozunaSchemaGetResp
_ = String -> Text
Data.Text.pack String
"RpbYokozunaSchemaGetResp"
  packedMessageDescriptor :: Proxy RpbYokozunaSchemaGetResp -> ByteString
packedMessageDescriptor Proxy RpbYokozunaSchemaGetResp
_
    = ByteString
"\n\
      \\CANRpbYokozunaSchemaGetResp\DC2*\n\
      \\ACKschema\CAN\SOH \STX(\v2\DC2.RpbYokozunaSchemaR\ACKschema"
  packedFileDescriptor :: Proxy RpbYokozunaSchemaGetResp -> ByteString
packedFileDescriptor Proxy RpbYokozunaSchemaGetResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaSchemaGetResp)
fieldsByTag
    = let
        schema__field_descriptor :: FieldDescriptor RpbYokozunaSchemaGetResp
schema__field_descriptor
          = String
-> FieldTypeDescriptor RpbYokozunaSchema
-> FieldAccessor RpbYokozunaSchemaGetResp RpbYokozunaSchema
-> FieldDescriptor RpbYokozunaSchemaGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"schema"
              (MessageOrGroup -> FieldTypeDescriptor RpbYokozunaSchema
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbYokozunaSchema)
              (WireDefault RpbYokozunaSchema
-> Lens
     RpbYokozunaSchemaGetResp
     RpbYokozunaSchemaGetResp
     RpbYokozunaSchema
     RpbYokozunaSchema
-> FieldAccessor RpbYokozunaSchemaGetResp RpbYokozunaSchema
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbYokozunaSchema
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"schema")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaSchemaGetResp
      in
        [(Tag, FieldDescriptor RpbYokozunaSchemaGetResp)]
-> Map Tag (FieldDescriptor RpbYokozunaSchemaGetResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaSchemaGetResp
schema__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaSchemaGetResp FieldSet
unknownFields
    = (RpbYokozunaSchemaGetResp -> FieldSet)
-> (RpbYokozunaSchemaGetResp
    -> FieldSet -> RpbYokozunaSchemaGetResp)
-> Lens' RpbYokozunaSchemaGetResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaSchemaGetResp -> FieldSet
_RpbYokozunaSchemaGetResp'_unknownFields
        (\ RpbYokozunaSchemaGetResp
x__ FieldSet
y__ -> RpbYokozunaSchemaGetResp
x__ {_RpbYokozunaSchemaGetResp'_unknownFields :: FieldSet
_RpbYokozunaSchemaGetResp'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaSchemaGetResp
defMessage
    = RpbYokozunaSchemaGetResp'_constructor :: RpbYokozunaSchema -> FieldSet -> RpbYokozunaSchemaGetResp
RpbYokozunaSchemaGetResp'_constructor
        {_RpbYokozunaSchemaGetResp'schema :: RpbYokozunaSchema
_RpbYokozunaSchemaGetResp'schema = RpbYokozunaSchema
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbYokozunaSchemaGetResp'_unknownFields :: FieldSet
_RpbYokozunaSchemaGetResp'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaSchemaGetResp
parseMessage
    = let
        loop ::
          RpbYokozunaSchemaGetResp
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaSchemaGetResp
        loop :: RpbYokozunaSchemaGetResp -> Bool -> Parser RpbYokozunaSchemaGetResp
loop RpbYokozunaSchemaGetResp
x Bool
required'schema
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'schema then (:) String
"schema" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbYokozunaSchemaGetResp -> Parser RpbYokozunaSchemaGetResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbYokozunaSchemaGetResp RpbYokozunaSchemaGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp
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
  RpbYokozunaSchemaGetResp RpbYokozunaSchemaGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaSchemaGetResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do RpbYokozunaSchema
y <- Parser RpbYokozunaSchema -> String -> Parser RpbYokozunaSchema
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbYokozunaSchema -> Parser RpbYokozunaSchema
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 RpbYokozunaSchema
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"schema"
                                RpbYokozunaSchemaGetResp -> Bool -> Parser RpbYokozunaSchemaGetResp
loop
                                  (Setter
  RpbYokozunaSchemaGetResp
  RpbYokozunaSchemaGetResp
  RpbYokozunaSchema
  RpbYokozunaSchema
-> RpbYokozunaSchema
-> RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"schema") RpbYokozunaSchema
y RpbYokozunaSchemaGetResp
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaSchemaGetResp -> Bool -> Parser RpbYokozunaSchemaGetResp
loop
                                  (Setter
  RpbYokozunaSchemaGetResp RpbYokozunaSchemaGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaSchemaGetResp
-> RpbYokozunaSchemaGetResp
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
  RpbYokozunaSchemaGetResp RpbYokozunaSchemaGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaSchemaGetResp
x)
                                  Bool
required'schema
      in
        Parser RpbYokozunaSchemaGetResp
-> String -> Parser RpbYokozunaSchemaGetResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaSchemaGetResp -> Bool -> Parser RpbYokozunaSchemaGetResp
loop RpbYokozunaSchemaGetResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbYokozunaSchemaGetResp"
  buildMessage :: RpbYokozunaSchemaGetResp -> Builder
buildMessage
    = \ RpbYokozunaSchemaGetResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                ((ByteString -> Builder)
-> (RpbYokozunaSchema -> ByteString)
-> RpbYokozunaSchema
-> 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))
                   RpbYokozunaSchema -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                   (FoldLike
  RpbYokozunaSchema
  RpbYokozunaSchemaGetResp
  RpbYokozunaSchemaGetResp
  RpbYokozunaSchema
  RpbYokozunaSchema
-> RpbYokozunaSchemaGetResp -> RpbYokozunaSchema
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"schema") RpbYokozunaSchemaGetResp
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RpbYokozunaSchemaGetResp
  RpbYokozunaSchemaGetResp
  FieldSet
  FieldSet
-> RpbYokozunaSchemaGetResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbYokozunaSchemaGetResp
  RpbYokozunaSchemaGetResp
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaSchemaGetResp
_x))
instance Control.DeepSeq.NFData RpbYokozunaSchemaGetResp where
  rnf :: RpbYokozunaSchemaGetResp -> ()
rnf
    = \ RpbYokozunaSchemaGetResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaSchemaGetResp -> FieldSet
_RpbYokozunaSchemaGetResp'_unknownFields RpbYokozunaSchemaGetResp
x__)
             (RpbYokozunaSchema -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaSchemaGetResp -> RpbYokozunaSchema
_RpbYokozunaSchemaGetResp'schema RpbYokozunaSchemaGetResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.schema' @:: Lens' RpbYokozunaSchemaPutReq RpbYokozunaSchema@ -}
data RpbYokozunaSchemaPutReq
  = RpbYokozunaSchemaPutReq'_constructor {RpbYokozunaSchemaPutReq -> RpbYokozunaSchema
_RpbYokozunaSchemaPutReq'schema :: !RpbYokozunaSchema,
                                          RpbYokozunaSchemaPutReq -> FieldSet
_RpbYokozunaSchemaPutReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
(RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool)
-> (RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool)
-> Eq RpbYokozunaSchemaPutReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
$c/= :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
== :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
$c== :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
Prelude.Eq, Eq RpbYokozunaSchemaPutReq
Eq RpbYokozunaSchemaPutReq
-> (RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Ordering)
-> (RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool)
-> (RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool)
-> (RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool)
-> (RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool)
-> (RpbYokozunaSchemaPutReq
    -> RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq)
-> (RpbYokozunaSchemaPutReq
    -> RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq)
-> Ord RpbYokozunaSchemaPutReq
RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Ordering
RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq
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 :: RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq
$cmin :: RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq
max :: RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq
$cmax :: RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq
>= :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
$c>= :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
> :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
$c> :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
<= :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
$c<= :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
< :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
$c< :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Bool
compare :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Ordering
$ccompare :: RpbYokozunaSchemaPutReq -> RpbYokozunaSchemaPutReq -> Ordering
$cp1Ord :: Eq RpbYokozunaSchemaPutReq
Prelude.Ord)
instance Prelude.Show RpbYokozunaSchemaPutReq where
  showsPrec :: Int -> RpbYokozunaSchemaPutReq -> ShowS
showsPrec Int
_ RpbYokozunaSchemaPutReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (RpbYokozunaSchemaPutReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort RpbYokozunaSchemaPutReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField RpbYokozunaSchemaPutReq "schema" RpbYokozunaSchema where
  fieldOf :: Proxy# "schema"
-> (RpbYokozunaSchema -> f RpbYokozunaSchema)
-> RpbYokozunaSchemaPutReq
-> f RpbYokozunaSchemaPutReq
fieldOf Proxy# "schema"
_
    = ((RpbYokozunaSchema -> f RpbYokozunaSchema)
 -> RpbYokozunaSchemaPutReq -> f RpbYokozunaSchemaPutReq)
-> ((RpbYokozunaSchema -> f RpbYokozunaSchema)
    -> RpbYokozunaSchema -> f RpbYokozunaSchema)
-> (RpbYokozunaSchema -> f RpbYokozunaSchema)
-> RpbYokozunaSchemaPutReq
-> f RpbYokozunaSchemaPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((RpbYokozunaSchemaPutReq -> RpbYokozunaSchema)
-> (RpbYokozunaSchemaPutReq
    -> RpbYokozunaSchema -> RpbYokozunaSchemaPutReq)
-> Lens
     RpbYokozunaSchemaPutReq
     RpbYokozunaSchemaPutReq
     RpbYokozunaSchema
     RpbYokozunaSchema
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           RpbYokozunaSchemaPutReq -> RpbYokozunaSchema
_RpbYokozunaSchemaPutReq'schema
           (\ RpbYokozunaSchemaPutReq
x__ RpbYokozunaSchema
y__ -> RpbYokozunaSchemaPutReq
x__ {_RpbYokozunaSchemaPutReq'schema :: RpbYokozunaSchema
_RpbYokozunaSchemaPutReq'schema = RpbYokozunaSchema
y__}))
        (RpbYokozunaSchema -> f RpbYokozunaSchema)
-> RpbYokozunaSchema -> f RpbYokozunaSchema
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message RpbYokozunaSchemaPutReq where
  messageName :: Proxy RpbYokozunaSchemaPutReq -> Text
messageName Proxy RpbYokozunaSchemaPutReq
_ = String -> Text
Data.Text.pack String
"RpbYokozunaSchemaPutReq"
  packedMessageDescriptor :: Proxy RpbYokozunaSchemaPutReq -> ByteString
packedMessageDescriptor Proxy RpbYokozunaSchemaPutReq
_
    = ByteString
"\n\
      \\ETBRpbYokozunaSchemaPutReq\DC2*\n\
      \\ACKschema\CAN\SOH \STX(\v2\DC2.RpbYokozunaSchemaR\ACKschema"
  packedFileDescriptor :: Proxy RpbYokozunaSchemaPutReq -> ByteString
packedFileDescriptor Proxy RpbYokozunaSchemaPutReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor RpbYokozunaSchemaPutReq)
fieldsByTag
    = let
        schema__field_descriptor :: FieldDescriptor RpbYokozunaSchemaPutReq
schema__field_descriptor
          = String
-> FieldTypeDescriptor RpbYokozunaSchema
-> FieldAccessor RpbYokozunaSchemaPutReq RpbYokozunaSchema
-> FieldDescriptor RpbYokozunaSchemaPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"schema"
              (MessageOrGroup -> FieldTypeDescriptor RpbYokozunaSchema
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbYokozunaSchema)
              (WireDefault RpbYokozunaSchema
-> Lens
     RpbYokozunaSchemaPutReq
     RpbYokozunaSchemaPutReq
     RpbYokozunaSchema
     RpbYokozunaSchema
-> FieldAccessor RpbYokozunaSchemaPutReq RpbYokozunaSchema
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault RpbYokozunaSchema
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"schema")) ::
              Data.ProtoLens.FieldDescriptor RpbYokozunaSchemaPutReq
      in
        [(Tag, FieldDescriptor RpbYokozunaSchemaPutReq)]
-> Map Tag (FieldDescriptor RpbYokozunaSchemaPutReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor RpbYokozunaSchemaPutReq
schema__field_descriptor)]
  unknownFields :: LensLike' f RpbYokozunaSchemaPutReq FieldSet
unknownFields
    = (RpbYokozunaSchemaPutReq -> FieldSet)
-> (RpbYokozunaSchemaPutReq -> FieldSet -> RpbYokozunaSchemaPutReq)
-> Lens' RpbYokozunaSchemaPutReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        RpbYokozunaSchemaPutReq -> FieldSet
_RpbYokozunaSchemaPutReq'_unknownFields
        (\ RpbYokozunaSchemaPutReq
x__ FieldSet
y__ -> RpbYokozunaSchemaPutReq
x__ {_RpbYokozunaSchemaPutReq'_unknownFields :: FieldSet
_RpbYokozunaSchemaPutReq'_unknownFields = FieldSet
y__})
  defMessage :: RpbYokozunaSchemaPutReq
defMessage
    = RpbYokozunaSchemaPutReq'_constructor :: RpbYokozunaSchema -> FieldSet -> RpbYokozunaSchemaPutReq
RpbYokozunaSchemaPutReq'_constructor
        {_RpbYokozunaSchemaPutReq'schema :: RpbYokozunaSchema
_RpbYokozunaSchemaPutReq'schema = RpbYokozunaSchema
forall msg. Message msg => msg
Data.ProtoLens.defMessage,
         _RpbYokozunaSchemaPutReq'_unknownFields :: FieldSet
_RpbYokozunaSchemaPutReq'_unknownFields = []}
  parseMessage :: Parser RpbYokozunaSchemaPutReq
parseMessage
    = let
        loop ::
          RpbYokozunaSchemaPutReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser RpbYokozunaSchemaPutReq
        loop :: RpbYokozunaSchemaPutReq -> Bool -> Parser RpbYokozunaSchemaPutReq
loop RpbYokozunaSchemaPutReq
x Bool
required'schema
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'schema then (:) String
"schema" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      RpbYokozunaSchemaPutReq -> Parser RpbYokozunaSchemaPutReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  RpbYokozunaSchemaPutReq RpbYokozunaSchemaPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq
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
  RpbYokozunaSchemaPutReq RpbYokozunaSchemaPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) RpbYokozunaSchemaPutReq
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do RpbYokozunaSchema
y <- Parser RpbYokozunaSchema -> String -> Parser RpbYokozunaSchema
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser RpbYokozunaSchema -> Parser RpbYokozunaSchema
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 RpbYokozunaSchema
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"schema"
                                RpbYokozunaSchemaPutReq -> Bool -> Parser RpbYokozunaSchemaPutReq
loop
                                  (Setter
  RpbYokozunaSchemaPutReq
  RpbYokozunaSchemaPutReq
  RpbYokozunaSchema
  RpbYokozunaSchema
-> RpbYokozunaSchema
-> RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"schema") RpbYokozunaSchema
y RpbYokozunaSchemaPutReq
x)
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                RpbYokozunaSchemaPutReq -> Bool -> Parser RpbYokozunaSchemaPutReq
loop
                                  (Setter
  RpbYokozunaSchemaPutReq RpbYokozunaSchemaPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> RpbYokozunaSchemaPutReq
-> RpbYokozunaSchemaPutReq
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
  RpbYokozunaSchemaPutReq RpbYokozunaSchemaPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) RpbYokozunaSchemaPutReq
x)
                                  Bool
required'schema
      in
        Parser RpbYokozunaSchemaPutReq
-> String -> Parser RpbYokozunaSchemaPutReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do RpbYokozunaSchemaPutReq -> Bool -> Parser RpbYokozunaSchemaPutReq
loop RpbYokozunaSchemaPutReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True)
          String
"RpbYokozunaSchemaPutReq"
  buildMessage :: RpbYokozunaSchemaPutReq -> Builder
buildMessage
    = \ RpbYokozunaSchemaPutReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                ((ByteString -> Builder)
-> (RpbYokozunaSchema -> ByteString)
-> RpbYokozunaSchema
-> 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))
                   RpbYokozunaSchema -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                   (FoldLike
  RpbYokozunaSchema
  RpbYokozunaSchemaPutReq
  RpbYokozunaSchemaPutReq
  RpbYokozunaSchema
  RpbYokozunaSchema
-> RpbYokozunaSchemaPutReq -> RpbYokozunaSchema
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "schema" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"schema") RpbYokozunaSchemaPutReq
_x)))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike
  FieldSet
  RpbYokozunaSchemaPutReq
  RpbYokozunaSchemaPutReq
  FieldSet
  FieldSet
-> RpbYokozunaSchemaPutReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  RpbYokozunaSchemaPutReq
  RpbYokozunaSchemaPutReq
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields RpbYokozunaSchemaPutReq
_x))
instance Control.DeepSeq.NFData RpbYokozunaSchemaPutReq where
  rnf :: RpbYokozunaSchemaPutReq -> ()
rnf
    = \ RpbYokozunaSchemaPutReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (RpbYokozunaSchemaPutReq -> FieldSet
_RpbYokozunaSchemaPutReq'_unknownFields RpbYokozunaSchemaPutReq
x__)
             (RpbYokozunaSchema -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (RpbYokozunaSchemaPutReq -> RpbYokozunaSchema
_RpbYokozunaSchemaPutReq'schema RpbYokozunaSchemaPutReq
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.adds' @:: Lens' SetOp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'adds' @:: Lens' SetOp (Data.Vector.Vector Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.removes' @:: Lens' SetOp [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'removes' @:: Lens' SetOp (Data.Vector.Vector Data.ByteString.ByteString)@ -}
data SetOp
  = SetOp'_constructor {SetOp -> Vector ByteString
_SetOp'adds :: !(Data.Vector.Vector Data.ByteString.ByteString),
                        SetOp -> Vector ByteString
_SetOp'removes :: !(Data.Vector.Vector Data.ByteString.ByteString),
                        SetOp -> FieldSet
_SetOp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (SetOp -> SetOp -> Bool
(SetOp -> SetOp -> Bool) -> (SetOp -> SetOp -> Bool) -> Eq SetOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetOp -> SetOp -> Bool
$c/= :: SetOp -> SetOp -> Bool
== :: SetOp -> SetOp -> Bool
$c== :: SetOp -> SetOp -> Bool
Prelude.Eq, Eq SetOp
Eq SetOp
-> (SetOp -> SetOp -> Ordering)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> SetOp)
-> (SetOp -> SetOp -> SetOp)
-> Ord SetOp
SetOp -> SetOp -> Bool
SetOp -> SetOp -> Ordering
SetOp -> SetOp -> SetOp
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 :: SetOp -> SetOp -> SetOp
$cmin :: SetOp -> SetOp -> SetOp
max :: SetOp -> SetOp -> SetOp
$cmax :: SetOp -> SetOp -> SetOp
>= :: SetOp -> SetOp -> Bool
$c>= :: SetOp -> SetOp -> Bool
> :: SetOp -> SetOp -> Bool
$c> :: SetOp -> SetOp -> Bool
<= :: SetOp -> SetOp -> Bool
$c<= :: SetOp -> SetOp -> Bool
< :: SetOp -> SetOp -> Bool
$c< :: SetOp -> SetOp -> Bool
compare :: SetOp -> SetOp -> Ordering
$ccompare :: SetOp -> SetOp -> Ordering
$cp1Ord :: Eq SetOp
Prelude.Ord)
instance Prelude.Show SetOp where
  showsPrec :: Int -> SetOp -> ShowS
showsPrec Int
_ SetOp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (SetOp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort SetOp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField SetOp "adds" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "adds"
-> ([ByteString] -> f [ByteString]) -> SetOp -> f SetOp
fieldOf Proxy# "adds"
_
    = ((Vector ByteString -> f (Vector ByteString)) -> SetOp -> f SetOp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> SetOp
-> f SetOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((SetOp -> Vector ByteString)
-> (SetOp -> Vector ByteString -> SetOp)
-> Lens SetOp SetOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           SetOp -> Vector ByteString
_SetOp'adds (\ SetOp
x__ Vector ByteString
y__ -> SetOp
x__ {_SetOp'adds :: Vector ByteString
_SetOp'adds = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField SetOp "vec'adds" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'adds"
-> (Vector ByteString -> f (Vector ByteString)) -> SetOp -> f SetOp
fieldOf Proxy# "vec'adds"
_
    = ((Vector ByteString -> f (Vector ByteString)) -> SetOp -> f SetOp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> SetOp
-> f SetOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((SetOp -> Vector ByteString)
-> (SetOp -> Vector ByteString -> SetOp)
-> Lens SetOp SetOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           SetOp -> Vector ByteString
_SetOp'adds (\ SetOp
x__ Vector ByteString
y__ -> SetOp
x__ {_SetOp'adds :: Vector ByteString
_SetOp'adds = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField SetOp "removes" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "removes"
-> ([ByteString] -> f [ByteString]) -> SetOp -> f SetOp
fieldOf Proxy# "removes"
_
    = ((Vector ByteString -> f (Vector ByteString)) -> SetOp -> f SetOp)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> SetOp
-> f SetOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((SetOp -> Vector ByteString)
-> (SetOp -> Vector ByteString -> SetOp)
-> Lens SetOp SetOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           SetOp -> Vector ByteString
_SetOp'removes (\ SetOp
x__ Vector ByteString
y__ -> SetOp
x__ {_SetOp'removes :: Vector ByteString
_SetOp'removes = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField SetOp "vec'removes" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'removes"
-> (Vector ByteString -> f (Vector ByteString)) -> SetOp -> f SetOp
fieldOf Proxy# "vec'removes"
_
    = ((Vector ByteString -> f (Vector ByteString)) -> SetOp -> f SetOp)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> SetOp
-> f SetOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((SetOp -> Vector ByteString)
-> (SetOp -> Vector ByteString -> SetOp)
-> Lens SetOp SetOp (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           SetOp -> Vector ByteString
_SetOp'removes (\ SetOp
x__ Vector ByteString
y__ -> SetOp
x__ {_SetOp'removes :: Vector ByteString
_SetOp'removes = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message SetOp where
  messageName :: Proxy SetOp -> Text
messageName Proxy SetOp
_ = String -> Text
Data.Text.pack String
"SetOp"
  packedMessageDescriptor :: Proxy SetOp -> ByteString
packedMessageDescriptor Proxy SetOp
_
    = ByteString
"\n\
      \\ENQSetOp\DC2\DC2\n\
      \\EOTadds\CAN\SOH \ETX(\fR\EOTadds\DC2\CAN\n\
      \\aremoves\CAN\STX \ETX(\fR\aremoves"
  packedFileDescriptor :: Proxy SetOp -> ByteString
packedFileDescriptor Proxy SetOp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor SetOp)
fieldsByTag
    = let
        adds__field_descriptor :: FieldDescriptor SetOp
adds__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor SetOp ByteString
-> FieldDescriptor SetOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"adds"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' SetOp [ByteString] -> FieldAccessor SetOp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"adds")) ::
              Data.ProtoLens.FieldDescriptor SetOp
        removes__field_descriptor :: FieldDescriptor SetOp
removes__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor SetOp ByteString
-> FieldDescriptor SetOp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"removes"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' SetOp [ByteString] -> FieldAccessor SetOp ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "removes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"removes")) ::
              Data.ProtoLens.FieldDescriptor SetOp
      in
        [(Tag, FieldDescriptor SetOp)] -> Map Tag (FieldDescriptor SetOp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor SetOp
adds__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor SetOp
removes__field_descriptor)]
  unknownFields :: LensLike' f SetOp FieldSet
unknownFields
    = (SetOp -> FieldSet)
-> (SetOp -> FieldSet -> SetOp) -> Lens' SetOp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        SetOp -> FieldSet
_SetOp'_unknownFields
        (\ SetOp
x__ FieldSet
y__ -> SetOp
x__ {_SetOp'_unknownFields :: FieldSet
_SetOp'_unknownFields = FieldSet
y__})
  defMessage :: SetOp
defMessage
    = SetOp'_constructor :: Vector ByteString -> Vector ByteString -> FieldSet -> SetOp
SetOp'_constructor
        {_SetOp'adds :: Vector ByteString
_SetOp'adds = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _SetOp'removes :: Vector ByteString
_SetOp'removes = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _SetOp'_unknownFields :: FieldSet
_SetOp'_unknownFields = []}
  parseMessage :: Parser SetOp
parseMessage
    = let
        loop ::
          SetOp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
                -> Data.ProtoLens.Encoding.Bytes.Parser SetOp
        loop :: SetOp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld ByteString
-> Parser SetOp
loop SetOp
x Growing Vector RealWorld ByteString
mutable'adds Growing Vector RealWorld ByteString
mutable'removes
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'adds <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'adds)
                      Vector ByteString
frozen'removes <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'removes)
                      (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]))))
                      SetOp -> Parser SetOp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter SetOp SetOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> SetOp -> SetOp
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 SetOp SetOp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter SetOp SetOp (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> SetOp -> SetOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'adds")
                              Vector ByteString
frozen'adds
                              (Setter SetOp SetOp (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> SetOp -> SetOp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'removes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'removes") Vector ByteString
frozen'removes SetOp
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
"adds"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'adds ByteString
y)
                                SetOp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld ByteString
-> Parser SetOp
loop SetOp
x Growing Vector RealWorld ByteString
v Growing Vector RealWorld ByteString
mutable'removes
                        Word64
18
                          -> 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
"removes"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'removes ByteString
y)
                                SetOp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld ByteString
-> Parser SetOp
loop SetOp
x Growing Vector RealWorld ByteString
mutable'adds Growing Vector RealWorld ByteString
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                SetOp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld ByteString
-> Parser SetOp
loop
                                  (Setter SetOp SetOp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> SetOp -> SetOp
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 SetOp SetOp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) SetOp
x)
                                  Growing Vector RealWorld ByteString
mutable'adds
                                  Growing Vector RealWorld ByteString
mutable'removes
      in
        Parser SetOp -> String -> Parser SetOp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'adds <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld ByteString
mutable'removes <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              SetOp
-> Growing Vector RealWorld ByteString
-> Growing Vector RealWorld ByteString
-> Parser SetOp
loop SetOp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld ByteString
mutable'adds Growing Vector RealWorld ByteString
mutable'removes)
          String
"SetOp"
  buildMessage :: SetOp -> Builder
buildMessage
    = \ SetOp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ ByteString
_v
                   -> 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))
                (FoldLike
  (Vector ByteString)
  SetOp
  SetOp
  (Vector ByteString)
  (Vector ByteString)
-> SetOp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'adds" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'adds") SetOp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ ByteString
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((\ 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))
                   (FoldLike
  (Vector ByteString)
  SetOp
  SetOp
  (Vector ByteString)
  (Vector ByteString)
-> SetOp -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'removes" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'removes") SetOp
_x))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet SetOp SetOp FieldSet FieldSet
-> SetOp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet SetOp SetOp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields SetOp
_x)))
instance Control.DeepSeq.NFData SetOp where
  rnf :: SetOp -> ()
rnf
    = \ SetOp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (SetOp -> FieldSet
_SetOp'_unknownFields SetOp
x__)
             (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (SetOp -> Vector ByteString
_SetOp'adds SetOp
x__)
                (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (SetOp -> Vector ByteString
_SetOp'removes SetOp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.varcharValue' @:: Lens' TsCell Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'varcharValue' @:: Lens' TsCell (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.sint64Value' @:: Lens' TsCell Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'sint64Value' @:: Lens' TsCell (Prelude.Maybe Data.Int.Int64)@
         * 'Proto.Riak_Fields.timestampValue' @:: Lens' TsCell Data.Int.Int64@
         * 'Proto.Riak_Fields.maybe'timestampValue' @:: Lens' TsCell (Prelude.Maybe Data.Int.Int64)@
         * 'Proto.Riak_Fields.booleanValue' @:: Lens' TsCell Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'booleanValue' @:: Lens' TsCell (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.doubleValue' @:: Lens' TsCell Prelude.Double@
         * 'Proto.Riak_Fields.maybe'doubleValue' @:: Lens' TsCell (Prelude.Maybe Prelude.Double)@ -}
data TsCell
  = TsCell'_constructor {TsCell -> Maybe ByteString
_TsCell'varcharValue :: !(Prelude.Maybe Data.ByteString.ByteString),
                         TsCell -> Maybe Int64
_TsCell'sint64Value :: !(Prelude.Maybe Data.Int.Int64),
                         TsCell -> Maybe Int64
_TsCell'timestampValue :: !(Prelude.Maybe Data.Int.Int64),
                         TsCell -> Maybe Bool
_TsCell'booleanValue :: !(Prelude.Maybe Prelude.Bool),
                         TsCell -> Maybe Double
_TsCell'doubleValue :: !(Prelude.Maybe Prelude.Double),
                         TsCell -> FieldSet
_TsCell'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsCell -> TsCell -> Bool
(TsCell -> TsCell -> Bool)
-> (TsCell -> TsCell -> Bool) -> Eq TsCell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsCell -> TsCell -> Bool
$c/= :: TsCell -> TsCell -> Bool
== :: TsCell -> TsCell -> Bool
$c== :: TsCell -> TsCell -> Bool
Prelude.Eq, Eq TsCell
Eq TsCell
-> (TsCell -> TsCell -> Ordering)
-> (TsCell -> TsCell -> Bool)
-> (TsCell -> TsCell -> Bool)
-> (TsCell -> TsCell -> Bool)
-> (TsCell -> TsCell -> Bool)
-> (TsCell -> TsCell -> TsCell)
-> (TsCell -> TsCell -> TsCell)
-> Ord TsCell
TsCell -> TsCell -> Bool
TsCell -> TsCell -> Ordering
TsCell -> TsCell -> TsCell
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 :: TsCell -> TsCell -> TsCell
$cmin :: TsCell -> TsCell -> TsCell
max :: TsCell -> TsCell -> TsCell
$cmax :: TsCell -> TsCell -> TsCell
>= :: TsCell -> TsCell -> Bool
$c>= :: TsCell -> TsCell -> Bool
> :: TsCell -> TsCell -> Bool
$c> :: TsCell -> TsCell -> Bool
<= :: TsCell -> TsCell -> Bool
$c<= :: TsCell -> TsCell -> Bool
< :: TsCell -> TsCell -> Bool
$c< :: TsCell -> TsCell -> Bool
compare :: TsCell -> TsCell -> Ordering
$ccompare :: TsCell -> TsCell -> Ordering
$cp1Ord :: Eq TsCell
Prelude.Ord)
instance Prelude.Show TsCell where
  showsPrec :: Int -> TsCell -> ShowS
showsPrec Int
_ TsCell
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsCell -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsCell
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsCell "varcharValue" Data.ByteString.ByteString where
  fieldOf :: Proxy# "varcharValue"
-> (ByteString -> f ByteString) -> TsCell -> f TsCell
fieldOf Proxy# "varcharValue"
_
    = ((Maybe ByteString -> f (Maybe ByteString)) -> TsCell -> f TsCell)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe ByteString)
-> (TsCell -> Maybe ByteString -> TsCell)
-> Lens TsCell TsCell (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe ByteString
_TsCell'varcharValue
           (\ TsCell
x__ Maybe ByteString
y__ -> TsCell
x__ {_TsCell'varcharValue :: Maybe ByteString
_TsCell'varcharValue = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsCell "maybe'varcharValue" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'varcharValue"
-> (Maybe ByteString -> f (Maybe ByteString)) -> TsCell -> f TsCell
fieldOf Proxy# "maybe'varcharValue"
_
    = ((Maybe ByteString -> f (Maybe ByteString)) -> TsCell -> f TsCell)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe ByteString)
-> (TsCell -> Maybe ByteString -> TsCell)
-> Lens TsCell TsCell (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe ByteString
_TsCell'varcharValue
           (\ TsCell
x__ Maybe ByteString
y__ -> TsCell
x__ {_TsCell'varcharValue :: Maybe ByteString
_TsCell'varcharValue = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCell "sint64Value" Data.Int.Int64 where
  fieldOf :: Proxy# "sint64Value" -> (Int64 -> f Int64) -> TsCell -> f TsCell
fieldOf Proxy# "sint64Value"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> TsCell -> f TsCell)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Int64)
-> (TsCell -> Maybe Int64 -> TsCell)
-> Lens TsCell TsCell (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Int64
_TsCell'sint64Value (\ TsCell
x__ Maybe Int64
y__ -> TsCell
x__ {_TsCell'sint64Value :: Maybe Int64
_TsCell'sint64Value = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsCell "maybe'sint64Value" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'sint64Value"
-> (Maybe Int64 -> f (Maybe Int64)) -> TsCell -> f TsCell
fieldOf Proxy# "maybe'sint64Value"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> TsCell -> f TsCell)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Int64)
-> (TsCell -> Maybe Int64 -> TsCell)
-> Lens TsCell TsCell (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Int64
_TsCell'sint64Value (\ TsCell
x__ Maybe Int64
y__ -> TsCell
x__ {_TsCell'sint64Value :: Maybe Int64
_TsCell'sint64Value = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCell "timestampValue" Data.Int.Int64 where
  fieldOf :: Proxy# "timestampValue" -> (Int64 -> f Int64) -> TsCell -> f TsCell
fieldOf Proxy# "timestampValue"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> TsCell -> f TsCell)
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Int64)
-> (TsCell -> Maybe Int64 -> TsCell)
-> Lens TsCell TsCell (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Int64
_TsCell'timestampValue
           (\ TsCell
x__ Maybe Int64
y__ -> TsCell
x__ {_TsCell'timestampValue :: Maybe Int64
_TsCell'timestampValue = Maybe Int64
y__}))
        (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsCell "maybe'timestampValue" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'timestampValue"
-> (Maybe Int64 -> f (Maybe Int64)) -> TsCell -> f TsCell
fieldOf Proxy# "maybe'timestampValue"
_
    = ((Maybe Int64 -> f (Maybe Int64)) -> TsCell -> f TsCell)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe Int64 -> f (Maybe Int64))
-> (Maybe Int64 -> f (Maybe Int64))
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Int64)
-> (TsCell -> Maybe Int64 -> TsCell)
-> Lens TsCell TsCell (Maybe Int64) (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Int64
_TsCell'timestampValue
           (\ TsCell
x__ Maybe Int64
y__ -> TsCell
x__ {_TsCell'timestampValue :: Maybe Int64
_TsCell'timestampValue = Maybe Int64
y__}))
        (Maybe Int64 -> f (Maybe Int64)) -> Maybe Int64 -> f (Maybe Int64)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCell "booleanValue" Prelude.Bool where
  fieldOf :: Proxy# "booleanValue" -> (Bool -> f Bool) -> TsCell -> f TsCell
fieldOf Proxy# "booleanValue"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> TsCell -> f TsCell)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Bool)
-> (TsCell -> Maybe Bool -> TsCell)
-> Lens TsCell TsCell (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Bool
_TsCell'booleanValue
           (\ TsCell
x__ Maybe Bool
y__ -> TsCell
x__ {_TsCell'booleanValue :: Maybe Bool
_TsCell'booleanValue = 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 TsCell "maybe'booleanValue" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'booleanValue"
-> (Maybe Bool -> f (Maybe Bool)) -> TsCell -> f TsCell
fieldOf Proxy# "maybe'booleanValue"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> TsCell -> f TsCell)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Bool)
-> (TsCell -> Maybe Bool -> TsCell)
-> Lens TsCell TsCell (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Bool
_TsCell'booleanValue
           (\ TsCell
x__ Maybe Bool
y__ -> TsCell
x__ {_TsCell'booleanValue :: Maybe Bool
_TsCell'booleanValue = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCell "doubleValue" Prelude.Double where
  fieldOf :: Proxy# "doubleValue" -> (Double -> f Double) -> TsCell -> f TsCell
fieldOf Proxy# "doubleValue"
_
    = ((Maybe Double -> f (Maybe Double)) -> TsCell -> f TsCell)
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Double)
-> (TsCell -> Maybe Double -> TsCell)
-> Lens TsCell TsCell (Maybe Double) (Maybe Double)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Double
_TsCell'doubleValue (\ TsCell
x__ Maybe Double
y__ -> TsCell
x__ {_TsCell'doubleValue :: Maybe Double
_TsCell'doubleValue = Maybe Double
y__}))
        (Double -> Lens' (Maybe Double) Double
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Double
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsCell "maybe'doubleValue" (Prelude.Maybe Prelude.Double) where
  fieldOf :: Proxy# "maybe'doubleValue"
-> (Maybe Double -> f (Maybe Double)) -> TsCell -> f TsCell
fieldOf Proxy# "maybe'doubleValue"
_
    = ((Maybe Double -> f (Maybe Double)) -> TsCell -> f TsCell)
-> ((Maybe Double -> f (Maybe Double))
    -> Maybe Double -> f (Maybe Double))
-> (Maybe Double -> f (Maybe Double))
-> TsCell
-> f TsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCell -> Maybe Double)
-> (TsCell -> Maybe Double -> TsCell)
-> Lens TsCell TsCell (Maybe Double) (Maybe Double)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCell -> Maybe Double
_TsCell'doubleValue (\ TsCell
x__ Maybe Double
y__ -> TsCell
x__ {_TsCell'doubleValue :: Maybe Double
_TsCell'doubleValue = Maybe Double
y__}))
        (Maybe Double -> f (Maybe Double))
-> Maybe Double -> f (Maybe Double)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsCell where
  messageName :: Proxy TsCell -> Text
messageName Proxy TsCell
_ = String -> Text
Data.Text.pack String
"TsCell"
  packedMessageDescriptor :: Proxy TsCell -> ByteString
packedMessageDescriptor Proxy TsCell
_
    = ByteString
"\n\
      \\ACKTsCell\DC2#\n\
      \\rvarchar_value\CAN\SOH \SOH(\fR\fvarcharValue\DC2!\n\
      \\fsint64_value\CAN\STX \SOH(\DC2R\vsint64Value\DC2'\n\
      \\SItimestamp_value\CAN\ETX \SOH(\DC2R\SOtimestampValue\DC2#\n\
      \\rboolean_value\CAN\EOT \SOH(\bR\fbooleanValue\DC2!\n\
      \\fdouble_value\CAN\ENQ \SOH(\SOHR\vdoubleValue"
  packedFileDescriptor :: Proxy TsCell -> ByteString
packedFileDescriptor Proxy TsCell
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsCell)
fieldsByTag
    = let
        varcharValue__field_descriptor :: FieldDescriptor TsCell
varcharValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsCell ByteString
-> FieldDescriptor TsCell
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"varchar_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens TsCell TsCell (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor TsCell ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'varcharValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'varcharValue")) ::
              Data.ProtoLens.FieldDescriptor TsCell
        sint64Value__field_descriptor :: FieldDescriptor TsCell
sint64Value__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor TsCell Int64
-> FieldDescriptor TsCell
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"sint64_value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens TsCell TsCell (Maybe Int64) (Maybe Int64)
-> FieldAccessor TsCell Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'sint64Value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sint64Value")) ::
              Data.ProtoLens.FieldDescriptor TsCell
        timestampValue__field_descriptor :: FieldDescriptor TsCell
timestampValue__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor TsCell Int64
-> FieldDescriptor TsCell
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timestamp_value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens TsCell TsCell (Maybe Int64) (Maybe Int64)
-> FieldAccessor TsCell Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timestampValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timestampValue")) ::
              Data.ProtoLens.FieldDescriptor TsCell
        booleanValue__field_descriptor :: FieldDescriptor TsCell
booleanValue__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor TsCell Bool
-> FieldDescriptor TsCell
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"boolean_value"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens TsCell TsCell (Maybe Bool) (Maybe Bool)
-> FieldAccessor TsCell Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'booleanValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'booleanValue")) ::
              Data.ProtoLens.FieldDescriptor TsCell
        doubleValue__field_descriptor :: FieldDescriptor TsCell
doubleValue__field_descriptor
          = String
-> FieldTypeDescriptor Double
-> FieldAccessor TsCell Double
-> FieldDescriptor TsCell
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"double_value"
              (ScalarField Double -> FieldTypeDescriptor Double
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Double
Data.ProtoLens.DoubleField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Double)
              (Lens TsCell TsCell (Maybe Double) (Maybe Double)
-> FieldAccessor TsCell Double
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'doubleValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'doubleValue")) ::
              Data.ProtoLens.FieldDescriptor TsCell
      in
        [(Tag, FieldDescriptor TsCell)] -> Map Tag (FieldDescriptor TsCell)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsCell
varcharValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsCell
sint64Value__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsCell
timestampValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor TsCell
booleanValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor TsCell
doubleValue__field_descriptor)]
  unknownFields :: LensLike' f TsCell FieldSet
unknownFields
    = (TsCell -> FieldSet)
-> (TsCell -> FieldSet -> TsCell) -> Lens' TsCell FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsCell -> FieldSet
_TsCell'_unknownFields
        (\ TsCell
x__ FieldSet
y__ -> TsCell
x__ {_TsCell'_unknownFields :: FieldSet
_TsCell'_unknownFields = FieldSet
y__})
  defMessage :: TsCell
defMessage
    = TsCell'_constructor :: Maybe ByteString
-> Maybe Int64
-> Maybe Int64
-> Maybe Bool
-> Maybe Double
-> FieldSet
-> TsCell
TsCell'_constructor
        {_TsCell'varcharValue :: Maybe ByteString
_TsCell'varcharValue = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _TsCell'sint64Value :: Maybe Int64
_TsCell'sint64Value = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _TsCell'timestampValue :: Maybe Int64
_TsCell'timestampValue = Maybe Int64
forall a. Maybe a
Prelude.Nothing,
         _TsCell'booleanValue :: Maybe Bool
_TsCell'booleanValue = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _TsCell'doubleValue :: Maybe Double
_TsCell'doubleValue = Maybe Double
forall a. Maybe a
Prelude.Nothing, _TsCell'_unknownFields :: FieldSet
_TsCell'_unknownFields = []}
  parseMessage :: Parser TsCell
parseMessage
    = let
        loop :: TsCell -> Data.ProtoLens.Encoding.Bytes.Parser TsCell
        loop :: TsCell -> Parser TsCell
loop TsCell
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]))))
                      TsCell -> Parser TsCell
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsCell TsCell FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCell -> TsCell
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 TsCell TsCell FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsCell
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
"varchar_value"
                                TsCell -> Parser TsCell
loop
                                  (Setter TsCell TsCell ByteString ByteString
-> ByteString -> TsCell -> TsCell
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "varcharValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"varcharValue") ByteString
y TsCell
x)
                        Word64
16
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"sint64_value"
                                TsCell -> Parser TsCell
loop
                                  (Setter TsCell TsCell Int64 Int64 -> Int64 -> TsCell -> TsCell
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "sint64Value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"sint64Value") Int64
y TsCell
x)
                        Word64
24
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"timestamp_value"
                                TsCell -> Parser TsCell
loop
                                  (Setter TsCell TsCell Int64 Int64 -> Int64 -> TsCell -> TsCell
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "timestampValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timestampValue") Int64
y TsCell
x)
                        Word64
32
                          -> 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
"boolean_value"
                                TsCell -> Parser TsCell
loop
                                  (Setter TsCell TsCell Bool Bool -> Bool -> TsCell -> TsCell
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "booleanValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"booleanValue") Bool
y TsCell
x)
                        Word64
41
                          -> do Double
y <- Parser Double -> String -> Parser Double
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Double) -> Parser Word64 -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Double
Data.ProtoLens.Encoding.Bytes.wordToDouble
                                          Parser Word64
Data.ProtoLens.Encoding.Bytes.getFixed64)
                                       String
"double_value"
                                TsCell -> Parser TsCell
loop
                                  (Setter TsCell TsCell Double Double -> Double -> TsCell -> TsCell
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "doubleValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"doubleValue") Double
y TsCell
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsCell -> Parser TsCell
loop
                                  (Setter TsCell TsCell FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCell -> TsCell
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 TsCell TsCell FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsCell
x)
      in
        Parser TsCell -> String -> Parser TsCell
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsCell -> Parser TsCell
loop TsCell
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"TsCell"
  buildMessage :: TsCell -> Builder
buildMessage
    = \ TsCell
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe ByteString)
  TsCell
  TsCell
  (Maybe ByteString)
  (Maybe ByteString)
-> TsCell -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                    (forall s a (f :: * -> *).
(HasField s "maybe'varcharValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'varcharValue") TsCell
_x
              of
                Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just ByteString
_v)
                  -> 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))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike (Maybe Int64) TsCell TsCell (Maybe Int64) (Maybe Int64)
-> TsCell -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                       (forall s a (f :: * -> *).
(HasField s "maybe'sint64Value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'sint64Value") TsCell
_x
                 of
                   Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Int64
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                             Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                             Int64
_v))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike (Maybe Int64) TsCell TsCell (Maybe Int64) (Maybe Int64)
-> TsCell -> Maybe Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'timestampValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timestampValue") TsCell
_x
                    of
                      Maybe Int64
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Int64
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                   Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                                Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                                Int64
_v))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike (Maybe Bool) TsCell TsCell (Maybe Bool) (Maybe Bool)
-> TsCell -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                             (forall s a (f :: * -> *).
(HasField s "maybe'booleanValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'booleanValue") TsCell
_x
                       of
                         Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Bool
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (case
                              FoldLike (Maybe Double) TsCell TsCell (Maybe Double) (Maybe Double)
-> TsCell -> Maybe Double
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                (forall s a (f :: * -> *).
(HasField s "maybe'doubleValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'doubleValue") TsCell
_x
                          of
                            Maybe Double
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                            (Prelude.Just Double
_v)
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
41)
                                   ((Word64 -> Builder) -> (Double -> Word64) -> Double -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                                      Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putFixed64
                                      Double -> Word64
Data.ProtoLens.Encoding.Bytes.doubleToWord
                                      Double
_v))
                         (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                            (FoldLike FieldSet TsCell TsCell FieldSet FieldSet
-> TsCell -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsCell TsCell FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsCell
_x))))))
instance Control.DeepSeq.NFData TsCell where
  rnf :: TsCell -> ()
rnf
    = \ TsCell
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsCell -> FieldSet
_TsCell'_unknownFields TsCell
x__)
             (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsCell -> Maybe ByteString
_TsCell'varcharValue TsCell
x__)
                (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsCell -> Maybe Int64
_TsCell'sint64Value TsCell
x__)
                   (Maybe Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (TsCell -> Maybe Int64
_TsCell'timestampValue TsCell
x__)
                      (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (TsCell -> Maybe Bool
_TsCell'booleanValue TsCell
x__)
                         (Maybe Double -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsCell -> Maybe Double
_TsCell'doubleValue TsCell
x__) ())))))
{- | Fields :
     
         * 'Proto.Riak_Fields.name' @:: Lens' TsColumnDescription Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.type'' @:: Lens' TsColumnDescription TsColumnType@ -}
data TsColumnDescription
  = TsColumnDescription'_constructor {TsColumnDescription -> ByteString
_TsColumnDescription'name :: !Data.ByteString.ByteString,
                                      TsColumnDescription -> TsColumnType
_TsColumnDescription'type' :: !TsColumnType,
                                      TsColumnDescription -> FieldSet
_TsColumnDescription'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsColumnDescription -> TsColumnDescription -> Bool
(TsColumnDescription -> TsColumnDescription -> Bool)
-> (TsColumnDescription -> TsColumnDescription -> Bool)
-> Eq TsColumnDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsColumnDescription -> TsColumnDescription -> Bool
$c/= :: TsColumnDescription -> TsColumnDescription -> Bool
== :: TsColumnDescription -> TsColumnDescription -> Bool
$c== :: TsColumnDescription -> TsColumnDescription -> Bool
Prelude.Eq, Eq TsColumnDescription
Eq TsColumnDescription
-> (TsColumnDescription -> TsColumnDescription -> Ordering)
-> (TsColumnDescription -> TsColumnDescription -> Bool)
-> (TsColumnDescription -> TsColumnDescription -> Bool)
-> (TsColumnDescription -> TsColumnDescription -> Bool)
-> (TsColumnDescription -> TsColumnDescription -> Bool)
-> (TsColumnDescription
    -> TsColumnDescription -> TsColumnDescription)
-> (TsColumnDescription
    -> TsColumnDescription -> TsColumnDescription)
-> Ord TsColumnDescription
TsColumnDescription -> TsColumnDescription -> Bool
TsColumnDescription -> TsColumnDescription -> Ordering
TsColumnDescription -> TsColumnDescription -> TsColumnDescription
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 :: TsColumnDescription -> TsColumnDescription -> TsColumnDescription
$cmin :: TsColumnDescription -> TsColumnDescription -> TsColumnDescription
max :: TsColumnDescription -> TsColumnDescription -> TsColumnDescription
$cmax :: TsColumnDescription -> TsColumnDescription -> TsColumnDescription
>= :: TsColumnDescription -> TsColumnDescription -> Bool
$c>= :: TsColumnDescription -> TsColumnDescription -> Bool
> :: TsColumnDescription -> TsColumnDescription -> Bool
$c> :: TsColumnDescription -> TsColumnDescription -> Bool
<= :: TsColumnDescription -> TsColumnDescription -> Bool
$c<= :: TsColumnDescription -> TsColumnDescription -> Bool
< :: TsColumnDescription -> TsColumnDescription -> Bool
$c< :: TsColumnDescription -> TsColumnDescription -> Bool
compare :: TsColumnDescription -> TsColumnDescription -> Ordering
$ccompare :: TsColumnDescription -> TsColumnDescription -> Ordering
$cp1Ord :: Eq TsColumnDescription
Prelude.Ord)
instance Prelude.Show TsColumnDescription where
  showsPrec :: Int -> TsColumnDescription -> ShowS
showsPrec Int
_ TsColumnDescription
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsColumnDescription -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsColumnDescription
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsColumnDescription "name" Data.ByteString.ByteString where
  fieldOf :: Proxy# "name"
-> (ByteString -> f ByteString)
-> TsColumnDescription
-> f TsColumnDescription
fieldOf Proxy# "name"
_
    = ((ByteString -> f ByteString)
 -> TsColumnDescription -> f TsColumnDescription)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsColumnDescription
-> f TsColumnDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsColumnDescription -> ByteString)
-> (TsColumnDescription -> ByteString -> TsColumnDescription)
-> Lens
     TsColumnDescription TsColumnDescription ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsColumnDescription -> ByteString
_TsColumnDescription'name
           (\ TsColumnDescription
x__ ByteString
y__ -> TsColumnDescription
x__ {_TsColumnDescription'name :: ByteString
_TsColumnDescription'name = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsColumnDescription "type'" TsColumnType where
  fieldOf :: Proxy# "type'"
-> (TsColumnType -> f TsColumnType)
-> TsColumnDescription
-> f TsColumnDescription
fieldOf Proxy# "type'"
_
    = ((TsColumnType -> f TsColumnType)
 -> TsColumnDescription -> f TsColumnDescription)
-> ((TsColumnType -> f TsColumnType)
    -> TsColumnType -> f TsColumnType)
-> (TsColumnType -> f TsColumnType)
-> TsColumnDescription
-> f TsColumnDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsColumnDescription -> TsColumnType)
-> (TsColumnDescription -> TsColumnType -> TsColumnDescription)
-> Lens
     TsColumnDescription TsColumnDescription TsColumnType TsColumnType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsColumnDescription -> TsColumnType
_TsColumnDescription'type'
           (\ TsColumnDescription
x__ TsColumnType
y__ -> TsColumnDescription
x__ {_TsColumnDescription'type' :: TsColumnType
_TsColumnDescription'type' = TsColumnType
y__}))
        (TsColumnType -> f TsColumnType) -> TsColumnType -> f TsColumnType
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsColumnDescription where
  messageName :: Proxy TsColumnDescription -> Text
messageName Proxy TsColumnDescription
_ = String -> Text
Data.Text.pack String
"TsColumnDescription"
  packedMessageDescriptor :: Proxy TsColumnDescription -> ByteString
packedMessageDescriptor Proxy TsColumnDescription
_
    = ByteString
"\n\
      \\DC3TsColumnDescription\DC2\DC2\n\
      \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2!\n\
      \\EOTtype\CAN\STX \STX(\SO2\r.TsColumnTypeR\EOTtype"
  packedFileDescriptor :: Proxy TsColumnDescription -> ByteString
packedFileDescriptor Proxy TsColumnDescription
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsColumnDescription)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor TsColumnDescription
name__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsColumnDescription ByteString
-> FieldDescriptor TsColumnDescription
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (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
     TsColumnDescription TsColumnDescription ByteString ByteString
-> FieldAccessor TsColumnDescription ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name")) ::
              Data.ProtoLens.FieldDescriptor TsColumnDescription
        type'__field_descriptor :: FieldDescriptor TsColumnDescription
type'__field_descriptor
          = String
-> FieldTypeDescriptor TsColumnType
-> FieldAccessor TsColumnDescription TsColumnType
-> FieldDescriptor TsColumnDescription
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"type"
              (ScalarField TsColumnType -> FieldTypeDescriptor TsColumnType
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField TsColumnType
forall t. MessageEnum t => ScalarField t
Data.ProtoLens.EnumField ::
                 Data.ProtoLens.FieldTypeDescriptor TsColumnType)
              (WireDefault TsColumnType
-> Lens
     TsColumnDescription TsColumnDescription TsColumnType TsColumnType
-> FieldAccessor TsColumnDescription TsColumnType
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault TsColumnType
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'")) ::
              Data.ProtoLens.FieldDescriptor TsColumnDescription
      in
        [(Tag, FieldDescriptor TsColumnDescription)]
-> Map Tag (FieldDescriptor TsColumnDescription)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsColumnDescription
name__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsColumnDescription
type'__field_descriptor)]
  unknownFields :: LensLike' f TsColumnDescription FieldSet
unknownFields
    = (TsColumnDescription -> FieldSet)
-> (TsColumnDescription -> FieldSet -> TsColumnDescription)
-> Lens' TsColumnDescription FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsColumnDescription -> FieldSet
_TsColumnDescription'_unknownFields
        (\ TsColumnDescription
x__ FieldSet
y__ -> TsColumnDescription
x__ {_TsColumnDescription'_unknownFields :: FieldSet
_TsColumnDescription'_unknownFields = FieldSet
y__})
  defMessage :: TsColumnDescription
defMessage
    = TsColumnDescription'_constructor :: ByteString -> TsColumnType -> FieldSet -> TsColumnDescription
TsColumnDescription'_constructor
        {_TsColumnDescription'name :: ByteString
_TsColumnDescription'name = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsColumnDescription'type' :: TsColumnType
_TsColumnDescription'type' = TsColumnType
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsColumnDescription'_unknownFields :: FieldSet
_TsColumnDescription'_unknownFields = []}
  parseMessage :: Parser TsColumnDescription
parseMessage
    = let
        loop ::
          TsColumnDescription
          -> Prelude.Bool
             -> Prelude.Bool
                -> Data.ProtoLens.Encoding.Bytes.Parser TsColumnDescription
        loop :: TsColumnDescription -> Bool -> Bool -> Parser TsColumnDescription
loop TsColumnDescription
x Bool
required'name Bool
required'type'
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'name then (:) String
"name" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'type' then (:) String
"type" else [String] -> [String]
forall a. a -> a
Prelude.id) [])
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsColumnDescription -> Parser TsColumnDescription
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsColumnDescription TsColumnDescription FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> TsColumnDescription
-> TsColumnDescription
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 TsColumnDescription TsColumnDescription FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsColumnDescription
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
"name"
                                TsColumnDescription -> Bool -> Bool -> Parser TsColumnDescription
loop
                                  (Setter
  TsColumnDescription TsColumnDescription ByteString ByteString
-> ByteString -> TsColumnDescription -> TsColumnDescription
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") ByteString
y TsColumnDescription
x)
                                  Bool
Prelude.False
                                  Bool
required'type'
                        Word64
16
                          -> do TsColumnType
y <- Parser TsColumnType -> String -> Parser TsColumnType
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Int -> TsColumnType) -> Parser Int -> Parser TsColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Int -> TsColumnType
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
"type"
                                TsColumnDescription -> Bool -> Bool -> Parser TsColumnDescription
loop
                                  (Setter
  TsColumnDescription TsColumnDescription TsColumnType TsColumnType
-> TsColumnType -> TsColumnDescription -> TsColumnDescription
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") TsColumnType
y TsColumnDescription
x)
                                  Bool
required'name
                                  Bool
Prelude.False
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsColumnDescription -> Bool -> Bool -> Parser TsColumnDescription
loop
                                  (Setter TsColumnDescription TsColumnDescription FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> TsColumnDescription
-> TsColumnDescription
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 TsColumnDescription TsColumnDescription FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsColumnDescription
x)
                                  Bool
required'name
                                  Bool
required'type'
      in
        Parser TsColumnDescription -> String -> Parser TsColumnDescription
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsColumnDescription -> Bool -> Bool -> Parser TsColumnDescription
loop TsColumnDescription
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True)
          String
"TsColumnDescription"
  buildMessage :: TsColumnDescription -> Builder
buildMessage
    = \ TsColumnDescription
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString
  TsColumnDescription
  TsColumnDescription
  ByteString
  ByteString
-> TsColumnDescription -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") TsColumnDescription
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                   ((Int -> Builder)
-> (TsColumnType -> Int) -> TsColumnType -> 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)
                      TsColumnType -> Int
forall a. Enum a => a -> Int
Prelude.fromEnum
                      (FoldLike
  TsColumnType
  TsColumnDescription
  TsColumnDescription
  TsColumnType
  TsColumnType
-> TsColumnDescription -> TsColumnType
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "type'" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"type'") TsColumnDescription
_x)))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike
  FieldSet TsColumnDescription TsColumnDescription FieldSet FieldSet
-> TsColumnDescription -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet TsColumnDescription TsColumnDescription FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsColumnDescription
_x)))
instance Control.DeepSeq.NFData TsColumnDescription where
  rnf :: TsColumnDescription -> ()
rnf
    = \ TsColumnDescription
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsColumnDescription -> FieldSet
_TsColumnDescription'_unknownFields TsColumnDescription
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsColumnDescription -> ByteString
_TsColumnDescription'name TsColumnDescription
x__)
                (TsColumnType -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsColumnDescription -> TsColumnType
_TsColumnDescription'type' TsColumnDescription
x__) ()))
data TsColumnType
  = VARCHAR | SINT64 | DOUBLE | TIMESTAMP | BOOLEAN | BLOB
  deriving stock (Int -> TsColumnType -> ShowS
[TsColumnType] -> ShowS
TsColumnType -> String
(Int -> TsColumnType -> ShowS)
-> (TsColumnType -> String)
-> ([TsColumnType] -> ShowS)
-> Show TsColumnType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TsColumnType] -> ShowS
$cshowList :: [TsColumnType] -> ShowS
show :: TsColumnType -> String
$cshow :: TsColumnType -> String
showsPrec :: Int -> TsColumnType -> ShowS
$cshowsPrec :: Int -> TsColumnType -> ShowS
Prelude.Show, TsColumnType -> TsColumnType -> Bool
(TsColumnType -> TsColumnType -> Bool)
-> (TsColumnType -> TsColumnType -> Bool) -> Eq TsColumnType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsColumnType -> TsColumnType -> Bool
$c/= :: TsColumnType -> TsColumnType -> Bool
== :: TsColumnType -> TsColumnType -> Bool
$c== :: TsColumnType -> TsColumnType -> Bool
Prelude.Eq, Eq TsColumnType
Eq TsColumnType
-> (TsColumnType -> TsColumnType -> Ordering)
-> (TsColumnType -> TsColumnType -> Bool)
-> (TsColumnType -> TsColumnType -> Bool)
-> (TsColumnType -> TsColumnType -> Bool)
-> (TsColumnType -> TsColumnType -> Bool)
-> (TsColumnType -> TsColumnType -> TsColumnType)
-> (TsColumnType -> TsColumnType -> TsColumnType)
-> Ord TsColumnType
TsColumnType -> TsColumnType -> Bool
TsColumnType -> TsColumnType -> Ordering
TsColumnType -> TsColumnType -> TsColumnType
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 :: TsColumnType -> TsColumnType -> TsColumnType
$cmin :: TsColumnType -> TsColumnType -> TsColumnType
max :: TsColumnType -> TsColumnType -> TsColumnType
$cmax :: TsColumnType -> TsColumnType -> TsColumnType
>= :: TsColumnType -> TsColumnType -> Bool
$c>= :: TsColumnType -> TsColumnType -> Bool
> :: TsColumnType -> TsColumnType -> Bool
$c> :: TsColumnType -> TsColumnType -> Bool
<= :: TsColumnType -> TsColumnType -> Bool
$c<= :: TsColumnType -> TsColumnType -> Bool
< :: TsColumnType -> TsColumnType -> Bool
$c< :: TsColumnType -> TsColumnType -> Bool
compare :: TsColumnType -> TsColumnType -> Ordering
$ccompare :: TsColumnType -> TsColumnType -> Ordering
$cp1Ord :: Eq TsColumnType
Prelude.Ord)
instance Data.ProtoLens.MessageEnum TsColumnType where
  maybeToEnum :: Int -> Maybe TsColumnType
maybeToEnum Int
0 = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
VARCHAR
  maybeToEnum Int
1 = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
SINT64
  maybeToEnum Int
2 = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
DOUBLE
  maybeToEnum Int
3 = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
TIMESTAMP
  maybeToEnum Int
4 = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
BOOLEAN
  maybeToEnum Int
5 = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
BLOB
  maybeToEnum Int
_ = Maybe TsColumnType
forall a. Maybe a
Prelude.Nothing
  showEnum :: TsColumnType -> String
showEnum TsColumnType
VARCHAR = String
"VARCHAR"
  showEnum TsColumnType
SINT64 = String
"SINT64"
  showEnum TsColumnType
DOUBLE = String
"DOUBLE"
  showEnum TsColumnType
TIMESTAMP = String
"TIMESTAMP"
  showEnum TsColumnType
BOOLEAN = String
"BOOLEAN"
  showEnum TsColumnType
BLOB = String
"BLOB"
  readEnum :: String -> Maybe TsColumnType
readEnum String
k
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"VARCHAR" = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
VARCHAR
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"SINT64" = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
SINT64
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"DOUBLE" = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
DOUBLE
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"TIMESTAMP" = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
TIMESTAMP
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"BOOLEAN" = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
BOOLEAN
    | String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) String
k String
"BLOB" = TsColumnType -> Maybe TsColumnType
forall a. a -> Maybe a
Prelude.Just TsColumnType
BLOB
    | Bool
Prelude.otherwise
    = Maybe Int -> (Int -> Maybe TsColumnType) -> Maybe TsColumnType
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 TsColumnType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum
instance Prelude.Bounded TsColumnType where
  minBound :: TsColumnType
minBound = TsColumnType
VARCHAR
  maxBound :: TsColumnType
maxBound = TsColumnType
BLOB
instance Prelude.Enum TsColumnType where
  toEnum :: Int -> TsColumnType
toEnum Int
k__
    = TsColumnType
-> (TsColumnType -> TsColumnType)
-> Maybe TsColumnType
-> TsColumnType
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe
        (String -> TsColumnType
forall a. HasCallStack => String -> a
Prelude.error
           (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
              String
"toEnum: unknown value for enum TsColumnType: "
              (Int -> String
forall a. Show a => a -> String
Prelude.show Int
k__)))
        TsColumnType -> TsColumnType
forall a. a -> a
Prelude.id
        (Int -> Maybe TsColumnType
forall a. MessageEnum a => Int -> Maybe a
Data.ProtoLens.maybeToEnum Int
k__)
  fromEnum :: TsColumnType -> Int
fromEnum TsColumnType
VARCHAR = Int
0
  fromEnum TsColumnType
SINT64 = Int
1
  fromEnum TsColumnType
DOUBLE = Int
2
  fromEnum TsColumnType
TIMESTAMP = Int
3
  fromEnum TsColumnType
BOOLEAN = Int
4
  fromEnum TsColumnType
BLOB = Int
5
  succ :: TsColumnType -> TsColumnType
succ TsColumnType
BLOB
    = String -> TsColumnType
forall a. HasCallStack => String -> a
Prelude.error
        String
"TsColumnType.succ: bad argument BLOB. This value would be out of bounds."
  succ TsColumnType
VARCHAR = TsColumnType
SINT64
  succ TsColumnType
SINT64 = TsColumnType
DOUBLE
  succ TsColumnType
DOUBLE = TsColumnType
TIMESTAMP
  succ TsColumnType
TIMESTAMP = TsColumnType
BOOLEAN
  succ TsColumnType
BOOLEAN = TsColumnType
BLOB
  pred :: TsColumnType -> TsColumnType
pred TsColumnType
VARCHAR
    = String -> TsColumnType
forall a. HasCallStack => String -> a
Prelude.error
        String
"TsColumnType.pred: bad argument VARCHAR. This value would be out of bounds."
  pred TsColumnType
SINT64 = TsColumnType
VARCHAR
  pred TsColumnType
DOUBLE = TsColumnType
SINT64
  pred TsColumnType
TIMESTAMP = TsColumnType
DOUBLE
  pred TsColumnType
BOOLEAN = TsColumnType
TIMESTAMP
  pred TsColumnType
BLOB = TsColumnType
BOOLEAN
  enumFrom :: TsColumnType -> [TsColumnType]
enumFrom = TsColumnType -> [TsColumnType]
forall a. (Enum a, Bounded a) => a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFrom
  enumFromTo :: TsColumnType -> TsColumnType -> [TsColumnType]
enumFromTo = TsColumnType -> TsColumnType -> [TsColumnType]
forall a. Enum a => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromTo
  enumFromThen :: TsColumnType -> TsColumnType -> [TsColumnType]
enumFromThen = TsColumnType -> TsColumnType -> [TsColumnType]
forall a. (Enum a, Bounded a) => a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThen
  enumFromThenTo :: TsColumnType -> TsColumnType -> TsColumnType -> [TsColumnType]
enumFromThenTo = TsColumnType -> TsColumnType -> TsColumnType -> [TsColumnType]
forall a. Enum a => a -> a -> a -> [a]
Data.ProtoLens.Message.Enum.messageEnumFromThenTo
instance Data.ProtoLens.FieldDefault TsColumnType where
  fieldDefault :: TsColumnType
fieldDefault = TsColumnType
VARCHAR
instance Control.DeepSeq.NFData TsColumnType where
  rnf :: TsColumnType -> ()
rnf TsColumnType
x__ = TsColumnType -> () -> ()
Prelude.seq TsColumnType
x__ ()
{- | Fields :
     
         * 'Proto.Riak_Fields.ip' @:: Lens' TsCoverageEntry Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.port' @:: Lens' TsCoverageEntry Data.Word.Word32@
         * 'Proto.Riak_Fields.coverContext' @:: Lens' TsCoverageEntry Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.range' @:: Lens' TsCoverageEntry TsRange@
         * 'Proto.Riak_Fields.maybe'range' @:: Lens' TsCoverageEntry (Prelude.Maybe TsRange)@ -}
data TsCoverageEntry
  = TsCoverageEntry'_constructor {TsCoverageEntry -> ByteString
_TsCoverageEntry'ip :: !Data.ByteString.ByteString,
                                  TsCoverageEntry -> Word32
_TsCoverageEntry'port :: !Data.Word.Word32,
                                  TsCoverageEntry -> ByteString
_TsCoverageEntry'coverContext :: !Data.ByteString.ByteString,
                                  TsCoverageEntry -> Maybe TsRange
_TsCoverageEntry'range :: !(Prelude.Maybe TsRange),
                                  TsCoverageEntry -> FieldSet
_TsCoverageEntry'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsCoverageEntry -> TsCoverageEntry -> Bool
(TsCoverageEntry -> TsCoverageEntry -> Bool)
-> (TsCoverageEntry -> TsCoverageEntry -> Bool)
-> Eq TsCoverageEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsCoverageEntry -> TsCoverageEntry -> Bool
$c/= :: TsCoverageEntry -> TsCoverageEntry -> Bool
== :: TsCoverageEntry -> TsCoverageEntry -> Bool
$c== :: TsCoverageEntry -> TsCoverageEntry -> Bool
Prelude.Eq, Eq TsCoverageEntry
Eq TsCoverageEntry
-> (TsCoverageEntry -> TsCoverageEntry -> Ordering)
-> (TsCoverageEntry -> TsCoverageEntry -> Bool)
-> (TsCoverageEntry -> TsCoverageEntry -> Bool)
-> (TsCoverageEntry -> TsCoverageEntry -> Bool)
-> (TsCoverageEntry -> TsCoverageEntry -> Bool)
-> (TsCoverageEntry -> TsCoverageEntry -> TsCoverageEntry)
-> (TsCoverageEntry -> TsCoverageEntry -> TsCoverageEntry)
-> Ord TsCoverageEntry
TsCoverageEntry -> TsCoverageEntry -> Bool
TsCoverageEntry -> TsCoverageEntry -> Ordering
TsCoverageEntry -> TsCoverageEntry -> TsCoverageEntry
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 :: TsCoverageEntry -> TsCoverageEntry -> TsCoverageEntry
$cmin :: TsCoverageEntry -> TsCoverageEntry -> TsCoverageEntry
max :: TsCoverageEntry -> TsCoverageEntry -> TsCoverageEntry
$cmax :: TsCoverageEntry -> TsCoverageEntry -> TsCoverageEntry
>= :: TsCoverageEntry -> TsCoverageEntry -> Bool
$c>= :: TsCoverageEntry -> TsCoverageEntry -> Bool
> :: TsCoverageEntry -> TsCoverageEntry -> Bool
$c> :: TsCoverageEntry -> TsCoverageEntry -> Bool
<= :: TsCoverageEntry -> TsCoverageEntry -> Bool
$c<= :: TsCoverageEntry -> TsCoverageEntry -> Bool
< :: TsCoverageEntry -> TsCoverageEntry -> Bool
$c< :: TsCoverageEntry -> TsCoverageEntry -> Bool
compare :: TsCoverageEntry -> TsCoverageEntry -> Ordering
$ccompare :: TsCoverageEntry -> TsCoverageEntry -> Ordering
$cp1Ord :: Eq TsCoverageEntry
Prelude.Ord)
instance Prelude.Show TsCoverageEntry where
  showsPrec :: Int -> TsCoverageEntry -> ShowS
showsPrec Int
_ TsCoverageEntry
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsCoverageEntry -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsCoverageEntry
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsCoverageEntry "ip" Data.ByteString.ByteString where
  fieldOf :: Proxy# "ip"
-> (ByteString -> f ByteString)
-> TsCoverageEntry
-> f TsCoverageEntry
fieldOf Proxy# "ip"
_
    = ((ByteString -> f ByteString)
 -> TsCoverageEntry -> f TsCoverageEntry)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsCoverageEntry
-> f TsCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageEntry -> ByteString)
-> (TsCoverageEntry -> ByteString -> TsCoverageEntry)
-> Lens TsCoverageEntry TsCoverageEntry ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageEntry -> ByteString
_TsCoverageEntry'ip (\ TsCoverageEntry
x__ ByteString
y__ -> TsCoverageEntry
x__ {_TsCoverageEntry'ip :: ByteString
_TsCoverageEntry'ip = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCoverageEntry "port" Data.Word.Word32 where
  fieldOf :: Proxy# "port"
-> (Word32 -> f Word32) -> TsCoverageEntry -> f TsCoverageEntry
fieldOf Proxy# "port"
_
    = ((Word32 -> f Word32) -> TsCoverageEntry -> f TsCoverageEntry)
-> ((Word32 -> f Word32) -> Word32 -> f Word32)
-> (Word32 -> f Word32)
-> TsCoverageEntry
-> f TsCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageEntry -> Word32)
-> (TsCoverageEntry -> Word32 -> TsCoverageEntry)
-> Lens TsCoverageEntry TsCoverageEntry Word32 Word32
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageEntry -> Word32
_TsCoverageEntry'port
           (\ TsCoverageEntry
x__ Word32
y__ -> TsCoverageEntry
x__ {_TsCoverageEntry'port :: Word32
_TsCoverageEntry'port = Word32
y__}))
        (Word32 -> f Word32) -> Word32 -> f Word32
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCoverageEntry "coverContext" Data.ByteString.ByteString where
  fieldOf :: Proxy# "coverContext"
-> (ByteString -> f ByteString)
-> TsCoverageEntry
-> f TsCoverageEntry
fieldOf Proxy# "coverContext"
_
    = ((ByteString -> f ByteString)
 -> TsCoverageEntry -> f TsCoverageEntry)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsCoverageEntry
-> f TsCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageEntry -> ByteString)
-> (TsCoverageEntry -> ByteString -> TsCoverageEntry)
-> Lens TsCoverageEntry TsCoverageEntry ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageEntry -> ByteString
_TsCoverageEntry'coverContext
           (\ TsCoverageEntry
x__ ByteString
y__ -> TsCoverageEntry
x__ {_TsCoverageEntry'coverContext :: ByteString
_TsCoverageEntry'coverContext = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCoverageEntry "range" TsRange where
  fieldOf :: Proxy# "range"
-> (TsRange -> f TsRange) -> TsCoverageEntry -> f TsCoverageEntry
fieldOf Proxy# "range"
_
    = ((Maybe TsRange -> f (Maybe TsRange))
 -> TsCoverageEntry -> f TsCoverageEntry)
-> ((TsRange -> f TsRange) -> Maybe TsRange -> f (Maybe TsRange))
-> (TsRange -> f TsRange)
-> TsCoverageEntry
-> f TsCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageEntry -> Maybe TsRange)
-> (TsCoverageEntry -> Maybe TsRange -> TsCoverageEntry)
-> Lens
     TsCoverageEntry TsCoverageEntry (Maybe TsRange) (Maybe TsRange)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageEntry -> Maybe TsRange
_TsCoverageEntry'range
           (\ TsCoverageEntry
x__ Maybe TsRange
y__ -> TsCoverageEntry
x__ {_TsCoverageEntry'range :: Maybe TsRange
_TsCoverageEntry'range = Maybe TsRange
y__}))
        (TsRange -> Lens' (Maybe TsRange) TsRange
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens TsRange
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField TsCoverageEntry "maybe'range" (Prelude.Maybe TsRange) where
  fieldOf :: Proxy# "maybe'range"
-> (Maybe TsRange -> f (Maybe TsRange))
-> TsCoverageEntry
-> f TsCoverageEntry
fieldOf Proxy# "maybe'range"
_
    = ((Maybe TsRange -> f (Maybe TsRange))
 -> TsCoverageEntry -> f TsCoverageEntry)
-> ((Maybe TsRange -> f (Maybe TsRange))
    -> Maybe TsRange -> f (Maybe TsRange))
-> (Maybe TsRange -> f (Maybe TsRange))
-> TsCoverageEntry
-> f TsCoverageEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageEntry -> Maybe TsRange)
-> (TsCoverageEntry -> Maybe TsRange -> TsCoverageEntry)
-> Lens
     TsCoverageEntry TsCoverageEntry (Maybe TsRange) (Maybe TsRange)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageEntry -> Maybe TsRange
_TsCoverageEntry'range
           (\ TsCoverageEntry
x__ Maybe TsRange
y__ -> TsCoverageEntry
x__ {_TsCoverageEntry'range :: Maybe TsRange
_TsCoverageEntry'range = Maybe TsRange
y__}))
        (Maybe TsRange -> f (Maybe TsRange))
-> Maybe TsRange -> f (Maybe TsRange)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsCoverageEntry where
  messageName :: Proxy TsCoverageEntry -> Text
messageName Proxy TsCoverageEntry
_ = String -> Text
Data.Text.pack String
"TsCoverageEntry"
  packedMessageDescriptor :: Proxy TsCoverageEntry -> ByteString
packedMessageDescriptor Proxy TsCoverageEntry
_
    = ByteString
"\n\
      \\SITsCoverageEntry\DC2\SO\n\
      \\STXip\CAN\SOH \STX(\fR\STXip\DC2\DC2\n\
      \\EOTport\CAN\STX \STX(\rR\EOTport\DC2#\n\
      \\rcover_context\CAN\ETX \STX(\fR\fcoverContext\DC2\RS\n\
      \\ENQrange\CAN\EOT \SOH(\v2\b.TsRangeR\ENQrange"
  packedFileDescriptor :: Proxy TsCoverageEntry -> ByteString
packedFileDescriptor Proxy TsCoverageEntry
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsCoverageEntry)
fieldsByTag
    = let
        ip__field_descriptor :: FieldDescriptor TsCoverageEntry
ip__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsCoverageEntry ByteString
-> FieldDescriptor TsCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"ip"
              (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 TsCoverageEntry TsCoverageEntry ByteString ByteString
-> FieldAccessor TsCoverageEntry ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "ip" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ip")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageEntry
        port__field_descriptor :: FieldDescriptor TsCoverageEntry
port__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor TsCoverageEntry Word32
-> FieldDescriptor TsCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"port"
              (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 TsCoverageEntry TsCoverageEntry Word32 Word32
-> FieldAccessor TsCoverageEntry Word32
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Word32
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "port" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"port")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageEntry
        coverContext__field_descriptor :: FieldDescriptor TsCoverageEntry
coverContext__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsCoverageEntry ByteString
-> FieldDescriptor TsCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"cover_context"
              (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 TsCoverageEntry TsCoverageEntry ByteString ByteString
-> FieldAccessor TsCoverageEntry ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageEntry
        range__field_descriptor :: FieldDescriptor TsCoverageEntry
range__field_descriptor
          = String
-> FieldTypeDescriptor TsRange
-> FieldAccessor TsCoverageEntry TsRange
-> FieldDescriptor TsCoverageEntry
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"range"
              (MessageOrGroup -> FieldTypeDescriptor TsRange
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsRange)
              (Lens
  TsCoverageEntry TsCoverageEntry (Maybe TsRange) (Maybe TsRange)
-> FieldAccessor TsCoverageEntry TsRange
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'range" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'range")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageEntry
      in
        [(Tag, FieldDescriptor TsCoverageEntry)]
-> Map Tag (FieldDescriptor TsCoverageEntry)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsCoverageEntry
ip__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsCoverageEntry
port__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsCoverageEntry
coverContext__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor TsCoverageEntry
range__field_descriptor)]
  unknownFields :: LensLike' f TsCoverageEntry FieldSet
unknownFields
    = (TsCoverageEntry -> FieldSet)
-> (TsCoverageEntry -> FieldSet -> TsCoverageEntry)
-> Lens' TsCoverageEntry FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsCoverageEntry -> FieldSet
_TsCoverageEntry'_unknownFields
        (\ TsCoverageEntry
x__ FieldSet
y__ -> TsCoverageEntry
x__ {_TsCoverageEntry'_unknownFields :: FieldSet
_TsCoverageEntry'_unknownFields = FieldSet
y__})
  defMessage :: TsCoverageEntry
defMessage
    = TsCoverageEntry'_constructor :: ByteString
-> Word32
-> ByteString
-> Maybe TsRange
-> FieldSet
-> TsCoverageEntry
TsCoverageEntry'_constructor
        {_TsCoverageEntry'ip :: ByteString
_TsCoverageEntry'ip = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsCoverageEntry'port :: Word32
_TsCoverageEntry'port = Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsCoverageEntry'coverContext :: ByteString
_TsCoverageEntry'coverContext = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsCoverageEntry'range :: Maybe TsRange
_TsCoverageEntry'range = Maybe TsRange
forall a. Maybe a
Prelude.Nothing,
         _TsCoverageEntry'_unknownFields :: FieldSet
_TsCoverageEntry'_unknownFields = []}
  parseMessage :: Parser TsCoverageEntry
parseMessage
    = let
        loop ::
          TsCoverageEntry
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool
                   -> Data.ProtoLens.Encoding.Bytes.Parser TsCoverageEntry
        loop :: TsCoverageEntry -> Bool -> Bool -> Bool -> Parser TsCoverageEntry
loop TsCoverageEntry
x Bool
required'coverContext Bool
required'ip Bool
required'port
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'coverContext then
                                  (:) String
"cover_context"
                              else
                                  [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'ip then (:) String
"ip" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'port then (:) String
"port" else [String] -> [String]
forall a. a -> a
Prelude.id) []))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsCoverageEntry -> Parser TsCoverageEntry
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsCoverageEntry TsCoverageEntry FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCoverageEntry -> TsCoverageEntry
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 TsCoverageEntry TsCoverageEntry FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsCoverageEntry
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
"ip"
                                TsCoverageEntry -> Bool -> Bool -> Bool -> Parser TsCoverageEntry
loop
                                  (Setter TsCoverageEntry TsCoverageEntry ByteString ByteString
-> ByteString -> TsCoverageEntry -> TsCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "ip" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ip") ByteString
y TsCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
Prelude.False
                                  Bool
required'port
                        Word64
16
                          -> 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
"port"
                                TsCoverageEntry -> Bool -> Bool -> Bool -> Parser TsCoverageEntry
loop
                                  (Setter TsCoverageEntry TsCoverageEntry Word32 Word32
-> Word32 -> TsCoverageEntry -> TsCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "port" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"port") Word32
y TsCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
required'ip
                                  Bool
Prelude.False
                        Word64
26
                          -> 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
"cover_context"
                                TsCoverageEntry -> Bool -> Bool -> Bool -> Parser TsCoverageEntry
loop
                                  (Setter TsCoverageEntry TsCoverageEntry ByteString ByteString
-> ByteString -> TsCoverageEntry -> TsCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext") ByteString
y TsCoverageEntry
x)
                                  Bool
Prelude.False
                                  Bool
required'ip
                                  Bool
required'port
                        Word64
34
                          -> do TsRange
y <- Parser TsRange -> String -> Parser TsRange
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser TsRange -> Parser TsRange
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 TsRange
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"range"
                                TsCoverageEntry -> Bool -> Bool -> Bool -> Parser TsCoverageEntry
loop
                                  (Setter TsCoverageEntry TsCoverageEntry TsRange TsRange
-> TsRange -> TsCoverageEntry -> TsCoverageEntry
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "range" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"range") TsRange
y TsCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
required'ip
                                  Bool
required'port
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsCoverageEntry -> Bool -> Bool -> Bool -> Parser TsCoverageEntry
loop
                                  (Setter TsCoverageEntry TsCoverageEntry FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCoverageEntry -> TsCoverageEntry
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 TsCoverageEntry TsCoverageEntry FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsCoverageEntry
x)
                                  Bool
required'coverContext
                                  Bool
required'ip
                                  Bool
required'port
      in
        Parser TsCoverageEntry -> String -> Parser TsCoverageEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsCoverageEntry -> Bool -> Bool -> Bool -> Parser TsCoverageEntry
loop
                TsCoverageEntry
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Bool
Prelude.True Bool
Prelude.True)
          String
"TsCoverageEntry"
  buildMessage :: TsCoverageEntry -> Builder
buildMessage
    = \ TsCoverageEntry
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString TsCoverageEntry TsCoverageEntry ByteString ByteString
-> TsCoverageEntry -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "ip" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"ip") TsCoverageEntry
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                   ((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
                      (FoldLike Word32 TsCoverageEntry TsCoverageEntry Word32 Word32
-> TsCoverageEntry -> Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "port" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"port") TsCoverageEntry
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                      ((\ 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))
                         (FoldLike
  ByteString TsCoverageEntry TsCoverageEntry ByteString ByteString
-> TsCoverageEntry -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                            (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext") TsCoverageEntry
_x)))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe TsRange)
  TsCoverageEntry
  TsCoverageEntry
  (Maybe TsRange)
  (Maybe TsRange)
-> TsCoverageEntry -> Maybe TsRange
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'range" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'range") TsCoverageEntry
_x
                       of
                         Maybe TsRange
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just TsRange
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                ((ByteString -> Builder)
-> (TsRange -> ByteString) -> TsRange -> 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))
                                   TsRange -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                   TsRange
_v))
                      (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                         (FoldLike FieldSet TsCoverageEntry TsCoverageEntry FieldSet FieldSet
-> TsCoverageEntry -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsCoverageEntry TsCoverageEntry FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsCoverageEntry
_x)))))
instance Control.DeepSeq.NFData TsCoverageEntry where
  rnf :: TsCoverageEntry -> ()
rnf
    = \ TsCoverageEntry
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsCoverageEntry -> FieldSet
_TsCoverageEntry'_unknownFields TsCoverageEntry
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsCoverageEntry -> ByteString
_TsCoverageEntry'ip TsCoverageEntry
x__)
                (Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsCoverageEntry -> Word32
_TsCoverageEntry'port TsCoverageEntry
x__)
                   (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (TsCoverageEntry -> ByteString
_TsCoverageEntry'coverContext TsCoverageEntry
x__)
                      (Maybe TsRange -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsCoverageEntry -> Maybe TsRange
_TsCoverageEntry'range TsCoverageEntry
x__) ()))))
{- | Fields :
     
         * 'Proto.Riak_Fields.query' @:: Lens' TsCoverageReq TsInterpolation@
         * 'Proto.Riak_Fields.maybe'query' @:: Lens' TsCoverageReq (Prelude.Maybe TsInterpolation)@
         * 'Proto.Riak_Fields.table' @:: Lens' TsCoverageReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.replaceCover' @:: Lens' TsCoverageReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'replaceCover' @:: Lens' TsCoverageReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.unavailableCover' @:: Lens' TsCoverageReq [Data.ByteString.ByteString]@
         * 'Proto.Riak_Fields.vec'unavailableCover' @:: Lens' TsCoverageReq (Data.Vector.Vector Data.ByteString.ByteString)@ -}
data TsCoverageReq
  = TsCoverageReq'_constructor {TsCoverageReq -> Maybe TsInterpolation
_TsCoverageReq'query :: !(Prelude.Maybe TsInterpolation),
                                TsCoverageReq -> ByteString
_TsCoverageReq'table :: !Data.ByteString.ByteString,
                                TsCoverageReq -> Maybe ByteString
_TsCoverageReq'replaceCover :: !(Prelude.Maybe Data.ByteString.ByteString),
                                TsCoverageReq -> Vector ByteString
_TsCoverageReq'unavailableCover :: !(Data.Vector.Vector Data.ByteString.ByteString),
                                TsCoverageReq -> FieldSet
_TsCoverageReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsCoverageReq -> TsCoverageReq -> Bool
(TsCoverageReq -> TsCoverageReq -> Bool)
-> (TsCoverageReq -> TsCoverageReq -> Bool) -> Eq TsCoverageReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsCoverageReq -> TsCoverageReq -> Bool
$c/= :: TsCoverageReq -> TsCoverageReq -> Bool
== :: TsCoverageReq -> TsCoverageReq -> Bool
$c== :: TsCoverageReq -> TsCoverageReq -> Bool
Prelude.Eq, Eq TsCoverageReq
Eq TsCoverageReq
-> (TsCoverageReq -> TsCoverageReq -> Ordering)
-> (TsCoverageReq -> TsCoverageReq -> Bool)
-> (TsCoverageReq -> TsCoverageReq -> Bool)
-> (TsCoverageReq -> TsCoverageReq -> Bool)
-> (TsCoverageReq -> TsCoverageReq -> Bool)
-> (TsCoverageReq -> TsCoverageReq -> TsCoverageReq)
-> (TsCoverageReq -> TsCoverageReq -> TsCoverageReq)
-> Ord TsCoverageReq
TsCoverageReq -> TsCoverageReq -> Bool
TsCoverageReq -> TsCoverageReq -> Ordering
TsCoverageReq -> TsCoverageReq -> TsCoverageReq
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 :: TsCoverageReq -> TsCoverageReq -> TsCoverageReq
$cmin :: TsCoverageReq -> TsCoverageReq -> TsCoverageReq
max :: TsCoverageReq -> TsCoverageReq -> TsCoverageReq
$cmax :: TsCoverageReq -> TsCoverageReq -> TsCoverageReq
>= :: TsCoverageReq -> TsCoverageReq -> Bool
$c>= :: TsCoverageReq -> TsCoverageReq -> Bool
> :: TsCoverageReq -> TsCoverageReq -> Bool
$c> :: TsCoverageReq -> TsCoverageReq -> Bool
<= :: TsCoverageReq -> TsCoverageReq -> Bool
$c<= :: TsCoverageReq -> TsCoverageReq -> Bool
< :: TsCoverageReq -> TsCoverageReq -> Bool
$c< :: TsCoverageReq -> TsCoverageReq -> Bool
compare :: TsCoverageReq -> TsCoverageReq -> Ordering
$ccompare :: TsCoverageReq -> TsCoverageReq -> Ordering
$cp1Ord :: Eq TsCoverageReq
Prelude.Ord)
instance Prelude.Show TsCoverageReq where
  showsPrec :: Int -> TsCoverageReq -> ShowS
showsPrec Int
_ TsCoverageReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsCoverageReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsCoverageReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsCoverageReq "query" TsInterpolation where
  fieldOf :: Proxy# "query"
-> (TsInterpolation -> f TsInterpolation)
-> TsCoverageReq
-> f TsCoverageReq
fieldOf Proxy# "query"
_
    = ((Maybe TsInterpolation -> f (Maybe TsInterpolation))
 -> TsCoverageReq -> f TsCoverageReq)
-> ((TsInterpolation -> f TsInterpolation)
    -> Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> (TsInterpolation -> f TsInterpolation)
-> TsCoverageReq
-> f TsCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageReq -> Maybe TsInterpolation)
-> (TsCoverageReq -> Maybe TsInterpolation -> TsCoverageReq)
-> Lens
     TsCoverageReq
     TsCoverageReq
     (Maybe TsInterpolation)
     (Maybe TsInterpolation)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageReq -> Maybe TsInterpolation
_TsCoverageReq'query
           (\ TsCoverageReq
x__ Maybe TsInterpolation
y__ -> TsCoverageReq
x__ {_TsCoverageReq'query :: Maybe TsInterpolation
_TsCoverageReq'query = Maybe TsInterpolation
y__}))
        (TsInterpolation -> Lens' (Maybe TsInterpolation) TsInterpolation
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens TsInterpolation
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField TsCoverageReq "maybe'query" (Prelude.Maybe TsInterpolation) where
  fieldOf :: Proxy# "maybe'query"
-> (Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> TsCoverageReq
-> f TsCoverageReq
fieldOf Proxy# "maybe'query"
_
    = ((Maybe TsInterpolation -> f (Maybe TsInterpolation))
 -> TsCoverageReq -> f TsCoverageReq)
-> ((Maybe TsInterpolation -> f (Maybe TsInterpolation))
    -> Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> (Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> TsCoverageReq
-> f TsCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageReq -> Maybe TsInterpolation)
-> (TsCoverageReq -> Maybe TsInterpolation -> TsCoverageReq)
-> Lens
     TsCoverageReq
     TsCoverageReq
     (Maybe TsInterpolation)
     (Maybe TsInterpolation)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageReq -> Maybe TsInterpolation
_TsCoverageReq'query
           (\ TsCoverageReq
x__ Maybe TsInterpolation
y__ -> TsCoverageReq
x__ {_TsCoverageReq'query :: Maybe TsInterpolation
_TsCoverageReq'query = Maybe TsInterpolation
y__}))
        (Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> Maybe TsInterpolation -> f (Maybe TsInterpolation)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCoverageReq "table" Data.ByteString.ByteString where
  fieldOf :: Proxy# "table"
-> (ByteString -> f ByteString) -> TsCoverageReq -> f TsCoverageReq
fieldOf Proxy# "table"
_
    = ((ByteString -> f ByteString) -> TsCoverageReq -> f TsCoverageReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsCoverageReq
-> f TsCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageReq -> ByteString)
-> (TsCoverageReq -> ByteString -> TsCoverageReq)
-> Lens TsCoverageReq TsCoverageReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageReq -> ByteString
_TsCoverageReq'table
           (\ TsCoverageReq
x__ ByteString
y__ -> TsCoverageReq
x__ {_TsCoverageReq'table :: ByteString
_TsCoverageReq'table = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCoverageReq "replaceCover" Data.ByteString.ByteString where
  fieldOf :: Proxy# "replaceCover"
-> (ByteString -> f ByteString) -> TsCoverageReq -> f TsCoverageReq
fieldOf Proxy# "replaceCover"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> TsCoverageReq -> f TsCoverageReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> TsCoverageReq
-> f TsCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageReq -> Maybe ByteString)
-> (TsCoverageReq -> Maybe ByteString -> TsCoverageReq)
-> Lens
     TsCoverageReq TsCoverageReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageReq -> Maybe ByteString
_TsCoverageReq'replaceCover
           (\ TsCoverageReq
x__ Maybe ByteString
y__ -> TsCoverageReq
x__ {_TsCoverageReq'replaceCover :: Maybe ByteString
_TsCoverageReq'replaceCover = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsCoverageReq "maybe'replaceCover" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'replaceCover"
-> (Maybe ByteString -> f (Maybe ByteString))
-> TsCoverageReq
-> f TsCoverageReq
fieldOf Proxy# "maybe'replaceCover"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> TsCoverageReq -> f TsCoverageReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> TsCoverageReq
-> f TsCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageReq -> Maybe ByteString)
-> (TsCoverageReq -> Maybe ByteString -> TsCoverageReq)
-> Lens
     TsCoverageReq TsCoverageReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageReq -> Maybe ByteString
_TsCoverageReq'replaceCover
           (\ TsCoverageReq
x__ Maybe ByteString
y__ -> TsCoverageReq
x__ {_TsCoverageReq'replaceCover :: Maybe ByteString
_TsCoverageReq'replaceCover = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsCoverageReq "unavailableCover" [Data.ByteString.ByteString] where
  fieldOf :: Proxy# "unavailableCover"
-> ([ByteString] -> f [ByteString])
-> TsCoverageReq
-> f TsCoverageReq
fieldOf Proxy# "unavailableCover"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> TsCoverageReq -> f TsCoverageReq)
-> (([ByteString] -> f [ByteString])
    -> Vector ByteString -> f (Vector ByteString))
-> ([ByteString] -> f [ByteString])
-> TsCoverageReq
-> f TsCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageReq -> Vector ByteString)
-> (TsCoverageReq -> Vector ByteString -> TsCoverageReq)
-> Lens
     TsCoverageReq TsCoverageReq (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageReq -> Vector ByteString
_TsCoverageReq'unavailableCover
           (\ TsCoverageReq
x__ Vector ByteString
y__ -> TsCoverageReq
x__ {_TsCoverageReq'unavailableCover :: Vector ByteString
_TsCoverageReq'unavailableCover = Vector ByteString
y__}))
        ((Vector ByteString -> [ByteString])
-> (Vector ByteString -> [ByteString] -> Vector ByteString)
-> Lens
     (Vector ByteString) (Vector ByteString) [ByteString] [ByteString]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector ByteString -> [ByteString]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector ByteString
_ [ByteString]
y__ -> [ByteString] -> Vector ByteString
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [ByteString]
y__))
instance Data.ProtoLens.Field.HasField TsCoverageReq "vec'unavailableCover" (Data.Vector.Vector Data.ByteString.ByteString) where
  fieldOf :: Proxy# "vec'unavailableCover"
-> (Vector ByteString -> f (Vector ByteString))
-> TsCoverageReq
-> f TsCoverageReq
fieldOf Proxy# "vec'unavailableCover"
_
    = ((Vector ByteString -> f (Vector ByteString))
 -> TsCoverageReq -> f TsCoverageReq)
-> ((Vector ByteString -> f (Vector ByteString))
    -> Vector ByteString -> f (Vector ByteString))
-> (Vector ByteString -> f (Vector ByteString))
-> TsCoverageReq
-> f TsCoverageReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageReq -> Vector ByteString)
-> (TsCoverageReq -> Vector ByteString -> TsCoverageReq)
-> Lens
     TsCoverageReq TsCoverageReq (Vector ByteString) (Vector ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageReq -> Vector ByteString
_TsCoverageReq'unavailableCover
           (\ TsCoverageReq
x__ Vector ByteString
y__ -> TsCoverageReq
x__ {_TsCoverageReq'unavailableCover :: Vector ByteString
_TsCoverageReq'unavailableCover = Vector ByteString
y__}))
        (Vector ByteString -> f (Vector ByteString))
-> Vector ByteString -> f (Vector ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsCoverageReq where
  messageName :: Proxy TsCoverageReq -> Text
messageName Proxy TsCoverageReq
_ = String -> Text
Data.Text.pack String
"TsCoverageReq"
  packedMessageDescriptor :: Proxy TsCoverageReq -> ByteString
packedMessageDescriptor Proxy TsCoverageReq
_
    = ByteString
"\n\
      \\rTsCoverageReq\DC2&\n\
      \\ENQquery\CAN\SOH \SOH(\v2\DLE.TsInterpolationR\ENQquery\DC2\DC4\n\
      \\ENQtable\CAN\STX \STX(\fR\ENQtable\DC2#\n\
      \\rreplace_cover\CAN\ETX \SOH(\fR\freplaceCover\DC2+\n\
      \\DC1unavailable_cover\CAN\EOT \ETX(\fR\DLEunavailableCover"
  packedFileDescriptor :: Proxy TsCoverageReq -> ByteString
packedFileDescriptor Proxy TsCoverageReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsCoverageReq)
fieldsByTag
    = let
        query__field_descriptor :: FieldDescriptor TsCoverageReq
query__field_descriptor
          = String
-> FieldTypeDescriptor TsInterpolation
-> FieldAccessor TsCoverageReq TsInterpolation
-> FieldDescriptor TsCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"query"
              (MessageOrGroup -> FieldTypeDescriptor TsInterpolation
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsInterpolation)
              (Lens
  TsCoverageReq
  TsCoverageReq
  (Maybe TsInterpolation)
  (Maybe TsInterpolation)
-> FieldAccessor TsCoverageReq TsInterpolation
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'query" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'query")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageReq
        table__field_descriptor :: FieldDescriptor TsCoverageReq
table__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsCoverageReq ByteString
-> FieldDescriptor TsCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"table"
              (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 TsCoverageReq TsCoverageReq ByteString ByteString
-> FieldAccessor TsCoverageReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageReq
        replaceCover__field_descriptor :: FieldDescriptor TsCoverageReq
replaceCover__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsCoverageReq ByteString
-> FieldDescriptor TsCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"replace_cover"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens
  TsCoverageReq TsCoverageReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor TsCoverageReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'replaceCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'replaceCover")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageReq
        unavailableCover__field_descriptor :: FieldDescriptor TsCoverageReq
unavailableCover__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsCoverageReq ByteString
-> FieldDescriptor TsCoverageReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"unavailable_cover"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Packing
-> Lens' TsCoverageReq [ByteString]
-> FieldAccessor TsCoverageReq ByteString
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "unavailableCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"unavailableCover")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageReq
      in
        [(Tag, FieldDescriptor TsCoverageReq)]
-> Map Tag (FieldDescriptor TsCoverageReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsCoverageReq
query__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsCoverageReq
table__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsCoverageReq
replaceCover__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor TsCoverageReq
unavailableCover__field_descriptor)]
  unknownFields :: LensLike' f TsCoverageReq FieldSet
unknownFields
    = (TsCoverageReq -> FieldSet)
-> (TsCoverageReq -> FieldSet -> TsCoverageReq)
-> Lens' TsCoverageReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsCoverageReq -> FieldSet
_TsCoverageReq'_unknownFields
        (\ TsCoverageReq
x__ FieldSet
y__ -> TsCoverageReq
x__ {_TsCoverageReq'_unknownFields :: FieldSet
_TsCoverageReq'_unknownFields = FieldSet
y__})
  defMessage :: TsCoverageReq
defMessage
    = TsCoverageReq'_constructor :: Maybe TsInterpolation
-> ByteString
-> Maybe ByteString
-> Vector ByteString
-> FieldSet
-> TsCoverageReq
TsCoverageReq'_constructor
        {_TsCoverageReq'query :: Maybe TsInterpolation
_TsCoverageReq'query = Maybe TsInterpolation
forall a. Maybe a
Prelude.Nothing,
         _TsCoverageReq'table :: ByteString
_TsCoverageReq'table = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsCoverageReq'replaceCover :: Maybe ByteString
_TsCoverageReq'replaceCover = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _TsCoverageReq'unavailableCover :: Vector ByteString
_TsCoverageReq'unavailableCover = Vector ByteString
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsCoverageReq'_unknownFields :: FieldSet
_TsCoverageReq'_unknownFields = []}
  parseMessage :: Parser TsCoverageReq
parseMessage
    = let
        loop ::
          TsCoverageReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.ByteString.ByteString
                -> Data.ProtoLens.Encoding.Bytes.Parser TsCoverageReq
        loop :: TsCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser TsCoverageReq
loop TsCoverageReq
x Bool
required'table Growing Vector RealWorld ByteString
mutable'unavailableCover
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector ByteString
frozen'unavailableCover <- IO (Vector ByteString) -> Parser (Vector ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                                   (Growing Vector (PrimState IO) ByteString -> IO (Vector ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'unavailableCover)
                      (let
                         missing :: [String]
missing = (if Bool
required'table then (:) String
"table" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsCoverageReq -> Parser TsCoverageReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsCoverageReq TsCoverageReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCoverageReq -> TsCoverageReq
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 TsCoverageReq TsCoverageReq FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  TsCoverageReq TsCoverageReq (Vector ByteString) (Vector ByteString)
-> Vector ByteString -> TsCoverageReq -> TsCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'unavailableCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'unavailableCover")
                              Vector ByteString
frozen'unavailableCover
                              TsCoverageReq
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do TsInterpolation
y <- Parser TsInterpolation -> String -> Parser TsInterpolation
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser TsInterpolation -> Parser TsInterpolation
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 TsInterpolation
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"query"
                                TsCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser TsCoverageReq
loop
                                  (Setter TsCoverageReq TsCoverageReq TsInterpolation TsInterpolation
-> TsInterpolation -> TsCoverageReq -> TsCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "query" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"query") TsInterpolation
y TsCoverageReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
                        Word64
18
                          -> 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
"table"
                                TsCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser TsCoverageReq
loop
                                  (Setter TsCoverageReq TsCoverageReq ByteString ByteString
-> ByteString -> TsCoverageReq -> TsCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") ByteString
y TsCoverageReq
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
                        Word64
26
                          -> 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
"replace_cover"
                                TsCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser TsCoverageReq
loop
                                  (Setter TsCoverageReq TsCoverageReq ByteString ByteString
-> ByteString -> TsCoverageReq -> TsCoverageReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "replaceCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"replaceCover") ByteString
y TsCoverageReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
                        Word64
34
                          -> 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
"unavailable_cover"
                                Growing Vector RealWorld ByteString
v <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) ByteString
-> ByteString -> IO (Growing Vector (PrimState IO) ByteString)
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 ByteString
Growing Vector (PrimState IO) ByteString
mutable'unavailableCover ByteString
y)
                                TsCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser TsCoverageReq
loop TsCoverageReq
x Bool
required'table Growing Vector RealWorld ByteString
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser TsCoverageReq
loop
                                  (Setter TsCoverageReq TsCoverageReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCoverageReq -> TsCoverageReq
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 TsCoverageReq TsCoverageReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsCoverageReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld ByteString
mutable'unavailableCover
      in
        Parser TsCoverageReq -> String -> Parser TsCoverageReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld ByteString
mutable'unavailableCover <- IO (Growing Vector RealWorld ByteString)
-> Parser (Growing Vector RealWorld ByteString)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                            IO (Growing Vector RealWorld ByteString)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsCoverageReq
-> Bool
-> Growing Vector RealWorld ByteString
-> Parser TsCoverageReq
loop
                TsCoverageReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Growing Vector RealWorld ByteString
mutable'unavailableCover)
          String
"TsCoverageReq"
  buildMessage :: TsCoverageReq -> Builder
buildMessage
    = \ TsCoverageReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe TsInterpolation)
  TsCoverageReq
  TsCoverageReq
  (Maybe TsInterpolation)
  (Maybe TsInterpolation)
-> TsCoverageReq -> Maybe TsInterpolation
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'query" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'query") TsCoverageReq
_x
              of
                Maybe TsInterpolation
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just TsInterpolation
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (TsInterpolation -> ByteString) -> TsInterpolation -> 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))
                          TsInterpolation -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                          TsInterpolation
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                   ((\ 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))
                      (FoldLike
  ByteString TsCoverageReq TsCoverageReq ByteString ByteString
-> TsCoverageReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") TsCoverageReq
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  TsCoverageReq
  TsCoverageReq
  (Maybe ByteString)
  (Maybe ByteString)
-> TsCoverageReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'replaceCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'replaceCover") TsCoverageReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      ((ByteString -> Builder) -> Vector ByteString -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                         (\ ByteString
_v
                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
34)
                                 ((\ 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))
                         (FoldLike
  (Vector ByteString)
  TsCoverageReq
  TsCoverageReq
  (Vector ByteString)
  (Vector ByteString)
-> TsCoverageReq -> Vector ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                            (forall s a (f :: * -> *).
(HasField s "vec'unavailableCover" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'unavailableCover") TsCoverageReq
_x))
                      (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                         (FoldLike FieldSet TsCoverageReq TsCoverageReq FieldSet FieldSet
-> TsCoverageReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsCoverageReq TsCoverageReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsCoverageReq
_x)))))
instance Control.DeepSeq.NFData TsCoverageReq where
  rnf :: TsCoverageReq -> ()
rnf
    = \ TsCoverageReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsCoverageReq -> FieldSet
_TsCoverageReq'_unknownFields TsCoverageReq
x__)
             (Maybe TsInterpolation -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsCoverageReq -> Maybe TsInterpolation
_TsCoverageReq'query TsCoverageReq
x__)
                (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsCoverageReq -> ByteString
_TsCoverageReq'table TsCoverageReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (TsCoverageReq -> Maybe ByteString
_TsCoverageReq'replaceCover TsCoverageReq
x__)
                      (Vector ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (TsCoverageReq -> Vector ByteString
_TsCoverageReq'unavailableCover TsCoverageReq
x__) ()))))
{- | Fields :
     
         * 'Proto.Riak_Fields.entries' @:: Lens' TsCoverageResp [TsCoverageEntry]@
         * 'Proto.Riak_Fields.vec'entries' @:: Lens' TsCoverageResp (Data.Vector.Vector TsCoverageEntry)@ -}
data TsCoverageResp
  = TsCoverageResp'_constructor {TsCoverageResp -> Vector TsCoverageEntry
_TsCoverageResp'entries :: !(Data.Vector.Vector TsCoverageEntry),
                                 TsCoverageResp -> FieldSet
_TsCoverageResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsCoverageResp -> TsCoverageResp -> Bool
(TsCoverageResp -> TsCoverageResp -> Bool)
-> (TsCoverageResp -> TsCoverageResp -> Bool) -> Eq TsCoverageResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsCoverageResp -> TsCoverageResp -> Bool
$c/= :: TsCoverageResp -> TsCoverageResp -> Bool
== :: TsCoverageResp -> TsCoverageResp -> Bool
$c== :: TsCoverageResp -> TsCoverageResp -> Bool
Prelude.Eq, Eq TsCoverageResp
Eq TsCoverageResp
-> (TsCoverageResp -> TsCoverageResp -> Ordering)
-> (TsCoverageResp -> TsCoverageResp -> Bool)
-> (TsCoverageResp -> TsCoverageResp -> Bool)
-> (TsCoverageResp -> TsCoverageResp -> Bool)
-> (TsCoverageResp -> TsCoverageResp -> Bool)
-> (TsCoverageResp -> TsCoverageResp -> TsCoverageResp)
-> (TsCoverageResp -> TsCoverageResp -> TsCoverageResp)
-> Ord TsCoverageResp
TsCoverageResp -> TsCoverageResp -> Bool
TsCoverageResp -> TsCoverageResp -> Ordering
TsCoverageResp -> TsCoverageResp -> TsCoverageResp
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 :: TsCoverageResp -> TsCoverageResp -> TsCoverageResp
$cmin :: TsCoverageResp -> TsCoverageResp -> TsCoverageResp
max :: TsCoverageResp -> TsCoverageResp -> TsCoverageResp
$cmax :: TsCoverageResp -> TsCoverageResp -> TsCoverageResp
>= :: TsCoverageResp -> TsCoverageResp -> Bool
$c>= :: TsCoverageResp -> TsCoverageResp -> Bool
> :: TsCoverageResp -> TsCoverageResp -> Bool
$c> :: TsCoverageResp -> TsCoverageResp -> Bool
<= :: TsCoverageResp -> TsCoverageResp -> Bool
$c<= :: TsCoverageResp -> TsCoverageResp -> Bool
< :: TsCoverageResp -> TsCoverageResp -> Bool
$c< :: TsCoverageResp -> TsCoverageResp -> Bool
compare :: TsCoverageResp -> TsCoverageResp -> Ordering
$ccompare :: TsCoverageResp -> TsCoverageResp -> Ordering
$cp1Ord :: Eq TsCoverageResp
Prelude.Ord)
instance Prelude.Show TsCoverageResp where
  showsPrec :: Int -> TsCoverageResp -> ShowS
showsPrec Int
_ TsCoverageResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsCoverageResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsCoverageResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsCoverageResp "entries" [TsCoverageEntry] where
  fieldOf :: Proxy# "entries"
-> ([TsCoverageEntry] -> f [TsCoverageEntry])
-> TsCoverageResp
-> f TsCoverageResp
fieldOf Proxy# "entries"
_
    = ((Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
 -> TsCoverageResp -> f TsCoverageResp)
-> (([TsCoverageEntry] -> f [TsCoverageEntry])
    -> Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
-> ([TsCoverageEntry] -> f [TsCoverageEntry])
-> TsCoverageResp
-> f TsCoverageResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageResp -> Vector TsCoverageEntry)
-> (TsCoverageResp -> Vector TsCoverageEntry -> TsCoverageResp)
-> Lens
     TsCoverageResp
     TsCoverageResp
     (Vector TsCoverageEntry)
     (Vector TsCoverageEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageResp -> Vector TsCoverageEntry
_TsCoverageResp'entries
           (\ TsCoverageResp
x__ Vector TsCoverageEntry
y__ -> TsCoverageResp
x__ {_TsCoverageResp'entries :: Vector TsCoverageEntry
_TsCoverageResp'entries = Vector TsCoverageEntry
y__}))
        ((Vector TsCoverageEntry -> [TsCoverageEntry])
-> (Vector TsCoverageEntry
    -> [TsCoverageEntry] -> Vector TsCoverageEntry)
-> Lens
     (Vector TsCoverageEntry)
     (Vector TsCoverageEntry)
     [TsCoverageEntry]
     [TsCoverageEntry]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsCoverageEntry -> [TsCoverageEntry]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsCoverageEntry
_ [TsCoverageEntry]
y__ -> [TsCoverageEntry] -> Vector TsCoverageEntry
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsCoverageEntry]
y__))
instance Data.ProtoLens.Field.HasField TsCoverageResp "vec'entries" (Data.Vector.Vector TsCoverageEntry) where
  fieldOf :: Proxy# "vec'entries"
-> (Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
-> TsCoverageResp
-> f TsCoverageResp
fieldOf Proxy# "vec'entries"
_
    = ((Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
 -> TsCoverageResp -> f TsCoverageResp)
-> ((Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
    -> Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
-> (Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
-> TsCoverageResp
-> f TsCoverageResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsCoverageResp -> Vector TsCoverageEntry)
-> (TsCoverageResp -> Vector TsCoverageEntry -> TsCoverageResp)
-> Lens
     TsCoverageResp
     TsCoverageResp
     (Vector TsCoverageEntry)
     (Vector TsCoverageEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsCoverageResp -> Vector TsCoverageEntry
_TsCoverageResp'entries
           (\ TsCoverageResp
x__ Vector TsCoverageEntry
y__ -> TsCoverageResp
x__ {_TsCoverageResp'entries :: Vector TsCoverageEntry
_TsCoverageResp'entries = Vector TsCoverageEntry
y__}))
        (Vector TsCoverageEntry -> f (Vector TsCoverageEntry))
-> Vector TsCoverageEntry -> f (Vector TsCoverageEntry)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsCoverageResp where
  messageName :: Proxy TsCoverageResp -> Text
messageName Proxy TsCoverageResp
_ = String -> Text
Data.Text.pack String
"TsCoverageResp"
  packedMessageDescriptor :: Proxy TsCoverageResp -> ByteString
packedMessageDescriptor Proxy TsCoverageResp
_
    = ByteString
"\n\
      \\SOTsCoverageResp\DC2*\n\
      \\aentries\CAN\SOH \ETX(\v2\DLE.TsCoverageEntryR\aentries"
  packedFileDescriptor :: Proxy TsCoverageResp -> ByteString
packedFileDescriptor Proxy TsCoverageResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsCoverageResp)
fieldsByTag
    = let
        entries__field_descriptor :: FieldDescriptor TsCoverageResp
entries__field_descriptor
          = String
-> FieldTypeDescriptor TsCoverageEntry
-> FieldAccessor TsCoverageResp TsCoverageEntry
-> FieldDescriptor TsCoverageResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"entries"
              (MessageOrGroup -> FieldTypeDescriptor TsCoverageEntry
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsCoverageEntry)
              (Packing
-> Lens' TsCoverageResp [TsCoverageEntry]
-> FieldAccessor TsCoverageResp TsCoverageEntry
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "entries" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"entries")) ::
              Data.ProtoLens.FieldDescriptor TsCoverageResp
      in
        [(Tag, FieldDescriptor TsCoverageResp)]
-> Map Tag (FieldDescriptor TsCoverageResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsCoverageResp
entries__field_descriptor)]
  unknownFields :: LensLike' f TsCoverageResp FieldSet
unknownFields
    = (TsCoverageResp -> FieldSet)
-> (TsCoverageResp -> FieldSet -> TsCoverageResp)
-> Lens' TsCoverageResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsCoverageResp -> FieldSet
_TsCoverageResp'_unknownFields
        (\ TsCoverageResp
x__ FieldSet
y__ -> TsCoverageResp
x__ {_TsCoverageResp'_unknownFields :: FieldSet
_TsCoverageResp'_unknownFields = FieldSet
y__})
  defMessage :: TsCoverageResp
defMessage
    = TsCoverageResp'_constructor :: Vector TsCoverageEntry -> FieldSet -> TsCoverageResp
TsCoverageResp'_constructor
        {_TsCoverageResp'entries :: Vector TsCoverageEntry
_TsCoverageResp'entries = Vector TsCoverageEntry
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsCoverageResp'_unknownFields :: FieldSet
_TsCoverageResp'_unknownFields = []}
  parseMessage :: Parser TsCoverageResp
parseMessage
    = let
        loop ::
          TsCoverageResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsCoverageEntry
             -> Data.ProtoLens.Encoding.Bytes.Parser TsCoverageResp
        loop :: TsCoverageResp
-> Growing Vector RealWorld TsCoverageEntry
-> Parser TsCoverageResp
loop TsCoverageResp
x Growing Vector RealWorld TsCoverageEntry
mutable'entries
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsCoverageEntry
frozen'entries <- IO (Vector TsCoverageEntry) -> Parser (Vector TsCoverageEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) TsCoverageEntry
-> IO (Vector TsCoverageEntry)
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 TsCoverageEntry
Growing Vector (PrimState IO) TsCoverageEntry
mutable'entries)
                      (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]))))
                      TsCoverageResp -> Parser TsCoverageResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsCoverageResp TsCoverageResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCoverageResp -> TsCoverageResp
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 TsCoverageResp TsCoverageResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  TsCoverageResp
  TsCoverageResp
  (Vector TsCoverageEntry)
  (Vector TsCoverageEntry)
-> Vector TsCoverageEntry -> TsCoverageResp -> TsCoverageResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'entries" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'entries") Vector TsCoverageEntry
frozen'entries TsCoverageResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !TsCoverageEntry
y <- Parser TsCoverageEntry -> String -> Parser TsCoverageEntry
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsCoverageEntry -> Parser TsCoverageEntry
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 TsCoverageEntry
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"entries"
                                Growing Vector RealWorld TsCoverageEntry
v <- IO (Growing Vector RealWorld TsCoverageEntry)
-> Parser (Growing Vector RealWorld TsCoverageEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsCoverageEntry
-> TsCoverageEntry
-> IO (Growing Vector (PrimState IO) TsCoverageEntry)
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 TsCoverageEntry
Growing Vector (PrimState IO) TsCoverageEntry
mutable'entries TsCoverageEntry
y)
                                TsCoverageResp
-> Growing Vector RealWorld TsCoverageEntry
-> Parser TsCoverageResp
loop TsCoverageResp
x Growing Vector RealWorld TsCoverageEntry
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsCoverageResp
-> Growing Vector RealWorld TsCoverageEntry
-> Parser TsCoverageResp
loop
                                  (Setter TsCoverageResp TsCoverageResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsCoverageResp -> TsCoverageResp
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 TsCoverageResp TsCoverageResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsCoverageResp
x)
                                  Growing Vector RealWorld TsCoverageEntry
mutable'entries
      in
        Parser TsCoverageResp -> String -> Parser TsCoverageResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsCoverageEntry
mutable'entries <- IO (Growing Vector RealWorld TsCoverageEntry)
-> Parser (Growing Vector RealWorld TsCoverageEntry)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld TsCoverageEntry)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsCoverageResp
-> Growing Vector RealWorld TsCoverageEntry
-> Parser TsCoverageResp
loop TsCoverageResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld TsCoverageEntry
mutable'entries)
          String
"TsCoverageResp"
  buildMessage :: TsCoverageResp -> Builder
buildMessage
    = \ TsCoverageResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((TsCoverageEntry -> Builder) -> Vector TsCoverageEntry -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ TsCoverageEntry
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (TsCoverageEntry -> ByteString) -> TsCoverageEntry -> 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))
                           TsCoverageEntry -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           TsCoverageEntry
_v))
                (FoldLike
  (Vector TsCoverageEntry)
  TsCoverageResp
  TsCoverageResp
  (Vector TsCoverageEntry)
  (Vector TsCoverageEntry)
-> TsCoverageResp -> Vector TsCoverageEntry
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'entries" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'entries") TsCoverageResp
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet TsCoverageResp TsCoverageResp FieldSet FieldSet
-> TsCoverageResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsCoverageResp TsCoverageResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsCoverageResp
_x))
instance Control.DeepSeq.NFData TsCoverageResp where
  rnf :: TsCoverageResp -> ()
rnf
    = \ TsCoverageResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsCoverageResp -> FieldSet
_TsCoverageResp'_unknownFields TsCoverageResp
x__)
             (Vector TsCoverageEntry -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsCoverageResp -> Vector TsCoverageEntry
_TsCoverageResp'entries TsCoverageResp
x__) ())
{- | Fields :
     
         * 'Proto.Riak_Fields.table' @:: Lens' TsDelReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' TsDelReq [TsCell]@
         * 'Proto.Riak_Fields.vec'key' @:: Lens' TsDelReq (Data.Vector.Vector TsCell)@
         * 'Proto.Riak_Fields.vclock' @:: Lens' TsDelReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'vclock' @:: Lens' TsDelReq (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' TsDelReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' TsDelReq (Prelude.Maybe Data.Word.Word32)@ -}
data TsDelReq
  = TsDelReq'_constructor {TsDelReq -> ByteString
_TsDelReq'table :: !Data.ByteString.ByteString,
                           TsDelReq -> Vector TsCell
_TsDelReq'key :: !(Data.Vector.Vector TsCell),
                           TsDelReq -> Maybe ByteString
_TsDelReq'vclock :: !(Prelude.Maybe Data.ByteString.ByteString),
                           TsDelReq -> Maybe Word32
_TsDelReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                           TsDelReq -> FieldSet
_TsDelReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsDelReq -> TsDelReq -> Bool
(TsDelReq -> TsDelReq -> Bool)
-> (TsDelReq -> TsDelReq -> Bool) -> Eq TsDelReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsDelReq -> TsDelReq -> Bool
$c/= :: TsDelReq -> TsDelReq -> Bool
== :: TsDelReq -> TsDelReq -> Bool
$c== :: TsDelReq -> TsDelReq -> Bool
Prelude.Eq, Eq TsDelReq
Eq TsDelReq
-> (TsDelReq -> TsDelReq -> Ordering)
-> (TsDelReq -> TsDelReq -> Bool)
-> (TsDelReq -> TsDelReq -> Bool)
-> (TsDelReq -> TsDelReq -> Bool)
-> (TsDelReq -> TsDelReq -> Bool)
-> (TsDelReq -> TsDelReq -> TsDelReq)
-> (TsDelReq -> TsDelReq -> TsDelReq)
-> Ord TsDelReq
TsDelReq -> TsDelReq -> Bool
TsDelReq -> TsDelReq -> Ordering
TsDelReq -> TsDelReq -> TsDelReq
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 :: TsDelReq -> TsDelReq -> TsDelReq
$cmin :: TsDelReq -> TsDelReq -> TsDelReq
max :: TsDelReq -> TsDelReq -> TsDelReq
$cmax :: TsDelReq -> TsDelReq -> TsDelReq
>= :: TsDelReq -> TsDelReq -> Bool
$c>= :: TsDelReq -> TsDelReq -> Bool
> :: TsDelReq -> TsDelReq -> Bool
$c> :: TsDelReq -> TsDelReq -> Bool
<= :: TsDelReq -> TsDelReq -> Bool
$c<= :: TsDelReq -> TsDelReq -> Bool
< :: TsDelReq -> TsDelReq -> Bool
$c< :: TsDelReq -> TsDelReq -> Bool
compare :: TsDelReq -> TsDelReq -> Ordering
$ccompare :: TsDelReq -> TsDelReq -> Ordering
$cp1Ord :: Eq TsDelReq
Prelude.Ord)
instance Prelude.Show TsDelReq where
  showsPrec :: Int -> TsDelReq -> ShowS
showsPrec Int
_ TsDelReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsDelReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsDelReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsDelReq "table" Data.ByteString.ByteString where
  fieldOf :: Proxy# "table"
-> (ByteString -> f ByteString) -> TsDelReq -> f TsDelReq
fieldOf Proxy# "table"
_
    = ((ByteString -> f ByteString) -> TsDelReq -> f TsDelReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsDelReq
-> f TsDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsDelReq -> ByteString)
-> (TsDelReq -> ByteString -> TsDelReq)
-> Lens TsDelReq TsDelReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsDelReq -> ByteString
_TsDelReq'table (\ TsDelReq
x__ ByteString
y__ -> TsDelReq
x__ {_TsDelReq'table :: ByteString
_TsDelReq'table = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsDelReq "key" [TsCell] where
  fieldOf :: Proxy# "key" -> ([TsCell] -> f [TsCell]) -> TsDelReq -> f TsDelReq
fieldOf Proxy# "key"
_
    = ((Vector TsCell -> f (Vector TsCell)) -> TsDelReq -> f TsDelReq)
-> (([TsCell] -> f [TsCell]) -> Vector TsCell -> f (Vector TsCell))
-> ([TsCell] -> f [TsCell])
-> TsDelReq
-> f TsDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsDelReq -> Vector TsCell)
-> (TsDelReq -> Vector TsCell -> TsDelReq)
-> Lens TsDelReq TsDelReq (Vector TsCell) (Vector TsCell)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsDelReq -> Vector TsCell
_TsDelReq'key (\ TsDelReq
x__ Vector TsCell
y__ -> TsDelReq
x__ {_TsDelReq'key :: Vector TsCell
_TsDelReq'key = Vector TsCell
y__}))
        ((Vector TsCell -> [TsCell])
-> (Vector TsCell -> [TsCell] -> Vector TsCell)
-> Lens (Vector TsCell) (Vector TsCell) [TsCell] [TsCell]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsCell -> [TsCell]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsCell
_ [TsCell]
y__ -> [TsCell] -> Vector TsCell
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsCell]
y__))
instance Data.ProtoLens.Field.HasField TsDelReq "vec'key" (Data.Vector.Vector TsCell) where
  fieldOf :: Proxy# "vec'key"
-> (Vector TsCell -> f (Vector TsCell)) -> TsDelReq -> f TsDelReq
fieldOf Proxy# "vec'key"
_
    = ((Vector TsCell -> f (Vector TsCell)) -> TsDelReq -> f TsDelReq)
-> ((Vector TsCell -> f (Vector TsCell))
    -> Vector TsCell -> f (Vector TsCell))
-> (Vector TsCell -> f (Vector TsCell))
-> TsDelReq
-> f TsDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsDelReq -> Vector TsCell)
-> (TsDelReq -> Vector TsCell -> TsDelReq)
-> Lens TsDelReq TsDelReq (Vector TsCell) (Vector TsCell)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsDelReq -> Vector TsCell
_TsDelReq'key (\ TsDelReq
x__ Vector TsCell
y__ -> TsDelReq
x__ {_TsDelReq'key :: Vector TsCell
_TsDelReq'key = Vector TsCell
y__}))
        (Vector TsCell -> f (Vector TsCell))
-> Vector TsCell -> f (Vector TsCell)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsDelReq "vclock" Data.ByteString.ByteString where
  fieldOf :: Proxy# "vclock"
-> (ByteString -> f ByteString) -> TsDelReq -> f TsDelReq
fieldOf Proxy# "vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> TsDelReq -> f TsDelReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> TsDelReq
-> f TsDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsDelReq -> Maybe ByteString)
-> (TsDelReq -> Maybe ByteString -> TsDelReq)
-> Lens TsDelReq TsDelReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsDelReq -> Maybe ByteString
_TsDelReq'vclock (\ TsDelReq
x__ Maybe ByteString
y__ -> TsDelReq
x__ {_TsDelReq'vclock :: Maybe ByteString
_TsDelReq'vclock = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsDelReq "maybe'vclock" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'vclock"
-> (Maybe ByteString -> f (Maybe ByteString))
-> TsDelReq
-> f TsDelReq
fieldOf Proxy# "maybe'vclock"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> TsDelReq -> f TsDelReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> TsDelReq
-> f TsDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsDelReq -> Maybe ByteString)
-> (TsDelReq -> Maybe ByteString -> TsDelReq)
-> Lens TsDelReq TsDelReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsDelReq -> Maybe ByteString
_TsDelReq'vclock (\ TsDelReq
x__ Maybe ByteString
y__ -> TsDelReq
x__ {_TsDelReq'vclock :: Maybe ByteString
_TsDelReq'vclock = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsDelReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout" -> (Word32 -> f Word32) -> TsDelReq -> f TsDelReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> TsDelReq -> f TsDelReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> TsDelReq
-> f TsDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsDelReq -> Maybe Word32)
-> (TsDelReq -> Maybe Word32 -> TsDelReq)
-> Lens TsDelReq TsDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsDelReq -> Maybe Word32
_TsDelReq'timeout (\ TsDelReq
x__ Maybe Word32
y__ -> TsDelReq
x__ {_TsDelReq'timeout :: Maybe Word32
_TsDelReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsDelReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32)) -> TsDelReq -> f TsDelReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> TsDelReq -> f TsDelReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> TsDelReq
-> f TsDelReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsDelReq -> Maybe Word32)
-> (TsDelReq -> Maybe Word32 -> TsDelReq)
-> Lens TsDelReq TsDelReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsDelReq -> Maybe Word32
_TsDelReq'timeout (\ TsDelReq
x__ Maybe Word32
y__ -> TsDelReq
x__ {_TsDelReq'timeout :: Maybe Word32
_TsDelReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsDelReq where
  messageName :: Proxy TsDelReq -> Text
messageName Proxy TsDelReq
_ = String -> Text
Data.Text.pack String
"TsDelReq"
  packedMessageDescriptor :: Proxy TsDelReq -> ByteString
packedMessageDescriptor Proxy TsDelReq
_
    = ByteString
"\n\
      \\bTsDelReq\DC2\DC4\n\
      \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2\EM\n\
      \\ETXkey\CAN\STX \ETX(\v2\a.TsCellR\ETXkey\DC2\SYN\n\
      \\ACKvclock\CAN\ETX \SOH(\fR\ACKvclock\DC2\CAN\n\
      \\atimeout\CAN\EOT \SOH(\rR\atimeout"
  packedFileDescriptor :: Proxy TsDelReq -> ByteString
packedFileDescriptor Proxy TsDelReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsDelReq)
fieldsByTag
    = let
        table__field_descriptor :: FieldDescriptor TsDelReq
table__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsDelReq ByteString
-> FieldDescriptor TsDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"table"
              (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 TsDelReq TsDelReq ByteString ByteString
-> FieldAccessor TsDelReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table")) ::
              Data.ProtoLens.FieldDescriptor TsDelReq
        key__field_descriptor :: FieldDescriptor TsDelReq
key__field_descriptor
          = String
-> FieldTypeDescriptor TsCell
-> FieldAccessor TsDelReq TsCell
-> FieldDescriptor TsDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (MessageOrGroup -> FieldTypeDescriptor TsCell
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsCell)
              (Packing -> Lens' TsDelReq [TsCell] -> FieldAccessor TsDelReq TsCell
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor TsDelReq
        vclock__field_descriptor :: FieldDescriptor TsDelReq
vclock__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsDelReq ByteString
-> FieldDescriptor TsDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"vclock"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens TsDelReq TsDelReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor TsDelReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock")) ::
              Data.ProtoLens.FieldDescriptor TsDelReq
        timeout__field_descriptor :: FieldDescriptor TsDelReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor TsDelReq Word32
-> FieldDescriptor TsDelReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens TsDelReq TsDelReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor TsDelReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor TsDelReq
      in
        [(Tag, FieldDescriptor TsDelReq)]
-> Map Tag (FieldDescriptor TsDelReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsDelReq
table__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsDelReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsDelReq
vclock__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor TsDelReq
timeout__field_descriptor)]
  unknownFields :: LensLike' f TsDelReq FieldSet
unknownFields
    = (TsDelReq -> FieldSet)
-> (TsDelReq -> FieldSet -> TsDelReq) -> Lens' TsDelReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsDelReq -> FieldSet
_TsDelReq'_unknownFields
        (\ TsDelReq
x__ FieldSet
y__ -> TsDelReq
x__ {_TsDelReq'_unknownFields :: FieldSet
_TsDelReq'_unknownFields = FieldSet
y__})
  defMessage :: TsDelReq
defMessage
    = TsDelReq'_constructor :: ByteString
-> Vector TsCell
-> Maybe ByteString
-> Maybe Word32
-> FieldSet
-> TsDelReq
TsDelReq'_constructor
        {_TsDelReq'table :: ByteString
_TsDelReq'table = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsDelReq'key :: Vector TsCell
_TsDelReq'key = Vector TsCell
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsDelReq'vclock :: Maybe ByteString
_TsDelReq'vclock = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _TsDelReq'timeout :: Maybe Word32
_TsDelReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _TsDelReq'_unknownFields :: FieldSet
_TsDelReq'_unknownFields = []}
  parseMessage :: Parser TsDelReq
parseMessage
    = let
        loop ::
          TsDelReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsCell
                -> Data.ProtoLens.Encoding.Bytes.Parser TsDelReq
        loop :: TsDelReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsDelReq
loop TsDelReq
x Bool
required'table Growing Vector RealWorld TsCell
mutable'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsCell
frozen'key <- IO (Vector TsCell) -> Parser (Vector TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                      (Growing Vector (PrimState IO) TsCell -> IO (Vector TsCell)
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 TsCell
Growing Vector (PrimState IO) TsCell
mutable'key)
                      (let
                         missing :: [String]
missing = (if Bool
required'table then (:) String
"table" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsDelReq -> Parser TsDelReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsDelReq TsDelReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsDelReq -> TsDelReq
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 TsDelReq TsDelReq FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter TsDelReq TsDelReq (Vector TsCell) (Vector TsCell)
-> Vector TsCell -> TsDelReq -> TsDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'key") Vector TsCell
frozen'key TsDelReq
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
"table"
                                TsDelReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsDelReq
loop
                                  (Setter TsDelReq TsDelReq ByteString ByteString
-> ByteString -> TsDelReq -> TsDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") ByteString
y TsDelReq
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld TsCell
mutable'key
                        Word64
18
                          -> do !TsCell
y <- Parser TsCell -> String -> Parser TsCell
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsCell -> Parser TsCell
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 TsCell
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"key"
                                Growing Vector RealWorld TsCell
v <- IO (Growing Vector RealWorld TsCell)
-> Parser (Growing Vector RealWorld TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsCell
-> TsCell -> IO (Growing Vector (PrimState IO) TsCell)
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 TsCell
Growing Vector (PrimState IO) TsCell
mutable'key TsCell
y)
                                TsDelReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsDelReq
loop TsDelReq
x Bool
required'table Growing Vector RealWorld TsCell
v
                        Word64
26
                          -> 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
"vclock"
                                TsDelReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsDelReq
loop
                                  (Setter TsDelReq TsDelReq ByteString ByteString
-> ByteString -> TsDelReq -> TsDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vclock") ByteString
y TsDelReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld TsCell
mutable'key
                        Word64
32
                          -> 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
"timeout"
                                TsDelReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsDelReq
loop
                                  (Setter TsDelReq TsDelReq Word32 Word32
-> Word32 -> TsDelReq -> TsDelReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y TsDelReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld TsCell
mutable'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsDelReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsDelReq
loop
                                  (Setter TsDelReq TsDelReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsDelReq -> TsDelReq
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 TsDelReq TsDelReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsDelReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld TsCell
mutable'key
      in
        Parser TsDelReq -> String -> Parser TsDelReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsCell
mutable'key <- IO (Growing Vector RealWorld TsCell)
-> Parser (Growing Vector RealWorld TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                               IO (Growing Vector RealWorld TsCell)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsDelReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsDelReq
loop TsDelReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Growing Vector RealWorld TsCell
mutable'key)
          String
"TsDelReq"
  buildMessage :: TsDelReq -> Builder
buildMessage
    = \ TsDelReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString TsDelReq TsDelReq ByteString ByteString
-> TsDelReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") TsDelReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((TsCell -> Builder) -> Vector TsCell -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ TsCell
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (TsCell -> ByteString) -> TsCell -> 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))
                              TsCell -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              TsCell
_v))
                   (FoldLike
  (Vector TsCell) TsDelReq TsDelReq (Vector TsCell) (Vector TsCell)
-> TsDelReq -> Vector TsCell
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'key") TsDelReq
_x))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  TsDelReq
  TsDelReq
  (Maybe ByteString)
  (Maybe ByteString)
-> TsDelReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'vclock" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'vclock") TsDelReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (case
                           FoldLike
  (Maybe Word32) TsDelReq TsDelReq (Maybe Word32) (Maybe Word32)
-> TsDelReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") TsDelReq
_x
                       of
                         Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                         (Prelude.Just Word32
_v)
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                                ((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 TsDelReq TsDelReq FieldSet FieldSet
-> TsDelReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsDelReq TsDelReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsDelReq
_x)))))
instance Control.DeepSeq.NFData TsDelReq where
  rnf :: TsDelReq -> ()
rnf
    = \ TsDelReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsDelReq -> FieldSet
_TsDelReq'_unknownFields TsDelReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsDelReq -> ByteString
_TsDelReq'table TsDelReq
x__)
                (Vector TsCell -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsDelReq -> Vector TsCell
_TsDelReq'key TsDelReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (TsDelReq -> Maybe ByteString
_TsDelReq'vclock TsDelReq
x__)
                      (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsDelReq -> Maybe Word32
_TsDelReq'timeout TsDelReq
x__) ()))))
{- | Fields :
      -}
data TsDelResp
  = TsDelResp'_constructor {TsDelResp -> FieldSet
_TsDelResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsDelResp -> TsDelResp -> Bool
(TsDelResp -> TsDelResp -> Bool)
-> (TsDelResp -> TsDelResp -> Bool) -> Eq TsDelResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsDelResp -> TsDelResp -> Bool
$c/= :: TsDelResp -> TsDelResp -> Bool
== :: TsDelResp -> TsDelResp -> Bool
$c== :: TsDelResp -> TsDelResp -> Bool
Prelude.Eq, Eq TsDelResp
Eq TsDelResp
-> (TsDelResp -> TsDelResp -> Ordering)
-> (TsDelResp -> TsDelResp -> Bool)
-> (TsDelResp -> TsDelResp -> Bool)
-> (TsDelResp -> TsDelResp -> Bool)
-> (TsDelResp -> TsDelResp -> Bool)
-> (TsDelResp -> TsDelResp -> TsDelResp)
-> (TsDelResp -> TsDelResp -> TsDelResp)
-> Ord TsDelResp
TsDelResp -> TsDelResp -> Bool
TsDelResp -> TsDelResp -> Ordering
TsDelResp -> TsDelResp -> TsDelResp
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 :: TsDelResp -> TsDelResp -> TsDelResp
$cmin :: TsDelResp -> TsDelResp -> TsDelResp
max :: TsDelResp -> TsDelResp -> TsDelResp
$cmax :: TsDelResp -> TsDelResp -> TsDelResp
>= :: TsDelResp -> TsDelResp -> Bool
$c>= :: TsDelResp -> TsDelResp -> Bool
> :: TsDelResp -> TsDelResp -> Bool
$c> :: TsDelResp -> TsDelResp -> Bool
<= :: TsDelResp -> TsDelResp -> Bool
$c<= :: TsDelResp -> TsDelResp -> Bool
< :: TsDelResp -> TsDelResp -> Bool
$c< :: TsDelResp -> TsDelResp -> Bool
compare :: TsDelResp -> TsDelResp -> Ordering
$ccompare :: TsDelResp -> TsDelResp -> Ordering
$cp1Ord :: Eq TsDelResp
Prelude.Ord)
instance Prelude.Show TsDelResp where
  showsPrec :: Int -> TsDelResp -> ShowS
showsPrec Int
_ TsDelResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsDelResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsDelResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message TsDelResp where
  messageName :: Proxy TsDelResp -> Text
messageName Proxy TsDelResp
_ = String -> Text
Data.Text.pack String
"TsDelResp"
  packedMessageDescriptor :: Proxy TsDelResp -> ByteString
packedMessageDescriptor Proxy TsDelResp
_
    = ByteString
"\n\
      \\tTsDelResp"
  packedFileDescriptor :: Proxy TsDelResp -> ByteString
packedFileDescriptor Proxy TsDelResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsDelResp)
fieldsByTag = let in [(Tag, FieldDescriptor TsDelResp)]
-> Map Tag (FieldDescriptor TsDelResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f TsDelResp FieldSet
unknownFields
    = (TsDelResp -> FieldSet)
-> (TsDelResp -> FieldSet -> TsDelResp) -> Lens' TsDelResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsDelResp -> FieldSet
_TsDelResp'_unknownFields
        (\ TsDelResp
x__ FieldSet
y__ -> TsDelResp
x__ {_TsDelResp'_unknownFields :: FieldSet
_TsDelResp'_unknownFields = FieldSet
y__})
  defMessage :: TsDelResp
defMessage
    = TsDelResp'_constructor :: FieldSet -> TsDelResp
TsDelResp'_constructor {_TsDelResp'_unknownFields :: FieldSet
_TsDelResp'_unknownFields = []}
  parseMessage :: Parser TsDelResp
parseMessage
    = let
        loop :: TsDelResp -> Data.ProtoLens.Encoding.Bytes.Parser TsDelResp
        loop :: TsDelResp -> Parser TsDelResp
loop TsDelResp
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]))))
                      TsDelResp -> Parser TsDelResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsDelResp TsDelResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsDelResp -> TsDelResp
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 TsDelResp TsDelResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsDelResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsDelResp -> Parser TsDelResp
loop
                                  (Setter TsDelResp TsDelResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsDelResp -> TsDelResp
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 TsDelResp TsDelResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsDelResp
x) }
      in
        Parser TsDelResp -> String -> Parser TsDelResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsDelResp -> Parser TsDelResp
loop TsDelResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"TsDelResp"
  buildMessage :: TsDelResp -> Builder
buildMessage
    = \ TsDelResp
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike FieldSet TsDelResp TsDelResp FieldSet FieldSet
-> TsDelResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsDelResp TsDelResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsDelResp
_x)
instance Control.DeepSeq.NFData TsDelResp where
  rnf :: TsDelResp -> ()
rnf
    = \ TsDelResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsDelResp -> FieldSet
_TsDelResp'_unknownFields TsDelResp
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.table' @:: Lens' TsGetReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.key' @:: Lens' TsGetReq [TsCell]@
         * 'Proto.Riak_Fields.vec'key' @:: Lens' TsGetReq (Data.Vector.Vector TsCell)@
         * 'Proto.Riak_Fields.timeout' @:: Lens' TsGetReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' TsGetReq (Prelude.Maybe Data.Word.Word32)@ -}
data TsGetReq
  = TsGetReq'_constructor {TsGetReq -> ByteString
_TsGetReq'table :: !Data.ByteString.ByteString,
                           TsGetReq -> Vector TsCell
_TsGetReq'key :: !(Data.Vector.Vector TsCell),
                           TsGetReq -> Maybe Word32
_TsGetReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                           TsGetReq -> FieldSet
_TsGetReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsGetReq -> TsGetReq -> Bool
(TsGetReq -> TsGetReq -> Bool)
-> (TsGetReq -> TsGetReq -> Bool) -> Eq TsGetReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsGetReq -> TsGetReq -> Bool
$c/= :: TsGetReq -> TsGetReq -> Bool
== :: TsGetReq -> TsGetReq -> Bool
$c== :: TsGetReq -> TsGetReq -> Bool
Prelude.Eq, Eq TsGetReq
Eq TsGetReq
-> (TsGetReq -> TsGetReq -> Ordering)
-> (TsGetReq -> TsGetReq -> Bool)
-> (TsGetReq -> TsGetReq -> Bool)
-> (TsGetReq -> TsGetReq -> Bool)
-> (TsGetReq -> TsGetReq -> Bool)
-> (TsGetReq -> TsGetReq -> TsGetReq)
-> (TsGetReq -> TsGetReq -> TsGetReq)
-> Ord TsGetReq
TsGetReq -> TsGetReq -> Bool
TsGetReq -> TsGetReq -> Ordering
TsGetReq -> TsGetReq -> TsGetReq
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 :: TsGetReq -> TsGetReq -> TsGetReq
$cmin :: TsGetReq -> TsGetReq -> TsGetReq
max :: TsGetReq -> TsGetReq -> TsGetReq
$cmax :: TsGetReq -> TsGetReq -> TsGetReq
>= :: TsGetReq -> TsGetReq -> Bool
$c>= :: TsGetReq -> TsGetReq -> Bool
> :: TsGetReq -> TsGetReq -> Bool
$c> :: TsGetReq -> TsGetReq -> Bool
<= :: TsGetReq -> TsGetReq -> Bool
$c<= :: TsGetReq -> TsGetReq -> Bool
< :: TsGetReq -> TsGetReq -> Bool
$c< :: TsGetReq -> TsGetReq -> Bool
compare :: TsGetReq -> TsGetReq -> Ordering
$ccompare :: TsGetReq -> TsGetReq -> Ordering
$cp1Ord :: Eq TsGetReq
Prelude.Ord)
instance Prelude.Show TsGetReq where
  showsPrec :: Int -> TsGetReq -> ShowS
showsPrec Int
_ TsGetReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsGetReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsGetReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsGetReq "table" Data.ByteString.ByteString where
  fieldOf :: Proxy# "table"
-> (ByteString -> f ByteString) -> TsGetReq -> f TsGetReq
fieldOf Proxy# "table"
_
    = ((ByteString -> f ByteString) -> TsGetReq -> f TsGetReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsGetReq
-> f TsGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetReq -> ByteString)
-> (TsGetReq -> ByteString -> TsGetReq)
-> Lens TsGetReq TsGetReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetReq -> ByteString
_TsGetReq'table (\ TsGetReq
x__ ByteString
y__ -> TsGetReq
x__ {_TsGetReq'table :: ByteString
_TsGetReq'table = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsGetReq "key" [TsCell] where
  fieldOf :: Proxy# "key" -> ([TsCell] -> f [TsCell]) -> TsGetReq -> f TsGetReq
fieldOf Proxy# "key"
_
    = ((Vector TsCell -> f (Vector TsCell)) -> TsGetReq -> f TsGetReq)
-> (([TsCell] -> f [TsCell]) -> Vector TsCell -> f (Vector TsCell))
-> ([TsCell] -> f [TsCell])
-> TsGetReq
-> f TsGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetReq -> Vector TsCell)
-> (TsGetReq -> Vector TsCell -> TsGetReq)
-> Lens TsGetReq TsGetReq (Vector TsCell) (Vector TsCell)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetReq -> Vector TsCell
_TsGetReq'key (\ TsGetReq
x__ Vector TsCell
y__ -> TsGetReq
x__ {_TsGetReq'key :: Vector TsCell
_TsGetReq'key = Vector TsCell
y__}))
        ((Vector TsCell -> [TsCell])
-> (Vector TsCell -> [TsCell] -> Vector TsCell)
-> Lens (Vector TsCell) (Vector TsCell) [TsCell] [TsCell]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsCell -> [TsCell]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsCell
_ [TsCell]
y__ -> [TsCell] -> Vector TsCell
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsCell]
y__))
instance Data.ProtoLens.Field.HasField TsGetReq "vec'key" (Data.Vector.Vector TsCell) where
  fieldOf :: Proxy# "vec'key"
-> (Vector TsCell -> f (Vector TsCell)) -> TsGetReq -> f TsGetReq
fieldOf Proxy# "vec'key"
_
    = ((Vector TsCell -> f (Vector TsCell)) -> TsGetReq -> f TsGetReq)
-> ((Vector TsCell -> f (Vector TsCell))
    -> Vector TsCell -> f (Vector TsCell))
-> (Vector TsCell -> f (Vector TsCell))
-> TsGetReq
-> f TsGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetReq -> Vector TsCell)
-> (TsGetReq -> Vector TsCell -> TsGetReq)
-> Lens TsGetReq TsGetReq (Vector TsCell) (Vector TsCell)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetReq -> Vector TsCell
_TsGetReq'key (\ TsGetReq
x__ Vector TsCell
y__ -> TsGetReq
x__ {_TsGetReq'key :: Vector TsCell
_TsGetReq'key = Vector TsCell
y__}))
        (Vector TsCell -> f (Vector TsCell))
-> Vector TsCell -> f (Vector TsCell)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsGetReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout" -> (Word32 -> f Word32) -> TsGetReq -> f TsGetReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> TsGetReq -> f TsGetReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> TsGetReq
-> f TsGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetReq -> Maybe Word32)
-> (TsGetReq -> Maybe Word32 -> TsGetReq)
-> Lens TsGetReq TsGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetReq -> Maybe Word32
_TsGetReq'timeout (\ TsGetReq
x__ Maybe Word32
y__ -> TsGetReq
x__ {_TsGetReq'timeout :: Maybe Word32
_TsGetReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsGetReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32)) -> TsGetReq -> f TsGetReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32)) -> TsGetReq -> f TsGetReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> TsGetReq
-> f TsGetReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetReq -> Maybe Word32)
-> (TsGetReq -> Maybe Word32 -> TsGetReq)
-> Lens TsGetReq TsGetReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetReq -> Maybe Word32
_TsGetReq'timeout (\ TsGetReq
x__ Maybe Word32
y__ -> TsGetReq
x__ {_TsGetReq'timeout :: Maybe Word32
_TsGetReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsGetReq where
  messageName :: Proxy TsGetReq -> Text
messageName Proxy TsGetReq
_ = String -> Text
Data.Text.pack String
"TsGetReq"
  packedMessageDescriptor :: Proxy TsGetReq -> ByteString
packedMessageDescriptor Proxy TsGetReq
_
    = ByteString
"\n\
      \\bTsGetReq\DC2\DC4\n\
      \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2\EM\n\
      \\ETXkey\CAN\STX \ETX(\v2\a.TsCellR\ETXkey\DC2\CAN\n\
      \\atimeout\CAN\ETX \SOH(\rR\atimeout"
  packedFileDescriptor :: Proxy TsGetReq -> ByteString
packedFileDescriptor Proxy TsGetReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsGetReq)
fieldsByTag
    = let
        table__field_descriptor :: FieldDescriptor TsGetReq
table__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsGetReq ByteString
-> FieldDescriptor TsGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"table"
              (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 TsGetReq TsGetReq ByteString ByteString
-> FieldAccessor TsGetReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table")) ::
              Data.ProtoLens.FieldDescriptor TsGetReq
        key__field_descriptor :: FieldDescriptor TsGetReq
key__field_descriptor
          = String
-> FieldTypeDescriptor TsCell
-> FieldAccessor TsGetReq TsCell
-> FieldDescriptor TsGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (MessageOrGroup -> FieldTypeDescriptor TsCell
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsCell)
              (Packing -> Lens' TsGetReq [TsCell] -> FieldAccessor TsGetReq TsCell
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor TsGetReq
        timeout__field_descriptor :: FieldDescriptor TsGetReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor TsGetReq Word32
-> FieldDescriptor TsGetReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens TsGetReq TsGetReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor TsGetReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor TsGetReq
      in
        [(Tag, FieldDescriptor TsGetReq)]
-> Map Tag (FieldDescriptor TsGetReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsGetReq
table__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsGetReq
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsGetReq
timeout__field_descriptor)]
  unknownFields :: LensLike' f TsGetReq FieldSet
unknownFields
    = (TsGetReq -> FieldSet)
-> (TsGetReq -> FieldSet -> TsGetReq) -> Lens' TsGetReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsGetReq -> FieldSet
_TsGetReq'_unknownFields
        (\ TsGetReq
x__ FieldSet
y__ -> TsGetReq
x__ {_TsGetReq'_unknownFields :: FieldSet
_TsGetReq'_unknownFields = FieldSet
y__})
  defMessage :: TsGetReq
defMessage
    = TsGetReq'_constructor :: ByteString -> Vector TsCell -> Maybe Word32 -> FieldSet -> TsGetReq
TsGetReq'_constructor
        {_TsGetReq'table :: ByteString
_TsGetReq'table = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsGetReq'key :: Vector TsCell
_TsGetReq'key = Vector TsCell
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsGetReq'timeout :: Maybe Word32
_TsGetReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing, _TsGetReq'_unknownFields :: FieldSet
_TsGetReq'_unknownFields = []}
  parseMessage :: Parser TsGetReq
parseMessage
    = let
        loop ::
          TsGetReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsCell
                -> Data.ProtoLens.Encoding.Bytes.Parser TsGetReq
        loop :: TsGetReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsGetReq
loop TsGetReq
x Bool
required'table Growing Vector RealWorld TsCell
mutable'key
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsCell
frozen'key <- IO (Vector TsCell) -> Parser (Vector TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                      (Growing Vector (PrimState IO) TsCell -> IO (Vector TsCell)
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 TsCell
Growing Vector (PrimState IO) TsCell
mutable'key)
                      (let
                         missing :: [String]
missing = (if Bool
required'table then (:) String
"table" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsGetReq -> Parser TsGetReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsGetReq TsGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsGetReq -> TsGetReq
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 TsGetReq TsGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter TsGetReq TsGetReq (Vector TsCell) (Vector TsCell)
-> Vector TsCell -> TsGetReq -> TsGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'key") Vector TsCell
frozen'key TsGetReq
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
"table"
                                TsGetReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsGetReq
loop
                                  (Setter TsGetReq TsGetReq ByteString ByteString
-> ByteString -> TsGetReq -> TsGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") ByteString
y TsGetReq
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld TsCell
mutable'key
                        Word64
18
                          -> do !TsCell
y <- Parser TsCell -> String -> Parser TsCell
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsCell -> Parser TsCell
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 TsCell
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"key"
                                Growing Vector RealWorld TsCell
v <- IO (Growing Vector RealWorld TsCell)
-> Parser (Growing Vector RealWorld TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsCell
-> TsCell -> IO (Growing Vector (PrimState IO) TsCell)
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 TsCell
Growing Vector (PrimState IO) TsCell
mutable'key TsCell
y)
                                TsGetReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsGetReq
loop TsGetReq
x Bool
required'table Growing Vector RealWorld TsCell
v
                        Word64
24
                          -> 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
"timeout"
                                TsGetReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsGetReq
loop
                                  (Setter TsGetReq TsGetReq Word32 Word32
-> Word32 -> TsGetReq -> TsGetReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y TsGetReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld TsCell
mutable'key
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsGetReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsGetReq
loop
                                  (Setter TsGetReq TsGetReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsGetReq -> TsGetReq
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 TsGetReq TsGetReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsGetReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld TsCell
mutable'key
      in
        Parser TsGetReq -> String -> Parser TsGetReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsCell
mutable'key <- IO (Growing Vector RealWorld TsCell)
-> Parser (Growing Vector RealWorld TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                               IO (Growing Vector RealWorld TsCell)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsGetReq
-> Bool -> Growing Vector RealWorld TsCell -> Parser TsGetReq
loop TsGetReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Growing Vector RealWorld TsCell
mutable'key)
          String
"TsGetReq"
  buildMessage :: TsGetReq -> Builder
buildMessage
    = \ TsGetReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString TsGetReq TsGetReq ByteString ByteString
-> TsGetReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") TsGetReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((TsCell -> Builder) -> Vector TsCell -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ TsCell
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (TsCell -> ByteString) -> TsCell -> 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))
                              TsCell -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              TsCell
_v))
                   (FoldLike
  (Vector TsCell) TsGetReq TsGetReq (Vector TsCell) (Vector TsCell)
-> TsGetReq -> Vector TsCell
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'key") TsGetReq
_x))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Word32) TsGetReq TsGetReq (Maybe Word32) (Maybe Word32)
-> TsGetReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") TsGetReq
_x
                    of
                      Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Word32
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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 TsGetReq TsGetReq FieldSet FieldSet
-> TsGetReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsGetReq TsGetReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsGetReq
_x))))
instance Control.DeepSeq.NFData TsGetReq where
  rnf :: TsGetReq -> ()
rnf
    = \ TsGetReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsGetReq -> FieldSet
_TsGetReq'_unknownFields TsGetReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsGetReq -> ByteString
_TsGetReq'table TsGetReq
x__)
                (Vector TsCell -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsGetReq -> Vector TsCell
_TsGetReq'key TsGetReq
x__)
                   (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsGetReq -> Maybe Word32
_TsGetReq'timeout TsGetReq
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.columns' @:: Lens' TsGetResp [TsColumnDescription]@
         * 'Proto.Riak_Fields.vec'columns' @:: Lens' TsGetResp (Data.Vector.Vector TsColumnDescription)@
         * 'Proto.Riak_Fields.rows' @:: Lens' TsGetResp [TsRow]@
         * 'Proto.Riak_Fields.vec'rows' @:: Lens' TsGetResp (Data.Vector.Vector TsRow)@ -}
data TsGetResp
  = TsGetResp'_constructor {TsGetResp -> Vector TsColumnDescription
_TsGetResp'columns :: !(Data.Vector.Vector TsColumnDescription),
                            TsGetResp -> Vector TsRow
_TsGetResp'rows :: !(Data.Vector.Vector TsRow),
                            TsGetResp -> FieldSet
_TsGetResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsGetResp -> TsGetResp -> Bool
(TsGetResp -> TsGetResp -> Bool)
-> (TsGetResp -> TsGetResp -> Bool) -> Eq TsGetResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsGetResp -> TsGetResp -> Bool
$c/= :: TsGetResp -> TsGetResp -> Bool
== :: TsGetResp -> TsGetResp -> Bool
$c== :: TsGetResp -> TsGetResp -> Bool
Prelude.Eq, Eq TsGetResp
Eq TsGetResp
-> (TsGetResp -> TsGetResp -> Ordering)
-> (TsGetResp -> TsGetResp -> Bool)
-> (TsGetResp -> TsGetResp -> Bool)
-> (TsGetResp -> TsGetResp -> Bool)
-> (TsGetResp -> TsGetResp -> Bool)
-> (TsGetResp -> TsGetResp -> TsGetResp)
-> (TsGetResp -> TsGetResp -> TsGetResp)
-> Ord TsGetResp
TsGetResp -> TsGetResp -> Bool
TsGetResp -> TsGetResp -> Ordering
TsGetResp -> TsGetResp -> TsGetResp
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 :: TsGetResp -> TsGetResp -> TsGetResp
$cmin :: TsGetResp -> TsGetResp -> TsGetResp
max :: TsGetResp -> TsGetResp -> TsGetResp
$cmax :: TsGetResp -> TsGetResp -> TsGetResp
>= :: TsGetResp -> TsGetResp -> Bool
$c>= :: TsGetResp -> TsGetResp -> Bool
> :: TsGetResp -> TsGetResp -> Bool
$c> :: TsGetResp -> TsGetResp -> Bool
<= :: TsGetResp -> TsGetResp -> Bool
$c<= :: TsGetResp -> TsGetResp -> Bool
< :: TsGetResp -> TsGetResp -> Bool
$c< :: TsGetResp -> TsGetResp -> Bool
compare :: TsGetResp -> TsGetResp -> Ordering
$ccompare :: TsGetResp -> TsGetResp -> Ordering
$cp1Ord :: Eq TsGetResp
Prelude.Ord)
instance Prelude.Show TsGetResp where
  showsPrec :: Int -> TsGetResp -> ShowS
showsPrec Int
_ TsGetResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsGetResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsGetResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsGetResp "columns" [TsColumnDescription] where
  fieldOf :: Proxy# "columns"
-> ([TsColumnDescription] -> f [TsColumnDescription])
-> TsGetResp
-> f TsGetResp
fieldOf Proxy# "columns"
_
    = ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
 -> TsGetResp -> f TsGetResp)
-> (([TsColumnDescription] -> f [TsColumnDescription])
    -> Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> ([TsColumnDescription] -> f [TsColumnDescription])
-> TsGetResp
-> f TsGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetResp -> Vector TsColumnDescription)
-> (TsGetResp -> Vector TsColumnDescription -> TsGetResp)
-> Lens
     TsGetResp
     TsGetResp
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetResp -> Vector TsColumnDescription
_TsGetResp'columns (\ TsGetResp
x__ Vector TsColumnDescription
y__ -> TsGetResp
x__ {_TsGetResp'columns :: Vector TsColumnDescription
_TsGetResp'columns = Vector TsColumnDescription
y__}))
        ((Vector TsColumnDescription -> [TsColumnDescription])
-> (Vector TsColumnDescription
    -> [TsColumnDescription] -> Vector TsColumnDescription)
-> Lens
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
     [TsColumnDescription]
     [TsColumnDescription]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsColumnDescription -> [TsColumnDescription]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsColumnDescription
_ [TsColumnDescription]
y__ -> [TsColumnDescription] -> Vector TsColumnDescription
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsColumnDescription]
y__))
instance Data.ProtoLens.Field.HasField TsGetResp "vec'columns" (Data.Vector.Vector TsColumnDescription) where
  fieldOf :: Proxy# "vec'columns"
-> (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> TsGetResp
-> f TsGetResp
fieldOf Proxy# "vec'columns"
_
    = ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
 -> TsGetResp -> f TsGetResp)
-> ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
    -> Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> TsGetResp
-> f TsGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetResp -> Vector TsColumnDescription)
-> (TsGetResp -> Vector TsColumnDescription -> TsGetResp)
-> Lens
     TsGetResp
     TsGetResp
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetResp -> Vector TsColumnDescription
_TsGetResp'columns (\ TsGetResp
x__ Vector TsColumnDescription
y__ -> TsGetResp
x__ {_TsGetResp'columns :: Vector TsColumnDescription
_TsGetResp'columns = Vector TsColumnDescription
y__}))
        (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> Vector TsColumnDescription -> f (Vector TsColumnDescription)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsGetResp "rows" [TsRow] where
  fieldOf :: Proxy# "rows" -> ([TsRow] -> f [TsRow]) -> TsGetResp -> f TsGetResp
fieldOf Proxy# "rows"
_
    = ((Vector TsRow -> f (Vector TsRow)) -> TsGetResp -> f TsGetResp)
-> (([TsRow] -> f [TsRow]) -> Vector TsRow -> f (Vector TsRow))
-> ([TsRow] -> f [TsRow])
-> TsGetResp
-> f TsGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetResp -> Vector TsRow)
-> (TsGetResp -> Vector TsRow -> TsGetResp)
-> Lens TsGetResp TsGetResp (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetResp -> Vector TsRow
_TsGetResp'rows (\ TsGetResp
x__ Vector TsRow
y__ -> TsGetResp
x__ {_TsGetResp'rows :: Vector TsRow
_TsGetResp'rows = Vector TsRow
y__}))
        ((Vector TsRow -> [TsRow])
-> (Vector TsRow -> [TsRow] -> Vector TsRow)
-> Lens (Vector TsRow) (Vector TsRow) [TsRow] [TsRow]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsRow -> [TsRow]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsRow
_ [TsRow]
y__ -> [TsRow] -> Vector TsRow
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsRow]
y__))
instance Data.ProtoLens.Field.HasField TsGetResp "vec'rows" (Data.Vector.Vector TsRow) where
  fieldOf :: Proxy# "vec'rows"
-> (Vector TsRow -> f (Vector TsRow)) -> TsGetResp -> f TsGetResp
fieldOf Proxy# "vec'rows"
_
    = ((Vector TsRow -> f (Vector TsRow)) -> TsGetResp -> f TsGetResp)
-> ((Vector TsRow -> f (Vector TsRow))
    -> Vector TsRow -> f (Vector TsRow))
-> (Vector TsRow -> f (Vector TsRow))
-> TsGetResp
-> f TsGetResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsGetResp -> Vector TsRow)
-> (TsGetResp -> Vector TsRow -> TsGetResp)
-> Lens TsGetResp TsGetResp (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsGetResp -> Vector TsRow
_TsGetResp'rows (\ TsGetResp
x__ Vector TsRow
y__ -> TsGetResp
x__ {_TsGetResp'rows :: Vector TsRow
_TsGetResp'rows = Vector TsRow
y__}))
        (Vector TsRow -> f (Vector TsRow))
-> Vector TsRow -> f (Vector TsRow)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsGetResp where
  messageName :: Proxy TsGetResp -> Text
messageName Proxy TsGetResp
_ = String -> Text
Data.Text.pack String
"TsGetResp"
  packedMessageDescriptor :: Proxy TsGetResp -> ByteString
packedMessageDescriptor Proxy TsGetResp
_
    = ByteString
"\n\
      \\tTsGetResp\DC2.\n\
      \\acolumns\CAN\SOH \ETX(\v2\DC4.TsColumnDescriptionR\acolumns\DC2\SUB\n\
      \\EOTrows\CAN\STX \ETX(\v2\ACK.TsRowR\EOTrows"
  packedFileDescriptor :: Proxy TsGetResp -> ByteString
packedFileDescriptor Proxy TsGetResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsGetResp)
fieldsByTag
    = let
        columns__field_descriptor :: FieldDescriptor TsGetResp
columns__field_descriptor
          = String
-> FieldTypeDescriptor TsColumnDescription
-> FieldAccessor TsGetResp TsColumnDescription
-> FieldDescriptor TsGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"columns"
              (MessageOrGroup -> FieldTypeDescriptor TsColumnDescription
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsColumnDescription)
              (Packing
-> Lens' TsGetResp [TsColumnDescription]
-> FieldAccessor TsGetResp TsColumnDescription
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"columns")) ::
              Data.ProtoLens.FieldDescriptor TsGetResp
        rows__field_descriptor :: FieldDescriptor TsGetResp
rows__field_descriptor
          = String
-> FieldTypeDescriptor TsRow
-> FieldAccessor TsGetResp TsRow
-> FieldDescriptor TsGetResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"rows"
              (MessageOrGroup -> FieldTypeDescriptor TsRow
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsRow)
              (Packing -> Lens' TsGetResp [TsRow] -> FieldAccessor TsGetResp TsRow
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rows")) ::
              Data.ProtoLens.FieldDescriptor TsGetResp
      in
        [(Tag, FieldDescriptor TsGetResp)]
-> Map Tag (FieldDescriptor TsGetResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsGetResp
columns__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsGetResp
rows__field_descriptor)]
  unknownFields :: LensLike' f TsGetResp FieldSet
unknownFields
    = (TsGetResp -> FieldSet)
-> (TsGetResp -> FieldSet -> TsGetResp) -> Lens' TsGetResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsGetResp -> FieldSet
_TsGetResp'_unknownFields
        (\ TsGetResp
x__ FieldSet
y__ -> TsGetResp
x__ {_TsGetResp'_unknownFields :: FieldSet
_TsGetResp'_unknownFields = FieldSet
y__})
  defMessage :: TsGetResp
defMessage
    = TsGetResp'_constructor :: Vector TsColumnDescription -> Vector TsRow -> FieldSet -> TsGetResp
TsGetResp'_constructor
        {_TsGetResp'columns :: Vector TsColumnDescription
_TsGetResp'columns = Vector TsColumnDescription
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsGetResp'rows :: Vector TsRow
_TsGetResp'rows = Vector TsRow
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsGetResp'_unknownFields :: FieldSet
_TsGetResp'_unknownFields = []}
  parseMessage :: Parser TsGetResp
parseMessage
    = let
        loop ::
          TsGetResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsColumnDescription
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsRow
                -> Data.ProtoLens.Encoding.Bytes.Parser TsGetResp
        loop :: TsGetResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsGetResp
loop TsGetResp
x Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
mutable'rows
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsColumnDescription
frozen'columns <- IO (Vector TsColumnDescription)
-> Parser (Vector TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) TsColumnDescription
-> IO (Vector TsColumnDescription)
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 TsColumnDescription
Growing Vector (PrimState IO) TsColumnDescription
mutable'columns)
                      Vector TsRow
frozen'rows <- IO (Vector TsRow) -> Parser (Vector TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow -> IO (Vector TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'rows)
                      (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]))))
                      TsGetResp -> Parser TsGetResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsGetResp TsGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsGetResp -> TsGetResp
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 TsGetResp TsGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  TsGetResp
  TsGetResp
  (Vector TsColumnDescription)
  (Vector TsColumnDescription)
-> Vector TsColumnDescription -> TsGetResp -> TsGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'columns")
                              Vector TsColumnDescription
frozen'columns
                              (Setter TsGetResp TsGetResp (Vector TsRow) (Vector TsRow)
-> Vector TsRow -> TsGetResp -> TsGetResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'rows") Vector TsRow
frozen'rows TsGetResp
x)))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !TsColumnDescription
y <- Parser TsColumnDescription -> String -> Parser TsColumnDescription
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsColumnDescription -> Parser TsColumnDescription
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 TsColumnDescription
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"columns"
                                Growing Vector RealWorld TsColumnDescription
v <- IO (Growing Vector RealWorld TsColumnDescription)
-> Parser (Growing Vector RealWorld TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsColumnDescription
-> TsColumnDescription
-> IO (Growing Vector (PrimState IO) TsColumnDescription)
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 TsColumnDescription
Growing Vector (PrimState IO) TsColumnDescription
mutable'columns TsColumnDescription
y)
                                TsGetResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsGetResp
loop TsGetResp
x Growing Vector RealWorld TsColumnDescription
v Growing Vector RealWorld TsRow
mutable'rows
                        Word64
18
                          -> do !TsRow
y <- Parser TsRow -> String -> Parser TsRow
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsRow -> Parser TsRow
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 TsRow
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"rows"
                                Growing Vector RealWorld TsRow
v <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow
-> TsRow -> IO (Growing Vector (PrimState IO) TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'rows TsRow
y)
                                TsGetResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsGetResp
loop TsGetResp
x Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsGetResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsGetResp
loop
                                  (Setter TsGetResp TsGetResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsGetResp -> TsGetResp
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 TsGetResp TsGetResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsGetResp
x)
                                  Growing Vector RealWorld TsColumnDescription
mutable'columns
                                  Growing Vector RealWorld TsRow
mutable'rows
      in
        Parser TsGetResp -> String -> Parser TsGetResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsColumnDescription
mutable'columns <- IO (Growing Vector RealWorld TsColumnDescription)
-> Parser (Growing Vector RealWorld TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld TsColumnDescription)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld TsRow
mutable'rows <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld TsRow)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsGetResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsGetResp
loop TsGetResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
mutable'rows)
          String
"TsGetResp"
  buildMessage :: TsGetResp -> Builder
buildMessage
    = \ TsGetResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((TsColumnDescription -> Builder)
-> Vector TsColumnDescription -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ TsColumnDescription
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (TsColumnDescription -> ByteString)
-> TsColumnDescription
-> 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))
                           TsColumnDescription -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           TsColumnDescription
_v))
                (FoldLike
  (Vector TsColumnDescription)
  TsGetResp
  TsGetResp
  (Vector TsColumnDescription)
  (Vector TsColumnDescription)
-> TsGetResp -> Vector TsColumnDescription
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'columns") TsGetResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((TsRow -> Builder) -> Vector TsRow -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ TsRow
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (TsRow -> ByteString) -> TsRow -> 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))
                              TsRow -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              TsRow
_v))
                   (FoldLike
  (Vector TsRow) TsGetResp TsGetResp (Vector TsRow) (Vector TsRow)
-> TsGetResp -> Vector TsRow
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'rows") TsGetResp
_x))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet TsGetResp TsGetResp FieldSet FieldSet
-> TsGetResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsGetResp TsGetResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsGetResp
_x)))
instance Control.DeepSeq.NFData TsGetResp where
  rnf :: TsGetResp -> ()
rnf
    = \ TsGetResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsGetResp -> FieldSet
_TsGetResp'_unknownFields TsGetResp
x__)
             (Vector TsColumnDescription -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsGetResp -> Vector TsColumnDescription
_TsGetResp'columns TsGetResp
x__)
                (Vector TsRow -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsGetResp -> Vector TsRow
_TsGetResp'rows TsGetResp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.base' @:: Lens' TsInterpolation Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.interpolations' @:: Lens' TsInterpolation [RpbPair]@
         * 'Proto.Riak_Fields.vec'interpolations' @:: Lens' TsInterpolation (Data.Vector.Vector RpbPair)@ -}
data TsInterpolation
  = TsInterpolation'_constructor {TsInterpolation -> ByteString
_TsInterpolation'base :: !Data.ByteString.ByteString,
                                  TsInterpolation -> Vector RpbPair
_TsInterpolation'interpolations :: !(Data.Vector.Vector RpbPair),
                                  TsInterpolation -> FieldSet
_TsInterpolation'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsInterpolation -> TsInterpolation -> Bool
(TsInterpolation -> TsInterpolation -> Bool)
-> (TsInterpolation -> TsInterpolation -> Bool)
-> Eq TsInterpolation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsInterpolation -> TsInterpolation -> Bool
$c/= :: TsInterpolation -> TsInterpolation -> Bool
== :: TsInterpolation -> TsInterpolation -> Bool
$c== :: TsInterpolation -> TsInterpolation -> Bool
Prelude.Eq, Eq TsInterpolation
Eq TsInterpolation
-> (TsInterpolation -> TsInterpolation -> Ordering)
-> (TsInterpolation -> TsInterpolation -> Bool)
-> (TsInterpolation -> TsInterpolation -> Bool)
-> (TsInterpolation -> TsInterpolation -> Bool)
-> (TsInterpolation -> TsInterpolation -> Bool)
-> (TsInterpolation -> TsInterpolation -> TsInterpolation)
-> (TsInterpolation -> TsInterpolation -> TsInterpolation)
-> Ord TsInterpolation
TsInterpolation -> TsInterpolation -> Bool
TsInterpolation -> TsInterpolation -> Ordering
TsInterpolation -> TsInterpolation -> TsInterpolation
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 :: TsInterpolation -> TsInterpolation -> TsInterpolation
$cmin :: TsInterpolation -> TsInterpolation -> TsInterpolation
max :: TsInterpolation -> TsInterpolation -> TsInterpolation
$cmax :: TsInterpolation -> TsInterpolation -> TsInterpolation
>= :: TsInterpolation -> TsInterpolation -> Bool
$c>= :: TsInterpolation -> TsInterpolation -> Bool
> :: TsInterpolation -> TsInterpolation -> Bool
$c> :: TsInterpolation -> TsInterpolation -> Bool
<= :: TsInterpolation -> TsInterpolation -> Bool
$c<= :: TsInterpolation -> TsInterpolation -> Bool
< :: TsInterpolation -> TsInterpolation -> Bool
$c< :: TsInterpolation -> TsInterpolation -> Bool
compare :: TsInterpolation -> TsInterpolation -> Ordering
$ccompare :: TsInterpolation -> TsInterpolation -> Ordering
$cp1Ord :: Eq TsInterpolation
Prelude.Ord)
instance Prelude.Show TsInterpolation where
  showsPrec :: Int -> TsInterpolation -> ShowS
showsPrec Int
_ TsInterpolation
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsInterpolation -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsInterpolation
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsInterpolation "base" Data.ByteString.ByteString where
  fieldOf :: Proxy# "base"
-> (ByteString -> f ByteString)
-> TsInterpolation
-> f TsInterpolation
fieldOf Proxy# "base"
_
    = ((ByteString -> f ByteString)
 -> TsInterpolation -> f TsInterpolation)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsInterpolation
-> f TsInterpolation
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsInterpolation -> ByteString)
-> (TsInterpolation -> ByteString -> TsInterpolation)
-> Lens TsInterpolation TsInterpolation ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsInterpolation -> ByteString
_TsInterpolation'base
           (\ TsInterpolation
x__ ByteString
y__ -> TsInterpolation
x__ {_TsInterpolation'base :: ByteString
_TsInterpolation'base = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsInterpolation "interpolations" [RpbPair] where
  fieldOf :: Proxy# "interpolations"
-> ([RpbPair] -> f [RpbPair])
-> TsInterpolation
-> f TsInterpolation
fieldOf Proxy# "interpolations"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> TsInterpolation -> f TsInterpolation)
-> (([RpbPair] -> f [RpbPair])
    -> Vector RpbPair -> f (Vector RpbPair))
-> ([RpbPair] -> f [RpbPair])
-> TsInterpolation
-> f TsInterpolation
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsInterpolation -> Vector RpbPair)
-> (TsInterpolation -> Vector RpbPair -> TsInterpolation)
-> Lens
     TsInterpolation TsInterpolation (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsInterpolation -> Vector RpbPair
_TsInterpolation'interpolations
           (\ TsInterpolation
x__ Vector RpbPair
y__ -> TsInterpolation
x__ {_TsInterpolation'interpolations :: Vector RpbPair
_TsInterpolation'interpolations = Vector RpbPair
y__}))
        ((Vector RpbPair -> [RpbPair])
-> (Vector RpbPair -> [RpbPair] -> Vector RpbPair)
-> Lens (Vector RpbPair) (Vector RpbPair) [RpbPair] [RpbPair]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector RpbPair -> [RpbPair]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector RpbPair
_ [RpbPair]
y__ -> [RpbPair] -> Vector RpbPair
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [RpbPair]
y__))
instance Data.ProtoLens.Field.HasField TsInterpolation "vec'interpolations" (Data.Vector.Vector RpbPair) where
  fieldOf :: Proxy# "vec'interpolations"
-> (Vector RpbPair -> f (Vector RpbPair))
-> TsInterpolation
-> f TsInterpolation
fieldOf Proxy# "vec'interpolations"
_
    = ((Vector RpbPair -> f (Vector RpbPair))
 -> TsInterpolation -> f TsInterpolation)
-> ((Vector RpbPair -> f (Vector RpbPair))
    -> Vector RpbPair -> f (Vector RpbPair))
-> (Vector RpbPair -> f (Vector RpbPair))
-> TsInterpolation
-> f TsInterpolation
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsInterpolation -> Vector RpbPair)
-> (TsInterpolation -> Vector RpbPair -> TsInterpolation)
-> Lens
     TsInterpolation TsInterpolation (Vector RpbPair) (Vector RpbPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsInterpolation -> Vector RpbPair
_TsInterpolation'interpolations
           (\ TsInterpolation
x__ Vector RpbPair
y__ -> TsInterpolation
x__ {_TsInterpolation'interpolations :: Vector RpbPair
_TsInterpolation'interpolations = Vector RpbPair
y__}))
        (Vector RpbPair -> f (Vector RpbPair))
-> Vector RpbPair -> f (Vector RpbPair)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsInterpolation where
  messageName :: Proxy TsInterpolation -> Text
messageName Proxy TsInterpolation
_ = String -> Text
Data.Text.pack String
"TsInterpolation"
  packedMessageDescriptor :: Proxy TsInterpolation -> ByteString
packedMessageDescriptor Proxy TsInterpolation
_
    = ByteString
"\n\
      \\SITsInterpolation\DC2\DC2\n\
      \\EOTbase\CAN\SOH \STX(\fR\EOTbase\DC20\n\
      \\SOinterpolations\CAN\STX \ETX(\v2\b.RpbPairR\SOinterpolations"
  packedFileDescriptor :: Proxy TsInterpolation -> ByteString
packedFileDescriptor Proxy TsInterpolation
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsInterpolation)
fieldsByTag
    = let
        base__field_descriptor :: FieldDescriptor TsInterpolation
base__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsInterpolation ByteString
-> FieldDescriptor TsInterpolation
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"base"
              (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 TsInterpolation TsInterpolation ByteString ByteString
-> FieldAccessor TsInterpolation ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "base" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"base")) ::
              Data.ProtoLens.FieldDescriptor TsInterpolation
        interpolations__field_descriptor :: FieldDescriptor TsInterpolation
interpolations__field_descriptor
          = String
-> FieldTypeDescriptor RpbPair
-> FieldAccessor TsInterpolation RpbPair
-> FieldDescriptor TsInterpolation
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"interpolations"
              (MessageOrGroup -> FieldTypeDescriptor RpbPair
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor RpbPair)
              (Packing
-> Lens' TsInterpolation [RpbPair]
-> FieldAccessor TsInterpolation RpbPair
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked
                 (forall s a (f :: * -> *).
(HasField s "interpolations" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"interpolations")) ::
              Data.ProtoLens.FieldDescriptor TsInterpolation
      in
        [(Tag, FieldDescriptor TsInterpolation)]
-> Map Tag (FieldDescriptor TsInterpolation)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsInterpolation
base__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsInterpolation
interpolations__field_descriptor)]
  unknownFields :: LensLike' f TsInterpolation FieldSet
unknownFields
    = (TsInterpolation -> FieldSet)
-> (TsInterpolation -> FieldSet -> TsInterpolation)
-> Lens' TsInterpolation FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsInterpolation -> FieldSet
_TsInterpolation'_unknownFields
        (\ TsInterpolation
x__ FieldSet
y__ -> TsInterpolation
x__ {_TsInterpolation'_unknownFields :: FieldSet
_TsInterpolation'_unknownFields = FieldSet
y__})
  defMessage :: TsInterpolation
defMessage
    = TsInterpolation'_constructor :: ByteString -> Vector RpbPair -> FieldSet -> TsInterpolation
TsInterpolation'_constructor
        {_TsInterpolation'base :: ByteString
_TsInterpolation'base = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsInterpolation'interpolations :: Vector RpbPair
_TsInterpolation'interpolations = Vector RpbPair
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsInterpolation'_unknownFields :: FieldSet
_TsInterpolation'_unknownFields = []}
  parseMessage :: Parser TsInterpolation
parseMessage
    = let
        loop ::
          TsInterpolation
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld RpbPair
                -> Data.ProtoLens.Encoding.Bytes.Parser TsInterpolation
        loop :: TsInterpolation
-> Bool
-> Growing Vector RealWorld RpbPair
-> Parser TsInterpolation
loop TsInterpolation
x Bool
required'base Growing Vector RealWorld RpbPair
mutable'interpolations
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector RpbPair
frozen'interpolations <- IO (Vector RpbPair) -> Parser (Vector RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                                 (Growing Vector (PrimState IO) RpbPair -> IO (Vector RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'interpolations)
                      (let
                         missing :: [String]
missing = (if Bool
required'base then (:) String
"base" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsInterpolation -> Parser TsInterpolation
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsInterpolation TsInterpolation FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsInterpolation -> TsInterpolation
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 TsInterpolation TsInterpolation FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  TsInterpolation TsInterpolation (Vector RpbPair) (Vector RpbPair)
-> Vector RpbPair -> TsInterpolation -> TsInterpolation
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'interpolations" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'interpolations")
                              Vector RpbPair
frozen'interpolations
                              TsInterpolation
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
"base"
                                TsInterpolation
-> Bool
-> Growing Vector RealWorld RpbPair
-> Parser TsInterpolation
loop
                                  (Setter TsInterpolation TsInterpolation ByteString ByteString
-> ByteString -> TsInterpolation -> TsInterpolation
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "base" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"base") ByteString
y TsInterpolation
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld RpbPair
mutable'interpolations
                        Word64
18
                          -> do !RpbPair
y <- Parser RpbPair -> String -> Parser RpbPair
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser RpbPair -> Parser RpbPair
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 RpbPair
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"interpolations"
                                Growing Vector RealWorld RpbPair
v <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) RpbPair
-> RpbPair -> IO (Growing Vector (PrimState IO) RpbPair)
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 RpbPair
Growing Vector (PrimState IO) RpbPair
mutable'interpolations RpbPair
y)
                                TsInterpolation
-> Bool
-> Growing Vector RealWorld RpbPair
-> Parser TsInterpolation
loop TsInterpolation
x Bool
required'base Growing Vector RealWorld RpbPair
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsInterpolation
-> Bool
-> Growing Vector RealWorld RpbPair
-> Parser TsInterpolation
loop
                                  (Setter TsInterpolation TsInterpolation FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsInterpolation -> TsInterpolation
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 TsInterpolation TsInterpolation FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsInterpolation
x)
                                  Bool
required'base
                                  Growing Vector RealWorld RpbPair
mutable'interpolations
      in
        Parser TsInterpolation -> String -> Parser TsInterpolation
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld RpbPair
mutable'interpolations <- IO (Growing Vector RealWorld RpbPair)
-> Parser (Growing Vector RealWorld RpbPair)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          IO (Growing Vector RealWorld RpbPair)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsInterpolation
-> Bool
-> Growing Vector RealWorld RpbPair
-> Parser TsInterpolation
loop TsInterpolation
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True Growing Vector RealWorld RpbPair
mutable'interpolations)
          String
"TsInterpolation"
  buildMessage :: TsInterpolation -> Builder
buildMessage
    = \ TsInterpolation
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString TsInterpolation TsInterpolation ByteString ByteString
-> TsInterpolation -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "base" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"base") TsInterpolation
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((RpbPair -> Builder) -> Vector RpbPair -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ RpbPair
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (RpbPair -> ByteString) -> RpbPair -> 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))
                              RpbPair -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              RpbPair
_v))
                   (FoldLike
  (Vector RpbPair)
  TsInterpolation
  TsInterpolation
  (Vector RpbPair)
  (Vector RpbPair)
-> TsInterpolation -> Vector RpbPair
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                      (forall s a (f :: * -> *).
(HasField s "vec'interpolations" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'interpolations") TsInterpolation
_x))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet TsInterpolation TsInterpolation FieldSet FieldSet
-> TsInterpolation -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsInterpolation TsInterpolation FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsInterpolation
_x)))
instance Control.DeepSeq.NFData TsInterpolation where
  rnf :: TsInterpolation -> ()
rnf
    = \ TsInterpolation
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsInterpolation -> FieldSet
_TsInterpolation'_unknownFields TsInterpolation
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsInterpolation -> ByteString
_TsInterpolation'base TsInterpolation
x__)
                (Vector RpbPair -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsInterpolation -> Vector RpbPair
_TsInterpolation'interpolations TsInterpolation
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.table' @:: Lens' TsListKeysReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.timeout' @:: Lens' TsListKeysReq Data.Word.Word32@
         * 'Proto.Riak_Fields.maybe'timeout' @:: Lens' TsListKeysReq (Prelude.Maybe Data.Word.Word32)@ -}
data TsListKeysReq
  = TsListKeysReq'_constructor {TsListKeysReq -> ByteString
_TsListKeysReq'table :: !Data.ByteString.ByteString,
                                TsListKeysReq -> Maybe Word32
_TsListKeysReq'timeout :: !(Prelude.Maybe Data.Word.Word32),
                                TsListKeysReq -> FieldSet
_TsListKeysReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsListKeysReq -> TsListKeysReq -> Bool
(TsListKeysReq -> TsListKeysReq -> Bool)
-> (TsListKeysReq -> TsListKeysReq -> Bool) -> Eq TsListKeysReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsListKeysReq -> TsListKeysReq -> Bool
$c/= :: TsListKeysReq -> TsListKeysReq -> Bool
== :: TsListKeysReq -> TsListKeysReq -> Bool
$c== :: TsListKeysReq -> TsListKeysReq -> Bool
Prelude.Eq, Eq TsListKeysReq
Eq TsListKeysReq
-> (TsListKeysReq -> TsListKeysReq -> Ordering)
-> (TsListKeysReq -> TsListKeysReq -> Bool)
-> (TsListKeysReq -> TsListKeysReq -> Bool)
-> (TsListKeysReq -> TsListKeysReq -> Bool)
-> (TsListKeysReq -> TsListKeysReq -> Bool)
-> (TsListKeysReq -> TsListKeysReq -> TsListKeysReq)
-> (TsListKeysReq -> TsListKeysReq -> TsListKeysReq)
-> Ord TsListKeysReq
TsListKeysReq -> TsListKeysReq -> Bool
TsListKeysReq -> TsListKeysReq -> Ordering
TsListKeysReq -> TsListKeysReq -> TsListKeysReq
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 :: TsListKeysReq -> TsListKeysReq -> TsListKeysReq
$cmin :: TsListKeysReq -> TsListKeysReq -> TsListKeysReq
max :: TsListKeysReq -> TsListKeysReq -> TsListKeysReq
$cmax :: TsListKeysReq -> TsListKeysReq -> TsListKeysReq
>= :: TsListKeysReq -> TsListKeysReq -> Bool
$c>= :: TsListKeysReq -> TsListKeysReq -> Bool
> :: TsListKeysReq -> TsListKeysReq -> Bool
$c> :: TsListKeysReq -> TsListKeysReq -> Bool
<= :: TsListKeysReq -> TsListKeysReq -> Bool
$c<= :: TsListKeysReq -> TsListKeysReq -> Bool
< :: TsListKeysReq -> TsListKeysReq -> Bool
$c< :: TsListKeysReq -> TsListKeysReq -> Bool
compare :: TsListKeysReq -> TsListKeysReq -> Ordering
$ccompare :: TsListKeysReq -> TsListKeysReq -> Ordering
$cp1Ord :: Eq TsListKeysReq
Prelude.Ord)
instance Prelude.Show TsListKeysReq where
  showsPrec :: Int -> TsListKeysReq -> ShowS
showsPrec Int
_ TsListKeysReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsListKeysReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsListKeysReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsListKeysReq "table" Data.ByteString.ByteString where
  fieldOf :: Proxy# "table"
-> (ByteString -> f ByteString) -> TsListKeysReq -> f TsListKeysReq
fieldOf Proxy# "table"
_
    = ((ByteString -> f ByteString) -> TsListKeysReq -> f TsListKeysReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsListKeysReq
-> f TsListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsListKeysReq -> ByteString)
-> (TsListKeysReq -> ByteString -> TsListKeysReq)
-> Lens TsListKeysReq TsListKeysReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsListKeysReq -> ByteString
_TsListKeysReq'table
           (\ TsListKeysReq
x__ ByteString
y__ -> TsListKeysReq
x__ {_TsListKeysReq'table :: ByteString
_TsListKeysReq'table = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsListKeysReq "timeout" Data.Word.Word32 where
  fieldOf :: Proxy# "timeout"
-> (Word32 -> f Word32) -> TsListKeysReq -> f TsListKeysReq
fieldOf Proxy# "timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> TsListKeysReq -> f TsListKeysReq)
-> ((Word32 -> f Word32) -> Maybe Word32 -> f (Maybe Word32))
-> (Word32 -> f Word32)
-> TsListKeysReq
-> f TsListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsListKeysReq -> Maybe Word32)
-> (TsListKeysReq -> Maybe Word32 -> TsListKeysReq)
-> Lens TsListKeysReq TsListKeysReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsListKeysReq -> Maybe Word32
_TsListKeysReq'timeout
           (\ TsListKeysReq
x__ Maybe Word32
y__ -> TsListKeysReq
x__ {_TsListKeysReq'timeout :: Maybe Word32
_TsListKeysReq'timeout = Maybe Word32
y__}))
        (Word32 -> Lens' (Maybe Word32) Word32
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Word32
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsListKeysReq "maybe'timeout" (Prelude.Maybe Data.Word.Word32) where
  fieldOf :: Proxy# "maybe'timeout"
-> (Maybe Word32 -> f (Maybe Word32))
-> TsListKeysReq
-> f TsListKeysReq
fieldOf Proxy# "maybe'timeout"
_
    = ((Maybe Word32 -> f (Maybe Word32))
 -> TsListKeysReq -> f TsListKeysReq)
-> ((Maybe Word32 -> f (Maybe Word32))
    -> Maybe Word32 -> f (Maybe Word32))
-> (Maybe Word32 -> f (Maybe Word32))
-> TsListKeysReq
-> f TsListKeysReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsListKeysReq -> Maybe Word32)
-> (TsListKeysReq -> Maybe Word32 -> TsListKeysReq)
-> Lens TsListKeysReq TsListKeysReq (Maybe Word32) (Maybe Word32)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsListKeysReq -> Maybe Word32
_TsListKeysReq'timeout
           (\ TsListKeysReq
x__ Maybe Word32
y__ -> TsListKeysReq
x__ {_TsListKeysReq'timeout :: Maybe Word32
_TsListKeysReq'timeout = Maybe Word32
y__}))
        (Maybe Word32 -> f (Maybe Word32))
-> Maybe Word32 -> f (Maybe Word32)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsListKeysReq where
  messageName :: Proxy TsListKeysReq -> Text
messageName Proxy TsListKeysReq
_ = String -> Text
Data.Text.pack String
"TsListKeysReq"
  packedMessageDescriptor :: Proxy TsListKeysReq -> ByteString
packedMessageDescriptor Proxy TsListKeysReq
_
    = ByteString
"\n\
      \\rTsListKeysReq\DC2\DC4\n\
      \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2\CAN\n\
      \\atimeout\CAN\STX \SOH(\rR\atimeout"
  packedFileDescriptor :: Proxy TsListKeysReq -> ByteString
packedFileDescriptor Proxy TsListKeysReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsListKeysReq)
fieldsByTag
    = let
        table__field_descriptor :: FieldDescriptor TsListKeysReq
table__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsListKeysReq ByteString
-> FieldDescriptor TsListKeysReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"table"
              (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 TsListKeysReq TsListKeysReq ByteString ByteString
-> FieldAccessor TsListKeysReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table")) ::
              Data.ProtoLens.FieldDescriptor TsListKeysReq
        timeout__field_descriptor :: FieldDescriptor TsListKeysReq
timeout__field_descriptor
          = String
-> FieldTypeDescriptor Word32
-> FieldAccessor TsListKeysReq Word32
-> FieldDescriptor TsListKeysReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"timeout"
              (ScalarField Word32 -> FieldTypeDescriptor Word32
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Word32
Data.ProtoLens.UInt32Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32)
              (Lens TsListKeysReq TsListKeysReq (Maybe Word32) (Maybe Word32)
-> FieldAccessor TsListKeysReq Word32
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout")) ::
              Data.ProtoLens.FieldDescriptor TsListKeysReq
      in
        [(Tag, FieldDescriptor TsListKeysReq)]
-> Map Tag (FieldDescriptor TsListKeysReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsListKeysReq
table__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsListKeysReq
timeout__field_descriptor)]
  unknownFields :: LensLike' f TsListKeysReq FieldSet
unknownFields
    = (TsListKeysReq -> FieldSet)
-> (TsListKeysReq -> FieldSet -> TsListKeysReq)
-> Lens' TsListKeysReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsListKeysReq -> FieldSet
_TsListKeysReq'_unknownFields
        (\ TsListKeysReq
x__ FieldSet
y__ -> TsListKeysReq
x__ {_TsListKeysReq'_unknownFields :: FieldSet
_TsListKeysReq'_unknownFields = FieldSet
y__})
  defMessage :: TsListKeysReq
defMessage
    = TsListKeysReq'_constructor :: ByteString -> Maybe Word32 -> FieldSet -> TsListKeysReq
TsListKeysReq'_constructor
        {_TsListKeysReq'table :: ByteString
_TsListKeysReq'table = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsListKeysReq'timeout :: Maybe Word32
_TsListKeysReq'timeout = Maybe Word32
forall a. Maybe a
Prelude.Nothing,
         _TsListKeysReq'_unknownFields :: FieldSet
_TsListKeysReq'_unknownFields = []}
  parseMessage :: Parser TsListKeysReq
parseMessage
    = let
        loop ::
          TsListKeysReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Bytes.Parser TsListKeysReq
        loop :: TsListKeysReq -> Bool -> Parser TsListKeysReq
loop TsListKeysReq
x Bool
required'table
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing = (if Bool
required'table then (:) String
"table" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsListKeysReq -> Parser TsListKeysReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsListKeysReq TsListKeysReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsListKeysReq -> TsListKeysReq
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 TsListKeysReq TsListKeysReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsListKeysReq
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
"table"
                                TsListKeysReq -> Bool -> Parser TsListKeysReq
loop
                                  (Setter TsListKeysReq TsListKeysReq ByteString ByteString
-> ByteString -> TsListKeysReq -> TsListKeysReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") ByteString
y TsListKeysReq
x)
                                  Bool
Prelude.False
                        Word64
16
                          -> 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
"timeout"
                                TsListKeysReq -> Bool -> Parser TsListKeysReq
loop
                                  (Setter TsListKeysReq TsListKeysReq Word32 Word32
-> Word32 -> TsListKeysReq -> TsListKeysReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"timeout") Word32
y TsListKeysReq
x)
                                  Bool
required'table
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsListKeysReq -> Bool -> Parser TsListKeysReq
loop
                                  (Setter TsListKeysReq TsListKeysReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsListKeysReq -> TsListKeysReq
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 TsListKeysReq TsListKeysReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsListKeysReq
x)
                                  Bool
required'table
      in
        Parser TsListKeysReq -> String -> Parser TsListKeysReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsListKeysReq -> Bool -> Parser TsListKeysReq
loop TsListKeysReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage Bool
Prelude.True) String
"TsListKeysReq"
  buildMessage :: TsListKeysReq -> Builder
buildMessage
    = \ TsListKeysReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike
  ByteString TsListKeysReq TsListKeysReq ByteString ByteString
-> TsListKeysReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") TsListKeysReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Word32)
  TsListKeysReq
  TsListKeysReq
  (Maybe Word32)
  (Maybe Word32)
-> TsListKeysReq -> Maybe Word32
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'timeout" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'timeout") TsListKeysReq
_x
                 of
                   Maybe Word32
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Word32
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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 TsListKeysReq TsListKeysReq FieldSet FieldSet
-> TsListKeysReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsListKeysReq TsListKeysReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsListKeysReq
_x)))
instance Control.DeepSeq.NFData TsListKeysReq where
  rnf :: TsListKeysReq -> ()
rnf
    = \ TsListKeysReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsListKeysReq -> FieldSet
_TsListKeysReq'_unknownFields TsListKeysReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsListKeysReq -> ByteString
_TsListKeysReq'table TsListKeysReq
x__)
                (Maybe Word32 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsListKeysReq -> Maybe Word32
_TsListKeysReq'timeout TsListKeysReq
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.keys' @:: Lens' TsListKeysResp [TsRow]@
         * 'Proto.Riak_Fields.vec'keys' @:: Lens' TsListKeysResp (Data.Vector.Vector TsRow)@
         * 'Proto.Riak_Fields.done' @:: Lens' TsListKeysResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' TsListKeysResp (Prelude.Maybe Prelude.Bool)@ -}
data TsListKeysResp
  = TsListKeysResp'_constructor {TsListKeysResp -> Vector TsRow
_TsListKeysResp'keys :: !(Data.Vector.Vector TsRow),
                                 TsListKeysResp -> Maybe Bool
_TsListKeysResp'done :: !(Prelude.Maybe Prelude.Bool),
                                 TsListKeysResp -> FieldSet
_TsListKeysResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsListKeysResp -> TsListKeysResp -> Bool
(TsListKeysResp -> TsListKeysResp -> Bool)
-> (TsListKeysResp -> TsListKeysResp -> Bool) -> Eq TsListKeysResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsListKeysResp -> TsListKeysResp -> Bool
$c/= :: TsListKeysResp -> TsListKeysResp -> Bool
== :: TsListKeysResp -> TsListKeysResp -> Bool
$c== :: TsListKeysResp -> TsListKeysResp -> Bool
Prelude.Eq, Eq TsListKeysResp
Eq TsListKeysResp
-> (TsListKeysResp -> TsListKeysResp -> Ordering)
-> (TsListKeysResp -> TsListKeysResp -> Bool)
-> (TsListKeysResp -> TsListKeysResp -> Bool)
-> (TsListKeysResp -> TsListKeysResp -> Bool)
-> (TsListKeysResp -> TsListKeysResp -> Bool)
-> (TsListKeysResp -> TsListKeysResp -> TsListKeysResp)
-> (TsListKeysResp -> TsListKeysResp -> TsListKeysResp)
-> Ord TsListKeysResp
TsListKeysResp -> TsListKeysResp -> Bool
TsListKeysResp -> TsListKeysResp -> Ordering
TsListKeysResp -> TsListKeysResp -> TsListKeysResp
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 :: TsListKeysResp -> TsListKeysResp -> TsListKeysResp
$cmin :: TsListKeysResp -> TsListKeysResp -> TsListKeysResp
max :: TsListKeysResp -> TsListKeysResp -> TsListKeysResp
$cmax :: TsListKeysResp -> TsListKeysResp -> TsListKeysResp
>= :: TsListKeysResp -> TsListKeysResp -> Bool
$c>= :: TsListKeysResp -> TsListKeysResp -> Bool
> :: TsListKeysResp -> TsListKeysResp -> Bool
$c> :: TsListKeysResp -> TsListKeysResp -> Bool
<= :: TsListKeysResp -> TsListKeysResp -> Bool
$c<= :: TsListKeysResp -> TsListKeysResp -> Bool
< :: TsListKeysResp -> TsListKeysResp -> Bool
$c< :: TsListKeysResp -> TsListKeysResp -> Bool
compare :: TsListKeysResp -> TsListKeysResp -> Ordering
$ccompare :: TsListKeysResp -> TsListKeysResp -> Ordering
$cp1Ord :: Eq TsListKeysResp
Prelude.Ord)
instance Prelude.Show TsListKeysResp where
  showsPrec :: Int -> TsListKeysResp -> ShowS
showsPrec Int
_ TsListKeysResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsListKeysResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsListKeysResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsListKeysResp "keys" [TsRow] where
  fieldOf :: Proxy# "keys"
-> ([TsRow] -> f [TsRow]) -> TsListKeysResp -> f TsListKeysResp
fieldOf Proxy# "keys"
_
    = ((Vector TsRow -> f (Vector TsRow))
 -> TsListKeysResp -> f TsListKeysResp)
-> (([TsRow] -> f [TsRow]) -> Vector TsRow -> f (Vector TsRow))
-> ([TsRow] -> f [TsRow])
-> TsListKeysResp
-> f TsListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsListKeysResp -> Vector TsRow)
-> (TsListKeysResp -> Vector TsRow -> TsListKeysResp)
-> Lens TsListKeysResp TsListKeysResp (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsListKeysResp -> Vector TsRow
_TsListKeysResp'keys
           (\ TsListKeysResp
x__ Vector TsRow
y__ -> TsListKeysResp
x__ {_TsListKeysResp'keys :: Vector TsRow
_TsListKeysResp'keys = Vector TsRow
y__}))
        ((Vector TsRow -> [TsRow])
-> (Vector TsRow -> [TsRow] -> Vector TsRow)
-> Lens (Vector TsRow) (Vector TsRow) [TsRow] [TsRow]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsRow -> [TsRow]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsRow
_ [TsRow]
y__ -> [TsRow] -> Vector TsRow
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsRow]
y__))
instance Data.ProtoLens.Field.HasField TsListKeysResp "vec'keys" (Data.Vector.Vector TsRow) where
  fieldOf :: Proxy# "vec'keys"
-> (Vector TsRow -> f (Vector TsRow))
-> TsListKeysResp
-> f TsListKeysResp
fieldOf Proxy# "vec'keys"
_
    = ((Vector TsRow -> f (Vector TsRow))
 -> TsListKeysResp -> f TsListKeysResp)
-> ((Vector TsRow -> f (Vector TsRow))
    -> Vector TsRow -> f (Vector TsRow))
-> (Vector TsRow -> f (Vector TsRow))
-> TsListKeysResp
-> f TsListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsListKeysResp -> Vector TsRow)
-> (TsListKeysResp -> Vector TsRow -> TsListKeysResp)
-> Lens TsListKeysResp TsListKeysResp (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsListKeysResp -> Vector TsRow
_TsListKeysResp'keys
           (\ TsListKeysResp
x__ Vector TsRow
y__ -> TsListKeysResp
x__ {_TsListKeysResp'keys :: Vector TsRow
_TsListKeysResp'keys = Vector TsRow
y__}))
        (Vector TsRow -> f (Vector TsRow))
-> Vector TsRow -> f (Vector TsRow)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsListKeysResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done"
-> (Bool -> f Bool) -> TsListKeysResp -> f TsListKeysResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> TsListKeysResp -> f TsListKeysResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> TsListKeysResp
-> f TsListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsListKeysResp -> Maybe Bool)
-> (TsListKeysResp -> Maybe Bool -> TsListKeysResp)
-> Lens TsListKeysResp TsListKeysResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsListKeysResp -> Maybe Bool
_TsListKeysResp'done
           (\ TsListKeysResp
x__ Maybe Bool
y__ -> TsListKeysResp
x__ {_TsListKeysResp'done :: Maybe Bool
_TsListKeysResp'done = 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 TsListKeysResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool))
-> TsListKeysResp
-> f TsListKeysResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool))
 -> TsListKeysResp -> f TsListKeysResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> TsListKeysResp
-> f TsListKeysResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsListKeysResp -> Maybe Bool)
-> (TsListKeysResp -> Maybe Bool -> TsListKeysResp)
-> Lens TsListKeysResp TsListKeysResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsListKeysResp -> Maybe Bool
_TsListKeysResp'done
           (\ TsListKeysResp
x__ Maybe Bool
y__ -> TsListKeysResp
x__ {_TsListKeysResp'done :: Maybe Bool
_TsListKeysResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsListKeysResp where
  messageName :: Proxy TsListKeysResp -> Text
messageName Proxy TsListKeysResp
_ = String -> Text
Data.Text.pack String
"TsListKeysResp"
  packedMessageDescriptor :: Proxy TsListKeysResp -> ByteString
packedMessageDescriptor Proxy TsListKeysResp
_
    = ByteString
"\n\
      \\SOTsListKeysResp\DC2\SUB\n\
      \\EOTkeys\CAN\SOH \ETX(\v2\ACK.TsRowR\EOTkeys\DC2\DC2\n\
      \\EOTdone\CAN\STX \SOH(\bR\EOTdone"
  packedFileDescriptor :: Proxy TsListKeysResp -> ByteString
packedFileDescriptor Proxy TsListKeysResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsListKeysResp)
fieldsByTag
    = let
        keys__field_descriptor :: FieldDescriptor TsListKeysResp
keys__field_descriptor
          = String
-> FieldTypeDescriptor TsRow
-> FieldAccessor TsListKeysResp TsRow
-> FieldDescriptor TsListKeysResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"keys"
              (MessageOrGroup -> FieldTypeDescriptor TsRow
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsRow)
              (Packing
-> Lens' TsListKeysResp [TsRow]
-> FieldAccessor TsListKeysResp TsRow
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"keys")) ::
              Data.ProtoLens.FieldDescriptor TsListKeysResp
        done__field_descriptor :: FieldDescriptor TsListKeysResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor TsListKeysResp Bool
-> FieldDescriptor TsListKeysResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens TsListKeysResp TsListKeysResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor TsListKeysResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor TsListKeysResp
      in
        [(Tag, FieldDescriptor TsListKeysResp)]
-> Map Tag (FieldDescriptor TsListKeysResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsListKeysResp
keys__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsListKeysResp
done__field_descriptor)]
  unknownFields :: LensLike' f TsListKeysResp FieldSet
unknownFields
    = (TsListKeysResp -> FieldSet)
-> (TsListKeysResp -> FieldSet -> TsListKeysResp)
-> Lens' TsListKeysResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsListKeysResp -> FieldSet
_TsListKeysResp'_unknownFields
        (\ TsListKeysResp
x__ FieldSet
y__ -> TsListKeysResp
x__ {_TsListKeysResp'_unknownFields :: FieldSet
_TsListKeysResp'_unknownFields = FieldSet
y__})
  defMessage :: TsListKeysResp
defMessage
    = TsListKeysResp'_constructor :: Vector TsRow -> Maybe Bool -> FieldSet -> TsListKeysResp
TsListKeysResp'_constructor
        {_TsListKeysResp'keys :: Vector TsRow
_TsListKeysResp'keys = Vector TsRow
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsListKeysResp'done :: Maybe Bool
_TsListKeysResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _TsListKeysResp'_unknownFields :: FieldSet
_TsListKeysResp'_unknownFields = []}
  parseMessage :: Parser TsListKeysResp
parseMessage
    = let
        loop ::
          TsListKeysResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsRow
             -> Data.ProtoLens.Encoding.Bytes.Parser TsListKeysResp
        loop :: TsListKeysResp
-> Growing Vector RealWorld TsRow -> Parser TsListKeysResp
loop TsListKeysResp
x Growing Vector RealWorld TsRow
mutable'keys
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsRow
frozen'keys <- IO (Vector TsRow) -> Parser (Vector TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow -> IO (Vector TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'keys)
                      (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]))))
                      TsListKeysResp -> Parser TsListKeysResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsListKeysResp TsListKeysResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsListKeysResp -> TsListKeysResp
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 TsListKeysResp TsListKeysResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter TsListKeysResp TsListKeysResp (Vector TsRow) (Vector TsRow)
-> Vector TsRow -> TsListKeysResp -> TsListKeysResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'keys") Vector TsRow
frozen'keys TsListKeysResp
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !TsRow
y <- Parser TsRow -> String -> Parser TsRow
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsRow -> Parser TsRow
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 TsRow
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"keys"
                                Growing Vector RealWorld TsRow
v <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow
-> TsRow -> IO (Growing Vector (PrimState IO) TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'keys TsRow
y)
                                TsListKeysResp
-> Growing Vector RealWorld TsRow -> Parser TsListKeysResp
loop TsListKeysResp
x Growing Vector RealWorld TsRow
v
                        Word64
16
                          -> 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
"done"
                                TsListKeysResp
-> Growing Vector RealWorld TsRow -> Parser TsListKeysResp
loop
                                  (Setter TsListKeysResp TsListKeysResp Bool Bool
-> Bool -> TsListKeysResp -> TsListKeysResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y TsListKeysResp
x)
                                  Growing Vector RealWorld TsRow
mutable'keys
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsListKeysResp
-> Growing Vector RealWorld TsRow -> Parser TsListKeysResp
loop
                                  (Setter TsListKeysResp TsListKeysResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsListKeysResp -> TsListKeysResp
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 TsListKeysResp TsListKeysResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsListKeysResp
x)
                                  Growing Vector RealWorld TsRow
mutable'keys
      in
        Parser TsListKeysResp -> String -> Parser TsListKeysResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsRow
mutable'keys <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld TsRow)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsListKeysResp
-> Growing Vector RealWorld TsRow -> Parser TsListKeysResp
loop TsListKeysResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld TsRow
mutable'keys)
          String
"TsListKeysResp"
  buildMessage :: TsListKeysResp -> Builder
buildMessage
    = \ TsListKeysResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((TsRow -> Builder) -> Vector TsRow -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ TsRow
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (TsRow -> ByteString) -> TsRow -> 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))
                           TsRow -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           TsRow
_v))
                (FoldLike
  (Vector TsRow)
  TsListKeysResp
  TsListKeysResp
  (Vector TsRow)
  (Vector TsRow)
-> TsListKeysResp -> Vector TsRow
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'keys" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'keys") TsListKeysResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Bool)
  TsListKeysResp
  TsListKeysResp
  (Maybe Bool)
  (Maybe Bool)
-> TsListKeysResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") TsListKeysResp
_x
                 of
                   Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Bool
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet TsListKeysResp TsListKeysResp FieldSet FieldSet
-> TsListKeysResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsListKeysResp TsListKeysResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsListKeysResp
_x)))
instance Control.DeepSeq.NFData TsListKeysResp where
  rnf :: TsListKeysResp -> ()
rnf
    = \ TsListKeysResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsListKeysResp -> FieldSet
_TsListKeysResp'_unknownFields TsListKeysResp
x__)
             (Vector TsRow -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsListKeysResp -> Vector TsRow
_TsListKeysResp'keys TsListKeysResp
x__)
                (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsListKeysResp -> Maybe Bool
_TsListKeysResp'done TsListKeysResp
x__) ()))
{- | Fields :
     
         * 'Proto.Riak_Fields.table' @:: Lens' TsPutReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.columns' @:: Lens' TsPutReq [TsColumnDescription]@
         * 'Proto.Riak_Fields.vec'columns' @:: Lens' TsPutReq (Data.Vector.Vector TsColumnDescription)@
         * 'Proto.Riak_Fields.rows' @:: Lens' TsPutReq [TsRow]@
         * 'Proto.Riak_Fields.vec'rows' @:: Lens' TsPutReq (Data.Vector.Vector TsRow)@ -}
data TsPutReq
  = TsPutReq'_constructor {TsPutReq -> ByteString
_TsPutReq'table :: !Data.ByteString.ByteString,
                           TsPutReq -> Vector TsColumnDescription
_TsPutReq'columns :: !(Data.Vector.Vector TsColumnDescription),
                           TsPutReq -> Vector TsRow
_TsPutReq'rows :: !(Data.Vector.Vector TsRow),
                           TsPutReq -> FieldSet
_TsPutReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsPutReq -> TsPutReq -> Bool
(TsPutReq -> TsPutReq -> Bool)
-> (TsPutReq -> TsPutReq -> Bool) -> Eq TsPutReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsPutReq -> TsPutReq -> Bool
$c/= :: TsPutReq -> TsPutReq -> Bool
== :: TsPutReq -> TsPutReq -> Bool
$c== :: TsPutReq -> TsPutReq -> Bool
Prelude.Eq, Eq TsPutReq
Eq TsPutReq
-> (TsPutReq -> TsPutReq -> Ordering)
-> (TsPutReq -> TsPutReq -> Bool)
-> (TsPutReq -> TsPutReq -> Bool)
-> (TsPutReq -> TsPutReq -> Bool)
-> (TsPutReq -> TsPutReq -> Bool)
-> (TsPutReq -> TsPutReq -> TsPutReq)
-> (TsPutReq -> TsPutReq -> TsPutReq)
-> Ord TsPutReq
TsPutReq -> TsPutReq -> Bool
TsPutReq -> TsPutReq -> Ordering
TsPutReq -> TsPutReq -> TsPutReq
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 :: TsPutReq -> TsPutReq -> TsPutReq
$cmin :: TsPutReq -> TsPutReq -> TsPutReq
max :: TsPutReq -> TsPutReq -> TsPutReq
$cmax :: TsPutReq -> TsPutReq -> TsPutReq
>= :: TsPutReq -> TsPutReq -> Bool
$c>= :: TsPutReq -> TsPutReq -> Bool
> :: TsPutReq -> TsPutReq -> Bool
$c> :: TsPutReq -> TsPutReq -> Bool
<= :: TsPutReq -> TsPutReq -> Bool
$c<= :: TsPutReq -> TsPutReq -> Bool
< :: TsPutReq -> TsPutReq -> Bool
$c< :: TsPutReq -> TsPutReq -> Bool
compare :: TsPutReq -> TsPutReq -> Ordering
$ccompare :: TsPutReq -> TsPutReq -> Ordering
$cp1Ord :: Eq TsPutReq
Prelude.Ord)
instance Prelude.Show TsPutReq where
  showsPrec :: Int -> TsPutReq -> ShowS
showsPrec Int
_ TsPutReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsPutReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsPutReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsPutReq "table" Data.ByteString.ByteString where
  fieldOf :: Proxy# "table"
-> (ByteString -> f ByteString) -> TsPutReq -> f TsPutReq
fieldOf Proxy# "table"
_
    = ((ByteString -> f ByteString) -> TsPutReq -> f TsPutReq)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsPutReq
-> f TsPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsPutReq -> ByteString)
-> (TsPutReq -> ByteString -> TsPutReq)
-> Lens TsPutReq TsPutReq ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsPutReq -> ByteString
_TsPutReq'table (\ TsPutReq
x__ ByteString
y__ -> TsPutReq
x__ {_TsPutReq'table :: ByteString
_TsPutReq'table = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsPutReq "columns" [TsColumnDescription] where
  fieldOf :: Proxy# "columns"
-> ([TsColumnDescription] -> f [TsColumnDescription])
-> TsPutReq
-> f TsPutReq
fieldOf Proxy# "columns"
_
    = ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
 -> TsPutReq -> f TsPutReq)
-> (([TsColumnDescription] -> f [TsColumnDescription])
    -> Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> ([TsColumnDescription] -> f [TsColumnDescription])
-> TsPutReq
-> f TsPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsPutReq -> Vector TsColumnDescription)
-> (TsPutReq -> Vector TsColumnDescription -> TsPutReq)
-> Lens
     TsPutReq
     TsPutReq
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsPutReq -> Vector TsColumnDescription
_TsPutReq'columns (\ TsPutReq
x__ Vector TsColumnDescription
y__ -> TsPutReq
x__ {_TsPutReq'columns :: Vector TsColumnDescription
_TsPutReq'columns = Vector TsColumnDescription
y__}))
        ((Vector TsColumnDescription -> [TsColumnDescription])
-> (Vector TsColumnDescription
    -> [TsColumnDescription] -> Vector TsColumnDescription)
-> Lens
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
     [TsColumnDescription]
     [TsColumnDescription]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsColumnDescription -> [TsColumnDescription]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsColumnDescription
_ [TsColumnDescription]
y__ -> [TsColumnDescription] -> Vector TsColumnDescription
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsColumnDescription]
y__))
instance Data.ProtoLens.Field.HasField TsPutReq "vec'columns" (Data.Vector.Vector TsColumnDescription) where
  fieldOf :: Proxy# "vec'columns"
-> (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> TsPutReq
-> f TsPutReq
fieldOf Proxy# "vec'columns"
_
    = ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
 -> TsPutReq -> f TsPutReq)
-> ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
    -> Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> TsPutReq
-> f TsPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsPutReq -> Vector TsColumnDescription)
-> (TsPutReq -> Vector TsColumnDescription -> TsPutReq)
-> Lens
     TsPutReq
     TsPutReq
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsPutReq -> Vector TsColumnDescription
_TsPutReq'columns (\ TsPutReq
x__ Vector TsColumnDescription
y__ -> TsPutReq
x__ {_TsPutReq'columns :: Vector TsColumnDescription
_TsPutReq'columns = Vector TsColumnDescription
y__}))
        (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> Vector TsColumnDescription -> f (Vector TsColumnDescription)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsPutReq "rows" [TsRow] where
  fieldOf :: Proxy# "rows" -> ([TsRow] -> f [TsRow]) -> TsPutReq -> f TsPutReq
fieldOf Proxy# "rows"
_
    = ((Vector TsRow -> f (Vector TsRow)) -> TsPutReq -> f TsPutReq)
-> (([TsRow] -> f [TsRow]) -> Vector TsRow -> f (Vector TsRow))
-> ([TsRow] -> f [TsRow])
-> TsPutReq
-> f TsPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsPutReq -> Vector TsRow)
-> (TsPutReq -> Vector TsRow -> TsPutReq)
-> Lens TsPutReq TsPutReq (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsPutReq -> Vector TsRow
_TsPutReq'rows (\ TsPutReq
x__ Vector TsRow
y__ -> TsPutReq
x__ {_TsPutReq'rows :: Vector TsRow
_TsPutReq'rows = Vector TsRow
y__}))
        ((Vector TsRow -> [TsRow])
-> (Vector TsRow -> [TsRow] -> Vector TsRow)
-> Lens (Vector TsRow) (Vector TsRow) [TsRow] [TsRow]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsRow -> [TsRow]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsRow
_ [TsRow]
y__ -> [TsRow] -> Vector TsRow
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsRow]
y__))
instance Data.ProtoLens.Field.HasField TsPutReq "vec'rows" (Data.Vector.Vector TsRow) where
  fieldOf :: Proxy# "vec'rows"
-> (Vector TsRow -> f (Vector TsRow)) -> TsPutReq -> f TsPutReq
fieldOf Proxy# "vec'rows"
_
    = ((Vector TsRow -> f (Vector TsRow)) -> TsPutReq -> f TsPutReq)
-> ((Vector TsRow -> f (Vector TsRow))
    -> Vector TsRow -> f (Vector TsRow))
-> (Vector TsRow -> f (Vector TsRow))
-> TsPutReq
-> f TsPutReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsPutReq -> Vector TsRow)
-> (TsPutReq -> Vector TsRow -> TsPutReq)
-> Lens TsPutReq TsPutReq (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsPutReq -> Vector TsRow
_TsPutReq'rows (\ TsPutReq
x__ Vector TsRow
y__ -> TsPutReq
x__ {_TsPutReq'rows :: Vector TsRow
_TsPutReq'rows = Vector TsRow
y__}))
        (Vector TsRow -> f (Vector TsRow))
-> Vector TsRow -> f (Vector TsRow)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsPutReq where
  messageName :: Proxy TsPutReq -> Text
messageName Proxy TsPutReq
_ = String -> Text
Data.Text.pack String
"TsPutReq"
  packedMessageDescriptor :: Proxy TsPutReq -> ByteString
packedMessageDescriptor Proxy TsPutReq
_
    = ByteString
"\n\
      \\bTsPutReq\DC2\DC4\n\
      \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2.\n\
      \\acolumns\CAN\STX \ETX(\v2\DC4.TsColumnDescriptionR\acolumns\DC2\SUB\n\
      \\EOTrows\CAN\ETX \ETX(\v2\ACK.TsRowR\EOTrows"
  packedFileDescriptor :: Proxy TsPutReq -> ByteString
packedFileDescriptor Proxy TsPutReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsPutReq)
fieldsByTag
    = let
        table__field_descriptor :: FieldDescriptor TsPutReq
table__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsPutReq ByteString
-> FieldDescriptor TsPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"table"
              (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 TsPutReq TsPutReq ByteString ByteString
-> FieldAccessor TsPutReq ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table")) ::
              Data.ProtoLens.FieldDescriptor TsPutReq
        columns__field_descriptor :: FieldDescriptor TsPutReq
columns__field_descriptor
          = String
-> FieldTypeDescriptor TsColumnDescription
-> FieldAccessor TsPutReq TsColumnDescription
-> FieldDescriptor TsPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"columns"
              (MessageOrGroup -> FieldTypeDescriptor TsColumnDescription
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsColumnDescription)
              (Packing
-> Lens' TsPutReq [TsColumnDescription]
-> FieldAccessor TsPutReq TsColumnDescription
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"columns")) ::
              Data.ProtoLens.FieldDescriptor TsPutReq
        rows__field_descriptor :: FieldDescriptor TsPutReq
rows__field_descriptor
          = String
-> FieldTypeDescriptor TsRow
-> FieldAccessor TsPutReq TsRow
-> FieldDescriptor TsPutReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"rows"
              (MessageOrGroup -> FieldTypeDescriptor TsRow
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsRow)
              (Packing -> Lens' TsPutReq [TsRow] -> FieldAccessor TsPutReq TsRow
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rows")) ::
              Data.ProtoLens.FieldDescriptor TsPutReq
      in
        [(Tag, FieldDescriptor TsPutReq)]
-> Map Tag (FieldDescriptor TsPutReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsPutReq
table__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsPutReq
columns__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsPutReq
rows__field_descriptor)]
  unknownFields :: LensLike' f TsPutReq FieldSet
unknownFields
    = (TsPutReq -> FieldSet)
-> (TsPutReq -> FieldSet -> TsPutReq) -> Lens' TsPutReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsPutReq -> FieldSet
_TsPutReq'_unknownFields
        (\ TsPutReq
x__ FieldSet
y__ -> TsPutReq
x__ {_TsPutReq'_unknownFields :: FieldSet
_TsPutReq'_unknownFields = FieldSet
y__})
  defMessage :: TsPutReq
defMessage
    = TsPutReq'_constructor :: ByteString
-> Vector TsColumnDescription
-> Vector TsRow
-> FieldSet
-> TsPutReq
TsPutReq'_constructor
        {_TsPutReq'table :: ByteString
_TsPutReq'table = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsPutReq'columns :: Vector TsColumnDescription
_TsPutReq'columns = Vector TsColumnDescription
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsPutReq'rows :: Vector TsRow
_TsPutReq'rows = Vector TsRow
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsPutReq'_unknownFields :: FieldSet
_TsPutReq'_unknownFields = []}
  parseMessage :: Parser TsPutReq
parseMessage
    = let
        loop ::
          TsPutReq
          -> Prelude.Bool
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsColumnDescription
                -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsRow
                   -> Data.ProtoLens.Encoding.Bytes.Parser TsPutReq
        loop :: TsPutReq
-> Bool
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsPutReq
loop TsPutReq
x Bool
required'table Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
mutable'rows
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsColumnDescription
frozen'columns <- IO (Vector TsColumnDescription)
-> Parser (Vector TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) TsColumnDescription
-> IO (Vector TsColumnDescription)
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 TsColumnDescription
Growing Vector (PrimState IO) TsColumnDescription
mutable'columns)
                      Vector TsRow
frozen'rows <- IO (Vector TsRow) -> Parser (Vector TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow -> IO (Vector TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'rows)
                      (let
                         missing :: [String]
missing = (if Bool
required'table then (:) String
"table" else [String] -> [String]
forall a. a -> a
Prelude.id) []
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsPutReq -> Parser TsPutReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsPutReq TsPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsPutReq -> TsPutReq
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 TsPutReq TsPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  TsPutReq
  TsPutReq
  (Vector TsColumnDescription)
  (Vector TsColumnDescription)
-> Vector TsColumnDescription -> TsPutReq -> TsPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'columns")
                              Vector TsColumnDescription
frozen'columns
                              (Setter TsPutReq TsPutReq (Vector TsRow) (Vector TsRow)
-> Vector TsRow -> TsPutReq -> TsPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'rows") Vector TsRow
frozen'rows TsPutReq
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
"table"
                                TsPutReq
-> Bool
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsPutReq
loop
                                  (Setter TsPutReq TsPutReq ByteString ByteString
-> ByteString -> TsPutReq -> TsPutReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") ByteString
y TsPutReq
x)
                                  Bool
Prelude.False
                                  Growing Vector RealWorld TsColumnDescription
mutable'columns
                                  Growing Vector RealWorld TsRow
mutable'rows
                        Word64
18
                          -> do !TsColumnDescription
y <- Parser TsColumnDescription -> String -> Parser TsColumnDescription
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsColumnDescription -> Parser TsColumnDescription
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 TsColumnDescription
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"columns"
                                Growing Vector RealWorld TsColumnDescription
v <- IO (Growing Vector RealWorld TsColumnDescription)
-> Parser (Growing Vector RealWorld TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsColumnDescription
-> TsColumnDescription
-> IO (Growing Vector (PrimState IO) TsColumnDescription)
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 TsColumnDescription
Growing Vector (PrimState IO) TsColumnDescription
mutable'columns TsColumnDescription
y)
                                TsPutReq
-> Bool
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsPutReq
loop TsPutReq
x Bool
required'table Growing Vector RealWorld TsColumnDescription
v Growing Vector RealWorld TsRow
mutable'rows
                        Word64
26
                          -> do !TsRow
y <- Parser TsRow -> String -> Parser TsRow
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsRow -> Parser TsRow
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 TsRow
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"rows"
                                Growing Vector RealWorld TsRow
v <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow
-> TsRow -> IO (Growing Vector (PrimState IO) TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'rows TsRow
y)
                                TsPutReq
-> Bool
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsPutReq
loop TsPutReq
x Bool
required'table Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsPutReq
-> Bool
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsPutReq
loop
                                  (Setter TsPutReq TsPutReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsPutReq -> TsPutReq
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 TsPutReq TsPutReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsPutReq
x)
                                  Bool
required'table
                                  Growing Vector RealWorld TsColumnDescription
mutable'columns
                                  Growing Vector RealWorld TsRow
mutable'rows
      in
        Parser TsPutReq -> String -> Parser TsPutReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsColumnDescription
mutable'columns <- IO (Growing Vector RealWorld TsColumnDescription)
-> Parser (Growing Vector RealWorld TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld TsColumnDescription)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld TsRow
mutable'rows <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld TsRow)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsPutReq
-> Bool
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsPutReq
loop
                TsPutReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage
                Bool
Prelude.True
                Growing Vector RealWorld TsColumnDescription
mutable'columns
                Growing Vector RealWorld TsRow
mutable'rows)
          String
"TsPutReq"
  buildMessage :: TsPutReq -> Builder
buildMessage
    = \ TsPutReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString TsPutReq TsPutReq ByteString ByteString
-> TsPutReq -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "table" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"table") TsPutReq
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((TsColumnDescription -> Builder)
-> Vector TsColumnDescription -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ TsColumnDescription
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (TsColumnDescription -> ByteString)
-> TsColumnDescription
-> 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))
                              TsColumnDescription -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              TsColumnDescription
_v))
                   (FoldLike
  (Vector TsColumnDescription)
  TsPutReq
  TsPutReq
  (Vector TsColumnDescription)
  (Vector TsColumnDescription)
-> TsPutReq -> Vector TsColumnDescription
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'columns") TsPutReq
_x))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   ((TsRow -> Builder) -> Vector TsRow -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                      (\ TsRow
_v
                         -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                              (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                              ((ByteString -> Builder)
-> (TsRow -> ByteString) -> TsRow -> 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))
                                 TsRow -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                                 TsRow
_v))
                      (FoldLike
  (Vector TsRow) TsPutReq TsPutReq (Vector TsRow) (Vector TsRow)
-> TsPutReq -> Vector TsRow
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'rows") TsPutReq
_x))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike FieldSet TsPutReq TsPutReq FieldSet FieldSet
-> TsPutReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsPutReq TsPutReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsPutReq
_x))))
instance Control.DeepSeq.NFData TsPutReq where
  rnf :: TsPutReq -> ()
rnf
    = \ TsPutReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsPutReq -> FieldSet
_TsPutReq'_unknownFields TsPutReq
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsPutReq -> ByteString
_TsPutReq'table TsPutReq
x__)
                (Vector TsColumnDescription -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsPutReq -> Vector TsColumnDescription
_TsPutReq'columns TsPutReq
x__)
                   (Vector TsRow -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsPutReq -> Vector TsRow
_TsPutReq'rows TsPutReq
x__) ())))
{- | Fields :
      -}
data TsPutResp
  = TsPutResp'_constructor {TsPutResp -> FieldSet
_TsPutResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsPutResp -> TsPutResp -> Bool
(TsPutResp -> TsPutResp -> Bool)
-> (TsPutResp -> TsPutResp -> Bool) -> Eq TsPutResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsPutResp -> TsPutResp -> Bool
$c/= :: TsPutResp -> TsPutResp -> Bool
== :: TsPutResp -> TsPutResp -> Bool
$c== :: TsPutResp -> TsPutResp -> Bool
Prelude.Eq, Eq TsPutResp
Eq TsPutResp
-> (TsPutResp -> TsPutResp -> Ordering)
-> (TsPutResp -> TsPutResp -> Bool)
-> (TsPutResp -> TsPutResp -> Bool)
-> (TsPutResp -> TsPutResp -> Bool)
-> (TsPutResp -> TsPutResp -> Bool)
-> (TsPutResp -> TsPutResp -> TsPutResp)
-> (TsPutResp -> TsPutResp -> TsPutResp)
-> Ord TsPutResp
TsPutResp -> TsPutResp -> Bool
TsPutResp -> TsPutResp -> Ordering
TsPutResp -> TsPutResp -> TsPutResp
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 :: TsPutResp -> TsPutResp -> TsPutResp
$cmin :: TsPutResp -> TsPutResp -> TsPutResp
max :: TsPutResp -> TsPutResp -> TsPutResp
$cmax :: TsPutResp -> TsPutResp -> TsPutResp
>= :: TsPutResp -> TsPutResp -> Bool
$c>= :: TsPutResp -> TsPutResp -> Bool
> :: TsPutResp -> TsPutResp -> Bool
$c> :: TsPutResp -> TsPutResp -> Bool
<= :: TsPutResp -> TsPutResp -> Bool
$c<= :: TsPutResp -> TsPutResp -> Bool
< :: TsPutResp -> TsPutResp -> Bool
$c< :: TsPutResp -> TsPutResp -> Bool
compare :: TsPutResp -> TsPutResp -> Ordering
$ccompare :: TsPutResp -> TsPutResp -> Ordering
$cp1Ord :: Eq TsPutResp
Prelude.Ord)
instance Prelude.Show TsPutResp where
  showsPrec :: Int -> TsPutResp -> ShowS
showsPrec Int
_ TsPutResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsPutResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsPutResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Message TsPutResp where
  messageName :: Proxy TsPutResp -> Text
messageName Proxy TsPutResp
_ = String -> Text
Data.Text.pack String
"TsPutResp"
  packedMessageDescriptor :: Proxy TsPutResp -> ByteString
packedMessageDescriptor Proxy TsPutResp
_
    = ByteString
"\n\
      \\tTsPutResp"
  packedFileDescriptor :: Proxy TsPutResp -> ByteString
packedFileDescriptor Proxy TsPutResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsPutResp)
fieldsByTag = let in [(Tag, FieldDescriptor TsPutResp)]
-> Map Tag (FieldDescriptor TsPutResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList []
  unknownFields :: LensLike' f TsPutResp FieldSet
unknownFields
    = (TsPutResp -> FieldSet)
-> (TsPutResp -> FieldSet -> TsPutResp) -> Lens' TsPutResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsPutResp -> FieldSet
_TsPutResp'_unknownFields
        (\ TsPutResp
x__ FieldSet
y__ -> TsPutResp
x__ {_TsPutResp'_unknownFields :: FieldSet
_TsPutResp'_unknownFields = FieldSet
y__})
  defMessage :: TsPutResp
defMessage
    = TsPutResp'_constructor :: FieldSet -> TsPutResp
TsPutResp'_constructor {_TsPutResp'_unknownFields :: FieldSet
_TsPutResp'_unknownFields = []}
  parseMessage :: Parser TsPutResp
parseMessage
    = let
        loop :: TsPutResp -> Data.ProtoLens.Encoding.Bytes.Parser TsPutResp
        loop :: TsPutResp -> Parser TsPutResp
loop TsPutResp
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]))))
                      TsPutResp -> Parser TsPutResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsPutResp TsPutResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsPutResp -> TsPutResp
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 TsPutResp TsPutResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsPutResp
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of {
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsPutResp -> Parser TsPutResp
loop
                                  (Setter TsPutResp TsPutResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsPutResp -> TsPutResp
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 TsPutResp TsPutResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsPutResp
x) }
      in
        Parser TsPutResp -> String -> Parser TsPutResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsPutResp -> Parser TsPutResp
loop TsPutResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"TsPutResp"
  buildMessage :: TsPutResp -> Builder
buildMessage
    = \ TsPutResp
_x
        -> FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
             (FoldLike FieldSet TsPutResp TsPutResp FieldSet FieldSet
-> TsPutResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsPutResp TsPutResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsPutResp
_x)
instance Control.DeepSeq.NFData TsPutResp where
  rnf :: TsPutResp -> ()
rnf
    = \ TsPutResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsPutResp -> FieldSet
_TsPutResp'_unknownFields TsPutResp
x__) ()
{- | Fields :
     
         * 'Proto.Riak_Fields.query' @:: Lens' TsQueryReq TsInterpolation@
         * 'Proto.Riak_Fields.maybe'query' @:: Lens' TsQueryReq (Prelude.Maybe TsInterpolation)@
         * 'Proto.Riak_Fields.stream' @:: Lens' TsQueryReq Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'stream' @:: Lens' TsQueryReq (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Riak_Fields.coverContext' @:: Lens' TsQueryReq Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.maybe'coverContext' @:: Lens' TsQueryReq (Prelude.Maybe Data.ByteString.ByteString)@ -}
data TsQueryReq
  = TsQueryReq'_constructor {TsQueryReq -> Maybe TsInterpolation
_TsQueryReq'query :: !(Prelude.Maybe TsInterpolation),
                             TsQueryReq -> Maybe Bool
_TsQueryReq'stream :: !(Prelude.Maybe Prelude.Bool),
                             TsQueryReq -> Maybe ByteString
_TsQueryReq'coverContext :: !(Prelude.Maybe Data.ByteString.ByteString),
                             TsQueryReq -> FieldSet
_TsQueryReq'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsQueryReq -> TsQueryReq -> Bool
(TsQueryReq -> TsQueryReq -> Bool)
-> (TsQueryReq -> TsQueryReq -> Bool) -> Eq TsQueryReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsQueryReq -> TsQueryReq -> Bool
$c/= :: TsQueryReq -> TsQueryReq -> Bool
== :: TsQueryReq -> TsQueryReq -> Bool
$c== :: TsQueryReq -> TsQueryReq -> Bool
Prelude.Eq, Eq TsQueryReq
Eq TsQueryReq
-> (TsQueryReq -> TsQueryReq -> Ordering)
-> (TsQueryReq -> TsQueryReq -> Bool)
-> (TsQueryReq -> TsQueryReq -> Bool)
-> (TsQueryReq -> TsQueryReq -> Bool)
-> (TsQueryReq -> TsQueryReq -> Bool)
-> (TsQueryReq -> TsQueryReq -> TsQueryReq)
-> (TsQueryReq -> TsQueryReq -> TsQueryReq)
-> Ord TsQueryReq
TsQueryReq -> TsQueryReq -> Bool
TsQueryReq -> TsQueryReq -> Ordering
TsQueryReq -> TsQueryReq -> TsQueryReq
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 :: TsQueryReq -> TsQueryReq -> TsQueryReq
$cmin :: TsQueryReq -> TsQueryReq -> TsQueryReq
max :: TsQueryReq -> TsQueryReq -> TsQueryReq
$cmax :: TsQueryReq -> TsQueryReq -> TsQueryReq
>= :: TsQueryReq -> TsQueryReq -> Bool
$c>= :: TsQueryReq -> TsQueryReq -> Bool
> :: TsQueryReq -> TsQueryReq -> Bool
$c> :: TsQueryReq -> TsQueryReq -> Bool
<= :: TsQueryReq -> TsQueryReq -> Bool
$c<= :: TsQueryReq -> TsQueryReq -> Bool
< :: TsQueryReq -> TsQueryReq -> Bool
$c< :: TsQueryReq -> TsQueryReq -> Bool
compare :: TsQueryReq -> TsQueryReq -> Ordering
$ccompare :: TsQueryReq -> TsQueryReq -> Ordering
$cp1Ord :: Eq TsQueryReq
Prelude.Ord)
instance Prelude.Show TsQueryReq where
  showsPrec :: Int -> TsQueryReq -> ShowS
showsPrec Int
_ TsQueryReq
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsQueryReq -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsQueryReq
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsQueryReq "query" TsInterpolation where
  fieldOf :: Proxy# "query"
-> (TsInterpolation -> f TsInterpolation)
-> TsQueryReq
-> f TsQueryReq
fieldOf Proxy# "query"
_
    = ((Maybe TsInterpolation -> f (Maybe TsInterpolation))
 -> TsQueryReq -> f TsQueryReq)
-> ((TsInterpolation -> f TsInterpolation)
    -> Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> (TsInterpolation -> f TsInterpolation)
-> TsQueryReq
-> f TsQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryReq -> Maybe TsInterpolation)
-> (TsQueryReq -> Maybe TsInterpolation -> TsQueryReq)
-> Lens
     TsQueryReq
     TsQueryReq
     (Maybe TsInterpolation)
     (Maybe TsInterpolation)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryReq -> Maybe TsInterpolation
_TsQueryReq'query (\ TsQueryReq
x__ Maybe TsInterpolation
y__ -> TsQueryReq
x__ {_TsQueryReq'query :: Maybe TsInterpolation
_TsQueryReq'query = Maybe TsInterpolation
y__}))
        (TsInterpolation -> Lens' (Maybe TsInterpolation) TsInterpolation
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens TsInterpolation
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField TsQueryReq "maybe'query" (Prelude.Maybe TsInterpolation) where
  fieldOf :: Proxy# "maybe'query"
-> (Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> TsQueryReq
-> f TsQueryReq
fieldOf Proxy# "maybe'query"
_
    = ((Maybe TsInterpolation -> f (Maybe TsInterpolation))
 -> TsQueryReq -> f TsQueryReq)
-> ((Maybe TsInterpolation -> f (Maybe TsInterpolation))
    -> Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> (Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> TsQueryReq
-> f TsQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryReq -> Maybe TsInterpolation)
-> (TsQueryReq -> Maybe TsInterpolation -> TsQueryReq)
-> Lens
     TsQueryReq
     TsQueryReq
     (Maybe TsInterpolation)
     (Maybe TsInterpolation)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryReq -> Maybe TsInterpolation
_TsQueryReq'query (\ TsQueryReq
x__ Maybe TsInterpolation
y__ -> TsQueryReq
x__ {_TsQueryReq'query :: Maybe TsInterpolation
_TsQueryReq'query = Maybe TsInterpolation
y__}))
        (Maybe TsInterpolation -> f (Maybe TsInterpolation))
-> Maybe TsInterpolation -> f (Maybe TsInterpolation)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsQueryReq "stream" Prelude.Bool where
  fieldOf :: Proxy# "stream" -> (Bool -> f Bool) -> TsQueryReq -> f TsQueryReq
fieldOf Proxy# "stream"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> TsQueryReq -> f TsQueryReq)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> TsQueryReq
-> f TsQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryReq -> Maybe Bool)
-> (TsQueryReq -> Maybe Bool -> TsQueryReq)
-> Lens TsQueryReq TsQueryReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryReq -> Maybe Bool
_TsQueryReq'stream (\ TsQueryReq
x__ Maybe Bool
y__ -> TsQueryReq
x__ {_TsQueryReq'stream :: Maybe Bool
_TsQueryReq'stream = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.False)
instance Data.ProtoLens.Field.HasField TsQueryReq "maybe'stream" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'stream"
-> (Maybe Bool -> f (Maybe Bool)) -> TsQueryReq -> f TsQueryReq
fieldOf Proxy# "maybe'stream"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> TsQueryReq -> f TsQueryReq)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> TsQueryReq
-> f TsQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryReq -> Maybe Bool)
-> (TsQueryReq -> Maybe Bool -> TsQueryReq)
-> Lens TsQueryReq TsQueryReq (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryReq -> Maybe Bool
_TsQueryReq'stream (\ TsQueryReq
x__ Maybe Bool
y__ -> TsQueryReq
x__ {_TsQueryReq'stream :: Maybe Bool
_TsQueryReq'stream = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsQueryReq "coverContext" Data.ByteString.ByteString where
  fieldOf :: Proxy# "coverContext"
-> (ByteString -> f ByteString) -> TsQueryReq -> f TsQueryReq
fieldOf Proxy# "coverContext"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> TsQueryReq -> f TsQueryReq)
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> TsQueryReq
-> f TsQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryReq -> Maybe ByteString)
-> (TsQueryReq -> Maybe ByteString -> TsQueryReq)
-> Lens TsQueryReq TsQueryReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryReq -> Maybe ByteString
_TsQueryReq'coverContext
           (\ TsQueryReq
x__ Maybe ByteString
y__ -> TsQueryReq
x__ {_TsQueryReq'coverContext :: Maybe ByteString
_TsQueryReq'coverContext = Maybe ByteString
y__}))
        (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault)
instance Data.ProtoLens.Field.HasField TsQueryReq "maybe'coverContext" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'coverContext"
-> (Maybe ByteString -> f (Maybe ByteString))
-> TsQueryReq
-> f TsQueryReq
fieldOf Proxy# "maybe'coverContext"
_
    = ((Maybe ByteString -> f (Maybe ByteString))
 -> TsQueryReq -> f TsQueryReq)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ByteString -> f (Maybe ByteString))
-> TsQueryReq
-> f TsQueryReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryReq -> Maybe ByteString)
-> (TsQueryReq -> Maybe ByteString -> TsQueryReq)
-> Lens TsQueryReq TsQueryReq (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryReq -> Maybe ByteString
_TsQueryReq'coverContext
           (\ TsQueryReq
x__ Maybe ByteString
y__ -> TsQueryReq
x__ {_TsQueryReq'coverContext :: Maybe ByteString
_TsQueryReq'coverContext = Maybe ByteString
y__}))
        (Maybe ByteString -> f (Maybe ByteString))
-> Maybe ByteString -> f (Maybe ByteString)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsQueryReq where
  messageName :: Proxy TsQueryReq -> Text
messageName Proxy TsQueryReq
_ = String -> Text
Data.Text.pack String
"TsQueryReq"
  packedMessageDescriptor :: Proxy TsQueryReq -> ByteString
packedMessageDescriptor Proxy TsQueryReq
_
    = ByteString
"\n\
      \\n\
      \TsQueryReq\DC2&\n\
      \\ENQquery\CAN\SOH \SOH(\v2\DLE.TsInterpolationR\ENQquery\DC2\GS\n\
      \\ACKstream\CAN\STX \SOH(\b:\ENQfalseR\ACKstream\DC2#\n\
      \\rcover_context\CAN\ETX \SOH(\fR\fcoverContext"
  packedFileDescriptor :: Proxy TsQueryReq -> ByteString
packedFileDescriptor Proxy TsQueryReq
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsQueryReq)
fieldsByTag
    = let
        query__field_descriptor :: FieldDescriptor TsQueryReq
query__field_descriptor
          = String
-> FieldTypeDescriptor TsInterpolation
-> FieldAccessor TsQueryReq TsInterpolation
-> FieldDescriptor TsQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"query"
              (MessageOrGroup -> FieldTypeDescriptor TsInterpolation
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsInterpolation)
              (Lens
  TsQueryReq
  TsQueryReq
  (Maybe TsInterpolation)
  (Maybe TsInterpolation)
-> FieldAccessor TsQueryReq TsInterpolation
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'query" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'query")) ::
              Data.ProtoLens.FieldDescriptor TsQueryReq
        stream__field_descriptor :: FieldDescriptor TsQueryReq
stream__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor TsQueryReq Bool
-> FieldDescriptor TsQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"stream"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens TsQueryReq TsQueryReq (Maybe Bool) (Maybe Bool)
-> FieldAccessor TsQueryReq Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'stream")) ::
              Data.ProtoLens.FieldDescriptor TsQueryReq
        coverContext__field_descriptor :: FieldDescriptor TsQueryReq
coverContext__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsQueryReq ByteString
-> FieldDescriptor TsQueryReq
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"cover_context"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens TsQueryReq TsQueryReq (Maybe ByteString) (Maybe ByteString)
-> FieldAccessor TsQueryReq ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'coverContext")) ::
              Data.ProtoLens.FieldDescriptor TsQueryReq
      in
        [(Tag, FieldDescriptor TsQueryReq)]
-> Map Tag (FieldDescriptor TsQueryReq)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsQueryReq
query__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsQueryReq
stream__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsQueryReq
coverContext__field_descriptor)]
  unknownFields :: LensLike' f TsQueryReq FieldSet
unknownFields
    = (TsQueryReq -> FieldSet)
-> (TsQueryReq -> FieldSet -> TsQueryReq)
-> Lens' TsQueryReq FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsQueryReq -> FieldSet
_TsQueryReq'_unknownFields
        (\ TsQueryReq
x__ FieldSet
y__ -> TsQueryReq
x__ {_TsQueryReq'_unknownFields :: FieldSet
_TsQueryReq'_unknownFields = FieldSet
y__})
  defMessage :: TsQueryReq
defMessage
    = TsQueryReq'_constructor :: Maybe TsInterpolation
-> Maybe Bool -> Maybe ByteString -> FieldSet -> TsQueryReq
TsQueryReq'_constructor
        {_TsQueryReq'query :: Maybe TsInterpolation
_TsQueryReq'query = Maybe TsInterpolation
forall a. Maybe a
Prelude.Nothing,
         _TsQueryReq'stream :: Maybe Bool
_TsQueryReq'stream = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _TsQueryReq'coverContext :: Maybe ByteString
_TsQueryReq'coverContext = Maybe ByteString
forall a. Maybe a
Prelude.Nothing,
         _TsQueryReq'_unknownFields :: FieldSet
_TsQueryReq'_unknownFields = []}
  parseMessage :: Parser TsQueryReq
parseMessage
    = let
        loop ::
          TsQueryReq -> Data.ProtoLens.Encoding.Bytes.Parser TsQueryReq
        loop :: TsQueryReq -> Parser TsQueryReq
loop TsQueryReq
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]))))
                      TsQueryReq -> Parser TsQueryReq
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsQueryReq TsQueryReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsQueryReq -> TsQueryReq
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 TsQueryReq TsQueryReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsQueryReq
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do TsInterpolation
y <- Parser TsInterpolation -> String -> Parser TsInterpolation
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser TsInterpolation -> Parser TsInterpolation
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 TsInterpolation
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"query"
                                TsQueryReq -> Parser TsQueryReq
loop (Setter TsQueryReq TsQueryReq TsInterpolation TsInterpolation
-> TsInterpolation -> TsQueryReq -> TsQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "query" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"query") TsInterpolation
y TsQueryReq
x)
                        Word64
16
                          -> 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
"stream"
                                TsQueryReq -> Parser TsQueryReq
loop (Setter TsQueryReq TsQueryReq Bool Bool
-> Bool -> TsQueryReq -> TsQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"stream") Bool
y TsQueryReq
x)
                        Word64
26
                          -> 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
"cover_context"
                                TsQueryReq -> Parser TsQueryReq
loop
                                  (Setter TsQueryReq TsQueryReq ByteString ByteString
-> ByteString -> TsQueryReq -> TsQueryReq
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"coverContext") ByteString
y TsQueryReq
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsQueryReq -> Parser TsQueryReq
loop
                                  (Setter TsQueryReq TsQueryReq FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsQueryReq -> TsQueryReq
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 TsQueryReq TsQueryReq FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsQueryReq
x)
      in
        Parser TsQueryReq -> String -> Parser TsQueryReq
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsQueryReq -> Parser TsQueryReq
loop TsQueryReq
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"TsQueryReq"
  buildMessage :: TsQueryReq -> Builder
buildMessage
    = \ TsQueryReq
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe TsInterpolation)
  TsQueryReq
  TsQueryReq
  (Maybe TsInterpolation)
  (Maybe TsInterpolation)
-> TsQueryReq -> Maybe TsInterpolation
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'query" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'query") TsQueryReq
_x
              of
                Maybe TsInterpolation
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just TsInterpolation
_v)
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder)
-> (TsInterpolation -> ByteString) -> TsInterpolation -> 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))
                          TsInterpolation -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                          TsInterpolation
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe Bool) TsQueryReq TsQueryReq (Maybe Bool) (Maybe Bool)
-> TsQueryReq -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'stream" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'stream") TsQueryReq
_x
                 of
                   Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just Bool
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                          ((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))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe ByteString)
  TsQueryReq
  TsQueryReq
  (Maybe ByteString)
  (Maybe ByteString)
-> TsQueryReq -> Maybe ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                          (forall s a (f :: * -> *).
(HasField s "maybe'coverContext" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'coverContext") TsQueryReq
_x
                    of
                      Maybe ByteString
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just ByteString
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
26)
                             ((\ 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 TsQueryReq TsQueryReq FieldSet FieldSet
-> TsQueryReq -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsQueryReq TsQueryReq FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsQueryReq
_x))))
instance Control.DeepSeq.NFData TsQueryReq where
  rnf :: TsQueryReq -> ()
rnf
    = \ TsQueryReq
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsQueryReq -> FieldSet
_TsQueryReq'_unknownFields TsQueryReq
x__)
             (Maybe TsInterpolation -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsQueryReq -> Maybe TsInterpolation
_TsQueryReq'query TsQueryReq
x__)
                (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsQueryReq -> Maybe Bool
_TsQueryReq'stream TsQueryReq
x__)
                   (Maybe ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsQueryReq -> Maybe ByteString
_TsQueryReq'coverContext TsQueryReq
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.columns' @:: Lens' TsQueryResp [TsColumnDescription]@
         * 'Proto.Riak_Fields.vec'columns' @:: Lens' TsQueryResp (Data.Vector.Vector TsColumnDescription)@
         * 'Proto.Riak_Fields.rows' @:: Lens' TsQueryResp [TsRow]@
         * 'Proto.Riak_Fields.vec'rows' @:: Lens' TsQueryResp (Data.Vector.Vector TsRow)@
         * 'Proto.Riak_Fields.done' @:: Lens' TsQueryResp Prelude.Bool@
         * 'Proto.Riak_Fields.maybe'done' @:: Lens' TsQueryResp (Prelude.Maybe Prelude.Bool)@ -}
data TsQueryResp
  = TsQueryResp'_constructor {TsQueryResp -> Vector TsColumnDescription
_TsQueryResp'columns :: !(Data.Vector.Vector TsColumnDescription),
                              TsQueryResp -> Vector TsRow
_TsQueryResp'rows :: !(Data.Vector.Vector TsRow),
                              TsQueryResp -> Maybe Bool
_TsQueryResp'done :: !(Prelude.Maybe Prelude.Bool),
                              TsQueryResp -> FieldSet
_TsQueryResp'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsQueryResp -> TsQueryResp -> Bool
(TsQueryResp -> TsQueryResp -> Bool)
-> (TsQueryResp -> TsQueryResp -> Bool) -> Eq TsQueryResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsQueryResp -> TsQueryResp -> Bool
$c/= :: TsQueryResp -> TsQueryResp -> Bool
== :: TsQueryResp -> TsQueryResp -> Bool
$c== :: TsQueryResp -> TsQueryResp -> Bool
Prelude.Eq, Eq TsQueryResp
Eq TsQueryResp
-> (TsQueryResp -> TsQueryResp -> Ordering)
-> (TsQueryResp -> TsQueryResp -> Bool)
-> (TsQueryResp -> TsQueryResp -> Bool)
-> (TsQueryResp -> TsQueryResp -> Bool)
-> (TsQueryResp -> TsQueryResp -> Bool)
-> (TsQueryResp -> TsQueryResp -> TsQueryResp)
-> (TsQueryResp -> TsQueryResp -> TsQueryResp)
-> Ord TsQueryResp
TsQueryResp -> TsQueryResp -> Bool
TsQueryResp -> TsQueryResp -> Ordering
TsQueryResp -> TsQueryResp -> TsQueryResp
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 :: TsQueryResp -> TsQueryResp -> TsQueryResp
$cmin :: TsQueryResp -> TsQueryResp -> TsQueryResp
max :: TsQueryResp -> TsQueryResp -> TsQueryResp
$cmax :: TsQueryResp -> TsQueryResp -> TsQueryResp
>= :: TsQueryResp -> TsQueryResp -> Bool
$c>= :: TsQueryResp -> TsQueryResp -> Bool
> :: TsQueryResp -> TsQueryResp -> Bool
$c> :: TsQueryResp -> TsQueryResp -> Bool
<= :: TsQueryResp -> TsQueryResp -> Bool
$c<= :: TsQueryResp -> TsQueryResp -> Bool
< :: TsQueryResp -> TsQueryResp -> Bool
$c< :: TsQueryResp -> TsQueryResp -> Bool
compare :: TsQueryResp -> TsQueryResp -> Ordering
$ccompare :: TsQueryResp -> TsQueryResp -> Ordering
$cp1Ord :: Eq TsQueryResp
Prelude.Ord)
instance Prelude.Show TsQueryResp where
  showsPrec :: Int -> TsQueryResp -> ShowS
showsPrec Int
_ TsQueryResp
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsQueryResp -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsQueryResp
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsQueryResp "columns" [TsColumnDescription] where
  fieldOf :: Proxy# "columns"
-> ([TsColumnDescription] -> f [TsColumnDescription])
-> TsQueryResp
-> f TsQueryResp
fieldOf Proxy# "columns"
_
    = ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
 -> TsQueryResp -> f TsQueryResp)
-> (([TsColumnDescription] -> f [TsColumnDescription])
    -> Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> ([TsColumnDescription] -> f [TsColumnDescription])
-> TsQueryResp
-> f TsQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryResp -> Vector TsColumnDescription)
-> (TsQueryResp -> Vector TsColumnDescription -> TsQueryResp)
-> Lens
     TsQueryResp
     TsQueryResp
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryResp -> Vector TsColumnDescription
_TsQueryResp'columns
           (\ TsQueryResp
x__ Vector TsColumnDescription
y__ -> TsQueryResp
x__ {_TsQueryResp'columns :: Vector TsColumnDescription
_TsQueryResp'columns = Vector TsColumnDescription
y__}))
        ((Vector TsColumnDescription -> [TsColumnDescription])
-> (Vector TsColumnDescription
    -> [TsColumnDescription] -> Vector TsColumnDescription)
-> Lens
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
     [TsColumnDescription]
     [TsColumnDescription]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsColumnDescription -> [TsColumnDescription]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsColumnDescription
_ [TsColumnDescription]
y__ -> [TsColumnDescription] -> Vector TsColumnDescription
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsColumnDescription]
y__))
instance Data.ProtoLens.Field.HasField TsQueryResp "vec'columns" (Data.Vector.Vector TsColumnDescription) where
  fieldOf :: Proxy# "vec'columns"
-> (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> TsQueryResp
-> f TsQueryResp
fieldOf Proxy# "vec'columns"
_
    = ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
 -> TsQueryResp -> f TsQueryResp)
-> ((Vector TsColumnDescription -> f (Vector TsColumnDescription))
    -> Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> TsQueryResp
-> f TsQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryResp -> Vector TsColumnDescription)
-> (TsQueryResp -> Vector TsColumnDescription -> TsQueryResp)
-> Lens
     TsQueryResp
     TsQueryResp
     (Vector TsColumnDescription)
     (Vector TsColumnDescription)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryResp -> Vector TsColumnDescription
_TsQueryResp'columns
           (\ TsQueryResp
x__ Vector TsColumnDescription
y__ -> TsQueryResp
x__ {_TsQueryResp'columns :: Vector TsColumnDescription
_TsQueryResp'columns = Vector TsColumnDescription
y__}))
        (Vector TsColumnDescription -> f (Vector TsColumnDescription))
-> Vector TsColumnDescription -> f (Vector TsColumnDescription)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsQueryResp "rows" [TsRow] where
  fieldOf :: Proxy# "rows"
-> ([TsRow] -> f [TsRow]) -> TsQueryResp -> f TsQueryResp
fieldOf Proxy# "rows"
_
    = ((Vector TsRow -> f (Vector TsRow))
 -> TsQueryResp -> f TsQueryResp)
-> (([TsRow] -> f [TsRow]) -> Vector TsRow -> f (Vector TsRow))
-> ([TsRow] -> f [TsRow])
-> TsQueryResp
-> f TsQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryResp -> Vector TsRow)
-> (TsQueryResp -> Vector TsRow -> TsQueryResp)
-> Lens TsQueryResp TsQueryResp (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryResp -> Vector TsRow
_TsQueryResp'rows (\ TsQueryResp
x__ Vector TsRow
y__ -> TsQueryResp
x__ {_TsQueryResp'rows :: Vector TsRow
_TsQueryResp'rows = Vector TsRow
y__}))
        ((Vector TsRow -> [TsRow])
-> (Vector TsRow -> [TsRow] -> Vector TsRow)
-> Lens (Vector TsRow) (Vector TsRow) [TsRow] [TsRow]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsRow -> [TsRow]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsRow
_ [TsRow]
y__ -> [TsRow] -> Vector TsRow
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsRow]
y__))
instance Data.ProtoLens.Field.HasField TsQueryResp "vec'rows" (Data.Vector.Vector TsRow) where
  fieldOf :: Proxy# "vec'rows"
-> (Vector TsRow -> f (Vector TsRow))
-> TsQueryResp
-> f TsQueryResp
fieldOf Proxy# "vec'rows"
_
    = ((Vector TsRow -> f (Vector TsRow))
 -> TsQueryResp -> f TsQueryResp)
-> ((Vector TsRow -> f (Vector TsRow))
    -> Vector TsRow -> f (Vector TsRow))
-> (Vector TsRow -> f (Vector TsRow))
-> TsQueryResp
-> f TsQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryResp -> Vector TsRow)
-> (TsQueryResp -> Vector TsRow -> TsQueryResp)
-> Lens TsQueryResp TsQueryResp (Vector TsRow) (Vector TsRow)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryResp -> Vector TsRow
_TsQueryResp'rows (\ TsQueryResp
x__ Vector TsRow
y__ -> TsQueryResp
x__ {_TsQueryResp'rows :: Vector TsRow
_TsQueryResp'rows = Vector TsRow
y__}))
        (Vector TsRow -> f (Vector TsRow))
-> Vector TsRow -> f (Vector TsRow)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsQueryResp "done" Prelude.Bool where
  fieldOf :: Proxy# "done" -> (Bool -> f Bool) -> TsQueryResp -> f TsQueryResp
fieldOf Proxy# "done"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> TsQueryResp -> f TsQueryResp)
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> TsQueryResp
-> f TsQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryResp -> Maybe Bool)
-> (TsQueryResp -> Maybe Bool -> TsQueryResp)
-> Lens TsQueryResp TsQueryResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryResp -> Maybe Bool
_TsQueryResp'done (\ TsQueryResp
x__ Maybe Bool
y__ -> TsQueryResp
x__ {_TsQueryResp'done :: Maybe Bool
_TsQueryResp'done = Maybe Bool
y__}))
        (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
Prelude.True)
instance Data.ProtoLens.Field.HasField TsQueryResp "maybe'done" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'done"
-> (Maybe Bool -> f (Maybe Bool)) -> TsQueryResp -> f TsQueryResp
fieldOf Proxy# "maybe'done"
_
    = ((Maybe Bool -> f (Maybe Bool)) -> TsQueryResp -> f TsQueryResp)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool))
-> (Maybe Bool -> f (Maybe Bool))
-> TsQueryResp
-> f TsQueryResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsQueryResp -> Maybe Bool)
-> (TsQueryResp -> Maybe Bool -> TsQueryResp)
-> Lens TsQueryResp TsQueryResp (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsQueryResp -> Maybe Bool
_TsQueryResp'done (\ TsQueryResp
x__ Maybe Bool
y__ -> TsQueryResp
x__ {_TsQueryResp'done :: Maybe Bool
_TsQueryResp'done = Maybe Bool
y__}))
        (Maybe Bool -> f (Maybe Bool)) -> Maybe Bool -> f (Maybe Bool)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsQueryResp where
  messageName :: Proxy TsQueryResp -> Text
messageName Proxy TsQueryResp
_ = String -> Text
Data.Text.pack String
"TsQueryResp"
  packedMessageDescriptor :: Proxy TsQueryResp -> ByteString
packedMessageDescriptor Proxy TsQueryResp
_
    = ByteString
"\n\
      \\vTsQueryResp\DC2.\n\
      \\acolumns\CAN\SOH \ETX(\v2\DC4.TsColumnDescriptionR\acolumns\DC2\SUB\n\
      \\EOTrows\CAN\STX \ETX(\v2\ACK.TsRowR\EOTrows\DC2\CAN\n\
      \\EOTdone\CAN\ETX \SOH(\b:\EOTtrueR\EOTdone"
  packedFileDescriptor :: Proxy TsQueryResp -> ByteString
packedFileDescriptor Proxy TsQueryResp
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsQueryResp)
fieldsByTag
    = let
        columns__field_descriptor :: FieldDescriptor TsQueryResp
columns__field_descriptor
          = String
-> FieldTypeDescriptor TsColumnDescription
-> FieldAccessor TsQueryResp TsColumnDescription
-> FieldDescriptor TsQueryResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"columns"
              (MessageOrGroup -> FieldTypeDescriptor TsColumnDescription
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsColumnDescription)
              (Packing
-> Lens' TsQueryResp [TsColumnDescription]
-> FieldAccessor TsQueryResp TsColumnDescription
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"columns")) ::
              Data.ProtoLens.FieldDescriptor TsQueryResp
        rows__field_descriptor :: FieldDescriptor TsQueryResp
rows__field_descriptor
          = String
-> FieldTypeDescriptor TsRow
-> FieldAccessor TsQueryResp TsRow
-> FieldDescriptor TsQueryResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"rows"
              (MessageOrGroup -> FieldTypeDescriptor TsRow
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsRow)
              (Packing
-> Lens' TsQueryResp [TsRow] -> FieldAccessor TsQueryResp TsRow
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"rows")) ::
              Data.ProtoLens.FieldDescriptor TsQueryResp
        done__field_descriptor :: FieldDescriptor TsQueryResp
done__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor TsQueryResp Bool
-> FieldDescriptor TsQueryResp
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"done"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens TsQueryResp TsQueryResp (Maybe Bool) (Maybe Bool)
-> FieldAccessor TsQueryResp Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done")) ::
              Data.ProtoLens.FieldDescriptor TsQueryResp
      in
        [(Tag, FieldDescriptor TsQueryResp)]
-> Map Tag (FieldDescriptor TsQueryResp)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsQueryResp
columns__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsQueryResp
rows__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsQueryResp
done__field_descriptor)]
  unknownFields :: LensLike' f TsQueryResp FieldSet
unknownFields
    = (TsQueryResp -> FieldSet)
-> (TsQueryResp -> FieldSet -> TsQueryResp)
-> Lens' TsQueryResp FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsQueryResp -> FieldSet
_TsQueryResp'_unknownFields
        (\ TsQueryResp
x__ FieldSet
y__ -> TsQueryResp
x__ {_TsQueryResp'_unknownFields :: FieldSet
_TsQueryResp'_unknownFields = FieldSet
y__})
  defMessage :: TsQueryResp
defMessage
    = TsQueryResp'_constructor :: Vector TsColumnDescription
-> Vector TsRow -> Maybe Bool -> FieldSet -> TsQueryResp
TsQueryResp'_constructor
        {_TsQueryResp'columns :: Vector TsColumnDescription
_TsQueryResp'columns = Vector TsColumnDescription
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsQueryResp'rows :: Vector TsRow
_TsQueryResp'rows = Vector TsRow
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsQueryResp'done :: Maybe Bool
_TsQueryResp'done = Maybe Bool
forall a. Maybe a
Prelude.Nothing,
         _TsQueryResp'_unknownFields :: FieldSet
_TsQueryResp'_unknownFields = []}
  parseMessage :: Parser TsQueryResp
parseMessage
    = let
        loop ::
          TsQueryResp
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsColumnDescription
             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsRow
                -> Data.ProtoLens.Encoding.Bytes.Parser TsQueryResp
        loop :: TsQueryResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsQueryResp
loop TsQueryResp
x Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
mutable'rows
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsColumnDescription
frozen'columns <- IO (Vector TsColumnDescription)
-> Parser (Vector TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                          (Growing Vector (PrimState IO) TsColumnDescription
-> IO (Vector TsColumnDescription)
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 TsColumnDescription
Growing Vector (PrimState IO) TsColumnDescription
mutable'columns)
                      Vector TsRow
frozen'rows <- IO (Vector TsRow) -> Parser (Vector TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow -> IO (Vector TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'rows)
                      (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]))))
                      TsQueryResp -> Parser TsQueryResp
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsQueryResp TsQueryResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsQueryResp -> TsQueryResp
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 TsQueryResp TsQueryResp FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  TsQueryResp
  TsQueryResp
  (Vector TsColumnDescription)
  (Vector TsColumnDescription)
-> Vector TsColumnDescription -> TsQueryResp -> TsQueryResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'columns")
                              Vector TsColumnDescription
frozen'columns
                              (Setter TsQueryResp TsQueryResp (Vector TsRow) (Vector TsRow)
-> Vector TsRow -> TsQueryResp -> TsQueryResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                 (forall s a (f :: * -> *).
(HasField s "vec'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'rows") Vector TsRow
frozen'rows TsQueryResp
x)))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !TsColumnDescription
y <- Parser TsColumnDescription -> String -> Parser TsColumnDescription
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsColumnDescription -> Parser TsColumnDescription
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 TsColumnDescription
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"columns"
                                Growing Vector RealWorld TsColumnDescription
v <- IO (Growing Vector RealWorld TsColumnDescription)
-> Parser (Growing Vector RealWorld TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsColumnDescription
-> TsColumnDescription
-> IO (Growing Vector (PrimState IO) TsColumnDescription)
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 TsColumnDescription
Growing Vector (PrimState IO) TsColumnDescription
mutable'columns TsColumnDescription
y)
                                TsQueryResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsQueryResp
loop TsQueryResp
x Growing Vector RealWorld TsColumnDescription
v Growing Vector RealWorld TsRow
mutable'rows
                        Word64
18
                          -> do !TsRow
y <- Parser TsRow -> String -> Parser TsRow
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsRow -> Parser TsRow
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 TsRow
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"rows"
                                Growing Vector RealWorld TsRow
v <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsRow
-> TsRow -> IO (Growing Vector (PrimState IO) TsRow)
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 TsRow
Growing Vector (PrimState IO) TsRow
mutable'rows TsRow
y)
                                TsQueryResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsQueryResp
loop TsQueryResp
x Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
v
                        Word64
24
                          -> 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
"done"
                                TsQueryResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsQueryResp
loop
                                  (Setter TsQueryResp TsQueryResp Bool Bool
-> Bool -> TsQueryResp -> TsQueryResp
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"done") Bool
y TsQueryResp
x)
                                  Growing Vector RealWorld TsColumnDescription
mutable'columns
                                  Growing Vector RealWorld TsRow
mutable'rows
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsQueryResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsQueryResp
loop
                                  (Setter TsQueryResp TsQueryResp FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsQueryResp -> TsQueryResp
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 TsQueryResp TsQueryResp FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsQueryResp
x)
                                  Growing Vector RealWorld TsColumnDescription
mutable'columns
                                  Growing Vector RealWorld TsRow
mutable'rows
      in
        Parser TsQueryResp -> String -> Parser TsQueryResp
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsColumnDescription
mutable'columns <- IO (Growing Vector RealWorld TsColumnDescription)
-> Parser (Growing Vector RealWorld TsColumnDescription)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                   IO (Growing Vector RealWorld TsColumnDescription)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              Growing Vector RealWorld TsRow
mutable'rows <- IO (Growing Vector RealWorld TsRow)
-> Parser (Growing Vector RealWorld TsRow)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                IO (Growing Vector RealWorld TsRow)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsQueryResp
-> Growing Vector RealWorld TsColumnDescription
-> Growing Vector RealWorld TsRow
-> Parser TsQueryResp
loop TsQueryResp
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld TsColumnDescription
mutable'columns Growing Vector RealWorld TsRow
mutable'rows)
          String
"TsQueryResp"
  buildMessage :: TsQueryResp -> Builder
buildMessage
    = \ TsQueryResp
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((TsColumnDescription -> Builder)
-> Vector TsColumnDescription -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ TsColumnDescription
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (TsColumnDescription -> ByteString)
-> TsColumnDescription
-> 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))
                           TsColumnDescription -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           TsColumnDescription
_v))
                (FoldLike
  (Vector TsColumnDescription)
  TsQueryResp
  TsQueryResp
  (Vector TsColumnDescription)
  (Vector TsColumnDescription)
-> TsQueryResp -> Vector TsColumnDescription
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'columns" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'columns") TsQueryResp
_x))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                ((TsRow -> Builder) -> Vector TsRow -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                   (\ TsRow
_v
                      -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                           (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                           ((ByteString -> Builder)
-> (TsRow -> ByteString) -> TsRow -> 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))
                              TsRow -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                              TsRow
_v))
                   (FoldLike
  (Vector TsRow)
  TsQueryResp
  TsQueryResp
  (Vector TsRow)
  (Vector TsRow)
-> TsQueryResp -> Vector TsRow
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'rows" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'rows") TsQueryResp
_x))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (case
                        FoldLike
  (Maybe Bool) TsQueryResp TsQueryResp (Maybe Bool) (Maybe Bool)
-> TsQueryResp -> Maybe Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'done" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'done") TsQueryResp
_x
                    of
                      Maybe Bool
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                      (Prelude.Just Bool
_v)
                        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                             (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                             ((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))
                   (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                      (FoldLike FieldSet TsQueryResp TsQueryResp FieldSet FieldSet
-> TsQueryResp -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsQueryResp TsQueryResp FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsQueryResp
_x))))
instance Control.DeepSeq.NFData TsQueryResp where
  rnf :: TsQueryResp -> ()
rnf
    = \ TsQueryResp
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsQueryResp -> FieldSet
_TsQueryResp'_unknownFields TsQueryResp
x__)
             (Vector TsColumnDescription -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsQueryResp -> Vector TsColumnDescription
_TsQueryResp'columns TsQueryResp
x__)
                (Vector TsRow -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsQueryResp -> Vector TsRow
_TsQueryResp'rows TsQueryResp
x__)
                   (Maybe Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsQueryResp -> Maybe Bool
_TsQueryResp'done TsQueryResp
x__) ())))
{- | Fields :
     
         * 'Proto.Riak_Fields.fieldName' @:: Lens' TsRange Data.ByteString.ByteString@
         * 'Proto.Riak_Fields.lowerBound' @:: Lens' TsRange Data.Int.Int64@
         * 'Proto.Riak_Fields.lowerBoundInclusive' @:: Lens' TsRange Prelude.Bool@
         * 'Proto.Riak_Fields.upperBound' @:: Lens' TsRange Data.Int.Int64@
         * 'Proto.Riak_Fields.upperBoundInclusive' @:: Lens' TsRange Prelude.Bool@
         * 'Proto.Riak_Fields.desc' @:: Lens' TsRange Data.ByteString.ByteString@ -}
data TsRange
  = TsRange'_constructor {TsRange -> ByteString
_TsRange'fieldName :: !Data.ByteString.ByteString,
                          TsRange -> Int64
_TsRange'lowerBound :: !Data.Int.Int64,
                          TsRange -> Bool
_TsRange'lowerBoundInclusive :: !Prelude.Bool,
                          TsRange -> Int64
_TsRange'upperBound :: !Data.Int.Int64,
                          TsRange -> Bool
_TsRange'upperBoundInclusive :: !Prelude.Bool,
                          TsRange -> ByteString
_TsRange'desc :: !Data.ByteString.ByteString,
                          TsRange -> FieldSet
_TsRange'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsRange -> TsRange -> Bool
(TsRange -> TsRange -> Bool)
-> (TsRange -> TsRange -> Bool) -> Eq TsRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsRange -> TsRange -> Bool
$c/= :: TsRange -> TsRange -> Bool
== :: TsRange -> TsRange -> Bool
$c== :: TsRange -> TsRange -> Bool
Prelude.Eq, Eq TsRange
Eq TsRange
-> (TsRange -> TsRange -> Ordering)
-> (TsRange -> TsRange -> Bool)
-> (TsRange -> TsRange -> Bool)
-> (TsRange -> TsRange -> Bool)
-> (TsRange -> TsRange -> Bool)
-> (TsRange -> TsRange -> TsRange)
-> (TsRange -> TsRange -> TsRange)
-> Ord TsRange
TsRange -> TsRange -> Bool
TsRange -> TsRange -> Ordering
TsRange -> TsRange -> TsRange
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 :: TsRange -> TsRange -> TsRange
$cmin :: TsRange -> TsRange -> TsRange
max :: TsRange -> TsRange -> TsRange
$cmax :: TsRange -> TsRange -> TsRange
>= :: TsRange -> TsRange -> Bool
$c>= :: TsRange -> TsRange -> Bool
> :: TsRange -> TsRange -> Bool
$c> :: TsRange -> TsRange -> Bool
<= :: TsRange -> TsRange -> Bool
$c<= :: TsRange -> TsRange -> Bool
< :: TsRange -> TsRange -> Bool
$c< :: TsRange -> TsRange -> Bool
compare :: TsRange -> TsRange -> Ordering
$ccompare :: TsRange -> TsRange -> Ordering
$cp1Ord :: Eq TsRange
Prelude.Ord)
instance Prelude.Show TsRange where
  showsPrec :: Int -> TsRange -> ShowS
showsPrec Int
_ TsRange
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsRange -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsRange
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsRange "fieldName" Data.ByteString.ByteString where
  fieldOf :: Proxy# "fieldName"
-> (ByteString -> f ByteString) -> TsRange -> f TsRange
fieldOf Proxy# "fieldName"
_
    = ((ByteString -> f ByteString) -> TsRange -> f TsRange)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsRange
-> f TsRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRange -> ByteString)
-> (TsRange -> ByteString -> TsRange)
-> Lens TsRange TsRange ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRange -> ByteString
_TsRange'fieldName (\ TsRange
x__ ByteString
y__ -> TsRange
x__ {_TsRange'fieldName :: ByteString
_TsRange'fieldName = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsRange "lowerBound" Data.Int.Int64 where
  fieldOf :: Proxy# "lowerBound" -> (Int64 -> f Int64) -> TsRange -> f TsRange
fieldOf Proxy# "lowerBound"
_
    = ((Int64 -> f Int64) -> TsRange -> f TsRange)
-> ((Int64 -> f Int64) -> Int64 -> f Int64)
-> (Int64 -> f Int64)
-> TsRange
-> f TsRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRange -> Int64)
-> (TsRange -> Int64 -> TsRange)
-> Lens TsRange TsRange Int64 Int64
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRange -> Int64
_TsRange'lowerBound (\ TsRange
x__ Int64
y__ -> TsRange
x__ {_TsRange'lowerBound :: Int64
_TsRange'lowerBound = Int64
y__}))
        (Int64 -> f Int64) -> Int64 -> f Int64
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsRange "lowerBoundInclusive" Prelude.Bool where
  fieldOf :: Proxy# "lowerBoundInclusive"
-> (Bool -> f Bool) -> TsRange -> f TsRange
fieldOf Proxy# "lowerBoundInclusive"
_
    = ((Bool -> f Bool) -> TsRange -> f TsRange)
-> ((Bool -> f Bool) -> Bool -> f Bool)
-> (Bool -> f Bool)
-> TsRange
-> f TsRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRange -> Bool)
-> (TsRange -> Bool -> TsRange) -> Lens TsRange TsRange Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRange -> Bool
_TsRange'lowerBoundInclusive
           (\ TsRange
x__ Bool
y__ -> TsRange
x__ {_TsRange'lowerBoundInclusive :: Bool
_TsRange'lowerBoundInclusive = Bool
y__}))
        (Bool -> f Bool) -> Bool -> f Bool
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsRange "upperBound" Data.Int.Int64 where
  fieldOf :: Proxy# "upperBound" -> (Int64 -> f Int64) -> TsRange -> f TsRange
fieldOf Proxy# "upperBound"
_
    = ((Int64 -> f Int64) -> TsRange -> f TsRange)
-> ((Int64 -> f Int64) -> Int64 -> f Int64)
-> (Int64 -> f Int64)
-> TsRange
-> f TsRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRange -> Int64)
-> (TsRange -> Int64 -> TsRange)
-> Lens TsRange TsRange Int64 Int64
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRange -> Int64
_TsRange'upperBound (\ TsRange
x__ Int64
y__ -> TsRange
x__ {_TsRange'upperBound :: Int64
_TsRange'upperBound = Int64
y__}))
        (Int64 -> f Int64) -> Int64 -> f Int64
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsRange "upperBoundInclusive" Prelude.Bool where
  fieldOf :: Proxy# "upperBoundInclusive"
-> (Bool -> f Bool) -> TsRange -> f TsRange
fieldOf Proxy# "upperBoundInclusive"
_
    = ((Bool -> f Bool) -> TsRange -> f TsRange)
-> ((Bool -> f Bool) -> Bool -> f Bool)
-> (Bool -> f Bool)
-> TsRange
-> f TsRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRange -> Bool)
-> (TsRange -> Bool -> TsRange) -> Lens TsRange TsRange Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRange -> Bool
_TsRange'upperBoundInclusive
           (\ TsRange
x__ Bool
y__ -> TsRange
x__ {_TsRange'upperBoundInclusive :: Bool
_TsRange'upperBoundInclusive = Bool
y__}))
        (Bool -> f Bool) -> Bool -> f Bool
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField TsRange "desc" Data.ByteString.ByteString where
  fieldOf :: Proxy# "desc"
-> (ByteString -> f ByteString) -> TsRange -> f TsRange
fieldOf Proxy# "desc"
_
    = ((ByteString -> f ByteString) -> TsRange -> f TsRange)
-> ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> (ByteString -> f ByteString)
-> TsRange
-> f TsRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRange -> ByteString)
-> (TsRange -> ByteString -> TsRange)
-> Lens TsRange TsRange ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRange -> ByteString
_TsRange'desc (\ TsRange
x__ ByteString
y__ -> TsRange
x__ {_TsRange'desc :: ByteString
_TsRange'desc = ByteString
y__}))
        (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsRange where
  messageName :: Proxy TsRange -> Text
messageName Proxy TsRange
_ = String -> Text
Data.Text.pack String
"TsRange"
  packedMessageDescriptor :: Proxy TsRange -> ByteString
packedMessageDescriptor Proxy TsRange
_
    = ByteString
"\n\
      \\aTsRange\DC2\GS\n\
      \\n\
      \field_name\CAN\SOH \STX(\fR\tfieldName\DC2\US\n\
      \\vlower_bound\CAN\STX \STX(\DC2R\n\
      \lowerBound\DC22\n\
      \\NAKlower_bound_inclusive\CAN\ETX \STX(\bR\DC3lowerBoundInclusive\DC2\US\n\
      \\vupper_bound\CAN\EOT \STX(\DC2R\n\
      \upperBound\DC22\n\
      \\NAKupper_bound_inclusive\CAN\ENQ \STX(\bR\DC3upperBoundInclusive\DC2\DC2\n\
      \\EOTdesc\CAN\ACK \STX(\fR\EOTdesc"
  packedFileDescriptor :: Proxy TsRange -> ByteString
packedFileDescriptor Proxy TsRange
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsRange)
fieldsByTag
    = let
        fieldName__field_descriptor :: FieldDescriptor TsRange
fieldName__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsRange ByteString
-> FieldDescriptor TsRange
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"field_name"
              (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 TsRange TsRange ByteString ByteString
-> FieldAccessor TsRange ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "fieldName" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"fieldName")) ::
              Data.ProtoLens.FieldDescriptor TsRange
        lowerBound__field_descriptor :: FieldDescriptor TsRange
lowerBound__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor TsRange Int64
-> FieldDescriptor TsRange
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"lower_bound"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (WireDefault Int64
-> Lens TsRange TsRange Int64 Int64 -> FieldAccessor TsRange Int64
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Int64
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "lowerBound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lowerBound")) ::
              Data.ProtoLens.FieldDescriptor TsRange
        lowerBoundInclusive__field_descriptor :: FieldDescriptor TsRange
lowerBoundInclusive__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor TsRange Bool
-> FieldDescriptor TsRange
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"lower_bound_inclusive"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (WireDefault Bool
-> Lens TsRange TsRange Bool Bool -> FieldAccessor TsRange Bool
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Bool
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "lowerBoundInclusive" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lowerBoundInclusive")) ::
              Data.ProtoLens.FieldDescriptor TsRange
        upperBound__field_descriptor :: FieldDescriptor TsRange
upperBound__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor TsRange Int64
-> FieldDescriptor TsRange
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"upper_bound"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.SInt64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (WireDefault Int64
-> Lens TsRange TsRange Int64 Int64 -> FieldAccessor TsRange Int64
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Int64
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "upperBound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"upperBound")) ::
              Data.ProtoLens.FieldDescriptor TsRange
        upperBoundInclusive__field_descriptor :: FieldDescriptor TsRange
upperBoundInclusive__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor TsRange Bool
-> FieldDescriptor TsRange
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"upper_bound_inclusive"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (WireDefault Bool
-> Lens TsRange TsRange Bool Bool -> FieldAccessor TsRange Bool
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Bool
forall value. WireDefault value
Data.ProtoLens.Required
                 (forall s a (f :: * -> *).
(HasField s "upperBoundInclusive" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"upperBoundInclusive")) ::
              Data.ProtoLens.FieldDescriptor TsRange
        desc__field_descriptor :: FieldDescriptor TsRange
desc__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor TsRange ByteString
-> FieldDescriptor TsRange
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"desc"
              (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 TsRange TsRange ByteString ByteString
-> FieldAccessor TsRange ByteString
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault ByteString
forall value. WireDefault value
Data.ProtoLens.Required (forall s a (f :: * -> *).
(HasField s "desc" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"desc")) ::
              Data.ProtoLens.FieldDescriptor TsRange
      in
        [(Tag, FieldDescriptor TsRange)]
-> Map Tag (FieldDescriptor TsRange)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsRange
fieldName__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor TsRange
lowerBound__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor TsRange
lowerBoundInclusive__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor TsRange
upperBound__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor TsRange
upperBoundInclusive__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor TsRange
desc__field_descriptor)]
  unknownFields :: LensLike' f TsRange FieldSet
unknownFields
    = (TsRange -> FieldSet)
-> (TsRange -> FieldSet -> TsRange) -> Lens' TsRange FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsRange -> FieldSet
_TsRange'_unknownFields
        (\ TsRange
x__ FieldSet
y__ -> TsRange
x__ {_TsRange'_unknownFields :: FieldSet
_TsRange'_unknownFields = FieldSet
y__})
  defMessage :: TsRange
defMessage
    = TsRange'_constructor :: ByteString
-> Int64
-> Bool
-> Int64
-> Bool
-> ByteString
-> FieldSet
-> TsRange
TsRange'_constructor
        {_TsRange'fieldName :: ByteString
_TsRange'fieldName = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsRange'lowerBound :: Int64
_TsRange'lowerBound = Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsRange'lowerBoundInclusive :: Bool
_TsRange'lowerBoundInclusive = Bool
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsRange'upperBound :: Int64
_TsRange'upperBound = Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsRange'upperBoundInclusive :: Bool
_TsRange'upperBoundInclusive = Bool
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsRange'desc :: ByteString
_TsRange'desc = ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _TsRange'_unknownFields :: FieldSet
_TsRange'_unknownFields = []}
  parseMessage :: Parser TsRange
parseMessage
    = let
        loop ::
          TsRange
          -> Prelude.Bool
             -> Prelude.Bool
                -> Prelude.Bool
                   -> Prelude.Bool
                      -> Prelude.Bool
                         -> Prelude.Bool -> Data.ProtoLens.Encoding.Bytes.Parser TsRange
        loop :: TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
          TsRange
x
          Bool
required'desc
          Bool
required'fieldName
          Bool
required'lowerBound
          Bool
required'lowerBoundInclusive
          Bool
required'upperBound
          Bool
required'upperBoundInclusive
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let
                         missing :: [String]
missing
                           = (if Bool
required'desc then (:) String
"desc" else [String] -> [String]
forall a. a -> a
Prelude.id)
                               ((if Bool
required'fieldName then (:) String
"field_name" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                  ((if Bool
required'lowerBound then (:) String
"lower_bound" else [String] -> [String]
forall a. a -> a
Prelude.id)
                                     ((if Bool
required'lowerBoundInclusive then
                                           (:) String
"lower_bound_inclusive"
                                       else
                                           [String] -> [String]
forall a. a -> a
Prelude.id)
                                        ((if Bool
required'upperBound then
                                              (:) String
"upper_bound"
                                          else
                                              [String] -> [String]
forall a. a -> a
Prelude.id)
                                           ((if Bool
required'upperBoundInclusive then
                                                 (:) String
"upper_bound_inclusive"
                                             else
                                                 [String] -> [String]
forall a. a -> a
Prelude.id)
                                              [])))))
                       in
                         if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [String]
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]
missing :: [Prelude.String]))))
                      TsRange -> Parser TsRange
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsRange TsRange FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsRange -> TsRange
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 TsRange TsRange FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) TsRange
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
"field_name"
                                TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                                  (Setter TsRange TsRange ByteString ByteString
-> ByteString -> TsRange -> TsRange
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "fieldName" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"fieldName") ByteString
y TsRange
x)
                                  Bool
required'desc
                                  Bool
Prelude.False
                                  Bool
required'lowerBound
                                  Bool
required'lowerBoundInclusive
                                  Bool
required'upperBound
                                  Bool
required'upperBoundInclusive
                        Word64
16
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"lower_bound"
                                TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                                  (Setter TsRange TsRange Int64 Int64 -> Int64 -> TsRange -> TsRange
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "lowerBound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lowerBound") Int64
y TsRange
x)
                                  Bool
required'desc
                                  Bool
required'fieldName
                                  Bool
Prelude.False
                                  Bool
required'lowerBoundInclusive
                                  Bool
required'upperBound
                                  Bool
required'upperBoundInclusive
                        Word64
24
                          -> 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
"lower_bound_inclusive"
                                TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                                  (Setter TsRange TsRange Bool Bool -> Bool -> TsRange -> TsRange
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "lowerBoundInclusive" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lowerBoundInclusive") Bool
y TsRange
x)
                                  Bool
required'desc
                                  Bool
required'fieldName
                                  Bool
required'lowerBound
                                  Bool
Prelude.False
                                  Bool
required'upperBound
                                  Bool
required'upperBoundInclusive
                        Word64
32
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
Data.ProtoLens.Encoding.Bytes.wordToSignedInt64
                                          ((Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                             Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                             Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt))
                                       String
"upper_bound"
                                TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                                  (Setter TsRange TsRange Int64 Int64 -> Int64 -> TsRange -> TsRange
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "upperBound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"upperBound") Int64
y TsRange
x)
                                  Bool
required'desc
                                  Bool
required'fieldName
                                  Bool
required'lowerBound
                                  Bool
required'lowerBoundInclusive
                                  Bool
Prelude.False
                                  Bool
required'upperBoundInclusive
                        Word64
40
                          -> 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
"upper_bound_inclusive"
                                TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                                  (Setter TsRange TsRange Bool Bool -> Bool -> TsRange -> TsRange
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                                     (forall s a (f :: * -> *).
(HasField s "upperBoundInclusive" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"upperBoundInclusive") Bool
y TsRange
x)
                                  Bool
required'desc
                                  Bool
required'fieldName
                                  Bool
required'lowerBound
                                  Bool
required'lowerBoundInclusive
                                  Bool
required'upperBound
                                  Bool
Prelude.False
                        Word64
50
                          -> 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
"desc"
                                TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                                  (Setter TsRange TsRange ByteString ByteString
-> ByteString -> TsRange -> TsRange
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "desc" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"desc") ByteString
y TsRange
x)
                                  Bool
Prelude.False
                                  Bool
required'fieldName
                                  Bool
required'lowerBound
                                  Bool
required'lowerBoundInclusive
                                  Bool
required'upperBound
                                  Bool
required'upperBoundInclusive
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                                  (Setter TsRange TsRange FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsRange -> TsRange
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 TsRange TsRange FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsRange
x)
                                  Bool
required'desc
                                  Bool
required'fieldName
                                  Bool
required'lowerBound
                                  Bool
required'lowerBoundInclusive
                                  Bool
required'upperBound
                                  Bool
required'upperBoundInclusive
      in
        Parser TsRange -> String -> Parser TsRange
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do TsRange
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Parser TsRange
loop
                TsRange
forall msg. Message msg => msg
Data.ProtoLens.defMessage
                Bool
Prelude.True
                Bool
Prelude.True
                Bool
Prelude.True
                Bool
Prelude.True
                Bool
Prelude.True
                Bool
Prelude.True)
          String
"TsRange"
  buildMessage :: TsRange -> Builder
buildMessage
    = \ TsRange
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (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))
                   (FoldLike ByteString TsRange TsRange ByteString ByteString
-> TsRange -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "fieldName" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"fieldName") TsRange
_x)))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                   ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                      ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                      Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                      (FoldLike Int64 TsRange TsRange Int64 Int64 -> TsRange -> Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "lowerBound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lowerBound") TsRange
_x)))
                (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                      ((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)
                         (FoldLike Bool TsRange TsRange Bool Bool -> TsRange -> Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                            (forall s a (f :: * -> *).
(HasField s "lowerBoundInclusive" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"lowerBoundInclusive") TsRange
_x)))
                   (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
32)
                         ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                            ((Word64 -> Builder) -> (Word64 -> Word64) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                               Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
                            Int64 -> Word64
Data.ProtoLens.Encoding.Bytes.signedInt64ToWord
                            (FoldLike Int64 TsRange TsRange Int64 Int64 -> TsRange -> Int64
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "upperBound" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"upperBound") TsRange
_x)))
                      (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
40)
                            ((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)
                               (FoldLike Bool TsRange TsRange Bool Bool -> TsRange -> Bool
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view
                                  (forall s a (f :: * -> *).
(HasField s "upperBoundInclusive" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"upperBoundInclusive") TsRange
_x)))
                         (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                            (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                               (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                               ((\ 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))
                                  (FoldLike ByteString TsRange TsRange ByteString ByteString
-> TsRange -> ByteString
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "desc" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"desc") TsRange
_x)))
                            (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                               (FoldLike FieldSet TsRange TsRange FieldSet FieldSet
-> TsRange -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsRange TsRange FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsRange
_x)))))))
instance Control.DeepSeq.NFData TsRange where
  rnf :: TsRange -> ()
rnf
    = \ TsRange
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsRange -> FieldSet
_TsRange'_unknownFields TsRange
x__)
             (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (TsRange -> ByteString
_TsRange'fieldName TsRange
x__)
                (Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                   (TsRange -> Int64
_TsRange'lowerBound TsRange
x__)
                   (Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                      (TsRange -> Bool
_TsRange'lowerBoundInclusive TsRange
x__)
                      (Int64 -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                         (TsRange -> Int64
_TsRange'upperBound TsRange
x__)
                         (Bool -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                            (TsRange -> Bool
_TsRange'upperBoundInclusive TsRange
x__)
                            (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsRange -> ByteString
_TsRange'desc TsRange
x__) ()))))))
{- | Fields :
     
         * 'Proto.Riak_Fields.cells' @:: Lens' TsRow [TsCell]@
         * 'Proto.Riak_Fields.vec'cells' @:: Lens' TsRow (Data.Vector.Vector TsCell)@ -}
data TsRow
  = TsRow'_constructor {TsRow -> Vector TsCell
_TsRow'cells :: !(Data.Vector.Vector TsCell),
                        TsRow -> FieldSet
_TsRow'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (TsRow -> TsRow -> Bool
(TsRow -> TsRow -> Bool) -> (TsRow -> TsRow -> Bool) -> Eq TsRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TsRow -> TsRow -> Bool
$c/= :: TsRow -> TsRow -> Bool
== :: TsRow -> TsRow -> Bool
$c== :: TsRow -> TsRow -> Bool
Prelude.Eq, Eq TsRow
Eq TsRow
-> (TsRow -> TsRow -> Ordering)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> Bool)
-> (TsRow -> TsRow -> TsRow)
-> (TsRow -> TsRow -> TsRow)
-> Ord TsRow
TsRow -> TsRow -> Bool
TsRow -> TsRow -> Ordering
TsRow -> TsRow -> TsRow
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 :: TsRow -> TsRow -> TsRow
$cmin :: TsRow -> TsRow -> TsRow
max :: TsRow -> TsRow -> TsRow
$cmax :: TsRow -> TsRow -> TsRow
>= :: TsRow -> TsRow -> Bool
$c>= :: TsRow -> TsRow -> Bool
> :: TsRow -> TsRow -> Bool
$c> :: TsRow -> TsRow -> Bool
<= :: TsRow -> TsRow -> Bool
$c<= :: TsRow -> TsRow -> Bool
< :: TsRow -> TsRow -> Bool
$c< :: TsRow -> TsRow -> Bool
compare :: TsRow -> TsRow -> Ordering
$ccompare :: TsRow -> TsRow -> Ordering
$cp1Ord :: Eq TsRow
Prelude.Ord)
instance Prelude.Show TsRow where
  showsPrec :: Int -> TsRow -> ShowS
showsPrec Int
_ TsRow
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (TsRow -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort TsRow
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField TsRow "cells" [TsCell] where
  fieldOf :: Proxy# "cells" -> ([TsCell] -> f [TsCell]) -> TsRow -> f TsRow
fieldOf Proxy# "cells"
_
    = ((Vector TsCell -> f (Vector TsCell)) -> TsRow -> f TsRow)
-> (([TsCell] -> f [TsCell]) -> Vector TsCell -> f (Vector TsCell))
-> ([TsCell] -> f [TsCell])
-> TsRow
-> f TsRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRow -> Vector TsCell)
-> (TsRow -> Vector TsCell -> TsRow)
-> Lens TsRow TsRow (Vector TsCell) (Vector TsCell)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRow -> Vector TsCell
_TsRow'cells (\ TsRow
x__ Vector TsCell
y__ -> TsRow
x__ {_TsRow'cells :: Vector TsCell
_TsRow'cells = Vector TsCell
y__}))
        ((Vector TsCell -> [TsCell])
-> (Vector TsCell -> [TsCell] -> Vector TsCell)
-> Lens (Vector TsCell) (Vector TsCell) [TsCell] [TsCell]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector TsCell -> [TsCell]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector TsCell
_ [TsCell]
y__ -> [TsCell] -> Vector TsCell
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [TsCell]
y__))
instance Data.ProtoLens.Field.HasField TsRow "vec'cells" (Data.Vector.Vector TsCell) where
  fieldOf :: Proxy# "vec'cells"
-> (Vector TsCell -> f (Vector TsCell)) -> TsRow -> f TsRow
fieldOf Proxy# "vec'cells"
_
    = ((Vector TsCell -> f (Vector TsCell)) -> TsRow -> f TsRow)
-> ((Vector TsCell -> f (Vector TsCell))
    -> Vector TsCell -> f (Vector TsCell))
-> (Vector TsCell -> f (Vector TsCell))
-> TsRow
-> f TsRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((TsRow -> Vector TsCell)
-> (TsRow -> Vector TsCell -> TsRow)
-> Lens TsRow TsRow (Vector TsCell) (Vector TsCell)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           TsRow -> Vector TsCell
_TsRow'cells (\ TsRow
x__ Vector TsCell
y__ -> TsRow
x__ {_TsRow'cells :: Vector TsCell
_TsRow'cells = Vector TsCell
y__}))
        (Vector TsCell -> f (Vector TsCell))
-> Vector TsCell -> f (Vector TsCell)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message TsRow where
  messageName :: Proxy TsRow -> Text
messageName Proxy TsRow
_ = String -> Text
Data.Text.pack String
"TsRow"
  packedMessageDescriptor :: Proxy TsRow -> ByteString
packedMessageDescriptor Proxy TsRow
_
    = ByteString
"\n\
      \\ENQTsRow\DC2\GS\n\
      \\ENQcells\CAN\SOH \ETX(\v2\a.TsCellR\ENQcells"
  packedFileDescriptor :: Proxy TsRow -> ByteString
packedFileDescriptor Proxy TsRow
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor TsRow)
fieldsByTag
    = let
        cells__field_descriptor :: FieldDescriptor TsRow
cells__field_descriptor
          = String
-> FieldTypeDescriptor TsCell
-> FieldAccessor TsRow TsCell
-> FieldDescriptor TsRow
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"cells"
              (MessageOrGroup -> FieldTypeDescriptor TsCell
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor TsCell)
              (Packing -> Lens' TsRow [TsCell] -> FieldAccessor TsRow TsCell
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "cells" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"cells")) ::
              Data.ProtoLens.FieldDescriptor TsRow
      in
        [(Tag, FieldDescriptor TsRow)] -> Map Tag (FieldDescriptor TsRow)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor TsRow
cells__field_descriptor)]
  unknownFields :: LensLike' f TsRow FieldSet
unknownFields
    = (TsRow -> FieldSet)
-> (TsRow -> FieldSet -> TsRow) -> Lens' TsRow FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        TsRow -> FieldSet
_TsRow'_unknownFields
        (\ TsRow
x__ FieldSet
y__ -> TsRow
x__ {_TsRow'_unknownFields :: FieldSet
_TsRow'_unknownFields = FieldSet
y__})
  defMessage :: TsRow
defMessage
    = TsRow'_constructor :: Vector TsCell -> FieldSet -> TsRow
TsRow'_constructor
        {_TsRow'cells :: Vector TsCell
_TsRow'cells = Vector TsCell
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _TsRow'_unknownFields :: FieldSet
_TsRow'_unknownFields = []}
  parseMessage :: Parser TsRow
parseMessage
    = let
        loop ::
          TsRow
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TsCell
             -> Data.ProtoLens.Encoding.Bytes.Parser TsRow
        loop :: TsRow -> Growing Vector RealWorld TsCell -> Parser TsRow
loop TsRow
x Growing Vector RealWorld TsCell
mutable'cells
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector TsCell
frozen'cells <- IO (Vector TsCell) -> Parser (Vector TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                        (Growing Vector (PrimState IO) TsCell -> IO (Vector TsCell)
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 TsCell
Growing Vector (PrimState IO) TsCell
mutable'cells)
                      (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]))))
                      TsRow -> Parser TsRow
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter TsRow TsRow FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsRow -> TsRow
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 TsRow TsRow FieldSet FieldSet
Data.ProtoLens.unknownFields
                           (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter TsRow TsRow (Vector TsCell) (Vector TsCell)
-> Vector TsCell -> TsRow -> TsRow
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'cells" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'cells") Vector TsCell
frozen'cells TsRow
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !TsCell
y <- Parser TsCell -> String -> Parser TsCell
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser TsCell -> Parser TsCell
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 TsCell
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"cells"
                                Growing Vector RealWorld TsCell
v <- IO (Growing Vector RealWorld TsCell)
-> Parser (Growing Vector RealWorld TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) TsCell
-> TsCell -> IO (Growing Vector (PrimState IO) TsCell)
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 TsCell
Growing Vector (PrimState IO) TsCell
mutable'cells TsCell
y)
                                TsRow -> Growing Vector RealWorld TsCell -> Parser TsRow
loop TsRow
x Growing Vector RealWorld TsCell
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                TsRow -> Growing Vector RealWorld TsCell -> Parser TsRow
loop
                                  (Setter TsRow TsRow FieldSet FieldSet
-> (FieldSet -> FieldSet) -> TsRow -> TsRow
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 TsRow TsRow FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) TsRow
x)
                                  Growing Vector RealWorld TsCell
mutable'cells
      in
        Parser TsRow -> String -> Parser TsRow
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld TsCell
mutable'cells <- IO (Growing Vector RealWorld TsCell)
-> Parser (Growing Vector RealWorld TsCell)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                 IO (Growing Vector RealWorld TsCell)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              TsRow -> Growing Vector RealWorld TsCell -> Parser TsRow
loop TsRow
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld TsCell
mutable'cells)
          String
"TsRow"
  buildMessage :: TsRow -> Builder
buildMessage
    = \ TsRow
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((TsCell -> Builder) -> Vector TsCell -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ TsCell
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (TsCell -> ByteString) -> TsCell -> 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))
                           TsCell -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage
                           TsCell
_v))
                (FoldLike
  (Vector TsCell) TsRow TsRow (Vector TsCell) (Vector TsCell)
-> TsRow -> Vector TsCell
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'cells" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'cells") TsRow
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet TsRow TsRow FieldSet FieldSet
-> TsRow -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet TsRow TsRow FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields TsRow
_x))
instance Control.DeepSeq.NFData TsRow where
  rnf :: TsRow -> ()
rnf
    = \ TsRow
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (TsRow -> FieldSet
_TsRow'_unknownFields TsRow
x__)
             (Vector TsCell -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (TsRow -> Vector TsCell
_TsRow'cells TsRow
x__) ())
packedFileDescriptor :: Data.ByteString.ByteString
packedFileDescriptor :: ByteString
packedFileDescriptor
  = ByteString
"\n\
    \\n\
    \riak.proto\"@\n\
    \\fRpbErrorResp\DC2\SYN\n\
    \\ACKerrmsg\CAN\SOH \STX(\fR\ACKerrmsg\DC2\CAN\n\
    \\aerrcode\CAN\STX \STX(\rR\aerrcode\"Q\n\
    \\DC4RpbGetServerInfoResp\DC2\DC2\n\
    \\EOTnode\CAN\SOH \SOH(\fR\EOTnode\DC2%\n\
    \\SOserver_version\CAN\STX \SOH(\fR\rserverVersion\"1\n\
    \\aRpbPair\DC2\DLE\n\
    \\ETXkey\CAN\SOH \STX(\fR\ETXkey\DC2\DC4\n\
    \\ENQvalue\CAN\STX \SOH(\fR\ENQvalue\"=\n\
    \\SIRpbGetBucketReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DC2\n\
    \\EOTtype\CAN\STX \SOH(\fR\EOTtype\"9\n\
    \\DLERpbGetBucketResp\DC2%\n\
    \\ENQprops\CAN\SOH \STX(\v2\SI.RpbBucketPropsR\ENQprops\"d\n\
    \\SIRpbSetBucketReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2%\n\
    \\ENQprops\CAN\STX \STX(\v2\SI.RpbBucketPropsR\ENQprops\DC2\DC2\n\
    \\EOTtype\CAN\ETX \SOH(\fR\EOTtype\"?\n\
    \\DC1RpbResetBucketReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DC2\n\
    \\EOTtype\CAN\STX \SOH(\fR\EOTtype\")\n\
    \\DC3RpbGetBucketTypeReq\DC2\DC2\n\
    \\EOTtype\CAN\SOH \STX(\fR\EOTtype\"P\n\
    \\DC3RpbSetBucketTypeReq\DC2\DC2\n\
    \\EOTtype\CAN\SOH \STX(\fR\EOTtype\DC2%\n\
    \\ENQprops\CAN\STX \STX(\v2\SI.RpbBucketPropsR\ENQprops\"?\n\
    \\tRpbModFun\DC2\SYN\n\
    \\ACKmodule\CAN\SOH \STX(\fR\ACKmodule\DC2\SUB\n\
    \\bfunction\CAN\STX \STX(\fR\bfunction\"G\n\
    \\rRpbCommitHook\DC2\"\n\
    \\ACKmodfun\CAN\SOH \SOH(\v2\n\
    \.RpbModFunR\ACKmodfun\DC2\DC2\n\
    \\EOTname\CAN\STX \SOH(\fR\EOTname\"\245\a\n\
    \\SORpbBucketProps\DC2\DC3\n\
    \\ENQn_val\CAN\SOH \SOH(\rR\EOTnVal\DC2\GS\n\
    \\n\
    \allow_mult\CAN\STX \SOH(\bR\tallowMult\DC2&\n\
    \\SIlast_write_wins\CAN\ETX \SOH(\bR\rlastWriteWins\DC2,\n\
    \\tprecommit\CAN\EOT \ETX(\v2\SO.RpbCommitHookR\tprecommit\DC2*\n\
    \\rhas_precommit\CAN\ENQ \SOH(\b:\ENQfalseR\fhasPrecommit\DC2.\n\
    \\n\
    \postcommit\CAN\ACK \ETX(\v2\SO.RpbCommitHookR\n\
    \postcommit\DC2,\n\
    \\SOhas_postcommit\CAN\a \SOH(\b:\ENQfalseR\rhasPostcommit\DC2-\n\
    \\fchash_keyfun\CAN\b \SOH(\v2\n\
    \.RpbModFunR\vchashKeyfun\DC2$\n\
    \\alinkfun\CAN\t \SOH(\v2\n\
    \.RpbModFunR\alinkfun\DC2\GS\n\
    \\n\
    \old_vclock\CAN\n\
    \ \SOH(\rR\toldVclock\DC2!\n\
    \\fyoung_vclock\CAN\v \SOH(\rR\vyoungVclock\DC2\GS\n\
    \\n\
    \big_vclock\CAN\f \SOH(\rR\tbigVclock\DC2!\n\
    \\fsmall_vclock\CAN\r \SOH(\rR\vsmallVclock\DC2\SO\n\
    \\STXpr\CAN\SO \SOH(\rR\STXpr\DC2\f\n\
    \\SOHr\CAN\SI \SOH(\rR\SOHr\DC2\f\n\
    \\SOHw\CAN\DLE \SOH(\rR\SOHw\DC2\SO\n\
    \\STXpw\CAN\DC1 \SOH(\rR\STXpw\DC2\SO\n\
    \\STXdw\CAN\DC2 \SOH(\rR\STXdw\DC2\SO\n\
    \\STXrw\CAN\DC3 \SOH(\rR\STXrw\DC2!\n\
    \\fbasic_quorum\CAN\DC4 \SOH(\bR\vbasicQuorum\DC2\US\n\
    \\vnotfound_ok\CAN\NAK \SOH(\bR\n\
    \notfoundOk\DC2\CAN\n\
    \\abackend\CAN\SYN \SOH(\fR\abackend\DC2\SYN\n\
    \\ACKsearch\CAN\ETB \SOH(\bR\ACKsearch\DC2/\n\
    \\EOTrepl\CAN\CAN \SOH(\SO2\ESC.RpbBucketProps.RpbReplModeR\EOTrepl\DC2!\n\
    \\fsearch_index\CAN\EM \SOH(\fR\vsearchIndex\DC2\SUB\n\
    \\bdatatype\CAN\SUB \SOH(\fR\bdatatype\DC2\RS\n\
    \\n\
    \consistent\CAN\ESC \SOH(\bR\n\
    \consistent\DC2\GS\n\
    \\n\
    \write_once\CAN\FS \SOH(\bR\twriteOnce\DC2#\n\
    \\rhll_precision\CAN\GS \SOH(\rR\fhllPrecision\DC2\DLE\n\
    \\ETXttl\CAN\RS \SOH(\rR\ETXttl\">\n\
    \\vRpbReplMode\DC2\t\n\
    \\ENQFALSE\DLE\NUL\DC2\f\n\
    \\bREALTIME\DLE\SOH\DC2\f\n\
    \\bFULLSYNC\DLE\STX\DC2\b\n\
    \\EOTTRUE\DLE\ETX\"<\n\
    \\n\
    \RpbAuthReq\DC2\DC2\n\
    \\EOTuser\CAN\SOH \STX(\fR\EOTuser\DC2\SUB\n\
    \\bpassword\CAN\STX \STX(\fR\bpassword\"\145\SOH\n\
    \\bMapField\DC2\DC2\n\
    \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2*\n\
    \\EOTtype\CAN\STX \STX(\SO2\SYN.MapField.MapFieldTypeR\EOTtype\"E\n\
    \\fMapFieldType\DC2\v\n\
    \\aCOUNTER\DLE\SOH\DC2\a\n\
    \\ETXSET\DLE\STX\DC2\f\n\
    \\bREGISTER\DLE\ETX\DC2\b\n\
    \\EOTFLAG\DLE\EOT\DC2\a\n\
    \\ETXMAP\DLE\ENQ\"\219\SOH\n\
    \\bMapEntry\DC2\US\n\
    \\ENQfield\CAN\SOH \STX(\v2\t.MapFieldR\ENQfield\DC2#\n\
    \\rcounter_value\CAN\STX \SOH(\DC2R\fcounterValue\DC2\ESC\n\
    \\tset_value\CAN\ETX \ETX(\fR\bsetValue\DC2%\n\
    \\SOregister_value\CAN\EOT \SOH(\fR\rregisterValue\DC2\GS\n\
    \\n\
    \flag_value\CAN\ENQ \SOH(\bR\tflagValue\DC2&\n\
    \\tmap_value\CAN\ACK \ETX(\v2\t.MapEntryR\bmapValue\"\175\STX\n\
    \\n\
    \DtFetchReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\DC2\n\
    \\EOTtype\CAN\ETX \STX(\fR\EOTtype\DC2\f\n\
    \\SOHr\CAN\EOT \SOH(\rR\SOHr\DC2\SO\n\
    \\STXpr\CAN\ENQ \SOH(\rR\STXpr\DC2!\n\
    \\fbasic_quorum\CAN\ACK \SOH(\bR\vbasicQuorum\DC2\US\n\
    \\vnotfound_ok\CAN\a \SOH(\bR\n\
    \notfoundOk\DC2\CAN\n\
    \\atimeout\CAN\b \SOH(\rR\atimeout\DC2#\n\
    \\rsloppy_quorum\CAN\t \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
    \\ENQn_val\CAN\n\
    \ \SOH(\rR\EOTnVal\DC2-\n\
    \\SIinclude_context\CAN\v \SOH(\b:\EOTtrueR\SOincludeContext\"\175\SOH\n\
    \\aDtValue\DC2#\n\
    \\rcounter_value\CAN\SOH \SOH(\DC2R\fcounterValue\DC2\ESC\n\
    \\tset_value\CAN\STX \ETX(\fR\bsetValue\DC2&\n\
    \\tmap_value\CAN\ETX \ETX(\v2\t.MapEntryR\bmapValue\DC2\ESC\n\
    \\thll_value\CAN\EOT \SOH(\EOTR\bhllValue\DC2\GS\n\
    \\n\
    \gset_value\CAN\ENQ \ETX(\fR\tgsetValue\"\176\SOH\n\
    \\vDtFetchResp\DC2\CAN\n\
    \\acontext\CAN\SOH \SOH(\fR\acontext\DC2)\n\
    \\EOTtype\CAN\STX \STX(\SO2\NAK.DtFetchResp.DataTypeR\EOTtype\DC2\RS\n\
    \\ENQvalue\CAN\ETX \SOH(\v2\b.DtValueR\ENQvalue\"<\n\
    \\bDataType\DC2\v\n\
    \\aCOUNTER\DLE\SOH\DC2\a\n\
    \\ETXSET\DLE\STX\DC2\a\n\
    \\ETXMAP\DLE\ETX\DC2\a\n\
    \\ETXHLL\DLE\EOT\DC2\b\n\
    \\EOTGSET\DLE\ENQ\")\n\
    \\tCounterOp\DC2\FS\n\
    \\tincrement\CAN\SOH \SOH(\DC2R\tincrement\"5\n\
    \\ENQSetOp\DC2\DC2\n\
    \\EOTadds\CAN\SOH \ETX(\fR\EOTadds\DC2\CAN\n\
    \\aremoves\CAN\STX \ETX(\fR\aremoves\"\FS\n\
    \\ACKGSetOp\DC2\DC2\n\
    \\EOTadds\CAN\SOH \ETX(\fR\EOTadds\"\ESC\n\
    \\ENQHllOp\DC2\DC2\n\
    \\EOTadds\CAN\SOH \ETX(\fR\EOTadds\"\133\STX\n\
    \\tMapUpdate\DC2\US\n\
    \\ENQfield\CAN\SOH \STX(\v2\t.MapFieldR\ENQfield\DC2)\n\
    \\n\
    \counter_op\CAN\STX \SOH(\v2\n\
    \.CounterOpR\tcounterOp\DC2\GS\n\
    \\ACKset_op\CAN\ETX \SOH(\v2\ACK.SetOpR\ENQsetOp\DC2\US\n\
    \\vregister_op\CAN\EOT \SOH(\fR\n\
    \registerOp\DC2*\n\
    \\aflag_op\CAN\ENQ \SOH(\SO2\DC1.MapUpdate.FlagOpR\ACKflagOp\DC2\GS\n\
    \\ACKmap_op\CAN\ACK \SOH(\v2\ACK.MapOpR\ENQmapOp\"!\n\
    \\ACKFlagOp\DC2\n\
    \\n\
    \\ACKENABLE\DLE\SOH\DC2\v\n\
    \\aDISABLE\DLE\STX\"R\n\
    \\ENQMapOp\DC2#\n\
    \\aremoves\CAN\SOH \ETX(\v2\t.MapFieldR\aremoves\DC2$\n\
    \\aupdates\CAN\STX \ETX(\v2\n\
    \.MapUpdateR\aupdates\"\176\SOH\n\
    \\EOTDtOp\DC2)\n\
    \\n\
    \counter_op\CAN\SOH \SOH(\v2\n\
    \.CounterOpR\tcounterOp\DC2\GS\n\
    \\ACKset_op\CAN\STX \SOH(\v2\ACK.SetOpR\ENQsetOp\DC2\GS\n\
    \\ACKmap_op\CAN\ETX \SOH(\v2\ACK.MapOpR\ENQmapOp\DC2\GS\n\
    \\ACKhll_op\CAN\EOT \SOH(\v2\ACK.HllOpR\ENQhllOp\DC2 \n\
    \\agset_op\CAN\ENQ \SOH(\v2\a.GSetOpR\ACKgsetOp\"\213\STX\n\
    \\vDtUpdateReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \SOH(\fR\ETXkey\DC2\DC2\n\
    \\EOTtype\CAN\ETX \STX(\fR\EOTtype\DC2\CAN\n\
    \\acontext\CAN\EOT \SOH(\fR\acontext\DC2\NAK\n\
    \\STXop\CAN\ENQ \STX(\v2\ENQ.DtOpR\STXop\DC2\f\n\
    \\SOHw\CAN\ACK \SOH(\rR\SOHw\DC2\SO\n\
    \\STXdw\CAN\a \SOH(\rR\STXdw\DC2\SO\n\
    \\STXpw\CAN\b \SOH(\rR\STXpw\DC2&\n\
    \\vreturn_body\CAN\t \SOH(\b:\ENQfalseR\n\
    \returnBody\DC2\CAN\n\
    \\atimeout\CAN\n\
    \ \SOH(\rR\atimeout\DC2#\n\
    \\rsloppy_quorum\CAN\v \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
    \\ENQn_val\CAN\f \SOH(\rR\EOTnVal\DC2-\n\
    \\SIinclude_context\CAN\r \SOH(\b:\EOTtrueR\SOincludeContext\"\224\SOH\n\
    \\fDtUpdateResp\DC2\DLE\n\
    \\ETXkey\CAN\SOH \SOH(\fR\ETXkey\DC2\CAN\n\
    \\acontext\CAN\STX \SOH(\fR\acontext\DC2#\n\
    \\rcounter_value\CAN\ETX \SOH(\DC2R\fcounterValue\DC2\ESC\n\
    \\tset_value\CAN\EOT \ETX(\fR\bsetValue\DC2&\n\
    \\tmap_value\CAN\ENQ \ETX(\v2\t.MapEntryR\bmapValue\DC2\ESC\n\
    \\thll_value\CAN\ACK \SOH(\EOTR\bhllValue\DC2\GS\n\
    \\n\
    \gset_value\CAN\a \ETX(\fR\tgsetValue\"\r\n\
    \\vRpbAuthResp\"\f\n\
    \\n\
    \RpbDelResp\"\DC3\n\
    \\DC1RpbGetClientIdReq\"\NAK\n\
    \\DC3RpbGetServerInfoReq\"\f\n\
    \\n\
    \RpbPingReq\"\r\n\
    \\vRpbPingResp\"\DC4\n\
    \\DC2RpbResetBucketResp\"\DC2\n\
    \\DLERpbSetBucketResp\"1\n\
    \\DC2RpbGetClientIdResp\DC2\ESC\n\
    \\tclient_id\CAN\SOH \STX(\fR\bclientId\"0\n\
    \\DC1RpbSetClientIdReq\DC2\ESC\n\
    \\tclient_id\CAN\SOH \STX(\fR\bclientId\"\218\STX\n\
    \\tRpbGetReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\f\n\
    \\SOHr\CAN\ETX \SOH(\rR\SOHr\DC2\SO\n\
    \\STXpr\CAN\EOT \SOH(\rR\STXpr\DC2!\n\
    \\fbasic_quorum\CAN\ENQ \SOH(\bR\vbasicQuorum\DC2\US\n\
    \\vnotfound_ok\CAN\ACK \SOH(\bR\n\
    \notfoundOk\DC2\US\n\
    \\vif_modified\CAN\a \SOH(\fR\n\
    \ifModified\DC2\DC2\n\
    \\EOThead\CAN\b \SOH(\bR\EOThead\DC2$\n\
    \\rdeletedvclock\CAN\t \SOH(\bR\rdeletedvclock\DC2\CAN\n\
    \\atimeout\CAN\n\
    \ \SOH(\rR\atimeout\DC2#\n\
    \\rsloppy_quorum\CAN\v \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
    \\ENQn_val\CAN\f \SOH(\rR\EOTnVal\DC2\DC2\n\
    \\EOTtype\CAN\r \SOH(\fR\EOTtype\"i\n\
    \\n\
    \RpbGetResp\DC2%\n\
    \\acontent\CAN\SOH \ETX(\v2\v.RpbContentR\acontent\DC2\SYN\n\
    \\ACKvclock\CAN\STX \SOH(\fR\ACKvclock\DC2\FS\n\
    \\tunchanged\CAN\ETX \SOH(\bR\tunchanged\"\172\ETX\n\
    \\tRpbPutReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \SOH(\fR\ETXkey\DC2\SYN\n\
    \\ACKvclock\CAN\ETX \SOH(\fR\ACKvclock\DC2%\n\
    \\acontent\CAN\EOT \STX(\v2\v.RpbContentR\acontent\DC2\f\n\
    \\SOHw\CAN\ENQ \SOH(\rR\SOHw\DC2\SO\n\
    \\STXdw\CAN\ACK \SOH(\rR\STXdw\DC2\US\n\
    \\vreturn_body\CAN\a \SOH(\bR\n\
    \returnBody\DC2\SO\n\
    \\STXpw\CAN\b \SOH(\rR\STXpw\DC2&\n\
    \\SIif_not_modified\CAN\t \SOH(\bR\rifNotModified\DC2\"\n\
    \\rif_none_match\CAN\n\
    \ \SOH(\bR\vifNoneMatch\DC2\US\n\
    \\vreturn_head\CAN\v \SOH(\bR\n\
    \returnHead\DC2\CAN\n\
    \\atimeout\CAN\f \SOH(\rR\atimeout\DC2\DC2\n\
    \\EOTasis\CAN\r \SOH(\bR\EOTasis\DC2#\n\
    \\rsloppy_quorum\CAN\SO \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
    \\ENQn_val\CAN\SI \SOH(\rR\EOTnVal\DC2\DC2\n\
    \\EOTtype\CAN\DLE \SOH(\fR\EOTtype\"]\n\
    \\n\
    \RpbPutResp\DC2%\n\
    \\acontent\CAN\SOH \ETX(\v2\v.RpbContentR\acontent\DC2\SYN\n\
    \\ACKvclock\CAN\STX \SOH(\fR\ACKvclock\DC2\DLE\n\
    \\ETXkey\CAN\ETX \SOH(\fR\ETXkey\"\145\STX\n\
    \\tRpbDelReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\SO\n\
    \\STXrw\CAN\ETX \SOH(\rR\STXrw\DC2\SYN\n\
    \\ACKvclock\CAN\EOT \SOH(\fR\ACKvclock\DC2\f\n\
    \\SOHr\CAN\ENQ \SOH(\rR\SOHr\DC2\f\n\
    \\SOHw\CAN\ACK \SOH(\rR\SOHw\DC2\SO\n\
    \\STXpr\CAN\a \SOH(\rR\STXpr\DC2\SO\n\
    \\STXpw\CAN\b \SOH(\rR\STXpw\DC2\SO\n\
    \\STXdw\CAN\t \SOH(\rR\STXdw\DC2\CAN\n\
    \\atimeout\CAN\n\
    \ \SOH(\rR\atimeout\DC2#\n\
    \\rsloppy_quorum\CAN\v \SOH(\bR\fsloppyQuorum\DC2\DC3\n\
    \\ENQn_val\CAN\f \SOH(\rR\EOTnVal\DC2\DC2\n\
    \\EOTtype\CAN\r \SOH(\fR\EOTtype\"Y\n\
    \\DC1RpbListBucketsReq\DC2\CAN\n\
    \\atimeout\CAN\SOH \SOH(\rR\atimeout\DC2\SYN\n\
    \\ACKstream\CAN\STX \SOH(\bR\ACKstream\DC2\DC2\n\
    \\EOTtype\CAN\ETX \SOH(\fR\EOTtype\"B\n\
    \\DC2RpbListBucketsResp\DC2\CAN\n\
    \\abuckets\CAN\SOH \ETX(\fR\abuckets\DC2\DC2\n\
    \\EOTdone\CAN\STX \SOH(\bR\EOTdone\"V\n\
    \\SORpbListKeysReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\CAN\n\
    \\atimeout\CAN\STX \SOH(\rR\atimeout\DC2\DC2\n\
    \\EOTtype\CAN\ETX \SOH(\fR\EOTtype\"9\n\
    \\SIRpbListKeysResp\DC2\DC2\n\
    \\EOTkeys\CAN\SOH \ETX(\fR\EOTkeys\DC2\DC2\n\
    \\EOTdone\CAN\STX \SOH(\bR\EOTdone\"K\n\
    \\fRpbMapRedReq\DC2\CAN\n\
    \\arequest\CAN\SOH \STX(\fR\arequest\DC2!\n\
    \\fcontent_type\CAN\STX \STX(\fR\vcontentType\"U\n\
    \\rRpbMapRedResp\DC2\DC4\n\
    \\ENQphase\CAN\SOH \SOH(\rR\ENQphase\DC2\SUB\n\
    \\bresponse\CAN\STX \SOH(\fR\bresponse\DC2\DC2\n\
    \\EOTdone\CAN\ETX \SOH(\bR\EOTdone\"\155\EOT\n\
    \\vRpbIndexReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DC4\n\
    \\ENQindex\CAN\STX \STX(\fR\ENQindex\DC21\n\
    \\ENQqtype\CAN\ETX \STX(\SO2\ESC.RpbIndexReq.IndexQueryTypeR\ENQqtype\DC2\DLE\n\
    \\ETXkey\CAN\EOT \SOH(\fR\ETXkey\DC2\ESC\n\
    \\trange_min\CAN\ENQ \SOH(\fR\brangeMin\DC2\ESC\n\
    \\trange_max\CAN\ACK \SOH(\fR\brangeMax\DC2!\n\
    \\freturn_terms\CAN\a \SOH(\bR\vreturnTerms\DC2\SYN\n\
    \\ACKstream\CAN\b \SOH(\bR\ACKstream\DC2\US\n\
    \\vmax_results\CAN\t \SOH(\rR\n\
    \maxResults\DC2\"\n\
    \\fcontinuation\CAN\n\
    \ \SOH(\fR\fcontinuation\DC2\CAN\n\
    \\atimeout\CAN\v \SOH(\rR\atimeout\DC2\DC2\n\
    \\EOTtype\CAN\f \SOH(\fR\EOTtype\DC2\GS\n\
    \\n\
    \term_regex\CAN\r \SOH(\fR\ttermRegex\DC2'\n\
    \\SIpagination_sort\CAN\SO \SOH(\bR\SOpaginationSort\DC2#\n\
    \\rcover_context\CAN\SI \SOH(\fR\fcoverContext\DC2\US\n\
    \\vreturn_body\CAN\DLE \SOH(\bR\n\
    \returnBody\"#\n\
    \\SOIndexQueryType\DC2\ACK\n\
    \\STXeq\DLE\NUL\DC2\t\n\
    \\ENQrange\DLE\SOH\"~\n\
    \\fRpbIndexResp\DC2\DC2\n\
    \\EOTkeys\CAN\SOH \ETX(\fR\EOTkeys\DC2\"\n\
    \\aresults\CAN\STX \ETX(\v2\b.RpbPairR\aresults\DC2\"\n\
    \\fcontinuation\CAN\ETX \SOH(\fR\fcontinuation\DC2\DC2\n\
    \\EOTdone\CAN\EOT \SOH(\bR\EOTdone\"u\n\
    \\DLERpbIndexBodyResp\DC2)\n\
    \\aobjects\CAN\SOH \ETX(\v2\SI.RpbIndexObjectR\aobjects\DC2\"\n\
    \\fcontinuation\CAN\STX \SOH(\fR\fcontinuation\DC2\DC2\n\
    \\EOTdone\CAN\ETX \SOH(\bR\EOTdone\"\189\STX\n\
    \\SORpbCSBucketReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\ESC\n\
    \\tstart_key\CAN\STX \STX(\fR\bstartKey\DC2\ETB\n\
    \\aend_key\CAN\ETX \SOH(\fR\ACKendKey\DC2#\n\
    \\n\
    \start_incl\CAN\EOT \SOH(\b:\EOTtrueR\tstartIncl\DC2 \n\
    \\bend_incl\CAN\ENQ \SOH(\b:\ENQfalseR\aendIncl\DC2\"\n\
    \\fcontinuation\CAN\ACK \SOH(\fR\fcontinuation\DC2\US\n\
    \\vmax_results\CAN\a \SOH(\rR\n\
    \maxResults\DC2\CAN\n\
    \\atimeout\CAN\b \SOH(\rR\atimeout\DC2\DC2\n\
    \\EOTtype\CAN\t \SOH(\fR\EOTtype\DC2#\n\
    \\rcover_context\CAN\n\
    \ \SOH(\fR\fcoverContext\"t\n\
    \\SIRpbCSBucketResp\DC2)\n\
    \\aobjects\CAN\SOH \ETX(\v2\SI.RpbIndexObjectR\aobjects\DC2\"\n\
    \\fcontinuation\CAN\STX \SOH(\fR\fcontinuation\DC2\DC2\n\
    \\EOTdone\CAN\ETX \SOH(\bR\EOTdone\"G\n\
    \\SORpbIndexObject\DC2\DLE\n\
    \\ETXkey\CAN\SOH \STX(\fR\ETXkey\DC2#\n\
    \\ACKobject\CAN\STX \STX(\v2\v.RpbGetRespR\ACKobject\"\245\STX\n\
    \\n\
    \RpbContent\DC2\DC4\n\
    \\ENQvalue\CAN\SOH \STX(\fR\ENQvalue\DC2!\n\
    \\fcontent_type\CAN\STX \SOH(\fR\vcontentType\DC2\CAN\n\
    \\acharset\CAN\ETX \SOH(\fR\acharset\DC2)\n\
    \\DLEcontent_encoding\CAN\EOT \SOH(\fR\SIcontentEncoding\DC2\DC2\n\
    \\EOTvtag\CAN\ENQ \SOH(\fR\EOTvtag\DC2\RS\n\
    \\ENQlinks\CAN\ACK \ETX(\v2\b.RpbLinkR\ENQlinks\DC2\EM\n\
    \\blast_mod\CAN\a \SOH(\rR\alastMod\DC2$\n\
    \\SOlast_mod_usecs\CAN\b \SOH(\rR\flastModUsecs\DC2$\n\
    \\busermeta\CAN\t \ETX(\v2\b.RpbPairR\busermeta\DC2\"\n\
    \\aindexes\CAN\n\
    \ \ETX(\v2\b.RpbPairR\aindexes\DC2\CAN\n\
    \\adeleted\CAN\v \SOH(\bR\adeleted\DC2\DLE\n\
    \\ETXttl\CAN\f \SOH(\rR\ETXttl\"E\n\
    \\aRpbLink\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \SOH(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \SOH(\fR\ETXkey\DC2\DLE\n\
    \\ETXtag\CAN\ETX \SOH(\fR\ETXtag\"\167\SOH\n\
    \\DC3RpbCounterUpdateReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\SYN\n\
    \\ACKamount\CAN\ETX \STX(\DC2R\ACKamount\DC2\f\n\
    \\SOHw\CAN\EOT \SOH(\rR\SOHw\DC2\SO\n\
    \\STXdw\CAN\ENQ \SOH(\rR\STXdw\DC2\SO\n\
    \\STXpw\CAN\ACK \SOH(\rR\STXpw\DC2 \n\
    \\vreturnvalue\CAN\a \SOH(\bR\vreturnvalue\",\n\
    \\DC4RpbCounterUpdateResp\DC2\DC4\n\
    \\ENQvalue\CAN\SOH \SOH(\DC2R\ENQvalue\"\158\SOH\n\
    \\DLERpbCounterGetReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\f\n\
    \\SOHr\CAN\ETX \SOH(\rR\SOHr\DC2\SO\n\
    \\STXpr\CAN\EOT \SOH(\rR\STXpr\DC2!\n\
    \\fbasic_quorum\CAN\ENQ \SOH(\bR\vbasicQuorum\DC2\US\n\
    \\vnotfound_ok\CAN\ACK \SOH(\bR\n\
    \notfoundOk\")\n\
    \\DC1RpbCounterGetResp\DC2\DC4\n\
    \\ENQvalue\CAN\SOH \SOH(\DC2R\ENQvalue\"Z\n\
    \\SUBRpbGetBucketKeyPreflistReq\DC2\SYN\n\
    \\ACKbucket\CAN\SOH \STX(\fR\ACKbucket\DC2\DLE\n\
    \\ETXkey\CAN\STX \STX(\fR\ETXkey\DC2\DC2\n\
    \\EOTtype\CAN\ETX \SOH(\fR\EOTtype\"T\n\
    \\ESCRpbGetBucketKeyPreflistResp\DC25\n\
    \\bpreflist\CAN\SOH \ETX(\v2\EM.RpbBucketKeyPreflistItemR\bpreflist\"f\n\
    \\CANRpbBucketKeyPreflistItem\DC2\FS\n\
    \\tpartition\CAN\SOH \STX(\ETXR\tpartition\DC2\DC2\n\
    \\EOTnode\CAN\STX \STX(\fR\EOTnode\DC2\CAN\n\
    \\aprimary\CAN\ETX \STX(\bR\aprimary\"\181\SOH\n\
    \\SORpbCoverageReq\DC2\DC2\n\
    \\EOTtype\CAN\SOH \SOH(\fR\EOTtype\DC2\SYN\n\
    \\ACKbucket\CAN\STX \STX(\fR\ACKbucket\DC2%\n\
    \\SOmin_partitions\CAN\ETX \SOH(\rR\rminPartitions\DC2#\n\
    \\rreplace_cover\CAN\EOT \SOH(\fR\freplaceCover\DC2+\n\
    \\DC1unavailable_cover\CAN\ENQ \ETX(\fR\DLEunavailableCover\">\n\
    \\SIRpbCoverageResp\DC2+\n\
    \\aentries\CAN\SOH \ETX(\v2\DC1.RpbCoverageEntryR\aentries\"\128\SOH\n\
    \\DLERpbCoverageEntry\DC2\SO\n\
    \\STXip\CAN\SOH \STX(\fR\STXip\DC2\DC2\n\
    \\EOTport\CAN\STX \STX(\rR\EOTport\DC2#\n\
    \\rkeyspace_desc\CAN\ETX \SOH(\fR\fkeyspaceDesc\DC2#\n\
    \\rcover_context\CAN\EOT \STX(\fR\fcoverContext\"0\n\
    \\fRpbSearchDoc\DC2 \n\
    \\ACKfields\CAN\SOH \ETX(\v2\b.RpbPairR\ACKfields\"\215\SOH\n\
    \\DC1RpbSearchQueryReq\DC2\f\n\
    \\SOHq\CAN\SOH \STX(\fR\SOHq\DC2\DC4\n\
    \\ENQindex\CAN\STX \STX(\fR\ENQindex\DC2\DC2\n\
    \\EOTrows\CAN\ETX \SOH(\rR\EOTrows\DC2\DC4\n\
    \\ENQstart\CAN\EOT \SOH(\rR\ENQstart\DC2\DC2\n\
    \\EOTsort\CAN\ENQ \SOH(\fR\EOTsort\DC2\SYN\n\
    \\ACKfilter\CAN\ACK \SOH(\fR\ACKfilter\DC2\SO\n\
    \\STXdf\CAN\a \SOH(\fR\STXdf\DC2\SO\n\
    \\STXop\CAN\b \SOH(\fR\STXop\DC2\SO\n\
    \\STXfl\CAN\t \ETX(\fR\STXfl\DC2\CAN\n\
    \\apresort\CAN\n\
    \ \SOH(\fR\apresort\"q\n\
    \\DC2RpbSearchQueryResp\DC2!\n\
    \\EOTdocs\CAN\SOH \ETX(\v2\r.RpbSearchDocR\EOTdocs\DC2\ESC\n\
    \\tmax_score\CAN\STX \SOH(\STXR\bmaxScore\DC2\ESC\n\
    \\tnum_found\CAN\ETX \SOH(\rR\bnumFound\"x\n\
    \\n\
    \TsQueryReq\DC2&\n\
    \\ENQquery\CAN\SOH \SOH(\v2\DLE.TsInterpolationR\ENQquery\DC2\GS\n\
    \\ACKstream\CAN\STX \SOH(\b:\ENQfalseR\ACKstream\DC2#\n\
    \\rcover_context\CAN\ETX \SOH(\fR\fcoverContext\"s\n\
    \\vTsQueryResp\DC2.\n\
    \\acolumns\CAN\SOH \ETX(\v2\DC4.TsColumnDescriptionR\acolumns\DC2\SUB\n\
    \\EOTrows\CAN\STX \ETX(\v2\ACK.TsRowR\EOTrows\DC2\CAN\n\
    \\EOTdone\CAN\ETX \SOH(\b:\EOTtrueR\EOTdone\"U\n\
    \\bTsGetReq\DC2\DC4\n\
    \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2\EM\n\
    \\ETXkey\CAN\STX \ETX(\v2\a.TsCellR\ETXkey\DC2\CAN\n\
    \\atimeout\CAN\ETX \SOH(\rR\atimeout\"W\n\
    \\tTsGetResp\DC2.\n\
    \\acolumns\CAN\SOH \ETX(\v2\DC4.TsColumnDescriptionR\acolumns\DC2\SUB\n\
    \\EOTrows\CAN\STX \ETX(\v2\ACK.TsRowR\EOTrows\"l\n\
    \\bTsPutReq\DC2\DC4\n\
    \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2.\n\
    \\acolumns\CAN\STX \ETX(\v2\DC4.TsColumnDescriptionR\acolumns\DC2\SUB\n\
    \\EOTrows\CAN\ETX \ETX(\v2\ACK.TsRowR\EOTrows\"\v\n\
    \\tTsPutResp\"m\n\
    \\bTsDelReq\DC2\DC4\n\
    \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2\EM\n\
    \\ETXkey\CAN\STX \ETX(\v2\a.TsCellR\ETXkey\DC2\SYN\n\
    \\ACKvclock\CAN\ETX \SOH(\fR\ACKvclock\DC2\CAN\n\
    \\atimeout\CAN\EOT \SOH(\rR\atimeout\"\v\n\
    \\tTsDelResp\"W\n\
    \\SITsInterpolation\DC2\DC2\n\
    \\EOTbase\CAN\SOH \STX(\fR\EOTbase\DC20\n\
    \\SOinterpolations\CAN\STX \ETX(\v2\b.RpbPairR\SOinterpolations\"L\n\
    \\DC3TsColumnDescription\DC2\DC2\n\
    \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2!\n\
    \\EOTtype\CAN\STX \STX(\SO2\r.TsColumnTypeR\EOTtype\"&\n\
    \\ENQTsRow\DC2\GS\n\
    \\ENQcells\CAN\SOH \ETX(\v2\a.TsCellR\ENQcells\"\193\SOH\n\
    \\ACKTsCell\DC2#\n\
    \\rvarchar_value\CAN\SOH \SOH(\fR\fvarcharValue\DC2!\n\
    \\fsint64_value\CAN\STX \SOH(\DC2R\vsint64Value\DC2'\n\
    \\SItimestamp_value\CAN\ETX \SOH(\DC2R\SOtimestampValue\DC2#\n\
    \\rboolean_value\CAN\EOT \SOH(\bR\fbooleanValue\DC2!\n\
    \\fdouble_value\CAN\ENQ \SOH(\SOHR\vdoubleValue\"?\n\
    \\rTsListKeysReq\DC2\DC4\n\
    \\ENQtable\CAN\SOH \STX(\fR\ENQtable\DC2\CAN\n\
    \\atimeout\CAN\STX \SOH(\rR\atimeout\"@\n\
    \\SOTsListKeysResp\DC2\SUB\n\
    \\EOTkeys\CAN\SOH \ETX(\v2\ACK.TsRowR\EOTkeys\DC2\DC2\n\
    \\EOTdone\CAN\STX \SOH(\bR\EOTdone\"\159\SOH\n\
    \\rTsCoverageReq\DC2&\n\
    \\ENQquery\CAN\SOH \SOH(\v2\DLE.TsInterpolationR\ENQquery\DC2\DC4\n\
    \\ENQtable\CAN\STX \STX(\fR\ENQtable\DC2#\n\
    \\rreplace_cover\CAN\ETX \SOH(\fR\freplaceCover\DC2+\n\
    \\DC1unavailable_cover\CAN\EOT \ETX(\fR\DLEunavailableCover\"<\n\
    \\SOTsCoverageResp\DC2*\n\
    \\aentries\CAN\SOH \ETX(\v2\DLE.TsCoverageEntryR\aentries\"z\n\
    \\SITsCoverageEntry\DC2\SO\n\
    \\STXip\CAN\SOH \STX(\fR\STXip\DC2\DC2\n\
    \\EOTport\CAN\STX \STX(\rR\EOTport\DC2#\n\
    \\rcover_context\CAN\ETX \STX(\fR\fcoverContext\DC2\RS\n\
    \\ENQrange\CAN\EOT \SOH(\v2\b.TsRangeR\ENQrange\"\230\SOH\n\
    \\aTsRange\DC2\GS\n\
    \\n\
    \field_name\CAN\SOH \STX(\fR\tfieldName\DC2\US\n\
    \\vlower_bound\CAN\STX \STX(\DC2R\n\
    \lowerBound\DC22\n\
    \\NAKlower_bound_inclusive\CAN\ETX \STX(\bR\DC3lowerBoundInclusive\DC2\US\n\
    \\vupper_bound\CAN\EOT \STX(\DC2R\n\
    \upperBound\DC22\n\
    \\NAKupper_bound_inclusive\CAN\ENQ \STX(\bR\DC3upperBoundInclusive\DC2\DC2\n\
    \\EOTdesc\CAN\ACK \STX(\fR\EOTdesc\"S\n\
    \\DLERpbYokozunaIndex\DC2\DC2\n\
    \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2\SYN\n\
    \\ACKschema\CAN\STX \SOH(\fR\ACKschema\DC2\DC3\n\
    \\ENQn_val\CAN\ETX \SOH(\rR\EOTnVal\",\n\
    \\SYNRpbYokozunaIndexGetReq\DC2\DC2\n\
    \\EOTname\CAN\SOH \SOH(\fR\EOTname\"B\n\
    \\ETBRpbYokozunaIndexGetResp\DC2'\n\
    \\ENQindex\CAN\SOH \ETX(\v2\DC1.RpbYokozunaIndexR\ENQindex\"[\n\
    \\SYNRpbYokozunaIndexPutReq\DC2'\n\
    \\ENQindex\CAN\SOH \STX(\v2\DC1.RpbYokozunaIndexR\ENQindex\DC2\CAN\n\
    \\atimeout\CAN\STX \SOH(\rR\atimeout\"/\n\
    \\EMRpbYokozunaIndexDeleteReq\DC2\DC2\n\
    \\EOTname\CAN\SOH \STX(\fR\EOTname\"A\n\
    \\DC1RpbYokozunaSchema\DC2\DC2\n\
    \\EOTname\CAN\SOH \STX(\fR\EOTname\DC2\CAN\n\
    \\acontent\CAN\STX \SOH(\fR\acontent\"E\n\
    \\ETBRpbYokozunaSchemaPutReq\DC2*\n\
    \\ACKschema\CAN\SOH \STX(\v2\DC2.RpbYokozunaSchemaR\ACKschema\"-\n\
    \\ETBRpbYokozunaSchemaGetReq\DC2\DC2\n\
    \\EOTname\CAN\SOH \STX(\fR\EOTname\"F\n\
    \\CANRpbYokozunaSchemaGetResp\DC2*\n\
    \\ACKschema\CAN\SOH \STX(\v2\DC2.RpbYokozunaSchemaR\ACKschema*Y\n\
    \\fTsColumnType\DC2\v\n\
    \\aVARCHAR\DLE\NUL\DC2\n\
    \\n\
    \\ACKSINT64\DLE\SOH\DC2\n\
    \\n\
    \\ACKDOUBLE\DLE\STX\DC2\r\n\
    \\tTIMESTAMP\DLE\ETX\DC2\v\n\
    \\aBOOLEAN\DLE\EOT\DC2\b\n\
    \\EOTBLOB\DLE\ENQJ\249\188\STX\n\
    \\a\DC2\ENQ\NUL\NUL\246\a\SOH\n\
    \\199\ETX\n\
    \\SOH\f\DC2\ETX\NUL\NUL\DC2\"\188\ETX -------------------------------------------------------------------\n\
    \ riak.proto: Protocol buffers for Riak\n\
    \ -------------------------------------------------------------------\n\
    \\n\
    \ NOTE: IMPORTANT\n\
    \ Any change to the definitions in this file REQUIRES the following\n\
    \ steps after:\n\
    \\n\
    \ # Re-generate erlang source from changed .proto files:\n\
    \ make erl_protogen\n\
    \\n\
    \ # Commit changed files:\n\
    \ git add -A; git commit -m 'Update erlang code from .proto files'\n\
    \\n\
    \\177\SOH\n\
    \\STX\EOT\NUL\DC2\EOT\NAK\NUL\CAN\SOH\SUB/ Error response - may be generated for any Req\n\
    \2t Java package specifiers\n\
    \ option java_package = \"com.basho.riak.protobuf\";\n\
    \ option java_outer_classname = \"RiakPB\";\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\NUL\SOH\DC2\ETX\NAK\b\DC4\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\NUL\DC2\ETX\SYN\EOT\RS\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\EOT\DC2\ETX\SYN\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\ENQ\DC2\ETX\SYN\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\SOH\DC2\ETX\SYN\DC3\EM\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\ETX\DC2\ETX\SYN\FS\GS\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\SOH\DC2\ETX\ETB\EOT \n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\SOH\EOT\DC2\ETX\ETB\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\SOH\ENQ\DC2\ETX\ETB\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\SOH\SOH\DC2\ETX\ETB\DC4\ESC\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\SOH\ETX\DC2\ETX\ETB\RS\US\n\
    \f\n\
    \\STX\EOT\SOH\DC2\EOT\ESC\NUL\RS\SOH\SUBZ Get server info request - no message defined, just send RpbGetServerInfoReq message code\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\SOH\SOH\DC2\ETX\ESC\b\FS\n\
    \\v\n\
    \\EOT\EOT\SOH\STX\NUL\DC2\ETX\FS\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\EOT\DC2\ETX\FS\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\ENQ\DC2\ETX\FS\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\SOH\DC2\ETX\FS\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\ETX\DC2\ETX\FS\SUB\ESC\n\
    \\v\n\
    \\EOT\EOT\SOH\STX\SOH\DC2\ETX\GS\EOT&\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\SOH\EOT\DC2\ETX\GS\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\SOH\ENQ\DC2\ETX\GS\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\SOH\SOH\DC2\ETX\GS\DC3!\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\SOH\ETX\DC2\ETX\GS$%\n\
    \Q\n\
    \\STX\EOT\STX\DC2\EOT!\NUL$\SOH\SUBE Key/value pair - used for user metadata, indexes, search doc fields\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\STX\SOH\DC2\ETX!\b\SI\n\
    \\v\n\
    \\EOT\EOT\STX\STX\NUL\DC2\ETX\"\EOT\ESC\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\EOT\DC2\ETX\"\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\ENQ\DC2\ETX\"\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\SOH\DC2\ETX\"\DC3\SYN\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX\"\EM\SUB\n\
    \\v\n\
    \\EOT\EOT\STX\STX\SOH\DC2\ETX#\EOT\GS\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\SOH\EOT\DC2\ETX#\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\SOH\ENQ\DC2\ETX#\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\SOH\SOH\DC2\ETX#\DC3\CAN\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\SOH\ETX\DC2\ETX#\ESC\FS\n\
    \+\n\
    \\STX\EOT\ETX\DC2\EOT(\NUL+\SOH\SUB\US Get bucket properties request\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\ETX\SOH\DC2\ETX(\b\ETB\n\
    \\v\n\
    \\EOT\EOT\ETX\STX\NUL\DC2\ETX)\EOT\RS\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\EOT\DC2\ETX)\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\ENQ\DC2\ETX)\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\SOH\DC2\ETX)\DC3\EM\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\ETX\DC2\ETX)\FS\GS\n\
    \\v\n\
    \\EOT\EOT\ETX\STX\SOH\DC2\ETX*\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\SOH\EOT\DC2\ETX*\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\SOH\ENQ\DC2\ETX*\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\SOH\SOH\DC2\ETX*\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\SOH\ETX\DC2\ETX*\SUB\ESC\n\
    \,\n\
    \\STX\EOT\EOT\DC2\EOT.\NUL0\SOH\SUB  Get bucket properties response\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\EOT\SOH\DC2\ETX.\b\CAN\n\
    \\v\n\
    \\EOT\EOT\EOT\STX\NUL\DC2\ETX/\EOT&\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\EOT\DC2\ETX/\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\ACK\DC2\ETX/\r\ESC\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\SOH\DC2\ETX/\FS!\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\ETX\DC2\ETX/$%\n\
    \+\n\
    \\STX\EOT\ENQ\DC2\EOT3\NUL7\SOH\SUB\US Set bucket properties request\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\ENQ\SOH\DC2\ETX3\b\ETB\n\
    \\v\n\
    \\EOT\EOT\ENQ\STX\NUL\DC2\ETX4\EOT\RS\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\EOT\DC2\ETX4\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\ENQ\DC2\ETX4\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\SOH\DC2\ETX4\DC3\EM\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\ETX\DC2\ETX4\FS\GS\n\
    \\v\n\
    \\EOT\EOT\ENQ\STX\SOH\DC2\ETX5\EOT&\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\SOH\EOT\DC2\ETX5\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\SOH\ACK\DC2\ETX5\r\ESC\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\SOH\SOH\DC2\ETX5\FS!\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\SOH\ETX\DC2\ETX5$%\n\
    \\v\n\
    \\EOT\EOT\ENQ\STX\STX\DC2\ETX6\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\STX\EOT\DC2\ETX6\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\STX\ENQ\DC2\ETX6\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\STX\SOH\DC2\ETX6\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\STX\ETX\DC2\ETX6\SUB\ESC\n\
    \\129\SOH\n\
    \\STX\EOT\ACK\DC2\EOT=\NUL@\SOH\SUB! Reset bucket properties request\n\
    \2R Set bucket properties response - no message defined, just send\n\
    \ RpbSetBucketResp\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\ACK\SOH\DC2\ETX=\b\EM\n\
    \\v\n\
    \\EOT\EOT\ACK\STX\NUL\DC2\ETX>\EOT\RS\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\NUL\EOT\DC2\ETX>\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\NUL\ENQ\DC2\ETX>\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\NUL\SOH\DC2\ETX>\DC3\EM\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\NUL\ETX\DC2\ETX>\FS\GS\n\
    \\v\n\
    \\EOT\EOT\ACK\STX\SOH\DC2\ETX?\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\SOH\EOT\DC2\ETX?\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\SOH\ENQ\DC2\ETX?\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\SOH\SOH\DC2\ETX?\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\ACK\STX\SOH\ETX\DC2\ETX?\SUB\ESC\n\
    \+\n\
    \\STX\EOT\a\DC2\EOTC\NULE\SOH\SUB\US Get bucket properties request\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\a\SOH\DC2\ETXC\b\ESC\n\
    \\v\n\
    \\EOT\EOT\a\STX\NUL\DC2\ETXD\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\a\STX\NUL\EOT\DC2\ETXD\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\a\STX\NUL\ENQ\DC2\ETXD\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\a\STX\NUL\SOH\DC2\ETXD\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\a\STX\NUL\ETX\DC2\ETXD\SUB\ESC\n\
    \+\n\
    \\STX\EOT\b\DC2\EOTH\NULK\SOH\SUB\US Set bucket properties request\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\b\SOH\DC2\ETXH\b\ESC\n\
    \\v\n\
    \\EOT\EOT\b\STX\NUL\DC2\ETXI\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\b\STX\NUL\EOT\DC2\ETXI\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\b\STX\NUL\ENQ\DC2\ETXI\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\b\STX\NUL\SOH\DC2\ETXI\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\b\STX\NUL\ETX\DC2\ETXI\SUB\ESC\n\
    \\v\n\
    \\EOT\EOT\b\STX\SOH\DC2\ETXJ\EOT&\n\
    \\f\n\
    \\ENQ\EOT\b\STX\SOH\EOT\DC2\ETXJ\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\b\STX\SOH\ACK\DC2\ETXJ\r\ESC\n\
    \\f\n\
    \\ENQ\EOT\b\STX\SOH\SOH\DC2\ETXJ\FS!\n\
    \\f\n\
    \\ENQ\EOT\b\STX\SOH\ETX\DC2\ETXJ$%\n\
    \\185\SOH\n\
    \\STX\EOT\t\DC2\EOTR\NULU\SOH\SUBY Module-Function pairs for commit hooks and other bucket properties\n\
    \ that take functions\n\
    \2R Set bucket properties response - no message defined, just send\n\
    \ RpbSetBucketResp\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\t\SOH\DC2\ETXR\b\DC1\n\
    \\v\n\
    \\EOT\EOT\t\STX\NUL\DC2\ETXS\EOT\RS\n\
    \\f\n\
    \\ENQ\EOT\t\STX\NUL\EOT\DC2\ETXS\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\t\STX\NUL\ENQ\DC2\ETXS\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\t\STX\NUL\SOH\DC2\ETXS\DC3\EM\n\
    \\f\n\
    \\ENQ\EOT\t\STX\NUL\ETX\DC2\ETXS\FS\GS\n\
    \\v\n\
    \\EOT\EOT\t\STX\SOH\DC2\ETXT\EOT \n\
    \\f\n\
    \\ENQ\EOT\t\STX\SOH\EOT\DC2\ETXT\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\t\STX\SOH\ENQ\DC2\ETXT\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\t\STX\SOH\SOH\DC2\ETXT\DC3\ESC\n\
    \\f\n\
    \\ENQ\EOT\t\STX\SOH\ETX\DC2\ETXT\RS\US\n\
    \Y\n\
    \\STX\EOT\n\
    \\DC2\EOTY\NUL\\\SOH\SUBM A commit hook, which may either be a modfun or a JavaScript named\n\
    \ function\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\n\
    \\SOH\DC2\ETXY\b\NAK\n\
    \\v\n\
    \\EOT\EOT\n\
    \\STX\NUL\DC2\ETXZ\EOT\"\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\NUL\EOT\DC2\ETXZ\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\NUL\ACK\DC2\ETXZ\r\SYN\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\NUL\SOH\DC2\ETXZ\ETB\GS\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\NUL\ETX\DC2\ETXZ !\n\
    \\v\n\
    \\EOT\EOT\n\
    \\STX\SOH\DC2\ETX[\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\SOH\EOT\DC2\ETX[\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\SOH\ENQ\DC2\ETX[\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\SOH\SOH\DC2\ETX[\DC3\ETB\n\
    \\f\n\
    \\ENQ\EOT\n\
    \\STX\SOH\ETX\DC2\ETX[\SUB\ESC\n\
    \ \n\
    \\STX\EOT\v\DC2\ENQ_\NUL\153\SOH\SOH\SUB\DC3 Bucket properties\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\v\SOH\DC2\ETX_\b\SYN\n\
    \(\n\
    \\EOT\EOT\v\STX\NUL\DC2\ETXa\EOT\RS\SUB\ESC Declared in riak_core_app\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NUL\EOT\DC2\ETXa\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NUL\ENQ\DC2\ETXa\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NUL\SOH\DC2\ETXa\DC4\EM\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NUL\ETX\DC2\ETXa\FS\GS\n\
    \\v\n\
    \\EOT\EOT\v\STX\SOH\DC2\ETXb\EOT!\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SOH\EOT\DC2\ETXb\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SOH\ENQ\DC2\ETXb\r\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SOH\SOH\DC2\ETXb\DC2\FS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SOH\ETX\DC2\ETXb\US \n\
    \\v\n\
    \\EOT\EOT\v\STX\STX\DC2\ETXc\EOT&\n\
    \\f\n\
    \\ENQ\EOT\v\STX\STX\EOT\DC2\ETXc\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\STX\ENQ\DC2\ETXc\r\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\STX\SOH\DC2\ETXc\DC2!\n\
    \\f\n\
    \\ENQ\EOT\v\STX\STX\ETX\DC2\ETXc$%\n\
    \\v\n\
    \\EOT\EOT\v\STX\ETX\DC2\ETXd\EOT)\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ETX\EOT\DC2\ETXd\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ETX\ACK\DC2\ETXd\r\SUB\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ETX\SOH\DC2\ETXd\ESC$\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ETX\ETX\DC2\ETXd'(\n\
    \\v\n\
    \\EOT\EOT\v\STX\EOT\DC2\ETXe\EOT6\n\
    \\f\n\
    \\ENQ\EOT\v\STX\EOT\EOT\DC2\ETXe\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\EOT\ENQ\DC2\ETXe\r\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\EOT\SOH\DC2\ETXe\DC2\US\n\
    \\f\n\
    \\ENQ\EOT\v\STX\EOT\ETX\DC2\ETXe\"#\n\
    \\f\n\
    \\ENQ\EOT\v\STX\EOT\b\DC2\ETXe$5\n\
    \\f\n\
    \\ENQ\EOT\v\STX\EOT\a\DC2\ETXe/4\n\
    \\v\n\
    \\EOT\EOT\v\STX\ENQ\DC2\ETXf\EOT*\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ENQ\EOT\DC2\ETXf\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ENQ\ACK\DC2\ETXf\r\SUB\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ENQ\SOH\DC2\ETXf\ESC%\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ENQ\ETX\DC2\ETXf()\n\
    \\v\n\
    \\EOT\EOT\v\STX\ACK\DC2\ETXg\EOT7\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ACK\EOT\DC2\ETXg\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ACK\ENQ\DC2\ETXg\r\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ACK\SOH\DC2\ETXg\DC2 \n\
    \\f\n\
    \\ENQ\EOT\v\STX\ACK\ETX\DC2\ETXg#$\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ACK\b\DC2\ETXg%6\n\
    \\f\n\
    \\ENQ\EOT\v\STX\ACK\a\DC2\ETXg05\n\
    \\v\n\
    \\EOT\EOT\v\STX\a\DC2\ETXh\EOT(\n\
    \\f\n\
    \\ENQ\EOT\v\STX\a\EOT\DC2\ETXh\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\a\ACK\DC2\ETXh\r\SYN\n\
    \\f\n\
    \\ENQ\EOT\v\STX\a\SOH\DC2\ETXh\ETB#\n\
    \\f\n\
    \\ENQ\EOT\v\STX\a\ETX\DC2\ETXh&'\n\
    \&\n\
    \\EOT\EOT\v\STX\b\DC2\ETXk\EOT#\SUB\EM Declared in riak_kv_app\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\v\STX\b\EOT\DC2\ETXk\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\b\ACK\DC2\ETXk\r\SYN\n\
    \\f\n\
    \\ENQ\EOT\v\STX\b\SOH\DC2\ETXk\ETB\RS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\b\ETX\DC2\ETXk!\"\n\
    \\v\n\
    \\EOT\EOT\v\STX\t\DC2\ETXl\EOT$\n\
    \\f\n\
    \\ENQ\EOT\v\STX\t\EOT\DC2\ETXl\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\t\ENQ\DC2\ETXl\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\t\SOH\DC2\ETXl\DC4\RS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\t\ETX\DC2\ETXl!#\n\
    \\v\n\
    \\EOT\EOT\v\STX\n\
    \\DC2\ETXm\EOT&\n\
    \\f\n\
    \\ENQ\EOT\v\STX\n\
    \\EOT\DC2\ETXm\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\n\
    \\ENQ\DC2\ETXm\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\n\
    \\SOH\DC2\ETXm\DC4 \n\
    \\f\n\
    \\ENQ\EOT\v\STX\n\
    \\ETX\DC2\ETXm#%\n\
    \\v\n\
    \\EOT\EOT\v\STX\v\DC2\ETXn\EOT$\n\
    \\f\n\
    \\ENQ\EOT\v\STX\v\EOT\DC2\ETXn\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\v\ENQ\DC2\ETXn\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\v\SOH\DC2\ETXn\DC4\RS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\v\ETX\DC2\ETXn!#\n\
    \\v\n\
    \\EOT\EOT\v\STX\f\DC2\ETXo\EOT&\n\
    \\f\n\
    \\ENQ\EOT\v\STX\f\EOT\DC2\ETXo\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\f\ENQ\DC2\ETXo\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\f\SOH\DC2\ETXo\DC4 \n\
    \\f\n\
    \\ENQ\EOT\v\STX\f\ETX\DC2\ETXo#%\n\
    \\v\n\
    \\EOT\EOT\v\STX\r\DC2\ETXp\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\r\EOT\DC2\ETXp\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\r\ENQ\DC2\ETXp\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\r\SOH\DC2\ETXp\DC4\SYN\n\
    \\f\n\
    \\ENQ\EOT\v\STX\r\ETX\DC2\ETXp\EM\ESC\n\
    \\v\n\
    \\EOT\EOT\v\STX\SO\DC2\ETXq\EOT\ESC\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SO\EOT\DC2\ETXq\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SO\ENQ\DC2\ETXq\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SO\SOH\DC2\ETXq\DC4\NAK\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SO\ETX\DC2\ETXq\CAN\SUB\n\
    \\v\n\
    \\EOT\EOT\v\STX\SI\DC2\ETXr\EOT\ESC\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SI\EOT\DC2\ETXr\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SI\ENQ\DC2\ETXr\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SI\SOH\DC2\ETXr\DC4\NAK\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SI\ETX\DC2\ETXr\CAN\SUB\n\
    \\v\n\
    \\EOT\EOT\v\STX\DLE\DC2\ETXs\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DLE\EOT\DC2\ETXs\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DLE\ENQ\DC2\ETXs\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DLE\SOH\DC2\ETXs\DC4\SYN\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DLE\ETX\DC2\ETXs\EM\ESC\n\
    \\v\n\
    \\EOT\EOT\v\STX\DC1\DC2\ETXt\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC1\EOT\DC2\ETXt\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC1\ENQ\DC2\ETXt\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC1\SOH\DC2\ETXt\DC4\SYN\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC1\ETX\DC2\ETXt\EM\ESC\n\
    \\v\n\
    \\EOT\EOT\v\STX\DC2\DC2\ETXu\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC2\EOT\DC2\ETXu\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC2\ENQ\DC2\ETXu\r\DC3\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC2\SOH\DC2\ETXu\DC4\SYN\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC2\ETX\DC2\ETXu\EM\ESC\n\
    \\v\n\
    \\EOT\EOT\v\STX\DC3\DC2\ETXv\EOT$\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC3\EOT\DC2\ETXv\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC3\ENQ\DC2\ETXv\r\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC3\SOH\DC2\ETXv\DC2\RS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC3\ETX\DC2\ETXv!#\n\
    \\v\n\
    \\EOT\EOT\v\STX\DC4\DC2\ETXw\EOT#\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC4\EOT\DC2\ETXw\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC4\ENQ\DC2\ETXw\r\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC4\SOH\DC2\ETXw\DC2\GS\n\
    \\f\n\
    \\ENQ\EOT\v\STX\DC4\ETX\DC2\ETXw \"\n\
    \,\n\
    \\EOT\EOT\v\STX\NAK\DC2\ETXz\EOT \SUB\US Used by riak_kv_multi_backend\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NAK\EOT\DC2\ETXz\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NAK\ENQ\DC2\ETXz\r\DC2\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NAK\SOH\DC2\ETXz\DC3\SUB\n\
    \\f\n\
    \\ENQ\EOT\v\STX\NAK\ETX\DC2\ETXz\GS\US\n\
    \/\n\
    \\EOT\EOT\v\STX\SYN\DC2\ETX}\EOT\RS\SUB\" Used by riak_search bucket fixup\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SYN\EOT\DC2\ETX}\EOT\f\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SYN\ENQ\DC2\ETX}\r\DC1\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SYN\SOH\DC2\ETX}\DC2\CAN\n\
    \\f\n\
    \\ENQ\EOT\v\STX\SYN\ETX\DC2\ETX}\ESC\GS\n\
    \0\n\
    \\EOT\EOT\v\EOT\NUL\DC2\ACK\128\SOH\EOT\133\SOH\ENQ\SUB  Used by riak_repl bucket fixup\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\v\EOT\NUL\SOH\DC2\EOT\128\SOH\t\DC4\n\
    \\SO\n\
    \\ACK\EOT\v\EOT\NUL\STX\NUL\DC2\EOT\129\SOH\b\DC2\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\NUL\SOH\DC2\EOT\129\SOH\b\r\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\NUL\STX\DC2\EOT\129\SOH\DLE\DC1\n\
    \\SO\n\
    \\ACK\EOT\v\EOT\NUL\STX\SOH\DC2\EOT\130\SOH\b\NAK\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\SOH\SOH\DC2\EOT\130\SOH\b\DLE\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\SOH\STX\DC2\EOT\130\SOH\DC3\DC4\n\
    \\SO\n\
    \\ACK\EOT\v\EOT\NUL\STX\STX\DC2\EOT\131\SOH\b\NAK\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\STX\SOH\DC2\EOT\131\SOH\b\DLE\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\STX\STX\DC2\EOT\131\SOH\DC3\DC4\n\
    \\SO\n\
    \\ACK\EOT\v\EOT\NUL\STX\ETX\DC2\EOT\132\SOH\b\DC1\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\ETX\SOH\DC2\EOT\132\SOH\b\f\n\
    \\SI\n\
    \\a\EOT\v\EOT\NUL\STX\ETX\STX\DC2\EOT\132\SOH\SI\DLE\n\
    \\f\n\
    \\EOT\EOT\v\STX\ETB\DC2\EOT\134\SOH\EOT#\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ETB\EOT\DC2\EOT\134\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ETB\ACK\DC2\EOT\134\SOH\r\CAN\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ETB\SOH\DC2\EOT\134\SOH\EM\GS\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ETB\ETX\DC2\EOT\134\SOH \"\n\
    \\FS\n\
    \\EOT\EOT\v\STX\CAN\DC2\EOT\137\SOH\EOT%\SUB\SO Search index\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\v\STX\CAN\EOT\DC2\EOT\137\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\v\STX\CAN\ENQ\DC2\EOT\137\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\v\STX\CAN\SOH\DC2\EOT\137\SOH\DC3\US\n\
    \\r\n\
    \\ENQ\EOT\v\STX\CAN\ETX\DC2\EOT\137\SOH\"$\n\
    \\FS\n\
    \\EOT\EOT\v\STX\EM\DC2\EOT\140\SOH\EOT!\SUB\SO KV Datatypes\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\v\STX\EM\EOT\DC2\EOT\140\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\v\STX\EM\ENQ\DC2\EOT\140\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\v\STX\EM\SOH\DC2\EOT\140\SOH\DC3\ESC\n\
    \\r\n\
    \\ENQ\EOT\v\STX\EM\ETX\DC2\EOT\140\SOH\RS \n\
    \%\n\
    \\EOT\EOT\v\STX\SUB\DC2\EOT\143\SOH\EOT\"\SUB\ETB KV strong consistency\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\v\STX\SUB\EOT\DC2\EOT\143\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\v\STX\SUB\ENQ\DC2\EOT\143\SOH\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\v\STX\SUB\SOH\DC2\EOT\143\SOH\DC2\FS\n\
    \\r\n\
    \\ENQ\EOT\v\STX\SUB\ETX\DC2\EOT\143\SOH\US!\n\
    \\FS\n\
    \\EOT\EOT\v\STX\ESC\DC2\EOT\146\SOH\EOT\"\SUB\SO KV fast path\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ESC\EOT\DC2\EOT\146\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ESC\ENQ\DC2\EOT\146\SOH\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ESC\SOH\DC2\EOT\146\SOH\DC2\FS\n\
    \\r\n\
    \\ENQ\EOT\v\STX\ESC\ETX\DC2\EOT\146\SOH\US!\n\
    \'\n\
    \\EOT\EOT\v\STX\FS\DC2\EOT\149\SOH\EOT'\SUB\EM Hyperlolog DT Precision\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\v\STX\FS\EOT\DC2\EOT\149\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\v\STX\FS\ENQ\DC2\EOT\149\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\v\STX\FS\SOH\DC2\EOT\149\SOH\DC4!\n\
    \\r\n\
    \\ENQ\EOT\v\STX\FS\ETX\DC2\EOT\149\SOH$&\n\
    \-\n\
    \\EOT\EOT\v\STX\GS\DC2\EOT\152\SOH\EOT\GS\SUB\US KV sweeper object expiry time\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\v\STX\GS\EOT\DC2\EOT\152\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\v\STX\GS\ENQ\DC2\EOT\152\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\v\STX\GS\SOH\DC2\EOT\152\SOH\DC4\ETB\n\
    \\r\n\
    \\ENQ\EOT\v\STX\GS\ETX\DC2\EOT\152\SOH\SUB\FS\n\
    \&\n\
    \\STX\EOT\f\DC2\ACK\156\SOH\NUL\159\SOH\SOH\SUB\CAN Authentication request\n\
    \\n\
    \\v\n\
    \\ETX\EOT\f\SOH\DC2\EOT\156\SOH\b\DC2\n\
    \\f\n\
    \\EOT\EOT\f\STX\NUL\DC2\EOT\157\SOH\EOT\FS\n\
    \\r\n\
    \\ENQ\EOT\f\STX\NUL\EOT\DC2\EOT\157\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\f\STX\NUL\ENQ\DC2\EOT\157\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\f\STX\NUL\SOH\DC2\EOT\157\SOH\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT\f\STX\NUL\ETX\DC2\EOT\157\SOH\SUB\ESC\n\
    \\f\n\
    \\EOT\EOT\f\STX\SOH\DC2\EOT\158\SOH\EOT \n\
    \\r\n\
    \\ENQ\EOT\f\STX\SOH\EOT\DC2\EOT\158\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\f\STX\SOH\ENQ\DC2\EOT\158\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\f\STX\SOH\SOH\DC2\EOT\158\SOH\DC3\ESC\n\
    \\r\n\
    \\ENQ\EOT\f\STX\SOH\ETX\DC2\EOT\158\SOH\RS\US\n\
    \\252\STX\n\
    \\STX\EOT\r\DC2\ACK\188\SOH\NUL\203\SOH\SOH\SUB\191\SOH\n\
    \ Field names in maps are composed of a binary identifier and a type.\n\
    \ This is so that two clients can create fields with the same name\n\
    \ but different types, and they converge independently.\n\
    \2v Java package specifiers\n\
    \ option java_package = \"com.basho.riak.protobuf\";\n\
    \ option java_outer_classname = \"RiakDtPB\";\n\
    \24\n\
    \ =============== DATA STRUCTURES =================\n\
    \\n\
    \\v\n\
    \\ETX\EOT\r\SOH\DC2\EOT\188\SOH\b\DLE\n\
    \t\n\
    \\EOT\EOT\r\EOT\NUL\DC2\ACK\193\SOH\EOT\199\SOH\ENQ\SUBd\n\
    \ The types that can be stored in a map are limited to counters,\n\
    \ sets, registers, flags, and maps.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\r\EOT\NUL\SOH\DC2\EOT\193\SOH\t\NAK\n\
    \\SO\n\
    \\ACK\EOT\r\EOT\NUL\STX\NUL\DC2\EOT\194\SOH\b\NAK\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\NUL\SOH\DC2\EOT\194\SOH\b\SI\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\NUL\STX\DC2\EOT\194\SOH\DC3\DC4\n\
    \\SO\n\
    \\ACK\EOT\r\EOT\NUL\STX\SOH\DC2\EOT\195\SOH\b\NAK\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\SOH\SOH\DC2\EOT\195\SOH\b\v\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\SOH\STX\DC2\EOT\195\SOH\DC3\DC4\n\
    \\SO\n\
    \\ACK\EOT\r\EOT\NUL\STX\STX\DC2\EOT\196\SOH\b\NAK\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\STX\SOH\DC2\EOT\196\SOH\b\DLE\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\STX\STX\DC2\EOT\196\SOH\DC3\DC4\n\
    \\SO\n\
    \\ACK\EOT\r\EOT\NUL\STX\ETX\DC2\EOT\197\SOH\b\NAK\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\ETX\SOH\DC2\EOT\197\SOH\b\f\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\ETX\STX\DC2\EOT\197\SOH\DC3\DC4\n\
    \\SO\n\
    \\ACK\EOT\r\EOT\NUL\STX\EOT\DC2\EOT\198\SOH\b\NAK\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\EOT\SOH\DC2\EOT\198\SOH\b\v\n\
    \\SI\n\
    \\a\EOT\r\EOT\NUL\STX\EOT\STX\DC2\EOT\198\SOH\DC3\DC4\n\
    \\f\n\
    \\EOT\EOT\r\STX\NUL\DC2\EOT\201\SOH\EOT#\n\
    \\r\n\
    \\ENQ\EOT\r\STX\NUL\EOT\DC2\EOT\201\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\r\STX\NUL\ENQ\DC2\EOT\201\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\r\STX\NUL\SOH\DC2\EOT\201\SOH\SUB\RS\n\
    \\r\n\
    \\ENQ\EOT\r\STX\NUL\ETX\DC2\EOT\201\SOH!\"\n\
    \\f\n\
    \\EOT\EOT\r\STX\SOH\DC2\EOT\202\SOH\EOT#\n\
    \\r\n\
    \\ENQ\EOT\r\STX\SOH\EOT\DC2\EOT\202\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\r\STX\SOH\ACK\DC2\EOT\202\SOH\r\EM\n\
    \\r\n\
    \\ENQ\EOT\r\STX\SOH\SOH\DC2\EOT\202\SOH\SUB\RS\n\
    \\r\n\
    \\ENQ\EOT\r\STX\SOH\ETX\DC2\EOT\202\SOH!\"\n\
    \\144\SOH\n\
    \\STX\EOT\SO\DC2\ACK\210\SOH\NUL\217\SOH\SOH\SUB\129\SOH\n\
    \ An entry in a map is a pair of a field-name and value. The type\n\
    \ defined in the field determines which value type is expected.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\SO\SOH\DC2\EOT\210\SOH\b\DLE\n\
    \\f\n\
    \\EOT\EOT\SO\STX\NUL\DC2\EOT\211\SOH\EOT \n\
    \\r\n\
    \\ENQ\EOT\SO\STX\NUL\EOT\DC2\EOT\211\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\NUL\ACK\DC2\EOT\211\SOH\r\NAK\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\NUL\SOH\DC2\EOT\211\SOH\SYN\ESC\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\NUL\ETX\DC2\EOT\211\SOH\RS\US\n\
    \\f\n\
    \\EOT\EOT\SO\STX\SOH\DC2\EOT\212\SOH\EOT)\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\SOH\EOT\DC2\EOT\212\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\SOH\ENQ\DC2\EOT\212\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\SOH\SOH\DC2\EOT\212\SOH\SYN#\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\SOH\ETX\DC2\EOT\212\SOH'(\n\
    \\f\n\
    \\EOT\EOT\SO\STX\STX\DC2\EOT\213\SOH\EOT)\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\STX\EOT\DC2\EOT\213\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\STX\ENQ\DC2\EOT\213\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\STX\SOH\DC2\EOT\213\SOH\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\STX\ETX\DC2\EOT\213\SOH'(\n\
    \\f\n\
    \\EOT\EOT\SO\STX\ETX\DC2\EOT\214\SOH\EOT)\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ETX\EOT\DC2\EOT\214\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ETX\ENQ\DC2\EOT\214\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ETX\SOH\DC2\EOT\214\SOH\SYN$\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ETX\ETX\DC2\EOT\214\SOH'(\n\
    \\f\n\
    \\EOT\EOT\SO\STX\EOT\DC2\EOT\215\SOH\EOT)\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\EOT\EOT\DC2\EOT\215\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\EOT\ENQ\DC2\EOT\215\SOH\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\EOT\SOH\DC2\EOT\215\SOH\SYN \n\
    \\r\n\
    \\ENQ\EOT\SO\STX\EOT\ETX\DC2\EOT\215\SOH'(\n\
    \\f\n\
    \\EOT\EOT\SO\STX\ENQ\DC2\EOT\216\SOH\EOT)\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ENQ\EOT\DC2\EOT\216\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ENQ\ACK\DC2\EOT\216\SOH\r\NAK\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ENQ\SOH\DC2\EOT\216\SOH\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\SO\STX\ENQ\ETX\DC2\EOT\216\SOH'(\n\
    \\214\SOH\n\
    \\STX\EOT\SI\DC2\ACK\228\SOH\NUL\246\SOH\SOH\SUB\155\SOH\n\
    \ The equivalent of KV's \"RpbGetReq\", results in a DtFetchResp. The\n\
    \ request-time options are limited to ones that are relevant to\n\
    \ structured data-types.\n\
    \2*\n\
    \ =============== FETCH =================\n\
    \\n\
    \\v\n\
    \\ETX\EOT\SI\SOH\DC2\EOT\228\SOH\b\DC2\n\
    \;\n\
    \\EOT\EOT\SI\STX\NUL\DC2\EOT\230\SOH\EOT\RS\SUB- The identifier: bucket, key and bucket-type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\NUL\EOT\DC2\EOT\230\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\NUL\ENQ\DC2\EOT\230\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\NUL\SOH\DC2\EOT\230\SOH\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\NUL\ETX\DC2\EOT\230\SOH\FS\GS\n\
    \\f\n\
    \\EOT\EOT\SI\STX\SOH\DC2\EOT\231\SOH\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\SOH\EOT\DC2\EOT\231\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\SOH\ENQ\DC2\EOT\231\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\SOH\SOH\DC2\EOT\231\SOH\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\SOH\ETX\DC2\EOT\231\SOH\FS\GS\n\
    \\f\n\
    \\EOT\EOT\SI\STX\STX\DC2\EOT\232\SOH\EOT\GS\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\STX\EOT\DC2\EOT\232\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\STX\ENQ\DC2\EOT\232\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\STX\SOH\DC2\EOT\232\SOH\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\STX\ETX\DC2\EOT\232\SOH\ESC\FS\n\
    \\US\n\
    \\EOT\EOT\SI\STX\ETX\DC2\EOT\235\SOH\EOT'\SUB\DC1 Request options\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ETX\EOT\DC2\EOT\235\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ETX\ENQ\DC2\EOT\235\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ETX\SOH\DC2\EOT\235\SOH\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ETX\ETX\DC2\EOT\235\SOH%&\n\
    \\f\n\
    \\EOT\EOT\SI\STX\EOT\DC2\EOT\236\SOH\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\EOT\EOT\DC2\EOT\236\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\EOT\ENQ\DC2\EOT\236\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\EOT\SOH\DC2\EOT\236\SOH\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\EOT\ETX\DC2\EOT\236\SOH%&\n\
    \\f\n\
    \\EOT\EOT\SI\STX\ENQ\DC2\EOT\237\SOH\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ENQ\EOT\DC2\EOT\237\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ENQ\ENQ\DC2\EOT\237\SOH\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ENQ\SOH\DC2\EOT\237\SOH\DC4 \n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ENQ\ETX\DC2\EOT\237\SOH%&\n\
    \\f\n\
    \\EOT\EOT\SI\STX\ACK\DC2\EOT\238\SOH\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ACK\EOT\DC2\EOT\238\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ACK\ENQ\DC2\EOT\238\SOH\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ACK\SOH\DC2\EOT\238\SOH\DC4\US\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\ACK\ETX\DC2\EOT\238\SOH%&\n\
    \\f\n\
    \\EOT\EOT\SI\STX\a\DC2\EOT\239\SOH\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\a\EOT\DC2\EOT\239\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\a\ENQ\DC2\EOT\239\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\a\SOH\DC2\EOT\239\SOH\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\a\ETX\DC2\EOT\239\SOH%&\n\
    \2\n\
    \\EOT\EOT\SI\STX\b\DC2\EOT\240\SOH\EOT'\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\b\EOT\DC2\EOT\240\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\b\ENQ\DC2\EOT\240\SOH\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\b\SOH\DC2\EOT\240\SOH\DC4!\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\b\ETX\DC2\EOT\240\SOH%&\n\
    \2\n\
    \\EOT\EOT\SI\STX\t\DC2\EOT\241\SOH\EOT'\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\t\EOT\DC2\EOT\241\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\t\ENQ\DC2\EOT\241\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\t\SOH\DC2\EOT\241\SOH\DC4\EM\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\t\ETX\DC2\EOT\241\SOH$&\n\
    \\137\SOH\n\
    \\EOT\EOT\SI\STX\n\
    \\DC2\EOT\245\SOH\EOT6\SUB{ For read-only requests or context-free operations, you can set\n\
    \ this to false to reduce the size of the response payload.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\n\
    \\EOT\DC2\EOT\245\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\n\
    \\ENQ\DC2\EOT\245\SOH\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\n\
    \\SOH\DC2\EOT\245\SOH\DC2!\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\n\
    \\ETX\DC2\EOT\245\SOH$&\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\n\
    \\b\DC2\EOT\245\SOH'5\n\
    \\r\n\
    \\ENQ\EOT\SI\STX\n\
    \\a\DC2\EOT\245\SOH04\n\
    \\139\SOH\n\
    \\STX\EOT\DLE\DC2\ACK\253\SOH\NUL\134\STX\SOH\SUB}\n\
    \ The value of the fetched data type. If present in the response,\n\
    \ then empty values (sets, maps) should be treated as such.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\DLE\SOH\DC2\EOT\253\SOH\b\SI\n\
    \\f\n\
    \\EOT\EOT\DLE\STX\NUL\DC2\EOT\254\SOH\EOT(\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\NUL\EOT\DC2\EOT\254\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\NUL\ENQ\DC2\EOT\254\SOH\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\NUL\SOH\DC2\EOT\254\SOH\SYN#\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\NUL\ETX\DC2\EOT\254\SOH&'\n\
    \\f\n\
    \\EOT\EOT\DLE\STX\SOH\DC2\EOT\255\SOH\EOT(\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\SOH\EOT\DC2\EOT\255\SOH\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\SOH\ENQ\DC2\EOT\255\SOH\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\SOH\SOH\DC2\EOT\255\SOH\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\SOH\ETX\DC2\EOT\255\SOH&'\n\
    \\f\n\
    \\EOT\EOT\DLE\STX\STX\DC2\EOT\128\STX\EOT(\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\STX\EOT\DC2\EOT\128\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\STX\ACK\DC2\EOT\128\STX\r\NAK\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\STX\SOH\DC2\EOT\128\STX\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\STX\ETX\DC2\EOT\128\STX&'\n\
    \T\n\
    \\EOT\EOT\DLE\STX\ETX\DC2\EOT\132\STX\EOT(\SUBF We return an estimated cardinality of the Hyperloglog set\n\
    \ on fetch.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\ETX\EOT\DC2\EOT\132\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\ETX\ENQ\DC2\EOT\132\STX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\ETX\SOH\DC2\EOT\132\STX\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\ETX\ETX\DC2\EOT\132\STX&'\n\
    \\f\n\
    \\EOT\EOT\DLE\STX\EOT\DC2\EOT\133\STX\EOT(\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\EOT\EOT\DC2\EOT\133\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\EOT\ENQ\DC2\EOT\133\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\EOT\SOH\DC2\EOT\133\STX\SYN \n\
    \\r\n\
    \\ENQ\EOT\DLE\STX\EOT\ETX\DC2\EOT\133\STX&'\n\
    \\216\ETX\n\
    \\STX\EOT\DC1\DC2\ACK\146\STX\NUL\158\STX\SOH\SUB\201\ETX\n\
    \ The response to a \"Fetch\" request. If the `include_context` option\n\
    \ is specified, an opaque \"context\" value will be returned along with\n\
    \ the user-friendly data. When sending an \"Update\" request, the\n\
    \ client should send this context as well, similar to how one would\n\
    \ send a vclock for KV updates. The `type` field indicates which\n\
    \ value type to expect. When the `value` field is missing from the\n\
    \ message, the client should interpret it as a \"not found\".\n\
    \\n\
    \\v\n\
    \\ETX\EOT\DC1\SOH\DC2\EOT\146\STX\b\DC3\n\
    \\SO\n\
    \\EOT\EOT\DC1\EOT\NUL\DC2\ACK\147\STX\EOT\153\STX\ENQ\n\
    \\r\n\
    \\ENQ\EOT\DC1\EOT\NUL\SOH\DC2\EOT\147\STX\t\DC1\n\
    \\SO\n\
    \\ACK\EOT\DC1\EOT\NUL\STX\NUL\DC2\EOT\148\STX\b\DC4\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\NUL\SOH\DC2\EOT\148\STX\b\SI\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\NUL\STX\DC2\EOT\148\STX\DC2\DC3\n\
    \\SO\n\
    \\ACK\EOT\DC1\EOT\NUL\STX\SOH\DC2\EOT\149\STX\b\DC4\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\SOH\SOH\DC2\EOT\149\STX\b\v\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\SOH\STX\DC2\EOT\149\STX\DC2\DC3\n\
    \\SO\n\
    \\ACK\EOT\DC1\EOT\NUL\STX\STX\DC2\EOT\150\STX\b\DC4\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\STX\SOH\DC2\EOT\150\STX\b\v\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\STX\STX\DC2\EOT\150\STX\DC2\DC3\n\
    \\SO\n\
    \\ACK\EOT\DC1\EOT\NUL\STX\ETX\DC2\EOT\151\STX\b\DC4\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\ETX\SOH\DC2\EOT\151\STX\b\v\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\ETX\STX\DC2\EOT\151\STX\DC2\DC3\n\
    \\SO\n\
    \\ACK\EOT\DC1\EOT\NUL\STX\EOT\DC2\EOT\152\STX\b\DC4\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\EOT\SOH\DC2\EOT\152\STX\b\f\n\
    \\SI\n\
    \\a\EOT\DC1\EOT\NUL\STX\EOT\STX\DC2\EOT\152\STX\DC2\DC3\n\
    \\f\n\
    \\EOT\EOT\DC1\STX\NUL\DC2\EOT\155\STX\EOT\"\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\NUL\EOT\DC2\EOT\155\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\NUL\ENQ\DC2\EOT\155\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\NUL\SOH\DC2\EOT\155\STX\SYN\GS\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\NUL\ETX\DC2\EOT\155\STX !\n\
    \\f\n\
    \\EOT\EOT\DC1\STX\SOH\DC2\EOT\156\STX\EOT\"\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\SOH\EOT\DC2\EOT\156\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\SOH\ACK\DC2\EOT\156\STX\r\NAK\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\SOH\SOH\DC2\EOT\156\STX\SYN\SUB\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\SOH\ETX\DC2\EOT\156\STX !\n\
    \\f\n\
    \\EOT\EOT\DC1\STX\STX\DC2\EOT\157\STX\EOT\"\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\STX\EOT\DC2\EOT\157\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\STX\ACK\DC2\EOT\157\STX\r\DC4\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\STX\SOH\DC2\EOT\157\STX\SYN\ESC\n\
    \\r\n\
    \\ENQ\EOT\DC1\STX\STX\ETX\DC2\EOT\157\STX !\n\
    \\231\SOH\n\
    \\STX\EOT\DC2\DC2\ACK\169\STX\NUL\171\STX\SOH\SUB\171\SOH\n\
    \ An operation to update a Counter, either on its own or inside a\n\
    \ Map. The `increment` field can be positive or negative. When absent,\n\
    \ the meaning is an increment by 1.\n\
    \2+\n\
    \ =============== UPDATE =================\n\
    \\n\
    \\v\n\
    \\ETX\EOT\DC2\SOH\DC2\EOT\169\STX\b\DC1\n\
    \\f\n\
    \\EOT\EOT\DC2\STX\NUL\DC2\EOT\170\STX\EOT\"\n\
    \\r\n\
    \\ENQ\EOT\DC2\STX\NUL\EOT\DC2\EOT\170\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DC2\STX\NUL\ENQ\DC2\EOT\170\STX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\DC2\STX\NUL\SOH\DC2\EOT\170\STX\DC4\GS\n\
    \\r\n\
    \\ENQ\EOT\DC2\STX\NUL\ETX\DC2\EOT\170\STX !\n\
    \\166\SOH\n\
    \\STX\EOT\DC3\DC2\ACK\178\STX\NUL\181\STX\SOH\SUB\151\SOH\n\
    \ An operation to update a Set, either on its own or inside a Map.\n\
    \ Set members are opaque binary values, you can only add or remove\n\
    \ them from a Set.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\DC3\SOH\DC2\EOT\178\STX\b\r\n\
    \\f\n\
    \\EOT\EOT\DC3\STX\NUL\DC2\EOT\179\STX\EOT\US\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\NUL\EOT\DC2\EOT\179\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\NUL\ENQ\DC2\EOT\179\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\NUL\SOH\DC2\EOT\179\STX\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\NUL\ETX\DC2\EOT\179\STX\GS\RS\n\
    \\f\n\
    \\EOT\EOT\DC3\STX\SOH\DC2\EOT\180\STX\EOT\US\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\SOH\EOT\DC2\EOT\180\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\SOH\ENQ\DC2\EOT\180\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\SOH\SOH\DC2\EOT\180\STX\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT\DC3\STX\SOH\ETX\DC2\EOT\180\STX\GS\RS\n\
    \\132\SOH\n\
    \\STX\EOT\DC4\DC2\ACK\188\STX\NUL\190\STX\SOH\SUBv\n\
    \ An operation to update a GSet, on its own.\n\
    \ GSet members are opaque binary values, you can only add\n\
    \ them to a Set.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\DC4\SOH\DC2\EOT\188\STX\b\SO\n\
    \\f\n\
    \\EOT\EOT\DC4\STX\NUL\DC2\EOT\189\STX\EOT\US\n\
    \\r\n\
    \\ENQ\EOT\DC4\STX\NUL\EOT\DC2\EOT\189\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\DC4\STX\NUL\ENQ\DC2\EOT\189\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\DC4\STX\NUL\SOH\DC2\EOT\189\STX\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT\DC4\STX\NUL\ETX\DC2\EOT\189\STX\GS\RS\n\
    \i\n\
    \\STX\EOT\NAK\DC2\ACK\196\STX\NUL\198\STX\SOH\SUB[\n\
    \ An operation to update a Hyperloglog Set, a top-level DT.\n\
    \ You can only add to a HllSet.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\NAK\SOH\DC2\EOT\196\STX\b\r\n\
    \\f\n\
    \\EOT\EOT\NAK\STX\NUL\DC2\EOT\197\STX\EOT\US\n\
    \\r\n\
    \\ENQ\EOT\NAK\STX\NUL\EOT\DC2\EOT\197\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\NAK\STX\NUL\ENQ\DC2\EOT\197\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\NAK\STX\NUL\SOH\DC2\EOT\197\STX\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT\NAK\STX\NUL\ETX\DC2\EOT\197\STX\GS\RS\n\
    \\206\SOH\n\
    \\STX\EOT\SYN\DC2\ACK\205\STX\NUL\228\STX\SOH\SUB\191\SOH\n\
    \ An operation to be applied to a value stored in a Map -- the\n\
    \ contents of an UPDATE operation. The operation field that is\n\
    \ present depends on the type of the field to which it is applied.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\SYN\SOH\DC2\EOT\205\STX\b\DC1\n\
    \\131\SOH\n\
    \\EOT\EOT\SYN\EOT\NUL\DC2\ACK\210\STX\EOT\213\STX\ENQ\SUBs\n\
    \ Flags only exist inside Maps and can only be enabled or\n\
    \ disabled, and there are no arguments to the operations.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SYN\EOT\NUL\SOH\DC2\EOT\210\STX\t\SI\n\
    \\SO\n\
    \\ACK\EOT\SYN\EOT\NUL\STX\NUL\DC2\EOT\211\STX\b\DC4\n\
    \\SI\n\
    \\a\EOT\SYN\EOT\NUL\STX\NUL\SOH\DC2\EOT\211\STX\b\SO\n\
    \\SI\n\
    \\a\EOT\SYN\EOT\NUL\STX\NUL\STX\DC2\EOT\211\STX\DC2\DC3\n\
    \\SO\n\
    \\ACK\EOT\SYN\EOT\NUL\STX\SOH\DC2\EOT\212\STX\b\DC4\n\
    \\SI\n\
    \\a\EOT\SYN\EOT\NUL\STX\SOH\SOH\DC2\EOT\212\STX\b\SI\n\
    \\SI\n\
    \\a\EOT\SYN\EOT\NUL\STX\SOH\STX\DC2\EOT\212\STX\DC2\DC3\n\
    \\f\n\
    \\EOT\EOT\SYN\STX\NUL\DC2\EOT\215\STX\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\NUL\EOT\DC2\EOT\215\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\NUL\ACK\DC2\EOT\215\STX\r\NAK\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\NUL\SOH\DC2\EOT\215\STX\ETB\FS\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\NUL\ETX\DC2\EOT\215\STX%&\n\
    \\f\n\
    \\EOT\EOT\SYN\STX\SOH\DC2\EOT\217\STX\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\SOH\EOT\DC2\EOT\217\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\SOH\ACK\DC2\EOT\217\STX\r\SYN\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\SOH\SOH\DC2\EOT\217\STX\ETB!\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\SOH\ETX\DC2\EOT\217\STX%&\n\
    \\f\n\
    \\EOT\EOT\SYN\STX\STX\DC2\EOT\218\STX\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\STX\EOT\DC2\EOT\218\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\STX\ACK\DC2\EOT\218\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\STX\SOH\DC2\EOT\218\STX\ETB\GS\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\STX\ETX\DC2\EOT\218\STX%&\n\
    \\131\SOH\n\
    \\EOT\EOT\SYN\STX\ETX\DC2\EOT\224\STX\EOT'\SUBu\n\
    \ There is only one operation on a register, which is to set its\n\
    \ value, therefore the \"operation\" is the new value.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ETX\EOT\DC2\EOT\224\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ETX\ENQ\DC2\EOT\224\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ETX\SOH\DC2\EOT\224\STX\ETB\"\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ETX\ETX\DC2\EOT\224\STX%&\n\
    \\f\n\
    \\EOT\EOT\SYN\STX\EOT\DC2\EOT\225\STX\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\EOT\EOT\DC2\EOT\225\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\EOT\ACK\DC2\EOT\225\STX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\EOT\SOH\DC2\EOT\225\STX\ETB\RS\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\EOT\ETX\DC2\EOT\225\STX%&\n\
    \\f\n\
    \\EOT\EOT\SYN\STX\ENQ\DC2\EOT\226\STX\EOT'\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ENQ\EOT\DC2\EOT\226\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ENQ\ACK\DC2\EOT\226\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ENQ\SOH\DC2\EOT\226\STX\ETB\GS\n\
    \\r\n\
    \\ENQ\EOT\SYN\STX\ENQ\ETX\DC2\EOT\226\STX%&\n\
    \e\n\
    \\STX\EOT\ETB\DC2\ACK\234\STX\NUL\242\STX\SOH\SUBW\n\
    \ An operation to update a Map. All operations apply to individual\n\
    \ fields in the Map.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\ETB\SOH\DC2\EOT\234\STX\b\r\n\
    \\139\SOH\n\
    \\EOT\EOT\ETB\STX\NUL\DC2\EOT\240\STX\EOT#\SUB}\n\
    \  REMOVE removes a field and value from the Map.\n\
    \ UPDATE applies type-specific\n\
    \ operations to the values stored in the Map.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\NUL\EOT\DC2\EOT\240\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\NUL\ACK\DC2\EOT\240\STX\r\NAK\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\NUL\SOH\DC2\EOT\240\STX\ETB\RS\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\NUL\ETX\DC2\EOT\240\STX!\"\n\
    \\f\n\
    \\EOT\EOT\ETB\STX\SOH\DC2\EOT\241\STX\EOT#\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\SOH\EOT\DC2\EOT\241\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\SOH\ACK\DC2\EOT\241\STX\r\SYN\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\SOH\SOH\DC2\EOT\241\STX\ETB\RS\n\
    \\r\n\
    \\ENQ\EOT\ETB\STX\SOH\ETX\DC2\EOT\241\STX!\"\n\
    \u\n\
    \\STX\EOT\CAN\DC2\ACK\248\STX\NUL\129\ETX\SOH\SUBg\n\
    \ A \"union\" type for update operations. The included operation\n\
    \ depends on the datatype being updated.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\CAN\SOH\DC2\EOT\248\STX\b\f\n\
    \\f\n\
    \\EOT\EOT\CAN\STX\NUL\DC2\EOT\249\STX\EOT&\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\NUL\EOT\DC2\EOT\249\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\NUL\ACK\DC2\EOT\249\STX\r\SYN\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\NUL\SOH\DC2\EOT\249\STX\ETB!\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\NUL\ETX\DC2\EOT\249\STX$%\n\
    \\f\n\
    \\EOT\EOT\CAN\STX\SOH\DC2\EOT\250\STX\EOT&\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\SOH\EOT\DC2\EOT\250\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\SOH\ACK\DC2\EOT\250\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\SOH\SOH\DC2\EOT\250\STX\ETB\GS\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\SOH\ETX\DC2\EOT\250\STX$%\n\
    \\f\n\
    \\EOT\EOT\CAN\STX\STX\DC2\EOT\251\STX\EOT&\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\STX\EOT\DC2\EOT\251\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\STX\ACK\DC2\EOT\251\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\STX\SOH\DC2\EOT\251\STX\ETB\GS\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\STX\ETX\DC2\EOT\251\STX$%\n\
    \Z\n\
    \\EOT\EOT\CAN\STX\ETX\DC2\EOT\255\STX\EOT&\SUBL Adding values to a hyperloglog (set) is just like adding values\n\
    \ to a set.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\ETX\EOT\DC2\EOT\255\STX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\ETX\ACK\DC2\EOT\255\STX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\ETX\SOH\DC2\EOT\255\STX\ETB\GS\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\ETX\ETX\DC2\EOT\255\STX$%\n\
    \\f\n\
    \\EOT\EOT\CAN\STX\EOT\DC2\EOT\128\ETX\EOT&\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\EOT\EOT\DC2\EOT\128\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\EOT\ACK\DC2\EOT\128\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\EOT\SOH\DC2\EOT\128\ETX\ETB\RS\n\
    \\r\n\
    \\ENQ\EOT\CAN\STX\EOT\ETX\DC2\EOT\128\ETX$%\n\
    \\133\STX\n\
    \\STX\EOT\EM\DC2\ACK\137\ETX\NUL\158\ETX\SOH\SUB\246\SOH\n\
    \ The equivalent of KV's \"RpbPutReq\", results in an empty response or\n\
    \ \"DtUpdateResp\" if `return_body` is specified, or the key is\n\
    \ assigned by the server. The request-time options are limited to\n\
    \ ones that are relevant to structured data-types.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\EM\SOH\DC2\EOT\137\ETX\b\DC3\n\
    \\RS\n\
    \\EOT\EOT\EM\STX\NUL\DC2\EOT\139\ETX\EOT\RS\SUB\DLE The identifier\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\NUL\EOT\DC2\EOT\139\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\NUL\ENQ\DC2\EOT\139\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\NUL\SOH\DC2\EOT\139\ETX\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\NUL\ETX\DC2\EOT\139\ETX\FS\GS\n\
    \C\n\
    \\EOT\EOT\EM\STX\SOH\DC2\EOT\140\ETX\EOT\RS\"5 missing key results in server-assigned key, like KV\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\SOH\EOT\DC2\EOT\140\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\SOH\ENQ\DC2\EOT\140\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\SOH\SOH\DC2\EOT\140\ETX\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\SOH\ETX\DC2\EOT\140\ETX\FS\GS\n\
    \]\n\
    \\EOT\EOT\EM\STX\STX\DC2\EOT\141\ETX\EOT\RS\"O bucket type, not data-type (but the data-type is constrained per bucket-type)\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\STX\EOT\DC2\EOT\141\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\STX\ENQ\DC2\EOT\141\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\STX\SOH\DC2\EOT\141\ETX\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\STX\ETX\DC2\EOT\141\ETX\FS\GS\n\
    \%\n\
    \\EOT\EOT\EM\STX\ETX\DC2\EOT\144\ETX\EOT\US\SUB\ETB Opaque update-context\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ETX\EOT\DC2\EOT\144\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ETX\ENQ\DC2\EOT\144\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ETX\SOH\DC2\EOT\144\ETX\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ETX\ETX\DC2\EOT\144\ETX\GS\RS\n\
    \\RS\n\
    \\EOT\EOT\EM\STX\EOT\DC2\EOT\147\ETX\EOT\SUB\SUB\DLE The operations\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\EOT\EOT\DC2\EOT\147\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\EOT\ACK\DC2\EOT\147\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\EOT\SOH\DC2\EOT\147\ETX\DC3\NAK\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\EOT\ETX\DC2\EOT\147\ETX\CAN\EM\n\
    \\US\n\
    \\EOT\EOT\EM\STX\ENQ\DC2\EOT\150\ETX\EOT)\SUB\DC1 Request options\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ENQ\EOT\DC2\EOT\150\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ENQ\ENQ\DC2\EOT\150\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ENQ\SOH\DC2\EOT\150\ETX\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ENQ\ETX\DC2\EOT\150\ETX'(\n\
    \\f\n\
    \\EOT\EOT\EM\STX\ACK\DC2\EOT\151\ETX\EOT)\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ACK\EOT\DC2\EOT\151\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ACK\ENQ\DC2\EOT\151\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ACK\SOH\DC2\EOT\151\ETX\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\ACK\ETX\DC2\EOT\151\ETX'(\n\
    \\f\n\
    \\EOT\EOT\EM\STX\a\DC2\EOT\152\ETX\EOT)\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\a\EOT\DC2\EOT\152\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\a\ENQ\DC2\EOT\152\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\a\SOH\DC2\EOT\152\ETX\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\a\ETX\DC2\EOT\152\ETX'(\n\
    \\f\n\
    \\EOT\EOT\EM\STX\b\DC2\EOT\153\ETX\EOT9\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\b\EOT\DC2\EOT\153\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\b\ENQ\DC2\EOT\153\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\b\SOH\DC2\EOT\153\ETX\DC4\US\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\b\ETX\DC2\EOT\153\ETX'(\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\b\b\DC2\EOT\153\ETX)8\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\b\a\DC2\EOT\153\ETX27\n\
    \\f\n\
    \\EOT\EOT\EM\STX\t\DC2\EOT\154\ETX\EOT)\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\t\EOT\DC2\EOT\154\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\t\ENQ\DC2\EOT\154\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\t\SOH\DC2\EOT\154\ETX\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\t\ETX\DC2\EOT\154\ETX&(\n\
    \2\n\
    \\EOT\EOT\EM\STX\n\
    \\DC2\EOT\155\ETX\EOT)\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\n\
    \\EOT\DC2\EOT\155\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\n\
    \\ENQ\DC2\EOT\155\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\n\
    \\SOH\DC2\EOT\155\ETX\DC4!\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\n\
    \\ETX\DC2\EOT\155\ETX&(\n\
    \2\n\
    \\EOT\EOT\EM\STX\v\DC2\EOT\156\ETX\EOT)\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\v\EOT\DC2\EOT\156\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\v\ENQ\DC2\EOT\156\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\v\SOH\DC2\EOT\156\ETX\DC4\EM\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\v\ETX\DC2\EOT\156\ETX&(\n\
    \M\n\
    \\EOT\EOT\EM\STX\f\DC2\EOT\157\ETX\EOT8\"? When return_body is true, should the context be returned too?\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\f\EOT\DC2\EOT\157\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\f\ENQ\DC2\EOT\157\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\f\SOH\DC2\EOT\157\ETX\DC4#\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\f\ETX\DC2\EOT\157\ETX&(\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\f\b\DC2\EOT\157\ETX)7\n\
    \\r\n\
    \\ENQ\EOT\EM\STX\f\a\DC2\EOT\157\ETX26\n\
    \\176\SOH\n\
    \\STX\EOT\SUB\DC2\ACK\166\ETX\NUL\177\ETX\SOH\SUB\161\SOH\n\
    \ The equivalent of KV's \"RpbPutResp\", contains the assigned key if\n\
    \ it was assigned by the server, and the resulting value and context\n\
    \ if return_body was set.\n\
    \\n\
    \\v\n\
    \\ETX\EOT\SUB\SOH\DC2\EOT\166\ETX\b\DC4\n\
    \2\n\
    \\EOT\EOT\SUB\STX\NUL\DC2\EOT\168\ETX\EOT(\SUB$ The key, if assigned by the server\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\NUL\EOT\DC2\EOT\168\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\NUL\ENQ\DC2\EOT\168\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\NUL\SOH\DC2\EOT\168\ETX\SYN\EM\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\NUL\ETX\DC2\EOT\168\ETX&'\n\
    \L\n\
    \\EOT\EOT\SUB\STX\SOH\DC2\EOT\171\ETX\EOT(\SUB> The opaque update context and value, if return_body was set.\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\SOH\EOT\DC2\EOT\171\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\SOH\ENQ\DC2\EOT\171\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\SOH\SOH\DC2\EOT\171\ETX\SYN\GS\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\SOH\ETX\DC2\EOT\171\ETX&'\n\
    \\f\n\
    \\EOT\EOT\SUB\STX\STX\DC2\EOT\172\ETX\EOT(\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\STX\EOT\DC2\EOT\172\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\STX\ENQ\DC2\EOT\172\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\STX\SOH\DC2\EOT\172\ETX\SYN#\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\STX\ETX\DC2\EOT\172\ETX&'\n\
    \\f\n\
    \\EOT\EOT\SUB\STX\ETX\DC2\EOT\173\ETX\EOT(\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ETX\EOT\DC2\EOT\173\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ETX\ENQ\DC2\EOT\173\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ETX\SOH\DC2\EOT\173\ETX\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ETX\ETX\DC2\EOT\173\ETX&'\n\
    \\f\n\
    \\EOT\EOT\SUB\STX\EOT\DC2\EOT\174\ETX\EOT(\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\EOT\EOT\DC2\EOT\174\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\EOT\ACK\DC2\EOT\174\ETX\r\NAK\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\EOT\SOH\DC2\EOT\174\ETX\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\EOT\ETX\DC2\EOT\174\ETX&'\n\
    \\f\n\
    \\EOT\EOT\SUB\STX\ENQ\DC2\EOT\175\ETX\EOT(\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ENQ\EOT\DC2\EOT\175\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ENQ\ENQ\DC2\EOT\175\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ENQ\SOH\DC2\EOT\175\ETX\SYN\US\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ENQ\ETX\DC2\EOT\175\ETX&'\n\
    \\f\n\
    \\EOT\EOT\SUB\STX\ACK\DC2\EOT\176\ETX\EOT(\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ACK\EOT\DC2\EOT\176\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ACK\ENQ\DC2\EOT\176\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ACK\SOH\DC2\EOT\176\ETX\SYN \n\
    \\r\n\
    \\ENQ\EOT\SUB\STX\ACK\ETX\DC2\EOT\176\ETX&'\n\
    \\n\
    \\n\
    \\STX\EOT\ESC\DC2\EOT\180\ETX\NUL\ETB\n\
    \\v\n\
    \\ETX\EOT\ESC\SOH\DC2\EOT\180\ETX\b\DC3\n\
    \\n\
    \\n\
    \\STX\EOT\FS\DC2\EOT\181\ETX\NUL\SYN\n\
    \\v\n\
    \\ETX\EOT\FS\SOH\DC2\EOT\181\ETX\b\DC2\n\
    \\n\
    \\n\
    \\STX\EOT\GS\DC2\EOT\182\ETX\NUL\GS\n\
    \\v\n\
    \\ETX\EOT\GS\SOH\DC2\EOT\182\ETX\b\EM\n\
    \\n\
    \\n\
    \\STX\EOT\RS\DC2\EOT\183\ETX\NUL\US\n\
    \\v\n\
    \\ETX\EOT\RS\SOH\DC2\EOT\183\ETX\b\ESC\n\
    \\n\
    \\n\
    \\STX\EOT\US\DC2\EOT\184\ETX\NUL\SYN\n\
    \\v\n\
    \\ETX\EOT\US\SOH\DC2\EOT\184\ETX\b\DC2\n\
    \\n\
    \\n\
    \\STX\EOT \DC2\EOT\185\ETX\NUL\ETB\n\
    \\v\n\
    \\ETX\EOT \SOH\DC2\EOT\185\ETX\b\DC3\n\
    \\n\
    \\n\
    \\STX\EOT!\DC2\EOT\186\ETX\NUL\RS\n\
    \\v\n\
    \\ETX\EOT!\SOH\DC2\EOT\186\ETX\b\SUB\n\
    \\n\
    \\n\
    \\STX\EOT\"\DC2\EOT\187\ETX\NUL\FS\n\
    \\v\n\
    \\ETX\EOT\"\SOH\DC2\EOT\187\ETX\b\CAN\n\
    \\130\STX\n\
    \\STX\EOT#\DC2\ACK\210\ETX\NUL\212\ETX\SOH\SUBU Get ClientId Request - no message defined, just send RpbGetClientIdReq message code\n\
    \2v Java package specifiers\n\
    \ option java_package = \"com.basho.riak.protobuf\";\n\
    \ option java_outer_classname = \"RiakKvPB\";\n\
    \2% import \"riak.proto\"; // for RpbPair\n\
    \\n\
    \\v\n\
    \\ETX\EOT#\SOH\DC2\EOT\210\ETX\b\SUB\n\
    \4\n\
    \\EOT\EOT#\STX\NUL\DC2\EOT\211\ETX\EOT!\"& Client id in use for this connection\n\
    \\n\
    \\r\n\
    \\ENQ\EOT#\STX\NUL\EOT\DC2\EOT\211\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT#\STX\NUL\ENQ\DC2\EOT\211\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT#\STX\NUL\SOH\DC2\EOT\211\ETX\DC3\FS\n\
    \\r\n\
    \\ENQ\EOT#\STX\NUL\ETX\DC2\EOT\211\ETX\US \n\
    \\f\n\
    \\STX\EOT$\DC2\ACK\214\ETX\NUL\216\ETX\SOH\n\
    \\v\n\
    \\ETX\EOT$\SOH\DC2\EOT\214\ETX\b\EM\n\
    \4\n\
    \\EOT\EOT$\STX\NUL\DC2\EOT\215\ETX\EOT!\"& Client id to use for this connection\n\
    \\n\
    \\r\n\
    \\ENQ\EOT$\STX\NUL\EOT\DC2\EOT\215\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT$\STX\NUL\ENQ\DC2\EOT\215\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT$\STX\NUL\SOH\DC2\EOT\215\ETX\DC3\FS\n\
    \\r\n\
    \\ENQ\EOT$\STX\NUL\ETX\DC2\EOT\215\ETX\US \n\
    \1\n\
    \\STX\EOT%\DC2\ACK\221\ETX\NUL\235\ETX\SOH\SUB# Get Request - retrieve bucket/key\n\
    \\n\
    \\v\n\
    \\ETX\EOT%\SOH\DC2\EOT\221\ETX\b\DC1\n\
    \\f\n\
    \\EOT\EOT%\STX\NUL\DC2\EOT\222\ETX\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT%\STX\NUL\EOT\DC2\EOT\222\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\NUL\ENQ\DC2\EOT\222\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT%\STX\NUL\SOH\DC2\EOT\222\ETX\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT%\STX\NUL\ETX\DC2\EOT\222\ETX\FS\GS\n\
    \\f\n\
    \\EOT\EOT%\STX\SOH\DC2\EOT\223\ETX\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT%\STX\SOH\EOT\DC2\EOT\223\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\SOH\ENQ\DC2\EOT\223\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT%\STX\SOH\SOH\DC2\EOT\223\ETX\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT%\STX\SOH\ETX\DC2\EOT\223\ETX\EM\SUB\n\
    \\f\n\
    \\EOT\EOT%\STX\STX\DC2\EOT\224\ETX\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOT%\STX\STX\EOT\DC2\EOT\224\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\STX\ENQ\DC2\EOT\224\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT%\STX\STX\SOH\DC2\EOT\224\ETX\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT%\STX\STX\ETX\DC2\EOT\224\ETX\CAN\EM\n\
    \\f\n\
    \\EOT\EOT%\STX\ETX\DC2\EOT\225\ETX\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT%\STX\ETX\EOT\DC2\EOT\225\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\ETX\ENQ\DC2\EOT\225\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT%\STX\ETX\SOH\DC2\EOT\225\ETX\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT%\STX\ETX\ETX\DC2\EOT\225\ETX\EM\SUB\n\
    \\f\n\
    \\EOT\EOT%\STX\EOT\DC2\EOT\226\ETX\EOT#\n\
    \\r\n\
    \\ENQ\EOT%\STX\EOT\EOT\DC2\EOT\226\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\EOT\ENQ\DC2\EOT\226\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT%\STX\EOT\SOH\DC2\EOT\226\ETX\DC2\RS\n\
    \\r\n\
    \\ENQ\EOT%\STX\EOT\ETX\DC2\EOT\226\ETX!\"\n\
    \\f\n\
    \\EOT\EOT%\STX\ENQ\DC2\EOT\227\ETX\EOT\"\n\
    \\r\n\
    \\ENQ\EOT%\STX\ENQ\EOT\DC2\EOT\227\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\ENQ\ENQ\DC2\EOT\227\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT%\STX\ENQ\SOH\DC2\EOT\227\ETX\DC2\GS\n\
    \\r\n\
    \\ENQ\EOT%\STX\ENQ\ETX\DC2\EOT\227\ETX !\n\
    \:\n\
    \\EOT\EOT%\STX\ACK\DC2\EOT\228\ETX\EOT#\", fail if the supplied vclock does not match\n\
    \\n\
    \\r\n\
    \\ENQ\EOT%\STX\ACK\EOT\DC2\EOT\228\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\ACK\ENQ\DC2\EOT\228\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT%\STX\ACK\SOH\DC2\EOT\228\ETX\DC3\RS\n\
    \\r\n\
    \\ENQ\EOT%\STX\ACK\ETX\DC2\EOT\228\ETX!\"\n\
    \/\n\
    \\EOT\EOT%\STX\a\DC2\EOT\229\ETX\EOT\ESC\"! return everything but the value\n\
    \\n\
    \\r\n\
    \\ENQ\EOT%\STX\a\EOT\DC2\EOT\229\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\a\ENQ\DC2\EOT\229\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT%\STX\a\SOH\DC2\EOT\229\ETX\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT%\STX\a\ETX\DC2\EOT\229\ETX\EM\SUB\n\
    \<\n\
    \\EOT\EOT%\STX\b\DC2\EOT\230\ETX\EOT$\". return the tombstone's vclock, if applicable\n\
    \\n\
    \\r\n\
    \\ENQ\EOT%\STX\b\EOT\DC2\EOT\230\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\b\ENQ\DC2\EOT\230\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT%\STX\b\SOH\DC2\EOT\230\ETX\DC2\US\n\
    \\r\n\
    \\ENQ\EOT%\STX\b\ETX\DC2\EOT\230\ETX\"#\n\
    \\f\n\
    \\EOT\EOT%\STX\t\DC2\EOT\231\ETX\EOT!\n\
    \\r\n\
    \\ENQ\EOT%\STX\t\EOT\DC2\EOT\231\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\t\ENQ\DC2\EOT\231\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT%\STX\t\SOH\DC2\EOT\231\ETX\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT%\STX\t\ETX\DC2\EOT\231\ETX\RS \n\
    \2\n\
    \\EOT\EOT%\STX\n\
    \\DC2\EOT\232\ETX\EOT%\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT%\STX\n\
    \\EOT\DC2\EOT\232\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\n\
    \\ENQ\DC2\EOT\232\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT%\STX\n\
    \\SOH\DC2\EOT\232\ETX\DC2\US\n\
    \\r\n\
    \\ENQ\EOT%\STX\n\
    \\ETX\DC2\EOT\232\ETX\"$\n\
    \2\n\
    \\EOT\EOT%\STX\v\DC2\EOT\233\ETX\EOT\US\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT%\STX\v\EOT\DC2\EOT\233\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\v\ENQ\DC2\EOT\233\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT%\STX\v\SOH\DC2\EOT\233\ETX\DC4\EM\n\
    \\r\n\
    \\ENQ\EOT%\STX\v\ETX\DC2\EOT\233\ETX\FS\RS\n\
    \D\n\
    \\EOT\EOT%\STX\f\DC2\EOT\234\ETX\EOT\GS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT%\STX\f\EOT\DC2\EOT\234\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT%\STX\f\ENQ\DC2\EOT\234\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT%\STX\f\SOH\DC2\EOT\234\ETX\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT%\STX\f\ETX\DC2\EOT\234\ETX\SUB\FS\n\
    \Z\n\
    \\STX\EOT&\DC2\ACK\238\ETX\NUL\242\ETX\SOH\SUBL Get Response - if the record was not found there will be no content/vclock\n\
    \\n\
    \\v\n\
    \\ETX\EOT&\SOH\DC2\EOT\238\ETX\b\DC2\n\
    \\f\n\
    \\EOT\EOT&\STX\NUL\DC2\EOT\239\ETX\EOT$\n\
    \\r\n\
    \\ENQ\EOT&\STX\NUL\EOT\DC2\EOT\239\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT&\STX\NUL\ACK\DC2\EOT\239\ETX\r\ETB\n\
    \\r\n\
    \\ENQ\EOT&\STX\NUL\SOH\DC2\EOT\239\ETX\CAN\US\n\
    \\r\n\
    \\ENQ\EOT&\STX\NUL\ETX\DC2\EOT\239\ETX\"#\n\
    \6\n\
    \\EOT\EOT&\STX\SOH\DC2\EOT\240\ETX\EOT\RS\"( the opaque vector clock for the object\n\
    \\n\
    \\r\n\
    \\ENQ\EOT&\STX\SOH\EOT\DC2\EOT\240\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT&\STX\SOH\ENQ\DC2\EOT\240\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT&\STX\SOH\SOH\DC2\EOT\240\ETX\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT&\STX\SOH\ETX\DC2\EOT\240\ETX\FS\GS\n\
    \\f\n\
    \\EOT\EOT&\STX\STX\DC2\EOT\241\ETX\EOT \n\
    \\r\n\
    \\ENQ\EOT&\STX\STX\EOT\DC2\EOT\241\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT&\STX\STX\ENQ\DC2\EOT\241\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT&\STX\STX\SOH\DC2\EOT\241\ETX\DC2\ESC\n\
    \\r\n\
    \\ENQ\EOT&\STX\STX\ETX\DC2\EOT\241\ETX\RS\US\n\
    \\135\SOH\n\
    \\STX\EOT'\DC2\ACK\247\ETX\NUL\136\EOT\SOH\SUBy Put request - if options.return_body is set then the updated metadata/data for\n\
    \               the key will be returned.\n\
    \\n\
    \\v\n\
    \\ETX\EOT'\SOH\DC2\EOT\247\ETX\b\DC1\n\
    \\f\n\
    \\EOT\EOT'\STX\NUL\DC2\EOT\248\ETX\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT'\STX\NUL\EOT\DC2\EOT\248\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\NUL\ENQ\DC2\EOT\248\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT'\STX\NUL\SOH\DC2\EOT\248\ETX\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT'\STX\NUL\ETX\DC2\EOT\248\ETX\FS\GS\n\
    \\f\n\
    \\EOT\EOT'\STX\SOH\DC2\EOT\249\ETX\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT'\STX\SOH\EOT\DC2\EOT\249\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\SOH\ENQ\DC2\EOT\249\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT'\STX\SOH\SOH\DC2\EOT\249\ETX\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT'\STX\SOH\ETX\DC2\EOT\249\ETX\EM\SUB\n\
    \\f\n\
    \\EOT\EOT'\STX\STX\DC2\EOT\250\ETX\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT'\STX\STX\EOT\DC2\EOT\250\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\STX\ENQ\DC2\EOT\250\ETX\r\DC2\n\
    \\r\n\
    \\ENQ\EOT'\STX\STX\SOH\DC2\EOT\250\ETX\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT'\STX\STX\ETX\DC2\EOT\250\ETX\FS\GS\n\
    \\f\n\
    \\EOT\EOT'\STX\ETX\DC2\EOT\251\ETX\EOT$\n\
    \\r\n\
    \\ENQ\EOT'\STX\ETX\EOT\DC2\EOT\251\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\ETX\ACK\DC2\EOT\251\ETX\r\ETB\n\
    \\r\n\
    \\ENQ\EOT'\STX\ETX\SOH\DC2\EOT\251\ETX\CAN\US\n\
    \\r\n\
    \\ENQ\EOT'\STX\ETX\ETX\DC2\EOT\251\ETX\"#\n\
    \\f\n\
    \\EOT\EOT'\STX\EOT\DC2\EOT\252\ETX\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOT'\STX\EOT\EOT\DC2\EOT\252\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\EOT\ENQ\DC2\EOT\252\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT'\STX\EOT\SOH\DC2\EOT\252\ETX\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT'\STX\EOT\ETX\DC2\EOT\252\ETX\CAN\EM\n\
    \\f\n\
    \\EOT\EOT'\STX\ENQ\DC2\EOT\253\ETX\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT'\STX\ENQ\EOT\DC2\EOT\253\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\ENQ\ENQ\DC2\EOT\253\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT'\STX\ENQ\SOH\DC2\EOT\253\ETX\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT'\STX\ENQ\ETX\DC2\EOT\253\ETX\EM\SUB\n\
    \\f\n\
    \\EOT\EOT'\STX\ACK\DC2\EOT\254\ETX\EOT\"\n\
    \\r\n\
    \\ENQ\EOT'\STX\ACK\EOT\DC2\EOT\254\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\ACK\ENQ\DC2\EOT\254\ETX\r\DC1\n\
    \\r\n\
    \\ENQ\EOT'\STX\ACK\SOH\DC2\EOT\254\ETX\DC2\GS\n\
    \\r\n\
    \\ENQ\EOT'\STX\ACK\ETX\DC2\EOT\254\ETX !\n\
    \\f\n\
    \\EOT\EOT'\STX\a\DC2\EOT\255\ETX\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT'\STX\a\EOT\DC2\EOT\255\ETX\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\a\ENQ\DC2\EOT\255\ETX\r\DC3\n\
    \\r\n\
    \\ENQ\EOT'\STX\a\SOH\DC2\EOT\255\ETX\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT'\STX\a\ETX\DC2\EOT\255\ETX\EM\SUB\n\
    \\f\n\
    \\EOT\EOT'\STX\b\DC2\EOT\128\EOT\EOT&\n\
    \\r\n\
    \\ENQ\EOT'\STX\b\EOT\DC2\EOT\128\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\b\ENQ\DC2\EOT\128\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT'\STX\b\SOH\DC2\EOT\128\EOT\DC2!\n\
    \\r\n\
    \\ENQ\EOT'\STX\b\ETX\DC2\EOT\128\EOT$%\n\
    \\f\n\
    \\EOT\EOT'\STX\t\DC2\EOT\129\EOT\EOT%\n\
    \\r\n\
    \\ENQ\EOT'\STX\t\EOT\DC2\EOT\129\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\t\ENQ\DC2\EOT\129\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT'\STX\t\SOH\DC2\EOT\129\EOT\DC2\US\n\
    \\r\n\
    \\ENQ\EOT'\STX\t\ETX\DC2\EOT\129\EOT\"$\n\
    \\f\n\
    \\EOT\EOT'\STX\n\
    \\DC2\EOT\130\EOT\EOT#\n\
    \\r\n\
    \\ENQ\EOT'\STX\n\
    \\EOT\DC2\EOT\130\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\n\
    \\ENQ\DC2\EOT\130\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT'\STX\n\
    \\SOH\DC2\EOT\130\EOT\DC2\GS\n\
    \\r\n\
    \\ENQ\EOT'\STX\n\
    \\ETX\DC2\EOT\130\EOT \"\n\
    \\f\n\
    \\EOT\EOT'\STX\v\DC2\EOT\131\EOT\EOT!\n\
    \\r\n\
    \\ENQ\EOT'\STX\v\EOT\DC2\EOT\131\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\v\ENQ\DC2\EOT\131\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT'\STX\v\SOH\DC2\EOT\131\EOT\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT'\STX\v\ETX\DC2\EOT\131\EOT\RS \n\
    \\f\n\
    \\EOT\EOT'\STX\f\DC2\EOT\132\EOT\EOT\FS\n\
    \\r\n\
    \\ENQ\EOT'\STX\f\EOT\DC2\EOT\132\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\f\ENQ\DC2\EOT\132\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT'\STX\f\SOH\DC2\EOT\132\EOT\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT'\STX\f\ETX\DC2\EOT\132\EOT\EM\ESC\n\
    \2\n\
    \\EOT\EOT'\STX\r\DC2\EOT\133\EOT\EOT%\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT'\STX\r\EOT\DC2\EOT\133\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\r\ENQ\DC2\EOT\133\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT'\STX\r\SOH\DC2\EOT\133\EOT\DC2\US\n\
    \\r\n\
    \\ENQ\EOT'\STX\r\ETX\DC2\EOT\133\EOT\"$\n\
    \2\n\
    \\EOT\EOT'\STX\SO\DC2\EOT\134\EOT\EOT\US\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT'\STX\SO\EOT\DC2\EOT\134\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\SO\ENQ\DC2\EOT\134\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT'\STX\SO\SOH\DC2\EOT\134\EOT\DC4\EM\n\
    \\r\n\
    \\ENQ\EOT'\STX\SO\ETX\DC2\EOT\134\EOT\FS\RS\n\
    \D\n\
    \\EOT\EOT'\STX\SI\DC2\EOT\135\EOT\EOT\GS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT'\STX\SI\EOT\DC2\EOT\135\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT'\STX\SI\ENQ\DC2\EOT\135\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT'\STX\SI\SOH\DC2\EOT\135\EOT\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT'\STX\SI\ETX\DC2\EOT\135\EOT\SUB\FS\n\
    \Z\n\
    \\STX\EOT(\DC2\ACK\139\EOT\NUL\143\EOT\SOH\SUBL Put response - same as get response with optional key if one was generated\n\
    \\n\
    \\v\n\
    \\ETX\EOT(\SOH\DC2\EOT\139\EOT\b\DC2\n\
    \\f\n\
    \\EOT\EOT(\STX\NUL\DC2\EOT\140\EOT\EOT$\n\
    \\r\n\
    \\ENQ\EOT(\STX\NUL\EOT\DC2\EOT\140\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT(\STX\NUL\ACK\DC2\EOT\140\EOT\r\ETB\n\
    \\r\n\
    \\ENQ\EOT(\STX\NUL\SOH\DC2\EOT\140\EOT\CAN\US\n\
    \\r\n\
    \\ENQ\EOT(\STX\NUL\ETX\DC2\EOT\140\EOT\"#\n\
    \6\n\
    \\EOT\EOT(\STX\SOH\DC2\EOT\141\EOT\EOT\RS\"( the opaque vector clock for the object\n\
    \\n\
    \\r\n\
    \\ENQ\EOT(\STX\SOH\EOT\DC2\EOT\141\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT(\STX\SOH\ENQ\DC2\EOT\141\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT(\STX\SOH\SOH\DC2\EOT\141\EOT\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT(\STX\SOH\ETX\DC2\EOT\141\EOT\FS\GS\n\
    \)\n\
    \\EOT\EOT(\STX\STX\DC2\EOT\142\EOT\EOT\ESC\"\ESC the key generated, if any\n\
    \\n\
    \\r\n\
    \\ENQ\EOT(\STX\STX\EOT\DC2\EOT\142\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT(\STX\STX\ENQ\DC2\EOT\142\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT(\STX\STX\SOH\DC2\EOT\142\EOT\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT(\STX\STX\ETX\DC2\EOT\142\EOT\EM\SUB\n\
    \\RS\n\
    \\STX\EOT)\DC2\ACK\147\EOT\NUL\161\EOT\SOH\SUB\DLE Delete request\n\
    \\n\
    \\v\n\
    \\ETX\EOT)\SOH\DC2\EOT\147\EOT\b\DC1\n\
    \\f\n\
    \\EOT\EOT)\STX\NUL\DC2\EOT\148\EOT\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT)\STX\NUL\EOT\DC2\EOT\148\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\NUL\ENQ\DC2\EOT\148\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT)\STX\NUL\SOH\DC2\EOT\148\EOT\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT)\STX\NUL\ETX\DC2\EOT\148\EOT\FS\GS\n\
    \\f\n\
    \\EOT\EOT)\STX\SOH\DC2\EOT\149\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT)\STX\SOH\EOT\DC2\EOT\149\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\SOH\ENQ\DC2\EOT\149\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT)\STX\SOH\SOH\DC2\EOT\149\EOT\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT)\STX\SOH\ETX\DC2\EOT\149\EOT\EM\SUB\n\
    \\f\n\
    \\EOT\EOT)\STX\STX\DC2\EOT\150\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT)\STX\STX\EOT\DC2\EOT\150\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\STX\ENQ\DC2\EOT\150\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\STX\SOH\DC2\EOT\150\EOT\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT)\STX\STX\ETX\DC2\EOT\150\EOT\EM\SUB\n\
    \\f\n\
    \\EOT\EOT)\STX\ETX\DC2\EOT\151\EOT\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT)\STX\ETX\EOT\DC2\EOT\151\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\ETX\ENQ\DC2\EOT\151\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT)\STX\ETX\SOH\DC2\EOT\151\EOT\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT)\STX\ETX\ETX\DC2\EOT\151\EOT\FS\GS\n\
    \\f\n\
    \\EOT\EOT)\STX\EOT\DC2\EOT\152\EOT\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOT)\STX\EOT\EOT\DC2\EOT\152\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\EOT\ENQ\DC2\EOT\152\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\EOT\SOH\DC2\EOT\152\EOT\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT)\STX\EOT\ETX\DC2\EOT\152\EOT\CAN\EM\n\
    \\f\n\
    \\EOT\EOT)\STX\ENQ\DC2\EOT\153\EOT\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOT)\STX\ENQ\EOT\DC2\EOT\153\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\ENQ\ENQ\DC2\EOT\153\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\ENQ\SOH\DC2\EOT\153\EOT\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT)\STX\ENQ\ETX\DC2\EOT\153\EOT\CAN\EM\n\
    \\f\n\
    \\EOT\EOT)\STX\ACK\DC2\EOT\154\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT)\STX\ACK\EOT\DC2\EOT\154\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\ACK\ENQ\DC2\EOT\154\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\ACK\SOH\DC2\EOT\154\EOT\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT)\STX\ACK\ETX\DC2\EOT\154\EOT\EM\SUB\n\
    \\f\n\
    \\EOT\EOT)\STX\a\DC2\EOT\155\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT)\STX\a\EOT\DC2\EOT\155\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\a\ENQ\DC2\EOT\155\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\a\SOH\DC2\EOT\155\EOT\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT)\STX\a\ETX\DC2\EOT\155\EOT\EM\SUB\n\
    \\f\n\
    \\EOT\EOT)\STX\b\DC2\EOT\156\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT)\STX\b\EOT\DC2\EOT\156\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\b\ENQ\DC2\EOT\156\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\b\SOH\DC2\EOT\156\EOT\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT)\STX\b\ETX\DC2\EOT\156\EOT\EM\SUB\n\
    \\f\n\
    \\EOT\EOT)\STX\t\DC2\EOT\157\EOT\EOT!\n\
    \\r\n\
    \\ENQ\EOT)\STX\t\EOT\DC2\EOT\157\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\t\ENQ\DC2\EOT\157\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\t\SOH\DC2\EOT\157\EOT\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT)\STX\t\ETX\DC2\EOT\157\EOT\RS \n\
    \2\n\
    \\EOT\EOT)\STX\n\
    \\DC2\EOT\158\EOT\EOT%\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT)\STX\n\
    \\EOT\DC2\EOT\158\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\n\
    \\ENQ\DC2\EOT\158\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT)\STX\n\
    \\SOH\DC2\EOT\158\EOT\DC2\US\n\
    \\r\n\
    \\ENQ\EOT)\STX\n\
    \\ETX\DC2\EOT\158\EOT\"$\n\
    \2\n\
    \\EOT\EOT)\STX\v\DC2\EOT\159\EOT\EOT\US\"$ Experimental, may change/disappear\n\
    \\n\
    \\r\n\
    \\ENQ\EOT)\STX\v\EOT\DC2\EOT\159\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\v\ENQ\DC2\EOT\159\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT)\STX\v\SOH\DC2\EOT\159\EOT\DC4\EM\n\
    \\r\n\
    \\ENQ\EOT)\STX\v\ETX\DC2\EOT\159\EOT\FS\RS\n\
    \D\n\
    \\EOT\EOT)\STX\f\DC2\EOT\160\EOT\EOT\GS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT)\STX\f\EOT\DC2\EOT\160\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT)\STX\f\ENQ\DC2\EOT\160\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT)\STX\f\SOH\DC2\EOT\160\EOT\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT)\STX\f\ETX\DC2\EOT\160\EOT\SUB\FS\n\
    \\133\SOH\n\
    \\STX\EOT*\DC2\ACK\166\EOT\NUL\170\EOT\SOH\SUB\SYN List buckets request\n\
    \2_ Delete response - not defined, will return a RpbDelResp on success or RpbErrorResp on failure\n\
    \\n\
    \\v\n\
    \\ETX\EOT*\SOH\DC2\EOT\166\EOT\b\EM\n\
    \\f\n\
    \\EOT\EOT*\STX\NUL\DC2\EOT\167\EOT\EOT \n\
    \\r\n\
    \\ENQ\EOT*\STX\NUL\EOT\DC2\EOT\167\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT*\STX\NUL\ENQ\DC2\EOT\167\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT*\STX\NUL\SOH\DC2\EOT\167\EOT\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT*\STX\NUL\ETX\DC2\EOT\167\EOT\RS\US\n\
    \\f\n\
    \\EOT\EOT*\STX\SOH\DC2\EOT\168\EOT\EOT\GS\n\
    \\r\n\
    \\ENQ\EOT*\STX\SOH\EOT\DC2\EOT\168\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT*\STX\SOH\ENQ\DC2\EOT\168\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT*\STX\SOH\SOH\DC2\EOT\168\EOT\DC2\CAN\n\
    \\r\n\
    \\ENQ\EOT*\STX\SOH\ETX\DC2\EOT\168\EOT\ESC\FS\n\
    \D\n\
    \\EOT\EOT*\STX\STX\DC2\EOT\169\EOT\EOT\FS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT*\STX\STX\EOT\DC2\EOT\169\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT*\STX\STX\ENQ\DC2\EOT\169\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT*\STX\STX\SOH\DC2\EOT\169\EOT\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT*\STX\STX\ETX\DC2\EOT\169\EOT\SUB\ESC\n\
    \\157\SOH\n\
    \\STX\EOT+\DC2\ACK\174\EOT\NUL\177\EOT\SOH\SUB\142\SOH List buckets response - one or more of these packets will be sent\n\
    \ the last one will have done set true (and may not have any buckets in it)\n\
    \\n\
    \\v\n\
    \\ETX\EOT+\SOH\DC2\EOT\174\EOT\b\SUB\n\
    \\f\n\
    \\EOT\EOT+\STX\NUL\DC2\EOT\175\EOT\EOT\US\n\
    \\r\n\
    \\ENQ\EOT+\STX\NUL\EOT\DC2\EOT\175\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT+\STX\NUL\ENQ\DC2\EOT\175\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT+\STX\NUL\SOH\DC2\EOT\175\EOT\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT+\STX\NUL\ETX\DC2\EOT\175\EOT\GS\RS\n\
    \\f\n\
    \\EOT\EOT+\STX\SOH\DC2\EOT\176\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT+\STX\SOH\EOT\DC2\EOT\176\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT+\STX\SOH\ENQ\DC2\EOT\176\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT+\STX\SOH\SOH\DC2\EOT\176\EOT\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT+\STX\SOH\ETX\DC2\EOT\176\EOT\EM\SUB\n\
    \+\n\
    \\STX\EOT,\DC2\ACK\181\EOT\NUL\185\EOT\SOH\SUB\GS List keys in bucket request\n\
    \\n\
    \\v\n\
    \\ETX\EOT,\SOH\DC2\EOT\181\EOT\b\SYN\n\
    \\f\n\
    \\EOT\EOT,\STX\NUL\DC2\EOT\182\EOT\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT,\STX\NUL\EOT\DC2\EOT\182\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT,\STX\NUL\ENQ\DC2\EOT\182\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT,\STX\NUL\SOH\DC2\EOT\182\EOT\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT,\STX\NUL\ETX\DC2\EOT\182\EOT\FS\GS\n\
    \\f\n\
    \\EOT\EOT,\STX\SOH\DC2\EOT\183\EOT\EOT \n\
    \\r\n\
    \\ENQ\EOT,\STX\SOH\EOT\DC2\EOT\183\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT,\STX\SOH\ENQ\DC2\EOT\183\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT,\STX\SOH\SOH\DC2\EOT\183\EOT\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT,\STX\SOH\ETX\DC2\EOT\183\EOT\RS\US\n\
    \D\n\
    \\EOT\EOT,\STX\STX\DC2\EOT\184\EOT\EOT\FS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT,\STX\STX\EOT\DC2\EOT\184\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT,\STX\STX\ENQ\DC2\EOT\184\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT,\STX\STX\SOH\DC2\EOT\184\EOT\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT,\STX\STX\ETX\DC2\EOT\184\EOT\SUB\ESC\n\
    \\161\SOH\n\
    \\STX\EOT-\DC2\ACK\189\EOT\NUL\192\EOT\SOH\SUB\146\SOH List keys in bucket response - one or more of these packets will be sent\n\
    \ the last one will have done set true (and may not have any keys in it)\n\
    \\n\
    \\v\n\
    \\ETX\EOT-\SOH\DC2\EOT\189\EOT\b\ETB\n\
    \\f\n\
    \\EOT\EOT-\STX\NUL\DC2\EOT\190\EOT\EOT\FS\n\
    \\r\n\
    \\ENQ\EOT-\STX\NUL\EOT\DC2\EOT\190\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT-\STX\NUL\ENQ\DC2\EOT\190\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT-\STX\NUL\SOH\DC2\EOT\190\EOT\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT-\STX\NUL\ETX\DC2\EOT\190\EOT\SUB\ESC\n\
    \\f\n\
    \\EOT\EOT-\STX\SOH\DC2\EOT\191\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT-\STX\SOH\EOT\DC2\EOT\191\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT-\STX\SOH\ENQ\DC2\EOT\191\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT-\STX\SOH\SOH\DC2\EOT\191\EOT\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT-\STX\SOH\ETX\DC2\EOT\191\EOT\EM\SUB\n\
    \\"\n\
    \\STX\EOT.\DC2\ACK\196\EOT\NUL\199\EOT\SOH\SUB\DC4 Map/Reduce request\n\
    \\n\
    \\v\n\
    \\ETX\EOT.\SOH\DC2\EOT\196\EOT\b\DC4\n\
    \\f\n\
    \\EOT\EOT.\STX\NUL\DC2\EOT\197\EOT\EOT\US\n\
    \\r\n\
    \\ENQ\EOT.\STX\NUL\EOT\DC2\EOT\197\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT.\STX\NUL\ENQ\DC2\EOT\197\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT.\STX\NUL\SOH\DC2\EOT\197\EOT\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT.\STX\NUL\ETX\DC2\EOT\197\EOT\GS\RS\n\
    \\f\n\
    \\EOT\EOT.\STX\SOH\DC2\EOT\198\EOT\EOT$\n\
    \\r\n\
    \\ENQ\EOT.\STX\SOH\EOT\DC2\EOT\198\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT.\STX\SOH\ENQ\DC2\EOT\198\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT.\STX\SOH\SOH\DC2\EOT\198\EOT\DC3\US\n\
    \\r\n\
    \\ENQ\EOT.\STX\SOH\ETX\DC2\EOT\198\EOT\"#\n\
    \\153\SOH\n\
    \\STX\EOT/\DC2\ACK\204\EOT\NUL\208\EOT\SOH\SUB\138\SOH Map/Reduce response\n\
    \ one or more of these packets will be sent the last one will have done set\n\
    \ true (and may not have phase/data in it)\n\
    \\n\
    \\v\n\
    \\ETX\EOT/\SOH\DC2\EOT\204\EOT\b\NAK\n\
    \\f\n\
    \\EOT\EOT/\STX\NUL\DC2\EOT\205\EOT\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT/\STX\NUL\EOT\DC2\EOT\205\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT/\STX\NUL\ENQ\DC2\EOT\205\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT/\STX\NUL\SOH\DC2\EOT\205\EOT\DC4\EM\n\
    \\r\n\
    \\ENQ\EOT/\STX\NUL\ETX\DC2\EOT\205\EOT\FS\GS\n\
    \\f\n\
    \\EOT\EOT/\STX\SOH\DC2\EOT\206\EOT\EOT \n\
    \\r\n\
    \\ENQ\EOT/\STX\SOH\EOT\DC2\EOT\206\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT/\STX\SOH\ENQ\DC2\EOT\206\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT/\STX\SOH\SOH\DC2\EOT\206\EOT\DC3\ESC\n\
    \\r\n\
    \\ENQ\EOT/\STX\SOH\ETX\DC2\EOT\206\EOT\RS\US\n\
    \\f\n\
    \\EOT\EOT/\STX\STX\DC2\EOT\207\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT/\STX\STX\EOT\DC2\EOT\207\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT/\STX\STX\ENQ\DC2\EOT\207\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT/\STX\STX\SOH\DC2\EOT\207\EOT\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT/\STX\STX\ETX\DC2\EOT\207\EOT\EM\SUB\n\
    \-\n\
    \\STX\EOT0\DC2\ACK\211\EOT\NUL\236\EOT\SOH\SUB\US Secondary Index query request\n\
    \\n\
    \\v\n\
    \\ETX\EOT0\SOH\DC2\EOT\211\EOT\b\DC3\n\
    \\SO\n\
    \\EOT\EOT0\EOT\NUL\DC2\ACK\212\EOT\EOT\215\EOT\ENQ\n\
    \\r\n\
    \\ENQ\EOT0\EOT\NUL\SOH\DC2\EOT\212\EOT\t\ETB\n\
    \\SO\n\
    \\ACK\EOT0\EOT\NUL\STX\NUL\DC2\EOT\213\EOT\b\SI\n\
    \\SI\n\
    \\a\EOT0\EOT\NUL\STX\NUL\SOH\DC2\EOT\213\EOT\b\n\
    \\n\
    \\SI\n\
    \\a\EOT0\EOT\NUL\STX\NUL\STX\DC2\EOT\213\EOT\r\SO\n\
    \\SO\n\
    \\ACK\EOT0\EOT\NUL\STX\SOH\DC2\EOT\214\EOT\b\DC2\n\
    \\SI\n\
    \\a\EOT0\EOT\NUL\STX\SOH\SOH\DC2\EOT\214\EOT\b\r\n\
    \\SI\n\
    \\a\EOT0\EOT\NUL\STX\SOH\STX\DC2\EOT\214\EOT\DLE\DC1\n\
    \\f\n\
    \\EOT\EOT0\STX\NUL\DC2\EOT\217\EOT\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT0\STX\NUL\EOT\DC2\EOT\217\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\NUL\ENQ\DC2\EOT\217\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\NUL\SOH\DC2\EOT\217\EOT\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT0\STX\NUL\ETX\DC2\EOT\217\EOT\FS\GS\n\
    \\f\n\
    \\EOT\EOT0\STX\SOH\DC2\EOT\218\EOT\EOT\GS\n\
    \\r\n\
    \\ENQ\EOT0\STX\SOH\EOT\DC2\EOT\218\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\SOH\ENQ\DC2\EOT\218\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\SOH\SOH\DC2\EOT\218\EOT\DC3\CAN\n\
    \\r\n\
    \\ENQ\EOT0\STX\SOH\ETX\DC2\EOT\218\EOT\ESC\FS\n\
    \\f\n\
    \\EOT\EOT0\STX\STX\DC2\EOT\219\EOT\EOT&\n\
    \\r\n\
    \\ENQ\EOT0\STX\STX\EOT\DC2\EOT\219\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\STX\ACK\DC2\EOT\219\EOT\r\ESC\n\
    \\r\n\
    \\ENQ\EOT0\STX\STX\SOH\DC2\EOT\219\EOT\FS!\n\
    \\r\n\
    \\ENQ\EOT0\STX\STX\ETX\DC2\EOT\219\EOT$%\n\
    \6\n\
    \\EOT\EOT0\STX\ETX\DC2\EOT\220\EOT\EOT\ESC\"( key here means equals value for index?\n\
    \\n\
    \\r\n\
    \\ENQ\EOT0\STX\ETX\EOT\DC2\EOT\220\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\ETX\ENQ\DC2\EOT\220\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\ETX\SOH\DC2\EOT\220\EOT\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT0\STX\ETX\ETX\DC2\EOT\220\EOT\EM\SUB\n\
    \\f\n\
    \\EOT\EOT0\STX\EOT\DC2\EOT\221\EOT\EOT!\n\
    \\r\n\
    \\ENQ\EOT0\STX\EOT\EOT\DC2\EOT\221\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\EOT\ENQ\DC2\EOT\221\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\EOT\SOH\DC2\EOT\221\EOT\DC3\FS\n\
    \\r\n\
    \\ENQ\EOT0\STX\EOT\ETX\DC2\EOT\221\EOT\US \n\
    \\f\n\
    \\EOT\EOT0\STX\ENQ\DC2\EOT\222\EOT\EOT!\n\
    \\r\n\
    \\ENQ\EOT0\STX\ENQ\EOT\DC2\EOT\222\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\ENQ\ENQ\DC2\EOT\222\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\ENQ\SOH\DC2\EOT\222\EOT\DC3\FS\n\
    \\r\n\
    \\ENQ\EOT0\STX\ENQ\ETX\DC2\EOT\222\EOT\US \n\
    \\f\n\
    \\EOT\EOT0\STX\ACK\DC2\EOT\223\EOT\EOT#\n\
    \\r\n\
    \\ENQ\EOT0\STX\ACK\EOT\DC2\EOT\223\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\ACK\ENQ\DC2\EOT\223\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT0\STX\ACK\SOH\DC2\EOT\223\EOT\DC2\RS\n\
    \\r\n\
    \\ENQ\EOT0\STX\ACK\ETX\DC2\EOT\223\EOT!\"\n\
    \\f\n\
    \\EOT\EOT0\STX\a\DC2\EOT\224\EOT\EOT\GS\n\
    \\r\n\
    \\ENQ\EOT0\STX\a\EOT\DC2\EOT\224\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\a\ENQ\DC2\EOT\224\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT0\STX\a\SOH\DC2\EOT\224\EOT\DC2\CAN\n\
    \\r\n\
    \\ENQ\EOT0\STX\a\ETX\DC2\EOT\224\EOT\ESC\FS\n\
    \\f\n\
    \\EOT\EOT0\STX\b\DC2\EOT\225\EOT\EOT$\n\
    \\r\n\
    \\ENQ\EOT0\STX\b\EOT\DC2\EOT\225\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\b\ENQ\DC2\EOT\225\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT0\STX\b\SOH\DC2\EOT\225\EOT\DC4\US\n\
    \\r\n\
    \\ENQ\EOT0\STX\b\ETX\DC2\EOT\225\EOT\"#\n\
    \\f\n\
    \\EOT\EOT0\STX\t\DC2\EOT\226\EOT\EOT%\n\
    \\r\n\
    \\ENQ\EOT0\STX\t\EOT\DC2\EOT\226\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\t\ENQ\DC2\EOT\226\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\t\SOH\DC2\EOT\226\EOT\DC3\US\n\
    \\r\n\
    \\ENQ\EOT0\STX\t\ETX\DC2\EOT\226\EOT\"$\n\
    \\f\n\
    \\EOT\EOT0\STX\n\
    \\DC2\EOT\227\EOT\EOT!\n\
    \\r\n\
    \\ENQ\EOT0\STX\n\
    \\EOT\DC2\EOT\227\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\n\
    \\ENQ\DC2\EOT\227\EOT\r\DC3\n\
    \\r\n\
    \\ENQ\EOT0\STX\n\
    \\SOH\DC2\EOT\227\EOT\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT0\STX\n\
    \\ETX\DC2\EOT\227\EOT\RS \n\
    \D\n\
    \\EOT\EOT0\STX\v\DC2\EOT\228\EOT\EOT\GS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT0\STX\v\EOT\DC2\EOT\228\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\v\ENQ\DC2\EOT\228\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\v\SOH\DC2\EOT\228\EOT\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT0\STX\v\ETX\DC2\EOT\228\EOT\SUB\FS\n\
    \\f\n\
    \\EOT\EOT0\STX\f\DC2\EOT\229\EOT\EOT#\n\
    \\r\n\
    \\ENQ\EOT0\STX\f\EOT\DC2\EOT\229\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\f\ENQ\DC2\EOT\229\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\f\SOH\DC2\EOT\229\EOT\DC3\GS\n\
    \\r\n\
    \\ENQ\EOT0\STX\f\ETX\DC2\EOT\229\EOT \"\n\
    \H\n\
    \\EOT\EOT0\STX\r\DC2\EOT\231\EOT\EOT'\SUB: Whether to use pagination sort for non-paginated queries\n\
    \\n\
    \\r\n\
    \\ENQ\EOT0\STX\r\EOT\DC2\EOT\231\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\r\ENQ\DC2\EOT\231\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT0\STX\r\SOH\DC2\EOT\231\EOT\DC2!\n\
    \\r\n\
    \\ENQ\EOT0\STX\r\ETX\DC2\EOT\231\EOT$&\n\
    \Q\n\
    \\EOT\EOT0\STX\SO\DC2\EOT\233\EOT\EOT&\SUB\US parallel extraction extension\n\
    \\"\" chopped up coverage plan per-req\n\
    \\n\
    \\r\n\
    \\ENQ\EOT0\STX\SO\EOT\DC2\EOT\233\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\SO\ENQ\DC2\EOT\233\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT0\STX\SO\SOH\DC2\EOT\233\EOT\DC3 \n\
    \\r\n\
    \\ENQ\EOT0\STX\SO\ETX\DC2\EOT\233\EOT#%\n\
    \S\n\
    \\EOT\EOT0\STX\SI\DC2\EOT\234\EOT\EOT#\"E Return values with keys, only works with $bucket/$key index queries\n\
    \\n\
    \\r\n\
    \\ENQ\EOT0\STX\SI\EOT\DC2\EOT\234\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT0\STX\SI\ENQ\DC2\EOT\234\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT0\STX\SI\SOH\DC2\EOT\234\EOT\DC2\GS\n\
    \\r\n\
    \\ENQ\EOT0\STX\SI\ETX\DC2\EOT\234\EOT \"\n\
    \.\n\
    \\STX\EOT1\DC2\ACK\239\EOT\NUL\244\EOT\SOH\SUB  Secondary Index query response\n\
    \\n\
    \\v\n\
    \\ETX\EOT1\SOH\DC2\EOT\239\EOT\b\DC4\n\
    \\f\n\
    \\EOT\EOT1\STX\NUL\DC2\EOT\240\EOT\EOT\FS\n\
    \\r\n\
    \\ENQ\EOT1\STX\NUL\EOT\DC2\EOT\240\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT1\STX\NUL\ENQ\DC2\EOT\240\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT1\STX\NUL\SOH\DC2\EOT\240\EOT\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT1\STX\NUL\ETX\DC2\EOT\240\EOT\SUB\ESC\n\
    \\f\n\
    \\EOT\EOT1\STX\SOH\DC2\EOT\241\EOT\EOT!\n\
    \\r\n\
    \\ENQ\EOT1\STX\SOH\EOT\DC2\EOT\241\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT1\STX\SOH\ACK\DC2\EOT\241\EOT\r\DC4\n\
    \\r\n\
    \\ENQ\EOT1\STX\SOH\SOH\DC2\EOT\241\EOT\NAK\FS\n\
    \\r\n\
    \\ENQ\EOT1\STX\SOH\ETX\DC2\EOT\241\EOT\US \n\
    \\f\n\
    \\EOT\EOT1\STX\STX\DC2\EOT\242\EOT\EOT$\n\
    \\r\n\
    \\ENQ\EOT1\STX\STX\EOT\DC2\EOT\242\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT1\STX\STX\ENQ\DC2\EOT\242\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT1\STX\STX\SOH\DC2\EOT\242\EOT\DC3\US\n\
    \\r\n\
    \\ENQ\EOT1\STX\STX\ETX\DC2\EOT\242\EOT\"#\n\
    \\f\n\
    \\EOT\EOT1\STX\ETX\DC2\EOT\243\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT1\STX\ETX\EOT\DC2\EOT\243\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT1\STX\ETX\ENQ\DC2\EOT\243\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT1\STX\ETX\SOH\DC2\EOT\243\EOT\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT1\STX\ETX\ETX\DC2\EOT\243\EOT\EM\SUB\n\
    \P\n\
    \\STX\EOT2\DC2\ACK\247\EOT\NUL\251\EOT\SOH\SUBB Stolen from CS bucket response, to be used when return_body=true\n\
    \\n\
    \\v\n\
    \\ETX\EOT2\SOH\DC2\EOT\247\EOT\b\CAN\n\
    \\f\n\
    \\EOT\EOT2\STX\NUL\DC2\EOT\248\EOT\EOT(\n\
    \\r\n\
    \\ENQ\EOT2\STX\NUL\EOT\DC2\EOT\248\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT2\STX\NUL\ACK\DC2\EOT\248\EOT\r\ESC\n\
    \\r\n\
    \\ENQ\EOT2\STX\NUL\SOH\DC2\EOT\248\EOT\FS#\n\
    \\r\n\
    \\ENQ\EOT2\STX\NUL\ETX\DC2\EOT\248\EOT&'\n\
    \\f\n\
    \\EOT\EOT2\STX\SOH\DC2\EOT\249\EOT\EOT$\n\
    \\r\n\
    \\ENQ\EOT2\STX\SOH\EOT\DC2\EOT\249\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT2\STX\SOH\ENQ\DC2\EOT\249\EOT\r\DC2\n\
    \\r\n\
    \\ENQ\EOT2\STX\SOH\SOH\DC2\EOT\249\EOT\DC3\US\n\
    \\r\n\
    \\ENQ\EOT2\STX\SOH\ETX\DC2\EOT\249\EOT\"#\n\
    \\f\n\
    \\EOT\EOT2\STX\STX\DC2\EOT\250\EOT\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT2\STX\STX\EOT\DC2\EOT\250\EOT\EOT\f\n\
    \\r\n\
    \\ENQ\EOT2\STX\STX\ENQ\DC2\EOT\250\EOT\r\DC1\n\
    \\r\n\
    \\ENQ\EOT2\STX\STX\SOH\DC2\EOT\250\EOT\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT2\STX\STX\ETX\DC2\EOT\250\EOT\EM\SUB\n\
    \e\n\
    \\STX\EOT3\DC2\ACK\128\ENQ\NUL\140\ENQ\SOH\SUBW added solely for riak_cs currently\n\
    \ for folding over a bucket and returning\n\
    \ objects.\n\
    \\n\
    \\v\n\
    \\ETX\EOT3\SOH\DC2\EOT\128\ENQ\b\SYN\n\
    \\f\n\
    \\EOT\EOT3\STX\NUL\DC2\EOT\129\ENQ\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT3\STX\NUL\EOT\DC2\EOT\129\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\NUL\ENQ\DC2\EOT\129\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT3\STX\NUL\SOH\DC2\EOT\129\ENQ\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT3\STX\NUL\ETX\DC2\EOT\129\ENQ\FS\GS\n\
    \\f\n\
    \\EOT\EOT3\STX\SOH\DC2\EOT\130\ENQ\EOT!\n\
    \\r\n\
    \\ENQ\EOT3\STX\SOH\EOT\DC2\EOT\130\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\SOH\ENQ\DC2\EOT\130\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT3\STX\SOH\SOH\DC2\EOT\130\ENQ\DC3\FS\n\
    \\r\n\
    \\ENQ\EOT3\STX\SOH\ETX\DC2\EOT\130\ENQ\US \n\
    \\f\n\
    \\EOT\EOT3\STX\STX\DC2\EOT\131\ENQ\EOT\US\n\
    \\r\n\
    \\ENQ\EOT3\STX\STX\EOT\DC2\EOT\131\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\STX\ENQ\DC2\EOT\131\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT3\STX\STX\SOH\DC2\EOT\131\ENQ\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT3\STX\STX\ETX\DC2\EOT\131\ENQ\GS\RS\n\
    \\f\n\
    \\EOT\EOT3\STX\ETX\DC2\EOT\132\ENQ\EOT2\n\
    \\r\n\
    \\ENQ\EOT3\STX\ETX\EOT\DC2\EOT\132\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\ETX\ENQ\DC2\EOT\132\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT3\STX\ETX\SOH\DC2\EOT\132\ENQ\DC2\FS\n\
    \\r\n\
    \\ENQ\EOT3\STX\ETX\ETX\DC2\EOT\132\ENQ\US \n\
    \\r\n\
    \\ENQ\EOT3\STX\ETX\b\DC2\EOT\132\ENQ!1\n\
    \\r\n\
    \\ENQ\EOT3\STX\ETX\a\DC2\EOT\132\ENQ,0\n\
    \\f\n\
    \\EOT\EOT3\STX\EOT\DC2\EOT\133\ENQ\EOT1\n\
    \\r\n\
    \\ENQ\EOT3\STX\EOT\EOT\DC2\EOT\133\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\EOT\ENQ\DC2\EOT\133\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT3\STX\EOT\SOH\DC2\EOT\133\ENQ\DC2\SUB\n\
    \\r\n\
    \\ENQ\EOT3\STX\EOT\ETX\DC2\EOT\133\ENQ\GS\RS\n\
    \\r\n\
    \\ENQ\EOT3\STX\EOT\b\DC2\EOT\133\ENQ\US0\n\
    \\r\n\
    \\ENQ\EOT3\STX\EOT\a\DC2\EOT\133\ENQ*/\n\
    \\f\n\
    \\EOT\EOT3\STX\ENQ\DC2\EOT\134\ENQ\EOT$\n\
    \\r\n\
    \\ENQ\EOT3\STX\ENQ\EOT\DC2\EOT\134\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\ENQ\ENQ\DC2\EOT\134\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT3\STX\ENQ\SOH\DC2\EOT\134\ENQ\DC3\US\n\
    \\r\n\
    \\ENQ\EOT3\STX\ENQ\ETX\DC2\EOT\134\ENQ\"#\n\
    \\f\n\
    \\EOT\EOT3\STX\ACK\DC2\EOT\135\ENQ\EOT$\n\
    \\r\n\
    \\ENQ\EOT3\STX\ACK\EOT\DC2\EOT\135\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\ACK\ENQ\DC2\EOT\135\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT3\STX\ACK\SOH\DC2\EOT\135\ENQ\DC4\US\n\
    \\r\n\
    \\ENQ\EOT3\STX\ACK\ETX\DC2\EOT\135\ENQ\"#\n\
    \\f\n\
    \\EOT\EOT3\STX\a\DC2\EOT\136\ENQ\EOT \n\
    \\r\n\
    \\ENQ\EOT3\STX\a\EOT\DC2\EOT\136\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\a\ENQ\DC2\EOT\136\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT3\STX\a\SOH\DC2\EOT\136\ENQ\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOT3\STX\a\ETX\DC2\EOT\136\ENQ\RS\US\n\
    \D\n\
    \\EOT\EOT3\STX\b\DC2\EOT\137\ENQ\EOT\FS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT3\STX\b\EOT\DC2\EOT\137\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\b\ENQ\DC2\EOT\137\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT3\STX\b\SOH\DC2\EOT\137\ENQ\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT3\STX\b\ETX\DC2\EOT\137\ENQ\SUB\ESC\n\
    \Q\n\
    \\EOT\EOT3\STX\t\DC2\EOT\139\ENQ\EOT&\SUB\US parallel extraction extension\n\
    \\"\" chopped up coverage plan per-req\n\
    \\n\
    \\r\n\
    \\ENQ\EOT3\STX\t\EOT\DC2\EOT\139\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT3\STX\t\ENQ\DC2\EOT\139\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT3\STX\t\SOH\DC2\EOT\139\ENQ\DC3 \n\
    \\r\n\
    \\ENQ\EOT3\STX\t\ETX\DC2\EOT\139\ENQ#%\n\
    \)\n\
    \\STX\EOT4\DC2\ACK\143\ENQ\NUL\147\ENQ\SOH\SUB\ESC return for CS bucket fold\n\
    \\n\
    \\v\n\
    \\ETX\EOT4\SOH\DC2\EOT\143\ENQ\b\ETB\n\
    \\f\n\
    \\EOT\EOT4\STX\NUL\DC2\EOT\144\ENQ\EOT(\n\
    \\r\n\
    \\ENQ\EOT4\STX\NUL\EOT\DC2\EOT\144\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT4\STX\NUL\ACK\DC2\EOT\144\ENQ\r\ESC\n\
    \\r\n\
    \\ENQ\EOT4\STX\NUL\SOH\DC2\EOT\144\ENQ\FS#\n\
    \\r\n\
    \\ENQ\EOT4\STX\NUL\ETX\DC2\EOT\144\ENQ&'\n\
    \\f\n\
    \\EOT\EOT4\STX\SOH\DC2\EOT\145\ENQ\EOT$\n\
    \\r\n\
    \\ENQ\EOT4\STX\SOH\EOT\DC2\EOT\145\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT4\STX\SOH\ENQ\DC2\EOT\145\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT4\STX\SOH\SOH\DC2\EOT\145\ENQ\DC3\US\n\
    \\r\n\
    \\ENQ\EOT4\STX\SOH\ETX\DC2\EOT\145\ENQ\"#\n\
    \\f\n\
    \\EOT\EOT4\STX\STX\DC2\EOT\146\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT4\STX\STX\EOT\DC2\EOT\146\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT4\STX\STX\ENQ\DC2\EOT\146\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT4\STX\STX\SOH\DC2\EOT\146\ENQ\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOT4\STX\STX\ETX\DC2\EOT\146\ENQ\EM\SUB\n\
    \\f\n\
    \\STX\EOT5\DC2\ACK\149\ENQ\NUL\152\ENQ\SOH\n\
    \\v\n\
    \\ETX\EOT5\SOH\DC2\EOT\149\ENQ\b\SYN\n\
    \\f\n\
    \\EOT\EOT5\STX\NUL\DC2\EOT\150\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT5\STX\NUL\EOT\DC2\EOT\150\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT5\STX\NUL\ENQ\DC2\EOT\150\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT5\STX\NUL\SOH\DC2\EOT\150\ENQ\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT5\STX\NUL\ETX\DC2\EOT\150\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT5\STX\SOH\DC2\EOT\151\ENQ\EOT#\n\
    \\r\n\
    \\ENQ\EOT5\STX\SOH\EOT\DC2\EOT\151\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT5\STX\SOH\ACK\DC2\EOT\151\ENQ\r\ETB\n\
    \\r\n\
    \\ENQ\EOT5\STX\SOH\SOH\DC2\EOT\151\ENQ\CAN\RS\n\
    \\r\n\
    \\ENQ\EOT5\STX\SOH\ETX\DC2\EOT\151\ENQ!\"\n\
    \f\n\
    \\STX\EOT6\DC2\ACK\156\ENQ\NUL\169\ENQ\SOH\SUBX Content message included in get/put responses\n\
    \ Holds the value and associated metadata\n\
    \\n\
    \\v\n\
    \\ETX\EOT6\SOH\DC2\EOT\156\ENQ\b\DC2\n\
    \\f\n\
    \\EOT\EOT6\STX\NUL\DC2\EOT\157\ENQ\EOT\GS\n\
    \\r\n\
    \\ENQ\EOT6\STX\NUL\EOT\DC2\EOT\157\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\NUL\ENQ\DC2\EOT\157\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT6\STX\NUL\SOH\DC2\EOT\157\ENQ\DC3\CAN\n\
    \\r\n\
    \\ENQ\EOT6\STX\NUL\ETX\DC2\EOT\157\ENQ\ESC\FS\n\
    \%\n\
    \\EOT\EOT6\STX\SOH\DC2\EOT\158\ENQ\EOT$\"\ETB the media type/format\n\
    \\n\
    \\r\n\
    \\ENQ\EOT6\STX\SOH\EOT\DC2\EOT\158\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\SOH\ENQ\DC2\EOT\158\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT6\STX\SOH\SOH\DC2\EOT\158\ENQ\DC3\US\n\
    \\r\n\
    \\ENQ\EOT6\STX\SOH\ETX\DC2\EOT\158\ENQ\"#\n\
    \\f\n\
    \\EOT\EOT6\STX\STX\DC2\EOT\159\ENQ\EOT\US\n\
    \\r\n\
    \\ENQ\EOT6\STX\STX\EOT\DC2\EOT\159\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\STX\ENQ\DC2\EOT\159\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT6\STX\STX\SOH\DC2\EOT\159\ENQ\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT6\STX\STX\ETX\DC2\EOT\159\ENQ\GS\RS\n\
    \\f\n\
    \\EOT\EOT6\STX\ETX\DC2\EOT\160\ENQ\EOT(\n\
    \\r\n\
    \\ENQ\EOT6\STX\ETX\EOT\DC2\EOT\160\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\ETX\ENQ\DC2\EOT\160\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT6\STX\ETX\SOH\DC2\EOT\160\ENQ\DC3#\n\
    \\r\n\
    \\ENQ\EOT6\STX\ETX\ETX\DC2\EOT\160\ENQ&'\n\
    \\f\n\
    \\EOT\EOT6\STX\EOT\DC2\EOT\161\ENQ\EOT\FS\n\
    \\r\n\
    \\ENQ\EOT6\STX\EOT\EOT\DC2\EOT\161\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\EOT\ENQ\DC2\EOT\161\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT6\STX\EOT\SOH\DC2\EOT\161\ENQ\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT6\STX\EOT\ETX\DC2\EOT\161\ENQ\SUB\ESC\n\
    \(\n\
    \\EOT\EOT6\STX\ENQ\DC2\EOT\162\ENQ\EOT\US\"\SUB links to other resources\n\
    \\n\
    \\r\n\
    \\ENQ\EOT6\STX\ENQ\EOT\DC2\EOT\162\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\ENQ\ACK\DC2\EOT\162\ENQ\r\DC4\n\
    \\r\n\
    \\ENQ\EOT6\STX\ENQ\SOH\DC2\EOT\162\ENQ\NAK\SUB\n\
    \\r\n\
    \\ENQ\EOT6\STX\ENQ\ETX\DC2\EOT\162\ENQ\GS\RS\n\
    \\f\n\
    \\EOT\EOT6\STX\ACK\DC2\EOT\163\ENQ\EOT!\n\
    \\r\n\
    \\ENQ\EOT6\STX\ACK\EOT\DC2\EOT\163\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\ACK\ENQ\DC2\EOT\163\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT6\STX\ACK\SOH\DC2\EOT\163\ENQ\DC4\FS\n\
    \\r\n\
    \\ENQ\EOT6\STX\ACK\ETX\DC2\EOT\163\ENQ\US \n\
    \\f\n\
    \\EOT\EOT6\STX\a\DC2\EOT\164\ENQ\EOT'\n\
    \\r\n\
    \\ENQ\EOT6\STX\a\EOT\DC2\EOT\164\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\a\ENQ\DC2\EOT\164\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT6\STX\a\SOH\DC2\EOT\164\ENQ\DC4\"\n\
    \\r\n\
    \\ENQ\EOT6\STX\a\ETX\DC2\EOT\164\ENQ%&\n\
    \4\n\
    \\EOT\EOT6\STX\b\DC2\EOT\165\ENQ\EOT\"\"& user metadata stored with the object\n\
    \\n\
    \\r\n\
    \\ENQ\EOT6\STX\b\EOT\DC2\EOT\165\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\b\ACK\DC2\EOT\165\ENQ\r\DC4\n\
    \\r\n\
    \\ENQ\EOT6\STX\b\SOH\DC2\EOT\165\ENQ\NAK\GS\n\
    \\r\n\
    \\ENQ\EOT6\STX\b\ETX\DC2\EOT\165\ENQ !\n\
    \4\n\
    \\EOT\EOT6\STX\t\DC2\EOT\166\ENQ\EOT\"\"& user metadata stored with the object\n\
    \\n\
    \\r\n\
    \\ENQ\EOT6\STX\t\EOT\DC2\EOT\166\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\t\ACK\DC2\EOT\166\ENQ\r\DC4\n\
    \\r\n\
    \\ENQ\EOT6\STX\t\SOH\DC2\EOT\166\ENQ\NAK\FS\n\
    \\r\n\
    \\ENQ\EOT6\STX\t\ETX\DC2\EOT\166\ENQ\US!\n\
    \\f\n\
    \\EOT\EOT6\STX\n\
    \\DC2\EOT\167\ENQ\EOT\US\n\
    \\r\n\
    \\ENQ\EOT6\STX\n\
    \\EOT\DC2\EOT\167\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\n\
    \\ENQ\DC2\EOT\167\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT6\STX\n\
    \\SOH\DC2\EOT\167\ENQ\DC2\EM\n\
    \\r\n\
    \\ENQ\EOT6\STX\n\
    \\ETX\DC2\EOT\167\ENQ\FS\RS\n\
    \\f\n\
    \\EOT\EOT6\STX\v\DC2\EOT\168\ENQ\EOT\GS\n\
    \\r\n\
    \\ENQ\EOT6\STX\v\EOT\DC2\EOT\168\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT6\STX\v\ENQ\DC2\EOT\168\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT6\STX\v\SOH\DC2\EOT\168\ENQ\DC4\ETB\n\
    \\r\n\
    \\ENQ\EOT6\STX\v\ETX\DC2\EOT\168\ENQ\SUB\FS\n\
    \\GS\n\
    \\STX\EOT7\DC2\ACK\172\ENQ\NUL\176\ENQ\SOH\SUB\SI Link metadata\n\
    \\n\
    \\v\n\
    \\ETX\EOT7\SOH\DC2\EOT\172\ENQ\b\SI\n\
    \\f\n\
    \\EOT\EOT7\STX\NUL\DC2\EOT\173\ENQ\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT7\STX\NUL\EOT\DC2\EOT\173\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT7\STX\NUL\ENQ\DC2\EOT\173\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT7\STX\NUL\SOH\DC2\EOT\173\ENQ\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT7\STX\NUL\ETX\DC2\EOT\173\ENQ\FS\GS\n\
    \\f\n\
    \\EOT\EOT7\STX\SOH\DC2\EOT\174\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT7\STX\SOH\EOT\DC2\EOT\174\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT7\STX\SOH\ENQ\DC2\EOT\174\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT7\STX\SOH\SOH\DC2\EOT\174\ENQ\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT7\STX\SOH\ETX\DC2\EOT\174\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT7\STX\STX\DC2\EOT\175\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT7\STX\STX\EOT\DC2\EOT\175\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT7\STX\STX\ENQ\DC2\EOT\175\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT7\STX\STX\SOH\DC2\EOT\175\ENQ\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT7\STX\STX\ETX\DC2\EOT\175\ENQ\EM\SUB\n\
    \&\n\
    \\STX\EOT8\DC2\ACK\179\ENQ\NUL\187\ENQ\SOH\SUB\CAN Counter update request\n\
    \\n\
    \\v\n\
    \\ETX\EOT8\SOH\DC2\EOT\179\ENQ\b\ESC\n\
    \\f\n\
    \\EOT\EOT8\STX\NUL\DC2\EOT\180\ENQ\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT8\STX\NUL\EOT\DC2\EOT\180\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT8\STX\NUL\ENQ\DC2\EOT\180\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT8\STX\NUL\SOH\DC2\EOT\180\ENQ\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT8\STX\NUL\ETX\DC2\EOT\180\ENQ\FS\GS\n\
    \\f\n\
    \\EOT\EOT8\STX\SOH\DC2\EOT\181\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT8\STX\SOH\EOT\DC2\EOT\181\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT8\STX\SOH\ENQ\DC2\EOT\181\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT8\STX\SOH\SOH\DC2\EOT\181\ENQ\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT8\STX\SOH\ETX\DC2\EOT\181\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT8\STX\STX\DC2\EOT\182\ENQ\EOT\US\n\
    \\r\n\
    \\ENQ\EOT8\STX\STX\EOT\DC2\EOT\182\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT8\STX\STX\ENQ\DC2\EOT\182\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT8\STX\STX\SOH\DC2\EOT\182\ENQ\DC4\SUB\n\
    \\r\n\
    \\ENQ\EOT8\STX\STX\ETX\DC2\EOT\182\ENQ\GS\RS\n\
    \\f\n\
    \\EOT\EOT8\STX\ETX\DC2\EOT\183\ENQ\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOT8\STX\ETX\EOT\DC2\EOT\183\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT8\STX\ETX\ENQ\DC2\EOT\183\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT8\STX\ETX\SOH\DC2\EOT\183\ENQ\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT8\STX\ETX\ETX\DC2\EOT\183\ENQ\CAN\EM\n\
    \\f\n\
    \\EOT\EOT8\STX\EOT\DC2\EOT\184\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT8\STX\EOT\EOT\DC2\EOT\184\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT8\STX\EOT\ENQ\DC2\EOT\184\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT8\STX\EOT\SOH\DC2\EOT\184\ENQ\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT8\STX\EOT\ETX\DC2\EOT\184\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT8\STX\ENQ\DC2\EOT\185\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT8\STX\ENQ\EOT\DC2\EOT\185\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT8\STX\ENQ\ENQ\DC2\EOT\185\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT8\STX\ENQ\SOH\DC2\EOT\185\ENQ\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT8\STX\ENQ\ETX\DC2\EOT\185\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT8\STX\ACK\DC2\EOT\186\ENQ\EOT\"\n\
    \\r\n\
    \\ENQ\EOT8\STX\ACK\EOT\DC2\EOT\186\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT8\STX\ACK\ENQ\DC2\EOT\186\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT8\STX\ACK\SOH\DC2\EOT\186\ENQ\DC2\GS\n\
    \\r\n\
    \\ENQ\EOT8\STX\ACK\ETX\DC2\EOT\186\ENQ !\n\
    \D\n\
    \\STX\EOT9\DC2\ACK\190\ENQ\NUL\192\ENQ\SOH\SUB6 Counter update response? No message | error response\n\
    \\n\
    \\v\n\
    \\ETX\EOT9\SOH\DC2\EOT\190\ENQ\b\FS\n\
    \\f\n\
    \\EOT\EOT9\STX\NUL\DC2\EOT\191\ENQ\b\"\n\
    \\r\n\
    \\ENQ\EOT9\STX\NUL\EOT\DC2\EOT\191\ENQ\b\DLE\n\
    \\r\n\
    \\ENQ\EOT9\STX\NUL\ENQ\DC2\EOT\191\ENQ\DC1\ETB\n\
    \\r\n\
    \\ENQ\EOT9\STX\NUL\SOH\DC2\EOT\191\ENQ\CAN\GS\n\
    \\r\n\
    \\ENQ\EOT9\STX\NUL\ETX\DC2\EOT\191\ENQ !\n\
    \\GS\n\
    \\STX\EOT:\DC2\ACK\195\ENQ\NUL\202\ENQ\SOH\SUB\SI counter value\n\
    \\n\
    \\v\n\
    \\ETX\EOT:\SOH\DC2\EOT\195\ENQ\b\CAN\n\
    \\f\n\
    \\EOT\EOT:\STX\NUL\DC2\EOT\196\ENQ\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT:\STX\NUL\EOT\DC2\EOT\196\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT:\STX\NUL\ENQ\DC2\EOT\196\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT:\STX\NUL\SOH\DC2\EOT\196\ENQ\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT:\STX\NUL\ETX\DC2\EOT\196\ENQ\FS\GS\n\
    \\f\n\
    \\EOT\EOT:\STX\SOH\DC2\EOT\197\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT:\STX\SOH\EOT\DC2\EOT\197\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT:\STX\SOH\ENQ\DC2\EOT\197\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT:\STX\SOH\SOH\DC2\EOT\197\ENQ\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT:\STX\SOH\ETX\DC2\EOT\197\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT:\STX\STX\DC2\EOT\198\ENQ\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOT:\STX\STX\EOT\DC2\EOT\198\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT:\STX\STX\ENQ\DC2\EOT\198\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT:\STX\STX\SOH\DC2\EOT\198\ENQ\DC4\NAK\n\
    \\r\n\
    \\ENQ\EOT:\STX\STX\ETX\DC2\EOT\198\ENQ\CAN\EM\n\
    \\f\n\
    \\EOT\EOT:\STX\ETX\DC2\EOT\199\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT:\STX\ETX\EOT\DC2\EOT\199\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT:\STX\ETX\ENQ\DC2\EOT\199\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT:\STX\ETX\SOH\DC2\EOT\199\ENQ\DC4\SYN\n\
    \\r\n\
    \\ENQ\EOT:\STX\ETX\ETX\DC2\EOT\199\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT:\STX\EOT\DC2\EOT\200\ENQ\EOT#\n\
    \\r\n\
    \\ENQ\EOT:\STX\EOT\EOT\DC2\EOT\200\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT:\STX\EOT\ENQ\DC2\EOT\200\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT:\STX\EOT\SOH\DC2\EOT\200\ENQ\DC2\RS\n\
    \\r\n\
    \\ENQ\EOT:\STX\EOT\ETX\DC2\EOT\200\ENQ!\"\n\
    \\f\n\
    \\EOT\EOT:\STX\ENQ\DC2\EOT\201\ENQ\EOT\"\n\
    \\r\n\
    \\ENQ\EOT:\STX\ENQ\EOT\DC2\EOT\201\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT:\STX\ENQ\ENQ\DC2\EOT\201\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT:\STX\ENQ\SOH\DC2\EOT\201\ENQ\DC2\GS\n\
    \\r\n\
    \\ENQ\EOT:\STX\ENQ\ETX\DC2\EOT\201\ENQ !\n\
    \&\n\
    \\STX\EOT;\DC2\ACK\205\ENQ\NUL\207\ENQ\SOH\SUB\CAN Counter value response\n\
    \\n\
    \\v\n\
    \\ETX\EOT;\SOH\DC2\EOT\205\ENQ\b\EM\n\
    \\f\n\
    \\EOT\EOT;\STX\NUL\DC2\EOT\206\ENQ\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT;\STX\NUL\EOT\DC2\EOT\206\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT;\STX\NUL\ENQ\DC2\EOT\206\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT;\STX\NUL\SOH\DC2\EOT\206\ENQ\DC4\EM\n\
    \\r\n\
    \\ENQ\EOT;\STX\NUL\ETX\DC2\EOT\206\ENQ\FS\GS\n\
    \/\n\
    \\STX\EOT<\DC2\ACK\210\ENQ\NUL\214\ENQ\SOH\SUB! Get bucket-key preflist request\n\
    \\n\
    \\v\n\
    \\ETX\EOT<\SOH\DC2\EOT\210\ENQ\b\"\n\
    \\f\n\
    \\EOT\EOT<\STX\NUL\DC2\EOT\211\ENQ\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT<\STX\NUL\EOT\DC2\EOT\211\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT<\STX\NUL\ENQ\DC2\EOT\211\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT<\STX\NUL\SOH\DC2\EOT\211\ENQ\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT<\STX\NUL\ETX\DC2\EOT\211\ENQ\FS\GS\n\
    \\f\n\
    \\EOT\EOT<\STX\SOH\DC2\EOT\212\ENQ\EOT\ESC\n\
    \\r\n\
    \\ENQ\EOT<\STX\SOH\EOT\DC2\EOT\212\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT<\STX\SOH\ENQ\DC2\EOT\212\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT<\STX\SOH\SOH\DC2\EOT\212\ENQ\DC3\SYN\n\
    \\r\n\
    \\ENQ\EOT<\STX\SOH\ETX\DC2\EOT\212\ENQ\EM\SUB\n\
    \\f\n\
    \\EOT\EOT<\STX\STX\DC2\EOT\213\ENQ\EOT\FS\n\
    \\r\n\
    \\ENQ\EOT<\STX\STX\EOT\DC2\EOT\213\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT<\STX\STX\ENQ\DC2\EOT\213\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT<\STX\STX\SOH\DC2\EOT\213\ENQ\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT<\STX\STX\ETX\DC2\EOT\213\ENQ\SUB\ESC\n\
    \0\n\
    \\STX\EOT=\DC2\ACK\217\ENQ\NUL\219\ENQ\SOH\SUB\" Get bucket-key preflist response\n\
    \\n\
    \\v\n\
    \\ETX\EOT=\SOH\DC2\EOT\217\ENQ\b#\n\
    \\f\n\
    \\EOT\EOT=\STX\NUL\DC2\EOT\218\ENQ\EOT3\n\
    \\r\n\
    \\ENQ\EOT=\STX\NUL\EOT\DC2\EOT\218\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT=\STX\NUL\ACK\DC2\EOT\218\ENQ\r%\n\
    \\r\n\
    \\ENQ\EOT=\STX\NUL\SOH\DC2\EOT\218\ENQ&.\n\
    \\r\n\
    \\ENQ\EOT=\STX\NUL\ETX\DC2\EOT\218\ENQ12\n\
    \\GS\n\
    \\STX\EOT>\DC2\ACK\222\ENQ\NUL\226\ENQ\SOH\SUB\SI Preflist item\n\
    \\n\
    \\v\n\
    \\ETX\EOT>\SOH\DC2\EOT\222\ENQ\b \n\
    \\f\n\
    \\EOT\EOT>\STX\NUL\DC2\EOT\223\ENQ\EOT!\n\
    \\r\n\
    \\ENQ\EOT>\STX\NUL\EOT\DC2\EOT\223\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT>\STX\NUL\ENQ\DC2\EOT\223\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT>\STX\NUL\SOH\DC2\EOT\223\ENQ\DC3\FS\n\
    \\r\n\
    \\ENQ\EOT>\STX\NUL\ETX\DC2\EOT\223\ENQ\US \n\
    \\f\n\
    \\EOT\EOT>\STX\SOH\DC2\EOT\224\ENQ\EOT\FS\n\
    \\r\n\
    \\ENQ\EOT>\STX\SOH\EOT\DC2\EOT\224\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT>\STX\SOH\ENQ\DC2\EOT\224\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT>\STX\SOH\SOH\DC2\EOT\224\ENQ\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT>\STX\SOH\ETX\DC2\EOT\224\ENQ\SUB\ESC\n\
    \\f\n\
    \\EOT\EOT>\STX\STX\DC2\EOT\225\ENQ\EOT\US\n\
    \\r\n\
    \\ENQ\EOT>\STX\STX\EOT\DC2\EOT\225\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT>\STX\STX\ENQ\DC2\EOT\225\ENQ\r\DC1\n\
    \\r\n\
    \\ENQ\EOT>\STX\STX\SOH\DC2\EOT\225\ENQ\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT>\STX\STX\ETX\DC2\EOT\225\ENQ\GS\RS\n\
    \J\n\
    \\STX\EOT?\DC2\ACK\230\ENQ\NUL\236\ENQ\SOH\SUB< Request a segmented coverage plan for the specified bucket\n\
    \\n\
    \\v\n\
    \\ETX\EOT?\SOH\DC2\EOT\230\ENQ\b\SYN\n\
    \D\n\
    \\EOT\EOT?\STX\NUL\DC2\EOT\231\ENQ\EOT\FS\"6 Bucket type, if not set we assume the 'default' type\n\
    \\n\
    \\r\n\
    \\ENQ\EOT?\STX\NUL\EOT\DC2\EOT\231\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT?\STX\NUL\ENQ\DC2\EOT\231\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT?\STX\NUL\SOH\DC2\EOT\231\ENQ\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT?\STX\NUL\ETX\DC2\EOT\231\ENQ\SUB\ESC\n\
    \\f\n\
    \\EOT\EOT?\STX\SOH\DC2\EOT\232\ENQ\EOT\RS\n\
    \\r\n\
    \\ENQ\EOT?\STX\SOH\EOT\DC2\EOT\232\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT?\STX\SOH\ENQ\DC2\EOT\232\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT?\STX\SOH\SOH\DC2\EOT\232\ENQ\DC3\EM\n\
    \\r\n\
    \\ENQ\EOT?\STX\SOH\ETX\DC2\EOT\232\ENQ\FS\GS\n\
    \\226\SOH\n\
    \\EOT\EOT?\STX\STX\DC2\EOT\233\ENQ\EOT'\"\211\SOH If undefined, we build a normal coverage plan. If <ring_size, we build a coverage plan with exactly ring_size entries, anything larger will have a power of 2 entries covering keyspaces smaller than a partition\n\
    \\n\
    \\r\n\
    \\ENQ\EOT?\STX\STX\EOT\DC2\EOT\233\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT?\STX\STX\ENQ\DC2\EOT\233\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOT?\STX\STX\SOH\DC2\EOT\233\ENQ\DC4\"\n\
    \\r\n\
    \\ENQ\EOT?\STX\STX\ETX\DC2\EOT\233\ENQ%&\n\
    \$\n\
    \\EOT\EOT?\STX\ETX\DC2\EOT\234\ENQ\EOT%\"\SYN For failure recovery\n\
    \\n\
    \\r\n\
    \\ENQ\EOT?\STX\ETX\EOT\DC2\EOT\234\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT?\STX\ETX\ENQ\DC2\EOT\234\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT?\STX\ETX\SOH\DC2\EOT\234\ENQ\DC3 \n\
    \\r\n\
    \\ENQ\EOT?\STX\ETX\ETX\DC2\EOT\234\ENQ#$\n\
    \g\n\
    \\EOT\EOT?\STX\EOT\DC2\EOT\235\ENQ\EOT)\"Y Other coverage contexts that have failed to assist Riak in deciding what nodes to avoid\n\
    \\n\
    \\r\n\
    \\ENQ\EOT?\STX\EOT\EOT\DC2\EOT\235\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOT?\STX\EOT\ENQ\DC2\EOT\235\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOT?\STX\EOT\SOH\DC2\EOT\235\ENQ\DC3$\n\
    \\r\n\
    \\ENQ\EOT?\STX\EOT\ETX\DC2\EOT\235\ENQ'(\n\
    \0\n\
    \\STX\EOT@\DC2\ACK\239\ENQ\NUL\241\ENQ\SOH\SUB\" Segmented coverage plan response\n\
    \\n\
    \\v\n\
    \\ETX\EOT@\SOH\DC2\EOT\239\ENQ\b\ETB\n\
    \\f\n\
    \\EOT\EOT@\STX\NUL\DC2\EOT\240\ENQ\ETX)\n\
    \\r\n\
    \\ENQ\EOT@\STX\NUL\EOT\DC2\EOT\240\ENQ\ETX\v\n\
    \\r\n\
    \\ENQ\EOT@\STX\NUL\ACK\DC2\EOT\240\ENQ\f\FS\n\
    \\r\n\
    \\ENQ\EOT@\STX\NUL\SOH\DC2\EOT\240\ENQ\GS$\n\
    \\r\n\
    \\ENQ\EOT@\STX\NUL\ETX\DC2\EOT\240\ENQ'(\n\
    \*\n\
    \\STX\EOTA\DC2\ACK\244\ENQ\NUL\249\ENQ\SOH\SUB\FS Segment of a coverage plan\n\
    \\n\
    \\v\n\
    \\ETX\EOTA\SOH\DC2\EOT\244\ENQ\b\CAN\n\
    \\f\n\
    \\EOT\EOTA\STX\NUL\DC2\EOT\245\ENQ\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOTA\STX\NUL\EOT\DC2\EOT\245\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOTA\STX\NUL\ENQ\DC2\EOT\245\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOTA\STX\NUL\SOH\DC2\EOT\245\ENQ\DC3\NAK\n\
    \\r\n\
    \\ENQ\EOTA\STX\NUL\ETX\DC2\EOT\245\ENQ\CAN\EM\n\
    \\f\n\
    \\EOT\EOTA\STX\SOH\DC2\EOT\246\ENQ\EOT\GS\n\
    \\r\n\
    \\ENQ\EOTA\STX\SOH\EOT\DC2\EOT\246\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOTA\STX\SOH\ENQ\DC2\EOT\246\ENQ\r\DC3\n\
    \\r\n\
    \\ENQ\EOTA\STX\SOH\SOH\DC2\EOT\246\ENQ\DC4\CAN\n\
    \\r\n\
    \\ENQ\EOTA\STX\SOH\ETX\DC2\EOT\246\ENQ\ESC\FS\n\
    \G\n\
    \\EOT\EOTA\STX\STX\DC2\EOT\247\ENQ\EOT%\"9 Some human readable description of the keyspace covered\n\
    \\n\
    \\r\n\
    \\ENQ\EOTA\STX\STX\EOT\DC2\EOT\247\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOTA\STX\STX\ENQ\DC2\EOT\247\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOTA\STX\STX\SOH\DC2\EOT\247\ENQ\DC3 \n\
    \\r\n\
    \\ENQ\EOTA\STX\STX\ETX\DC2\EOT\247\ENQ#$\n\
    \5\n\
    \\EOT\EOTA\STX\ETX\DC2\EOT\248\ENQ\EOT%\"' Opaque context to pass into 2I query.\n\
    \\n\
    \\r\n\
    \\ENQ\EOTA\STX\ETX\EOT\DC2\EOT\248\ENQ\EOT\f\n\
    \\r\n\
    \\ENQ\EOTA\STX\ETX\ENQ\DC2\EOT\248\ENQ\r\DC2\n\
    \\r\n\
    \\ENQ\EOTA\STX\ETX\SOH\DC2\EOT\248\ENQ\DC3 \n\
    \\r\n\
    \\ENQ\EOTA\STX\ETX\ETX\DC2\EOT\248\ENQ#$\n\
    \\160\SOH\n\
    \\STX\EOTB\DC2\ACK\143\ACK\NUL\145\ACK\SOH2\SYN import \"riak.proto\";\n\
    \2z java package specifiers\n\
    \ option java_package = \"com.basho.riak.protobuf\";\n\
    \ option java_outer_classname = \"RiakSearchPB\";\n\
    \\n\
    \\v\n\
    \\ETX\EOTB\SOH\DC2\EOT\143\ACK\b\DC4\n\
    \\f\n\
    \\EOT\EOTB\STX\NUL\DC2\EOT\144\ACK\STX\RS\n\
    \\r\n\
    \\ENQ\EOTB\STX\NUL\EOT\DC2\EOT\144\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTB\STX\NUL\ACK\DC2\EOT\144\ACK\v\DC2\n\
    \\r\n\
    \\ENQ\EOTB\STX\NUL\SOH\DC2\EOT\144\ACK\DC3\EM\n\
    \\r\n\
    \\ENQ\EOTB\STX\NUL\ETX\DC2\EOT\144\ACK\FS\GS\n\
    \\f\n\
    \\STX\EOTC\DC2\ACK\147\ACK\NUL\158\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTC\SOH\DC2\EOT\147\ACK\b\EM\n\
    \\FS\n\
    \\EOT\EOTC\STX\NUL\DC2\EOT\148\ACK\STX\RS\"\SO Query string\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\NUL\EOT\DC2\EOT\148\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\NUL\ENQ\DC2\EOT\148\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\NUL\SOH\DC2\EOT\148\ACK\DC2\DC3\n\
    \\r\n\
    \\ENQ\EOTC\STX\NUL\ETX\DC2\EOT\148\ACK\FS\GS\n\
    \\NAK\n\
    \\EOT\EOTC\STX\SOH\DC2\EOT\149\ACK\STX\RS\"\a Index\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\SOH\EOT\DC2\EOT\149\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\SOH\ENQ\DC2\EOT\149\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\SOH\SOH\DC2\EOT\149\ACK\DC2\ETB\n\
    \\r\n\
    \\ENQ\EOTC\STX\SOH\ETX\DC2\EOT\149\ACK\FS\GS\n\
    \\SUB\n\
    \\EOT\EOTC\STX\STX\DC2\EOT\150\ACK\STX\RS\"\f Limit rows\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\STX\EOT\DC2\EOT\150\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\STX\ENQ\DC2\EOT\150\ACK\v\DC1\n\
    \\r\n\
    \\ENQ\EOTC\STX\STX\SOH\DC2\EOT\150\ACK\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOTC\STX\STX\ETX\DC2\EOT\150\ACK\FS\GS\n\
    \\US\n\
    \\EOT\EOTC\STX\ETX\DC2\EOT\151\ACK\STX\RS\"\DC1 Starting offset\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\ETX\EOT\DC2\EOT\151\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\ETX\ENQ\DC2\EOT\151\ACK\v\DC1\n\
    \\r\n\
    \\ENQ\EOTC\STX\ETX\SOH\DC2\EOT\151\ACK\DC2\ETB\n\
    \\r\n\
    \\ENQ\EOTC\STX\ETX\ETX\DC2\EOT\151\ACK\FS\GS\n\
    \\SUB\n\
    \\EOT\EOTC\STX\EOT\DC2\EOT\152\ACK\STX\RS\"\f Sort order\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\EOT\EOT\DC2\EOT\152\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\EOT\ENQ\DC2\EOT\152\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\EOT\SOH\DC2\EOT\152\ACK\DC2\SYN\n\
    \\r\n\
    \\ENQ\EOTC\STX\EOT\ETX\DC2\EOT\152\ACK\FS\GS\n\
    \-\n\
    \\EOT\EOTC\STX\ENQ\DC2\EOT\153\ACK\STX\RS\"\US Inline fields filtering query\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\ENQ\EOT\DC2\EOT\153\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\ENQ\ENQ\DC2\EOT\153\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\ENQ\SOH\DC2\EOT\153\ACK\DC2\CAN\n\
    \\r\n\
    \\ENQ\EOTC\STX\ENQ\ETX\DC2\EOT\153\ACK\FS\GS\n\
    \\GS\n\
    \\EOT\EOTC\STX\ACK\DC2\EOT\154\ACK\STX\RS\"\SI Default field\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\ACK\EOT\DC2\EOT\154\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\ACK\ENQ\DC2\EOT\154\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\ACK\SOH\DC2\EOT\154\ACK\DC2\DC4\n\
    \\r\n\
    \\ENQ\EOTC\STX\ACK\ETX\DC2\EOT\154\ACK\FS\GS\n\
    \\SUB\n\
    \\EOT\EOTC\STX\a\DC2\EOT\155\ACK\STX\RS\"\f Default op\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\a\EOT\DC2\EOT\155\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\a\ENQ\DC2\EOT\155\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\a\SOH\DC2\EOT\155\ACK\DC2\DC4\n\
    \\r\n\
    \\ENQ\EOTC\STX\a\ETX\DC2\EOT\155\ACK\FS\GS\n\
    \=\n\
    \\EOT\EOTC\STX\b\DC2\EOT\156\ACK\STX\RS\"/ Return fields limit (for ids only, generally)\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\b\EOT\DC2\EOT\156\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\b\ENQ\DC2\EOT\156\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\b\SOH\DC2\EOT\156\ACK\DC2\DC4\n\
    \\r\n\
    \\ENQ\EOTC\STX\b\ETX\DC2\EOT\156\ACK\FS\GS\n\
    \%\n\
    \\EOT\EOTC\STX\t\DC2\EOT\157\ACK\STX\US\"\ETB Presort (key / score)\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\t\EOT\DC2\EOT\157\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTC\STX\t\ENQ\DC2\EOT\157\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTC\STX\t\SOH\DC2\EOT\157\ACK\DC2\EM\n\
    \\r\n\
    \\ENQ\EOTC\STX\t\ETX\DC2\EOT\157\ACK\FS\RS\n\
    \\f\n\
    \\STX\EOTD\DC2\ACK\160\ACK\NUL\164\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTD\SOH\DC2\EOT\160\ACK\b\SUB\n\
    \ \n\
    \\EOT\EOTD\STX\NUL\DC2\EOT\161\ACK\STX&\"\DC2 Result documents\n\
    \\n\
    \\r\n\
    \\ENQ\EOTD\STX\NUL\EOT\DC2\EOT\161\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTD\STX\NUL\ACK\DC2\EOT\161\ACK\v\ETB\n\
    \\r\n\
    \\ENQ\EOTD\STX\NUL\SOH\DC2\EOT\161\ACK\CAN\FS\n\
    \\r\n\
    \\ENQ\EOTD\STX\NUL\ETX\DC2\EOT\161\ACK$%\n\
    \\GS\n\
    \\EOT\EOTD\STX\SOH\DC2\EOT\162\ACK\STX&\"\SI Maximum score\n\
    \\n\
    \\r\n\
    \\ENQ\EOTD\STX\SOH\EOT\DC2\EOT\162\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTD\STX\SOH\ENQ\DC2\EOT\162\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTD\STX\SOH\SOH\DC2\EOT\162\ACK\CAN!\n\
    \\r\n\
    \\ENQ\EOTD\STX\SOH\ETX\DC2\EOT\162\ACK$%\n\
    \!\n\
    \\EOT\EOTD\STX\STX\DC2\EOT\163\ACK\STX&\"\DC3 Number of results\n\
    \\n\
    \\r\n\
    \\ENQ\EOTD\STX\STX\EOT\DC2\EOT\163\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTD\STX\STX\ENQ\DC2\EOT\163\ACK\v\DC1\n\
    \\r\n\
    \\ENQ\EOTD\STX\STX\SOH\DC2\EOT\163\ACK\CAN!\n\
    \\r\n\
    \\ENQ\EOTD\STX\STX\ETX\DC2\EOT\163\ACK$%\n\
    \\199\SOH\n\
    \\STX\EOTE\DC2\ACK\188\ACK\NUL\193\ACK\SOH\SUB\SUB Dispatch a query to Riak\n\
    \2v Java package specifiers\n\
    \ option java_package = \"com.basho.riak.protobuf\";\n\
    \ option java_outer_classname = \"RiakTsPB\";\n\
    \2% import \"riak.proto\"; // for RpbPair\n\
    \\n\
    \\v\n\
    \\ETX\EOTE\SOH\DC2\EOT\188\ACK\b\DC2\n\
    \L\n\
    \\EOT\EOTE\STX\NUL\DC2\EOT\190\ACK\STX%\SUB> left optional to support parameterized queries in the future\n\
    \\n\
    \\r\n\
    \\ENQ\EOTE\STX\NUL\EOT\DC2\EOT\190\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTE\STX\NUL\ACK\DC2\EOT\190\ACK\v\SUB\n\
    \\r\n\
    \\ENQ\EOTE\STX\NUL\SOH\DC2\EOT\190\ACK\ESC \n\
    \\r\n\
    \\ENQ\EOTE\STX\NUL\ETX\DC2\EOT\190\ACK#$\n\
    \\f\n\
    \\EOT\EOTE\STX\SOH\DC2\EOT\191\ACK\STX-\n\
    \\r\n\
    \\ENQ\EOTE\STX\SOH\EOT\DC2\EOT\191\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTE\STX\SOH\ENQ\DC2\EOT\191\ACK\v\SI\n\
    \\r\n\
    \\ENQ\EOTE\STX\SOH\SOH\DC2\EOT\191\ACK\DLE\SYN\n\
    \\r\n\
    \\ENQ\EOTE\STX\SOH\ETX\DC2\EOT\191\ACK\EM\SUB\n\
    \\r\n\
    \\ENQ\EOTE\STX\SOH\b\DC2\EOT\191\ACK\ESC,\n\
    \\r\n\
    \\ENQ\EOTE\STX\SOH\a\DC2\EOT\191\ACK&+\n\
    \0\n\
    \\EOT\EOTE\STX\STX\DC2\EOT\192\ACK\STX#\"\" chopped up coverage plan per-req\n\
    \\n\
    \\r\n\
    \\ENQ\EOTE\STX\STX\EOT\DC2\EOT\192\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTE\STX\STX\ENQ\DC2\EOT\192\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTE\STX\STX\SOH\DC2\EOT\192\ACK\DC1\RS\n\
    \\r\n\
    \\ENQ\EOTE\STX\STX\ETX\DC2\EOT\192\ACK!\"\n\
    \\f\n\
    \\STX\EOTF\DC2\ACK\195\ACK\NUL\199\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTF\SOH\DC2\EOT\195\ACK\b\DC3\n\
    \\f\n\
    \\EOT\EOTF\STX\NUL\DC2\EOT\196\ACK\STX+\n\
    \\r\n\
    \\ENQ\EOTF\STX\NUL\EOT\DC2\EOT\196\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTF\STX\NUL\ACK\DC2\EOT\196\ACK\v\RS\n\
    \\r\n\
    \\ENQ\EOTF\STX\NUL\SOH\DC2\EOT\196\ACK\US&\n\
    \\r\n\
    \\ENQ\EOTF\STX\NUL\ETX\DC2\EOT\196\ACK)*\n\
    \\ESC\n\
    \\EOT\EOTF\STX\SOH\DC2\EOT\197\ACK\STX\SUB\"\r 0 to n rows\n\
    \\n\
    \\r\n\
    \\ENQ\EOTF\STX\SOH\EOT\DC2\EOT\197\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTF\STX\SOH\ACK\DC2\EOT\197\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTF\STX\SOH\SOH\DC2\EOT\197\ACK\DC1\NAK\n\
    \\r\n\
    \\ENQ\EOTF\STX\SOH\ETX\DC2\EOT\197\ACK\CAN\EM\n\
    \\f\n\
    \\EOT\EOTF\STX\STX\DC2\EOT\198\ACK\STX*\n\
    \\r\n\
    \\ENQ\EOTF\STX\STX\EOT\DC2\EOT\198\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTF\STX\STX\ENQ\DC2\EOT\198\ACK\v\SI\n\
    \\r\n\
    \\ENQ\EOTF\STX\STX\SOH\DC2\EOT\198\ACK\DLE\DC4\n\
    \\r\n\
    \\ENQ\EOTF\STX\STX\ETX\DC2\EOT\198\ACK\ETB\CAN\n\
    \\r\n\
    \\ENQ\EOTF\STX\STX\b\DC2\EOT\198\ACK\EM)\n\
    \\r\n\
    \\ENQ\EOTF\STX\STX\a\DC2\EOT\198\ACK$(\n\
    \\f\n\
    \\STX\EOTG\DC2\ACK\201\ACK\NUL\205\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTG\SOH\DC2\EOT\201\ACK\b\DLE\n\
    \\f\n\
    \\EOT\EOTG\STX\NUL\DC2\EOT\202\ACK\STX\ESC\n\
    \\r\n\
    \\ENQ\EOTG\STX\NUL\EOT\DC2\EOT\202\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTG\STX\NUL\ENQ\DC2\EOT\202\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTG\STX\NUL\SOH\DC2\EOT\202\ACK\DC1\SYN\n\
    \\r\n\
    \\ENQ\EOTG\STX\NUL\ETX\DC2\EOT\202\ACK\EM\SUB\n\
    \\f\n\
    \\EOT\EOTG\STX\SOH\DC2\EOT\203\ACK\STX\SUB\n\
    \\r\n\
    \\ENQ\EOTG\STX\SOH\EOT\DC2\EOT\203\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTG\STX\SOH\ACK\DC2\EOT\203\ACK\v\DC1\n\
    \\r\n\
    \\ENQ\EOTG\STX\SOH\SOH\DC2\EOT\203\ACK\DC2\NAK\n\
    \\r\n\
    \\ENQ\EOTG\STX\SOH\ETX\DC2\EOT\203\ACK\CAN\EM\n\
    \\f\n\
    \\EOT\EOTG\STX\STX\DC2\EOT\204\ACK\STX\RS\n\
    \\r\n\
    \\ENQ\EOTG\STX\STX\EOT\DC2\EOT\204\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTG\STX\STX\ENQ\DC2\EOT\204\ACK\v\DC1\n\
    \\r\n\
    \\ENQ\EOTG\STX\STX\SOH\DC2\EOT\204\ACK\DC2\EM\n\
    \\r\n\
    \\ENQ\EOTG\STX\STX\ETX\DC2\EOT\204\ACK\FS\GS\n\
    \\f\n\
    \\STX\EOTH\DC2\ACK\207\ACK\NUL\210\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTH\SOH\DC2\EOT\207\ACK\b\DC1\n\
    \\f\n\
    \\EOT\EOTH\STX\NUL\DC2\EOT\208\ACK\STX+\n\
    \\r\n\
    \\ENQ\EOTH\STX\NUL\EOT\DC2\EOT\208\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTH\STX\NUL\ACK\DC2\EOT\208\ACK\v\RS\n\
    \\r\n\
    \\ENQ\EOTH\STX\NUL\SOH\DC2\EOT\208\ACK\US&\n\
    \\r\n\
    \\ENQ\EOTH\STX\NUL\ETX\DC2\EOT\208\ACK)*\n\
    \\ESC\n\
    \\EOT\EOTH\STX\SOH\DC2\EOT\209\ACK\STX\SUB\"\r 0 or 1 rows\n\
    \\n\
    \\r\n\
    \\ENQ\EOTH\STX\SOH\EOT\DC2\EOT\209\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTH\STX\SOH\ACK\DC2\EOT\209\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTH\STX\SOH\SOH\DC2\EOT\209\ACK\DC1\NAK\n\
    \\r\n\
    \\ENQ\EOTH\STX\SOH\ETX\DC2\EOT\209\ACK\CAN\EM\n\
    \\f\n\
    \\STX\EOTI\DC2\ACK\213\ACK\NUL\220\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTI\SOH\DC2\EOT\213\ACK\b\DLE\n\
    \\f\n\
    \\EOT\EOTI\STX\NUL\DC2\EOT\214\ACK\STX\ESC\n\
    \\r\n\
    \\ENQ\EOTI\STX\NUL\EOT\DC2\EOT\214\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTI\STX\NUL\ENQ\DC2\EOT\214\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTI\STX\NUL\SOH\DC2\EOT\214\ACK\DC1\SYN\n\
    \\r\n\
    \\ENQ\EOTI\STX\NUL\ETX\DC2\EOT\214\ACK\EM\SUB\n\
    \<\n\
    \\EOT\EOTI\STX\SOH\DC2\EOT\217\ACK\STX+\SUB. optional: omitting it should use table order\n\
    \\n\
    \\r\n\
    \\ENQ\EOTI\STX\SOH\EOT\DC2\EOT\217\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTI\STX\SOH\ACK\DC2\EOT\217\ACK\v\RS\n\
    \\r\n\
    \\ENQ\EOTI\STX\SOH\SOH\DC2\EOT\217\ACK\US&\n\
    \\r\n\
    \\ENQ\EOTI\STX\SOH\ETX\DC2\EOT\217\ACK)*\n\
    \\f\n\
    \\EOT\EOTI\STX\STX\DC2\EOT\219\ACK\STX\SUB\n\
    \\r\n\
    \\ENQ\EOTI\STX\STX\EOT\DC2\EOT\219\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTI\STX\STX\ACK\DC2\EOT\219\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTI\STX\STX\SOH\DC2\EOT\219\ACK\DC1\NAK\n\
    \\r\n\
    \\ENQ\EOTI\STX\STX\ETX\DC2\EOT\219\ACK\CAN\EM\n\
    \\f\n\
    \\STX\EOTJ\DC2\ACK\222\ACK\NUL\224\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTJ\SOH\DC2\EOT\222\ACK\b\DC1\n\
    \\f\n\
    \\STX\EOTK\DC2\ACK\226\ACK\NUL\231\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTK\SOH\DC2\EOT\226\ACK\b\DLE\n\
    \\f\n\
    \\EOT\EOTK\STX\NUL\DC2\EOT\227\ACK\STX\ESC\n\
    \\r\n\
    \\ENQ\EOTK\STX\NUL\EOT\DC2\EOT\227\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTK\STX\NUL\ENQ\DC2\EOT\227\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTK\STX\NUL\SOH\DC2\EOT\227\ACK\DC1\SYN\n\
    \\r\n\
    \\ENQ\EOTK\STX\NUL\ETX\DC2\EOT\227\ACK\EM\SUB\n\
    \\f\n\
    \\EOT\EOTK\STX\SOH\DC2\EOT\228\ACK\STX\SUB\n\
    \\r\n\
    \\ENQ\EOTK\STX\SOH\EOT\DC2\EOT\228\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTK\STX\SOH\ACK\DC2\EOT\228\ACK\v\DC1\n\
    \\r\n\
    \\ENQ\EOTK\STX\SOH\SOH\DC2\EOT\228\ACK\DC2\NAK\n\
    \\r\n\
    \\ENQ\EOTK\STX\SOH\ETX\DC2\EOT\228\ACK\CAN\EM\n\
    \\f\n\
    \\EOT\EOTK\STX\STX\DC2\EOT\229\ACK\STX\FS\n\
    \\r\n\
    \\ENQ\EOTK\STX\STX\EOT\DC2\EOT\229\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTK\STX\STX\ENQ\DC2\EOT\229\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTK\STX\STX\SOH\DC2\EOT\229\ACK\DC1\ETB\n\
    \\r\n\
    \\ENQ\EOTK\STX\STX\ETX\DC2\EOT\229\ACK\SUB\ESC\n\
    \\f\n\
    \\EOT\EOTK\STX\ETX\DC2\EOT\230\ACK\STX\RS\n\
    \\r\n\
    \\ENQ\EOTK\STX\ETX\EOT\DC2\EOT\230\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTK\STX\ETX\ENQ\DC2\EOT\230\ACK\v\DC1\n\
    \\r\n\
    \\ENQ\EOTK\STX\ETX\SOH\DC2\EOT\230\ACK\DC2\EM\n\
    \\r\n\
    \\ENQ\EOTK\STX\ETX\ETX\DC2\EOT\230\ACK\FS\GS\n\
    \\f\n\
    \\STX\EOTL\DC2\ACK\233\ACK\NUL\235\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTL\SOH\DC2\EOT\233\ACK\b\DC1\n\
    \\f\n\
    \\STX\EOTM\DC2\ACK\237\ACK\NUL\240\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTM\SOH\DC2\EOT\237\ACK\b\ETB\n\
    \\f\n\
    \\EOT\EOTM\STX\NUL\DC2\EOT\238\ACK\STX\SUB\n\
    \\r\n\
    \\ENQ\EOTM\STX\NUL\EOT\DC2\EOT\238\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTM\STX\NUL\ENQ\DC2\EOT\238\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTM\STX\NUL\SOH\DC2\EOT\238\ACK\DC1\NAK\n\
    \\r\n\
    \\ENQ\EOTM\STX\NUL\ETX\DC2\EOT\238\ACK\CAN\EM\n\
    \\f\n\
    \\EOT\EOTM\STX\SOH\DC2\EOT\239\ACK\STX&\n\
    \\r\n\
    \\ENQ\EOTM\STX\SOH\EOT\DC2\EOT\239\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTM\STX\SOH\ACK\DC2\EOT\239\ACK\v\DC2\n\
    \\r\n\
    \\ENQ\EOTM\STX\SOH\SOH\DC2\EOT\239\ACK\DC3!\n\
    \\r\n\
    \\ENQ\EOTM\STX\SOH\ETX\DC2\EOT\239\ACK$%\n\
    \\f\n\
    \\STX\ENQ\NUL\DC2\ACK\242\ACK\NUL\249\ACK\SOH\n\
    \\v\n\
    \\ETX\ENQ\NUL\SOH\DC2\EOT\242\ACK\ENQ\DC1\n\
    \\f\n\
    \\EOT\ENQ\NUL\STX\NUL\DC2\EOT\243\ACK\STX\SO\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\NUL\SOH\DC2\EOT\243\ACK\STX\t\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\NUL\STX\DC2\EOT\243\ACK\f\r\n\
    \\f\n\
    \\EOT\ENQ\NUL\STX\SOH\DC2\EOT\244\ACK\STX\r\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\SOH\SOH\DC2\EOT\244\ACK\STX\b\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\SOH\STX\DC2\EOT\244\ACK\v\f\n\
    \\f\n\
    \\EOT\ENQ\NUL\STX\STX\DC2\EOT\245\ACK\STX\r\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\STX\SOH\DC2\EOT\245\ACK\STX\b\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\STX\STX\DC2\EOT\245\ACK\v\f\n\
    \\f\n\
    \\EOT\ENQ\NUL\STX\ETX\DC2\EOT\246\ACK\STX\DLE\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\ETX\SOH\DC2\EOT\246\ACK\STX\v\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\ETX\STX\DC2\EOT\246\ACK\SO\SI\n\
    \\f\n\
    \\EOT\ENQ\NUL\STX\EOT\DC2\EOT\247\ACK\STX\SO\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\EOT\SOH\DC2\EOT\247\ACK\STX\t\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\EOT\STX\DC2\EOT\247\ACK\f\r\n\
    \\f\n\
    \\EOT\ENQ\NUL\STX\ENQ\DC2\EOT\248\ACK\STX\v\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\ENQ\SOH\DC2\EOT\248\ACK\STX\ACK\n\
    \\r\n\
    \\ENQ\ENQ\NUL\STX\ENQ\STX\DC2\EOT\248\ACK\t\n\
    \\n\
    \\f\n\
    \\STX\EOTN\DC2\ACK\251\ACK\NUL\254\ACK\SOH\n\
    \\v\n\
    \\ETX\EOTN\SOH\DC2\EOT\251\ACK\b\ESC\n\
    \\f\n\
    \\EOT\EOTN\STX\NUL\DC2\EOT\252\ACK\STX\SUB\n\
    \\r\n\
    \\ENQ\EOTN\STX\NUL\EOT\DC2\EOT\252\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTN\STX\NUL\ENQ\DC2\EOT\252\ACK\v\DLE\n\
    \\r\n\
    \\ENQ\EOTN\STX\NUL\SOH\DC2\EOT\252\ACK\DC1\NAK\n\
    \\r\n\
    \\ENQ\EOTN\STX\NUL\ETX\DC2\EOT\252\ACK\CAN\EM\n\
    \\f\n\
    \\EOT\EOTN\STX\SOH\DC2\EOT\253\ACK\STX!\n\
    \\r\n\
    \\ENQ\EOTN\STX\SOH\EOT\DC2\EOT\253\ACK\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTN\STX\SOH\ACK\DC2\EOT\253\ACK\v\ETB\n\
    \\r\n\
    \\ENQ\EOTN\STX\SOH\SOH\DC2\EOT\253\ACK\CAN\FS\n\
    \\r\n\
    \\ENQ\EOTN\STX\SOH\ETX\DC2\EOT\253\ACK\US \n\
    \\f\n\
    \\STX\EOTO\DC2\ACK\128\a\NUL\130\a\SOH\n\
    \\v\n\
    \\ETX\EOTO\SOH\DC2\EOT\128\a\b\r\n\
    \\f\n\
    \\EOT\EOTO\STX\NUL\DC2\EOT\129\a\STX\FS\n\
    \\r\n\
    \\ENQ\EOTO\STX\NUL\EOT\DC2\EOT\129\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTO\STX\NUL\ACK\DC2\EOT\129\a\v\DC1\n\
    \\r\n\
    \\ENQ\EOTO\STX\NUL\SOH\DC2\EOT\129\a\DC2\ETB\n\
    \\r\n\
    \\ENQ\EOTO\STX\NUL\ETX\DC2\EOT\129\a\SUB\ESC\n\
    \\f\n\
    \\STX\EOTP\DC2\ACK\132\a\NUL\138\a\SOH\n\
    \\v\n\
    \\ETX\EOTP\SOH\DC2\EOT\132\a\b\SO\n\
    \\f\n\
    \\EOT\EOTP\STX\NUL\DC2\EOT\133\a\STX#\n\
    \\r\n\
    \\ENQ\EOTP\STX\NUL\EOT\DC2\EOT\133\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTP\STX\NUL\ENQ\DC2\EOT\133\a\v\DLE\n\
    \\r\n\
    \\ENQ\EOTP\STX\NUL\SOH\DC2\EOT\133\a\DC1\RS\n\
    \\r\n\
    \\ENQ\EOTP\STX\NUL\ETX\DC2\EOT\133\a!\"\n\
    \\f\n\
    \\EOT\EOTP\STX\SOH\DC2\EOT\134\a\STX#\n\
    \\r\n\
    \\ENQ\EOTP\STX\SOH\EOT\DC2\EOT\134\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTP\STX\SOH\ENQ\DC2\EOT\134\a\v\DC1\n\
    \\r\n\
    \\ENQ\EOTP\STX\SOH\SOH\DC2\EOT\134\a\DC2\RS\n\
    \\r\n\
    \\ENQ\EOTP\STX\SOH\ETX\DC2\EOT\134\a!\"\n\
    \\f\n\
    \\EOT\EOTP\STX\STX\DC2\EOT\135\a\STX&\n\
    \\r\n\
    \\ENQ\EOTP\STX\STX\EOT\DC2\EOT\135\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTP\STX\STX\ENQ\DC2\EOT\135\a\v\DC1\n\
    \\r\n\
    \\ENQ\EOTP\STX\STX\SOH\DC2\EOT\135\a\DC2!\n\
    \\r\n\
    \\ENQ\EOTP\STX\STX\ETX\DC2\EOT\135\a$%\n\
    \\f\n\
    \\EOT\EOTP\STX\ETX\DC2\EOT\136\a\STX\"\n\
    \\r\n\
    \\ENQ\EOTP\STX\ETX\EOT\DC2\EOT\136\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTP\STX\ETX\ENQ\DC2\EOT\136\a\v\SI\n\
    \\r\n\
    \\ENQ\EOTP\STX\ETX\SOH\DC2\EOT\136\a\DLE\GS\n\
    \\r\n\
    \\ENQ\EOTP\STX\ETX\ETX\DC2\EOT\136\a !\n\
    \\f\n\
    \\EOT\EOTP\STX\EOT\DC2\EOT\137\a\STX#\n\
    \\r\n\
    \\ENQ\EOTP\STX\EOT\EOT\DC2\EOT\137\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTP\STX\EOT\ENQ\DC2\EOT\137\a\v\DC1\n\
    \\r\n\
    \\ENQ\EOTP\STX\EOT\SOH\DC2\EOT\137\a\DC2\RS\n\
    \\r\n\
    \\ENQ\EOTP\STX\EOT\ETX\DC2\EOT\137\a!\"\n\
    \\f\n\
    \\STX\EOTQ\DC2\ACK\140\a\NUL\143\a\SOH\n\
    \\v\n\
    \\ETX\EOTQ\SOH\DC2\EOT\140\a\b\NAK\n\
    \\f\n\
    \\EOT\EOTQ\STX\NUL\DC2\EOT\141\a\STX\ESC\n\
    \\r\n\
    \\ENQ\EOTQ\STX\NUL\EOT\DC2\EOT\141\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTQ\STX\NUL\ENQ\DC2\EOT\141\a\v\DLE\n\
    \\r\n\
    \\ENQ\EOTQ\STX\NUL\SOH\DC2\EOT\141\a\DC1\SYN\n\
    \\r\n\
    \\ENQ\EOTQ\STX\NUL\ETX\DC2\EOT\141\a\EM\SUB\n\
    \\f\n\
    \\EOT\EOTQ\STX\SOH\DC2\EOT\142\a\STX\RS\n\
    \\r\n\
    \\ENQ\EOTQ\STX\SOH\EOT\DC2\EOT\142\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTQ\STX\SOH\ENQ\DC2\EOT\142\a\v\DC1\n\
    \\r\n\
    \\ENQ\EOTQ\STX\SOH\SOH\DC2\EOT\142\a\DC2\EM\n\
    \\r\n\
    \\ENQ\EOTQ\STX\SOH\ETX\DC2\EOT\142\a\FS\GS\n\
    \\f\n\
    \\STX\EOTR\DC2\ACK\145\a\NUL\148\a\SOH\n\
    \\v\n\
    \\ETX\EOTR\SOH\DC2\EOT\145\a\b\SYN\n\
    \\f\n\
    \\EOT\EOTR\STX\NUL\DC2\EOT\146\a\STX\SUB\n\
    \\r\n\
    \\ENQ\EOTR\STX\NUL\EOT\DC2\EOT\146\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTR\STX\NUL\ACK\DC2\EOT\146\a\v\DLE\n\
    \\r\n\
    \\ENQ\EOTR\STX\NUL\SOH\DC2\EOT\146\a\DC1\NAK\n\
    \\r\n\
    \\ENQ\EOTR\STX\NUL\ETX\DC2\EOT\146\a\CAN\EM\n\
    \\f\n\
    \\EOT\EOTR\STX\SOH\DC2\EOT\147\a\STX\EM\n\
    \\r\n\
    \\ENQ\EOTR\STX\SOH\EOT\DC2\EOT\147\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTR\STX\SOH\ENQ\DC2\EOT\147\a\v\SI\n\
    \\r\n\
    \\ENQ\EOTR\STX\SOH\SOH\DC2\EOT\147\a\DLE\DC4\n\
    \\r\n\
    \\ENQ\EOTR\STX\SOH\ETX\DC2\EOT\147\a\ETB\CAN\n\
    \@\n\
    \\STX\EOTS\DC2\ACK\151\a\NUL\157\a\SOH\SUB2 Request a segmented coverage plan for this query\n\
    \\n\
    \\v\n\
    \\ETX\EOTS\SOH\DC2\EOT\151\a\b\NAK\n\
    \L\n\
    \\EOT\EOTS\STX\NUL\DC2\EOT\153\a\STX%\SUB> left optional to support parameterized queries in the future\n\
    \\n\
    \\r\n\
    \\ENQ\EOTS\STX\NUL\EOT\DC2\EOT\153\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTS\STX\NUL\ACK\DC2\EOT\153\a\v\SUB\n\
    \\r\n\
    \\ENQ\EOTS\STX\NUL\SOH\DC2\EOT\153\a\ESC \n\
    \\r\n\
    \\ENQ\EOTS\STX\NUL\ETX\DC2\EOT\153\a#$\n\
    \\f\n\
    \\EOT\EOTS\STX\SOH\DC2\EOT\154\a\STX\ESC\n\
    \\r\n\
    \\ENQ\EOTS\STX\SOH\EOT\DC2\EOT\154\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTS\STX\SOH\ENQ\DC2\EOT\154\a\v\DLE\n\
    \\r\n\
    \\ENQ\EOTS\STX\SOH\SOH\DC2\EOT\154\a\DC1\SYN\n\
    \\r\n\
    \\ENQ\EOTS\STX\SOH\ETX\DC2\EOT\154\a\EM\SUB\n\
    \$\n\
    \\EOT\EOTS\STX\STX\DC2\EOT\155\a\STX#\"\SYN For failure recovery\n\
    \\n\
    \\r\n\
    \\ENQ\EOTS\STX\STX\EOT\DC2\EOT\155\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTS\STX\STX\ENQ\DC2\EOT\155\a\v\DLE\n\
    \\r\n\
    \\ENQ\EOTS\STX\STX\SOH\DC2\EOT\155\a\DC1\RS\n\
    \\r\n\
    \\ENQ\EOTS\STX\STX\ETX\DC2\EOT\155\a!\"\n\
    \g\n\
    \\EOT\EOTS\STX\ETX\DC2\EOT\156\a\STX'\"Y Other coverage contexts that have failed to assist Riak in deciding what nodes to avoid\n\
    \\n\
    \\r\n\
    \\ENQ\EOTS\STX\ETX\EOT\DC2\EOT\156\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOTS\STX\ETX\ENQ\DC2\EOT\156\a\v\DLE\n\
    \\r\n\
    \\ENQ\EOTS\STX\ETX\SOH\DC2\EOT\156\a\DC1\"\n\
    \\r\n\
    \\ENQ\EOTS\STX\ETX\ETX\DC2\EOT\156\a%&\n\
    \3\n\
    \\STX\EOTT\DC2\ACK\160\a\NUL\162\a\SOH\SUB% Segmented TS coverage plan response\n\
    \\n\
    \\v\n\
    \\ETX\EOTT\SOH\DC2\EOT\160\a\b\SYN\n\
    \\f\n\
    \\EOT\EOTT\STX\NUL\DC2\EOT\161\a\ETX(\n\
    \\r\n\
    \\ENQ\EOTT\STX\NUL\EOT\DC2\EOT\161\a\ETX\v\n\
    \\r\n\
    \\ENQ\EOTT\STX\NUL\ACK\DC2\EOT\161\a\f\ESC\n\
    \\r\n\
    \\ENQ\EOTT\STX\NUL\SOH\DC2\EOT\161\a\FS#\n\
    \\r\n\
    \\ENQ\EOTT\STX\NUL\ETX\DC2\EOT\161\a&'\n\
    \-\n\
    \\STX\EOTU\DC2\ACK\165\a\NUL\170\a\SOH\SUB\US Segment of a TS coverage plan\n\
    \\n\
    \\v\n\
    \\ETX\EOTU\SOH\DC2\EOT\165\a\b\ETB\n\
    \\f\n\
    \\EOT\EOTU\STX\NUL\DC2\EOT\166\a\EOT\SUB\n\
    \\r\n\
    \\ENQ\EOTU\STX\NUL\EOT\DC2\EOT\166\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTU\STX\NUL\ENQ\DC2\EOT\166\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOTU\STX\NUL\SOH\DC2\EOT\166\a\DC3\NAK\n\
    \\r\n\
    \\ENQ\EOTU\STX\NUL\ETX\DC2\EOT\166\a\CAN\EM\n\
    \\f\n\
    \\EOT\EOTU\STX\SOH\DC2\EOT\167\a\EOT\GS\n\
    \\r\n\
    \\ENQ\EOTU\STX\SOH\EOT\DC2\EOT\167\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTU\STX\SOH\ENQ\DC2\EOT\167\a\r\DC3\n\
    \\r\n\
    \\ENQ\EOTU\STX\SOH\SOH\DC2\EOT\167\a\DC4\CAN\n\
    \\r\n\
    \\ENQ\EOTU\STX\SOH\ETX\DC2\EOT\167\a\ESC\FS\n\
    \=\n\
    \\EOT\EOTU\STX\STX\DC2\EOT\168\a\EOT%\"/ Opaque context to pass into follow-up request\n\
    \\n\
    \\r\n\
    \\ENQ\EOTU\STX\STX\EOT\DC2\EOT\168\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTU\STX\STX\ENQ\DC2\EOT\168\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOTU\STX\STX\SOH\DC2\EOT\168\a\DC3 \n\
    \\r\n\
    \\ENQ\EOTU\STX\STX\ETX\DC2\EOT\168\a#$\n\
    \B\n\
    \\EOT\EOTU\STX\ETX\DC2\EOT\169\a\EOT\US\"4 Might be other types of coverage queries/responses\n\
    \\n\
    \\r\n\
    \\ENQ\EOTU\STX\ETX\EOT\DC2\EOT\169\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTU\STX\ETX\ACK\DC2\EOT\169\a\r\DC4\n\
    \\r\n\
    \\ENQ\EOTU\STX\ETX\SOH\DC2\EOT\169\a\NAK\SUB\n\
    \\r\n\
    \\ENQ\EOTU\STX\ETX\ETX\DC2\EOT\169\a\GS\RS\n\
    \J\n\
    \\STX\EOTV\DC2\ACK\173\a\NUL\180\a\SOH\SUB< Each prospective subquery has a range of valid time values\n\
    \\n\
    \\v\n\
    \\ETX\EOTV\SOH\DC2\EOT\173\a\b\SI\n\
    \\f\n\
    \\EOT\EOTV\STX\NUL\DC2\EOT\174\a\EOT\"\n\
    \\r\n\
    \\ENQ\EOTV\STX\NUL\EOT\DC2\EOT\174\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTV\STX\NUL\ENQ\DC2\EOT\174\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOTV\STX\NUL\SOH\DC2\EOT\174\a\DC3\GS\n\
    \\r\n\
    \\ENQ\EOTV\STX\NUL\ETX\DC2\EOT\174\a !\n\
    \\f\n\
    \\EOT\EOTV\STX\SOH\DC2\EOT\175\a\EOT$\n\
    \\r\n\
    \\ENQ\EOTV\STX\SOH\EOT\DC2\EOT\175\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTV\STX\SOH\ENQ\DC2\EOT\175\a\r\DC3\n\
    \\r\n\
    \\ENQ\EOTV\STX\SOH\SOH\DC2\EOT\175\a\DC4\US\n\
    \\r\n\
    \\ENQ\EOTV\STX\SOH\ETX\DC2\EOT\175\a\"#\n\
    \\f\n\
    \\EOT\EOTV\STX\STX\DC2\EOT\176\a\EOT,\n\
    \\r\n\
    \\ENQ\EOTV\STX\STX\EOT\DC2\EOT\176\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTV\STX\STX\ENQ\DC2\EOT\176\a\r\DC1\n\
    \\r\n\
    \\ENQ\EOTV\STX\STX\SOH\DC2\EOT\176\a\DC2'\n\
    \\r\n\
    \\ENQ\EOTV\STX\STX\ETX\DC2\EOT\176\a*+\n\
    \\f\n\
    \\EOT\EOTV\STX\ETX\DC2\EOT\177\a\EOT$\n\
    \\r\n\
    \\ENQ\EOTV\STX\ETX\EOT\DC2\EOT\177\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTV\STX\ETX\ENQ\DC2\EOT\177\a\r\DC3\n\
    \\r\n\
    \\ENQ\EOTV\STX\ETX\SOH\DC2\EOT\177\a\DC4\US\n\
    \\r\n\
    \\ENQ\EOTV\STX\ETX\ETX\DC2\EOT\177\a\"#\n\
    \\f\n\
    \\EOT\EOTV\STX\EOT\DC2\EOT\178\a\EOT,\n\
    \\r\n\
    \\ENQ\EOTV\STX\EOT\EOT\DC2\EOT\178\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTV\STX\EOT\ENQ\DC2\EOT\178\a\r\DC1\n\
    \\r\n\
    \\ENQ\EOTV\STX\EOT\SOH\DC2\EOT\178\a\DC2'\n\
    \\r\n\
    \\ENQ\EOTV\STX\EOT\ETX\DC2\EOT\178\a*+\n\
    \A\n\
    \\EOT\EOTV\STX\ENQ\DC2\EOT\179\a\EOT\FS\"3 Some human readable description of the time range\n\
    \\n\
    \\r\n\
    \\ENQ\EOTV\STX\ENQ\EOT\DC2\EOT\179\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTV\STX\ENQ\ENQ\DC2\EOT\179\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOTV\STX\ENQ\SOH\DC2\EOT\179\a\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOTV\STX\ENQ\ETX\DC2\EOT\179\a\SUB\ESC\n\
    \\155\SOH\n\
    \\STX\EOTW\DC2\ACK\201\a\NUL\205\a\SOH2| java package specifiers\n\
    \ option java_package = \"com.basho.riak.protobuf\";\n\
    \ option java_outer_classname = \"RiakYokozunaPB\";\n\
    \2\SI Index queries\n\
    \\n\
    \\v\n\
    \\ETX\EOTW\SOH\DC2\EOT\201\a\b\CAN\n\
    \\SUB\n\
    \\EOT\EOTW\STX\NUL\DC2\EOT\202\a\EOT\US\"\f Index name\n\
    \\n\
    \\r\n\
    \\ENQ\EOTW\STX\NUL\EOT\DC2\EOT\202\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTW\STX\NUL\ENQ\DC2\EOT\202\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOTW\STX\NUL\SOH\DC2\EOT\202\a\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOTW\STX\NUL\ETX\DC2\EOT\202\a\GS\RS\n\
    \\ESC\n\
    \\EOT\EOTW\STX\SOH\DC2\EOT\203\a\EOT\US\"\r Schema name\n\
    \\n\
    \\r\n\
    \\ENQ\EOTW\STX\SOH\EOT\DC2\EOT\203\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTW\STX\SOH\ENQ\DC2\EOT\203\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOTW\STX\SOH\SOH\DC2\EOT\203\a\DC3\EM\n\
    \\r\n\
    \\ENQ\EOTW\STX\SOH\ETX\DC2\EOT\203\a\GS\RS\n\
    \\ETB\n\
    \\EOT\EOTW\STX\STX\DC2\EOT\204\a\EOT\US\"\t N value\n\
    \\n\
    \\r\n\
    \\ENQ\EOTW\STX\STX\EOT\DC2\EOT\204\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTW\STX\STX\ENQ\DC2\EOT\204\a\r\DC3\n\
    \\r\n\
    \\ENQ\EOTW\STX\STX\SOH\DC2\EOT\204\a\DC4\EM\n\
    \\r\n\
    \\ENQ\EOTW\STX\STX\ETX\DC2\EOT\204\a\GS\RS\n\
    \X\n\
    \\STX\EOTX\DC2\ACK\208\a\NUL\210\a\SOH\SUBJ GET request - If a name is given, return matching index, else return all\n\
    \\n\
    \\v\n\
    \\ETX\EOTX\SOH\DC2\EOT\208\a\b\RS\n\
    \\SUB\n\
    \\EOT\EOTX\STX\NUL\DC2\EOT\209\a\EOT\RS\"\f Index name\n\
    \\n\
    \\r\n\
    \\ENQ\EOTX\STX\NUL\EOT\DC2\EOT\209\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTX\STX\NUL\ENQ\DC2\EOT\209\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOTX\STX\NUL\SOH\DC2\EOT\209\a\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOTX\STX\NUL\ETX\DC2\EOT\209\a\FS\GS\n\
    \\f\n\
    \\STX\EOTY\DC2\ACK\212\a\NUL\214\a\SOH\n\
    \\v\n\
    \\ETX\EOTY\SOH\DC2\EOT\212\a\b\US\n\
    \\f\n\
    \\EOT\EOTY\STX\NUL\DC2\EOT\213\a\EOT*\n\
    \\r\n\
    \\ENQ\EOTY\STX\NUL\EOT\DC2\EOT\213\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTY\STX\NUL\ACK\DC2\EOT\213\a\r\GS\n\
    \\r\n\
    \\ENQ\EOTY\STX\NUL\SOH\DC2\EOT\213\a\RS#\n\
    \\r\n\
    \\ENQ\EOTY\STX\NUL\ETX\DC2\EOT\213\a()\n\
    \0\n\
    \\STX\EOTZ\DC2\ACK\217\a\NUL\220\a\SOH\SUB\" PUT request - Create a new index\n\
    \\n\
    \\v\n\
    \\ETX\EOTZ\SOH\DC2\EOT\217\a\b\RS\n\
    \\f\n\
    \\EOT\EOTZ\STX\NUL\DC2\EOT\218\a\EOT*\n\
    \\r\n\
    \\ENQ\EOTZ\STX\NUL\EOT\DC2\EOT\218\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTZ\STX\NUL\ACK\DC2\EOT\218\a\r\GS\n\
    \\r\n\
    \\ENQ\EOTZ\STX\NUL\SOH\DC2\EOT\218\a\RS#\n\
    \\r\n\
    \\ENQ\EOTZ\STX\NUL\ETX\DC2\EOT\218\a()\n\
    \\GS\n\
    \\EOT\EOTZ\STX\SOH\DC2\EOT\219\a\EOT*\"\SI Timeout value\n\
    \\n\
    \\r\n\
    \\ENQ\EOTZ\STX\SOH\EOT\DC2\EOT\219\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOTZ\STX\SOH\ENQ\DC2\EOT\219\a\r\DC3\n\
    \\r\n\
    \\ENQ\EOTZ\STX\SOH\SOH\DC2\EOT\219\a\DC4\ESC\n\
    \\r\n\
    \\ENQ\EOTZ\STX\SOH\ETX\DC2\EOT\219\a()\n\
    \0\n\
    \\STX\EOT[\DC2\ACK\223\a\NUL\225\a\SOH\SUB\" DELETE request - Remove an index\n\
    \\n\
    \\v\n\
    \\ETX\EOT[\SOH\DC2\EOT\223\a\b!\n\
    \\SUB\n\
    \\EOT\EOT[\STX\NUL\DC2\EOT\224\a\EOT\RS\"\f Index name\n\
    \\n\
    \\r\n\
    \\ENQ\EOT[\STX\NUL\EOT\DC2\EOT\224\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOT[\STX\NUL\ENQ\DC2\EOT\224\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOT[\STX\NUL\SOH\DC2\EOT\224\a\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT[\STX\NUL\ETX\DC2\EOT\224\a\FS\GS\n\
    \\RS\n\
    \\STX\EOT\\\DC2\ACK\229\a\NUL\232\a\SOH2\DLE Schema queries\n\
    \\n\
    \\v\n\
    \\ETX\EOT\\\SOH\DC2\EOT\229\a\b\EM\n\
    \\SUB\n\
    \\EOT\EOT\\\STX\NUL\DC2\EOT\230\a\EOT \"\f Index name\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\\\STX\NUL\EOT\DC2\EOT\230\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\\\STX\NUL\ENQ\DC2\EOT\230\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\\\STX\NUL\SOH\DC2\EOT\230\a\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT\\\STX\NUL\ETX\DC2\EOT\230\a\RS\US\n\
    \\ESC\n\
    \\EOT\EOT\\\STX\SOH\DC2\EOT\231\a\EOT \"\r Schema data\n\
    \\n\
    \\r\n\
    \\ENQ\EOT\\\STX\SOH\EOT\DC2\EOT\231\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOT\\\STX\SOH\ENQ\DC2\EOT\231\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOT\\\STX\SOH\SOH\DC2\EOT\231\a\DC3\SUB\n\
    \\r\n\
    \\ENQ\EOT\\\STX\SOH\ETX\DC2\EOT\231\a\RS\US\n\
    \G\n\
    \\STX\EOT]\DC2\ACK\235\a\NUL\237\a\SOH\SUB9 PUT request - create or potentially update a new schema\n\
    \\n\
    \\v\n\
    \\ETX\EOT]\SOH\DC2\EOT\235\a\b\US\n\
    \\f\n\
    \\EOT\EOT]\STX\NUL\DC2\EOT\236\a\EOT+\n\
    \\r\n\
    \\ENQ\EOT]\STX\NUL\EOT\DC2\EOT\236\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOT]\STX\NUL\ACK\DC2\EOT\236\a\r\RS\n\
    \\r\n\
    \\ENQ\EOT]\STX\NUL\SOH\DC2\EOT\236\a\US%\n\
    \\r\n\
    \\ENQ\EOT]\STX\NUL\ETX\DC2\EOT\236\a)*\n\
    \<\n\
    \\STX\EOT^\DC2\ACK\240\a\NUL\242\a\SOH\SUB. GET request - Return matching schema by name\n\
    \\n\
    \\v\n\
    \\ETX\EOT^\SOH\DC2\EOT\240\a\b\US\n\
    \\ESC\n\
    \\EOT\EOT^\STX\NUL\DC2\EOT\241\a\EOT\RS\"\r Schema name\n\
    \\n\
    \\r\n\
    \\ENQ\EOT^\STX\NUL\EOT\DC2\EOT\241\a\EOT\f\n\
    \\r\n\
    \\ENQ\EOT^\STX\NUL\ENQ\DC2\EOT\241\a\r\DC2\n\
    \\r\n\
    \\ENQ\EOT^\STX\NUL\SOH\DC2\EOT\241\a\DC3\ETB\n\
    \\r\n\
    \\ENQ\EOT^\STX\NUL\ETX\DC2\EOT\241\a\FS\GS\n\
    \\f\n\
    \\STX\EOT_\DC2\ACK\244\a\NUL\246\a\SOH\n\
    \\v\n\
    \\ETX\EOT_\SOH\DC2\EOT\244\a\b \n\
    \\f\n\
    \\EOT\EOT_\STX\NUL\DC2\EOT\245\a\STX)\n\
    \\r\n\
    \\ENQ\EOT_\STX\NUL\EOT\DC2\EOT\245\a\STX\n\
    \\n\
    \\r\n\
    \\ENQ\EOT_\STX\NUL\ACK\DC2\EOT\245\a\v\FS\n\
    \\r\n\
    \\ENQ\EOT_\STX\NUL\SOH\DC2\EOT\245\a\GS#\n\
    \\r\n\
    \\ENQ\EOT_\STX\NUL\ETX\DC2\EOT\245\a'("