diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE diff --git a/Network/Riak/MontageClient.hs b/Network/Riak/MontageClient.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient.hs @@ -0,0 +1,19 @@ +-- | +-- Module: Network.Riak.MontageClient +-- Maintainer: Erin Dahlgren +-- Stability: experimental +-- Portability: portable +-- +-- Exposes functions and types for making requests to the Montage riak resolution proxy + +module Network.Riak.MontageClient + ( + -- * Client functions + module Network.Riak.MontageClient.MontageClient + -- * Types + , MontageObject(..) + ) + where + +import Network.Riak.MontageClient.MontageClient +import Network.Riak.MontageClient.Proto.MontageClient.MontageObject diff --git a/Network/Riak/MontageClient/MontageClient.hs b/Network/Riak/MontageClient/MontageClient.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/MontageClient.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Network.Riak.MontageClient.MontageClient +-- Maintainer: Erin Dahlgren +-- Stability: experimental +-- Portability: portable +-- +-- Functions for making requests to the Montage riak resolution proxy. + +module Network.Riak.MontageClient.MontageClient + ( + -- * MontageObjects + -- $montageObjects + Bucket + , ReferenceBucket + , Key + -- * Get requests + , montageGet + , montageGetMany + , montageGetBy + , montageGetBy' + -- * Delete requests + , montageDelete + -- * Put requests + , montagePut + , montagePutMany + ) + where + +import System.UUID.V4 (uuid) +import System.Timeout (timeout) +import System.ZMQ as ZMQ +import System.IO +import System.IO.Error (IOError(..), ioeGetErrorString) +import Control.Monad.Error (throwError, strMsg, Error, MonadError) +import Control.Exception (try, SomeException(..), fromException, throw) +import Control.Monad + +import Data.Conduit.Pool (Pool, withResource) +import Data.Text.Format +import Data.Text.Format.Params +import qualified Data.Text.Lazy as T +import qualified Data.ListLike as LL +import qualified Data.Sequence as Seq + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as B + +import Text.ProtocolBuffers.Basic (toUtf8, uToString, Utf8) +import Text.ProtocolBuffers.WireMessage (messageGet, messagePut, Wire) +import Text.ProtocolBuffers.Reflections (ReflectDescriptor) + +import Network.Riak.MontageClient.Proto.MontageClient.MontageWireMessages +import Network.Riak.MontageClient.Proto.MontageClient.MontageObject as MO +import Network.Riak.MontageClient.Proto.MontageClient.MontageEnvelope as ME +import Network.Riak.MontageClient.Proto.MontageClient.MontageGetStatus +import Network.Riak.MontageClient.Proto.MontageClient.MontageGet +import Network.Riak.MontageClient.Proto.MontageClient.MontagePut +import Network.Riak.MontageClient.Proto.MontageClient.MontageGetMany +import Network.Riak.MontageClient.Proto.MontageClient.MontageGetReference +import Network.Riak.MontageClient.Proto.MontageClient.MontageGetResponse as MGR +import Network.Riak.MontageClient.Proto.MontageClient.MontagePutResponse as MPR +import Network.Riak.MontageClient.Proto.MontageClient.MontagePutManyResponse as MPMR +import Network.Riak.MontageClient.Proto.MontageClient.MontagePutMany +import Network.Riak.MontageClient.Proto.MontageClient.MontageDelete + +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageError as MErr + +type Bucket = L.ByteString + +type ReferenceBucket = L.ByteString + +type Key = L.ByteString + +type MontagePool = Pool (ZMQ.Socket Req) + +-- utils + +sTl :: S.ByteString -> B.ByteString +sTl s = B.fromChunks [s] + +formatThrow :: (Params ps, Error e, MonadError e m, Monad m) => Format -> ps -> m () +formatThrow f p = throwError (strMsg $ T.unpack $ format f p) + +assertM :: (Params ps, Error e, MonadError e m, Monad m) => Bool -> Format -> ps -> m () +assertM bool f p = when (not bool) $ formatThrow f p + +messageGetError :: (ReflectDescriptor a, Wire a) => B.ByteString -> B.ByteString -> a +messageGetError cls v = + case messageGet v of + Right (msg, x) | B.length x == 0 -> + msg + Right (_, x) | B.length x /= 0 -> + error ("error decoding " ++ B.unpack cls ++ ": did not consume all of input") + Left e -> + error ("error decoding " ++ B.unpack cls ++ ": " ++ e) + +--- client + +sixtySecs = 60 * 1000 * 1000 + +montageRpc :: MontagePool -> L.ByteString -> IO MontageEnvelope +montageRpc pool req = do + mr <- timeout sixtySecs rpc + case mr of + Just r -> return $ (messageGetError "MontageEnvelope" . sTl) r + Nothing -> error "timeout on montageRpc!" + where + rpc = withResource pool (\socket -> do + ZMQ.send' socket req [] + ZMQ.receive socket [] + ) + +montageRequest :: MontagePool -> MontageWireMessages -> L.ByteString -> IO MontageEnvelope +montageRequest pool wireMsg request = do + uid <- fmap (B.pack . show) uuid + let req = messagePut $ MontageEnvelope wireMsg request (Just uid) + res <- montageRpc pool req + assertM (ME.msgid res == Just uid) "mismatched req/response!" () + return res + +-- $montageObjects +-- +-- Requests to and responses from the Montage riak resolution proxy are wrapped in 'MontageObject's. A 'MontageObject' contains information about the target\/source ('Bucket' and 'Key'), the serialized data to store\/find, and a riak vector clock (which is originally 'Nothing'). +-- +-- You must have resolutions defined in your running proxy (see ) for each of the datatypes you are serializing and placing inside a 'MontageObject'. +-- +-- For @montageGetBy@ to complete its intermediate lookup, you must have @referenceKey@ defined for each of your datatypes in your running proxy. + +-- | Retrieve a 'MontageObject' from a 'Bucket' and 'Key', if data exists at that source. Montage itself resolves any siblings. +montageGet :: MontagePool -> Bucket -> Key -> IO (Maybe MontageObject) +montageGet pool buck key = do + res <- montageRequest pool MONTAGE_GET (messagePut $ MontageGet buck key Nothing) + case ME.mtype res of + MONTAGE_GET_RESPONSE -> return $ MGR.master $ messageGetError "montageGet: MontageGetResponse" $ ME.msg res + MONTAGE_ERROR -> formatThrow "Incorrect response to MontageGet: error={}, bucket={}, key={}" (Shown $ MErr.error msg, Shown buck, Shown key) >> return Nothing + where msg = messageGetError "montageGet: MontageGetResponse" $ ME.msg res + _ -> formatThrow "Unknown response to MontageGet" () >> return Nothing + +zipGets :: [MontageGetStatus] -> [MontageObject] -> [Maybe MontageObject] +zipGets ss objs = reverse $ snd $ foldl honest (objs, []) ss + where + honest (os, accum) status = case status of + EXISTS -> honest' os accum + MISSING -> (os, Nothing:accum) + + honest' [] _ = error "Status EXISTS when no more responses" + honest' (o:os) accum = (os, (Just o:accum)) + +-- | Retrieve many 'MontageObject's from a list of 'Bucket's and 'Key's, if data exists at those sources. Responses are ordered the same as the 'Bucket's and 'Key's. +montageGetMany :: MontagePool -> [(Bucket, Key)] -> IO ([Maybe MontageObject]) +montageGetMany pool gets = do + let gets' = Seq.fromList [ MontageGet buck key Nothing | (buck, key) <- gets ] + res <- montageRequest pool MONTAGE_GET_MANY (messagePut $ MontageGetMany gets') + case ME.mtype res of + MONTAGE_GET_RESPONSE -> + return $ zipGets (LL.toList . MGR.status $ mgr) (LL.toList . MGR.subs $ mgr) + where mgr = messageGetError "montageGetMany: MontageGetResponse" $ ME.msg res + MONTAGE_ERROR -> formatThrow "Incorrect response to MontageGetMany: error={}" (Only $ Shown $ MErr.error msg) >> return [] + where msg = messageGetError "montageGetMany: MontageGetResponse" $ ME.msg res + _ -> formatThrow "Unknown response to MontageGetMany" () >> return [] + +-- | Retrieve zero or more 'MontageObject's through an intermediate lookup. +-- +-- The first lookup will use the 'ReferenceBucket' and 'Key' to retreive a 'MontageObject. An implementation of @referenceKey@ (in the instances you define for the Montage proxy) extracts from this 'MontageObject' a sensible 'Key' that can be used for further lookups. @montageGetBy@ uses the intermediate 'Key' and each target 'Bucket' to retrieve 'MontageObject's. If a sensible intermediate 'Key' cannot be made, then @montageGetBy@ reacts the same as @montageGetMany@ when nothing can be found. +montageGetBy :: MontagePool -> ReferenceBucket -> Key -> [Bucket] -> IO ([Maybe MontageObject]) +montageGetBy pool buck key target = fmap snd (montageGetBy' pool buck key target) + +-- | Retrieve zero or more 'MontageObjects's through an intermediate lookup, but also give the intermediate 'Key' that was made if possible. +montageGetBy' :: MontagePool -> ReferenceBucket -> Key -> [Bucket] -> IO (Maybe MontageObject, [Maybe MontageObject]) +montageGetBy' pool buck key target = do + res <- montageRequest pool MONTAGE_GET_REFERENCE (messagePut $ MontageGetReference buck key (Seq.fromList target)) + case ME.mtype res of + MONTAGE_GET_RESPONSE -> return (MGR.master mo, values) + where + values = zipGets (LL.toList . MGR.status $ mo) (LL.toList . MGR.subs $ mo) + mo = messageGetError "montageGetReference: MontageGetResponse" $ ME.msg res + MONTAGE_ERROR -> formatThrow "Incorrect response to MontageGetReference: error={}, bucket={}, key={}" (Shown $ MErr.error msg, Shown buck, Shown key) >> return (Nothing, []) + where msg = messageGetError "montageGet: MontageGetResponse" $ ME.msg res + _ -> formatThrow "Unknown response to MontageGetReference" () >> return (Nothing, []) + +-- | Delete whatever is stored at 'Bucket' and 'Key'. +montageDelete :: MontagePool -> Bucket -> Key -> IO () +montageDelete pool buck key = do + res <- montageRequest pool MONTAGE_DELETE (messagePut $ MontageDelete buck key) + case ME.mtype res of + MONTAGE_DELETE_RESPONSE -> return () + MONTAGE_ERROR -> formatThrow "Incorrect response to MontageDelete: error={}, bucket={}, key={}" (Shown $ MErr.error msg, Shown buck, Shown key) >> return () + where msg = messageGetError "montageDelete: MontageDeleteResponse" $ ME.msg res + _ -> formatThrow "Unknown response to MontageDelete" () >> return () + +zipPuts :: [MontageObject] -> [MontageObject] -> [Maybe MontageObject] +zipPuts reqs objs = reverse $ snd $ foldl honest (objs, []) reqs + where + honest ([], accum) req = ([], Nothing:accum) + honest (o:os, accum) req = case ((MO.bucket req, MO.key req) == (MO.bucket o, MO.key o)) of + True -> (os, (Just o:accum)) + False -> (os, Nothing:accum) + +-- | Put data, wrapped in a 'MontageObject', at the 'Bucket' and 'Key' specified in that 'MontageObject'. +montagePut :: MontagePool -> MontageObject -> IO (Maybe MontageObject) +montagePut pool os = do + res <- montageRequest pool MONTAGE_PUT (messagePut $ MontagePut os) + case ME.mtype res of + MONTAGE_PUT_RESPONSE -> return $ Just $ MPR.object $ messageGetError "montagePut: put" $ ME.msg res + MONTAGE_ERROR -> formatThrow "Incorrect response to MontagePutMany: error={}" (Only $ uToString $ MErr.error msg) >> return Nothing + where msg = messageGetError "montagePut: MontagePutResponse" $ ME.msg res + _ -> formatThrow "Unknown response to MontagePut" () >> return Nothing + +-- | Put data, wrapped in 'MontageObject's, at the 'Bucket's and 'Key's specified in the 'MontageObject's. +montagePutMany :: MontagePool -> [MontageObject] -> IO ([Maybe MontageObject]) +montagePutMany pool os = do + res <- montageRequest pool MONTAGE_PUT_MANY (messagePut $ MontagePutMany $ Seq.fromList os) + case ME.mtype res of + MONTAGE_PUT_MANY_RESPONSE -> return $ zipPuts os objsPut + where objsPut = LL.map MPR.object $ MPMR.objects $ messageGetError "montagePutMany: put" $ ME.msg res + MONTAGE_ERROR -> formatThrow "Incorrect response to MontagePutMany: error={}" (Only $ uToString $ MErr.error msg) >> return [] + where msg = messageGetError "montagePutMany: MontageGetResponse" $ ME.msg res + _ -> formatThrow "Unknown response to MontagePutMany" () >> return [] diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageCommand.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageCommand.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageCommand.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageCommand (MontageCommand(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageCommand = MontageCommand{command :: !P'.Utf8, argument :: !(P'.Maybe P'.ByteString)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageCommand where + mergeAppend (MontageCommand x'1 x'2) (MontageCommand y'1 y'2) = MontageCommand (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) + +instance P'.Default MontageCommand where + defaultValue = MontageCommand P'.defaultValue P'.defaultValue + +instance P'.Wire MontageCommand where + wireSize ft' self'@(MontageCommand x'1 x'2) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 9 x'1 + P'.wireSizeOpt 1 12 x'2) + wirePut ft' self'@(MontageCommand x'1 x'2) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 9 x'1 + P'.wirePutOpt 18 12 x'2 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{command = new'Field}) (P'.wireGet 9) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{argument = Prelude'.Just new'Field}) (P'.wireGet 12) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageCommand) MontageCommand where + getVal m' f' = f' m' + +instance P'.GPB MontageCommand + +instance P'.ReflectDescriptor MontageCommand where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageCommand\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageCommand\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageCommand.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageCommand.command\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageCommand\"], baseName' = FName \"command\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageCommand.argument\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageCommand\"], baseName' = FName \"argument\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageCommandResponse.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageCommandResponse.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageCommandResponse.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageCommandResponse (MontageCommandResponse(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageCommandResponse = MontageCommandResponse{status :: !P'.Utf8, value :: !(P'.Maybe P'.ByteString)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageCommandResponse where + mergeAppend (MontageCommandResponse x'1 x'2) (MontageCommandResponse y'1 y'2) + = MontageCommandResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) + +instance P'.Default MontageCommandResponse where + defaultValue = MontageCommandResponse P'.defaultValue P'.defaultValue + +instance P'.Wire MontageCommandResponse where + wireSize ft' self'@(MontageCommandResponse x'1 x'2) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 9 x'1 + P'.wireSizeOpt 1 12 x'2) + wirePut ft' self'@(MontageCommandResponse x'1 x'2) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 9 x'1 + P'.wirePutOpt 18 12 x'2 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{status = new'Field}) (P'.wireGet 9) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{value = Prelude'.Just new'Field}) (P'.wireGet 12) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageCommandResponse) MontageCommandResponse where + getVal m' f' = f' m' + +instance P'.GPB MontageCommandResponse + +instance P'.ReflectDescriptor MontageCommandResponse where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageCommandResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageCommandResponse\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageCommandResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageCommandResponse.status\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageCommandResponse\"], baseName' = FName \"status\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageCommandResponse.value\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageCommandResponse\"], baseName' = FName \"value\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageDelete.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageDelete.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageDelete.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageDelete (MontageDelete(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageDelete = MontageDelete{bucket :: !P'.ByteString, key :: !P'.ByteString} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageDelete where + mergeAppend (MontageDelete x'1 x'2) (MontageDelete y'1 y'2) = MontageDelete (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) + +instance P'.Default MontageDelete where + defaultValue = MontageDelete P'.defaultValue P'.defaultValue + +instance P'.Wire MontageDelete where + wireSize ft' self'@(MontageDelete x'1 x'2) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeReq 1 12 x'2) + wirePut ft' self'@(MontageDelete x'1 x'2) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 12 x'1 + P'.wirePutReq 18 12 x'2 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageDelete) MontageDelete where + getVal m' f' = f' m' + +instance P'.GPB MontageDelete + +instance P'.ReflectDescriptor MontageDelete where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageDelete\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageDelete\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageDelete.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageDelete.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageDelete\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageDelete.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageDelete\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageDeleteResponse.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageDeleteResponse.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageDeleteResponse.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageDeleteResponse (MontageDeleteResponse(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageDeleteResponse = MontageDeleteResponse{} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageDeleteResponse where + mergeAppend MontageDeleteResponse MontageDeleteResponse = MontageDeleteResponse + +instance P'.Default MontageDeleteResponse where + defaultValue = MontageDeleteResponse + +instance P'.Wire MontageDeleteResponse where + wireSize ft' self'@(MontageDeleteResponse) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = 0 + wirePut ft' self'@(MontageDeleteResponse) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + Prelude'.return () + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageDeleteResponse) MontageDeleteResponse where + getVal m' f' = f' m' + +instance P'.GPB MontageDeleteResponse + +instance P'.ReflectDescriptor MontageDeleteResponse where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList []) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageDeleteResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageDeleteResponse\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageDeleteResponse.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageEnvelope.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageEnvelope.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageEnvelope.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageEnvelope (MontageEnvelope(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageWireMessages as MontageClient (MontageWireMessages) + +data MontageEnvelope = MontageEnvelope{mtype :: !MontageClient.MontageWireMessages, msg :: !P'.ByteString, + msgid :: !(P'.Maybe P'.ByteString)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageEnvelope where + mergeAppend (MontageEnvelope x'1 x'2 x'3) (MontageEnvelope y'1 y'2 y'3) + = MontageEnvelope (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) + +instance P'.Default MontageEnvelope where + defaultValue = MontageEnvelope P'.defaultValue P'.defaultValue P'.defaultValue + +instance P'.Wire MontageEnvelope where + wireSize ft' self'@(MontageEnvelope x'1 x'2 x'3) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 14 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeOpt 1 12 x'3) + wirePut ft' self'@(MontageEnvelope x'1 x'2 x'3) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 8 14 x'1 + P'.wirePutReq 18 12 x'2 + P'.wirePutOpt 26 12 x'3 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 8 -> Prelude'.fmap (\ !new'Field -> old'Self{mtype = new'Field}) (P'.wireGet 14) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{msg = new'Field}) (P'.wireGet 12) + 26 -> Prelude'.fmap (\ !new'Field -> old'Self{msgid = Prelude'.Just new'Field}) (P'.wireGet 12) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageEnvelope) MontageEnvelope where + getVal m' f' = f' m' + +instance P'.GPB MontageEnvelope + +instance P'.ReflectDescriptor MontageEnvelope where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8, 18]) (P'.fromDistinctAscList [8, 18, 26]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageEnvelope\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageEnvelope\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageEnvelope.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageEnvelope.mtype\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageEnvelope\"], baseName' = FName \"mtype\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageWireMessages\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageWireMessages\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageEnvelope.msg\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageEnvelope\"], baseName' = FName \"msg\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageEnvelope.msgid\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageEnvelope\"], baseName' = FName \"msgid\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageError.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageError.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageError.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageError (MontageError(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageError = MontageError{error :: !P'.Utf8} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageError where + mergeAppend (MontageError x'1) (MontageError y'1) = MontageError (P'.mergeAppend x'1 y'1) + +instance P'.Default MontageError where + defaultValue = MontageError P'.defaultValue + +instance P'.Wire MontageError where + wireSize ft' self'@(MontageError x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 9 x'1) + wirePut ft' self'@(MontageError x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 9 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{error = new'Field}) (P'.wireGet 9) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageError) MontageError where + getVal m' f' = f' m' + +instance P'.GPB MontageError + +instance P'.ReflectDescriptor MontageError where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageError\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageError\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageError.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageError.error\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageError\"], baseName' = FName \"error\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageGet.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageGet.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageGet.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageGet (MontageGet(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageSubrequestSpec as MontageClient (MontageSubrequestSpec) + +data MontageGet = MontageGet{bucket :: !P'.ByteString, key :: !P'.ByteString, + sub :: !(P'.Maybe MontageClient.MontageSubrequestSpec)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageGet where + mergeAppend (MontageGet x'1 x'2 x'3) (MontageGet y'1 y'2 y'3) + = MontageGet (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) + +instance P'.Default MontageGet where + defaultValue = MontageGet P'.defaultValue P'.defaultValue P'.defaultValue + +instance P'.Wire MontageGet where + wireSize ft' self'@(MontageGet x'1 x'2 x'3) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeOpt 1 11 x'3) + wirePut ft' self'@(MontageGet x'1 x'2 x'3) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 12 x'1 + P'.wirePutReq 18 12 x'2 + P'.wirePutOpt 26 11 x'3 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12) + 26 -> Prelude'.fmap (\ !new'Field -> old'Self{sub = P'.mergeAppend (sub old'Self) (Prelude'.Just new'Field)}) + (P'.wireGet 11) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageGet) MontageGet where + getVal m' f' = f' m' + +instance P'.GPB MontageGet + +instance P'.ReflectDescriptor MontageGet where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18, 26]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageGet\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageGet\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageGet.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGet.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGet\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGet.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGet\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGet.sub\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGet\"], baseName' = FName \"sub\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageSubrequestSpec\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageSubrequestSpec\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageGetMany.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetMany.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetMany.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageGetMany (MontageGetMany(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageGet as MontageClient (MontageGet) + +data MontageGetMany = MontageGetMany{gets :: !(P'.Seq MontageClient.MontageGet)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageGetMany where + mergeAppend (MontageGetMany x'1) (MontageGetMany y'1) = MontageGetMany (P'.mergeAppend x'1 y'1) + +instance P'.Default MontageGetMany where + defaultValue = MontageGetMany P'.defaultValue + +instance P'.Wire MontageGetMany where + wireSize ft' self'@(MontageGetMany x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeRep 1 11 x'1) + wirePut ft' self'@(MontageGetMany x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutRep 10 11 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{gets = P'.append (gets old'Self) new'Field}) (P'.wireGet 11) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageGetMany) MontageGetMany where + getVal m' f' = f' m' + +instance P'.GPB MontageGetMany + +instance P'.ReflectDescriptor MontageGetMany where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageGetMany\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageGetMany\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageGetMany.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGetMany.gets\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGetMany\"], baseName' = FName \"gets\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageGet\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageGet\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageGetReference.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetReference.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetReference.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageGetReference (MontageGetReference(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageGetReference = MontageGetReference{bucket :: !P'.ByteString, key :: !P'.ByteString, + target_buckets :: !(P'.Seq P'.ByteString)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageGetReference where + mergeAppend (MontageGetReference x'1 x'2 x'3) (MontageGetReference y'1 y'2 y'3) + = MontageGetReference (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) + +instance P'.Default MontageGetReference where + defaultValue = MontageGetReference P'.defaultValue P'.defaultValue P'.defaultValue + +instance P'.Wire MontageGetReference where + wireSize ft' self'@(MontageGetReference x'1 x'2 x'3) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeRep 1 12 x'3) + wirePut ft' self'@(MontageGetReference x'1 x'2 x'3) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 12 x'1 + P'.wirePutReq 18 12 x'2 + P'.wirePutRep 26 12 x'3 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12) + 26 -> Prelude'.fmap (\ !new'Field -> old'Self{target_buckets = P'.append (target_buckets old'Self) new'Field}) + (P'.wireGet 12) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageGetReference) MontageGetReference where + getVal m' f' = f' m' + +instance P'.GPB MontageGetReference + +instance P'.ReflectDescriptor MontageGetReference where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18, 26]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageGetReference\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageGetReference\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageGetReference.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGetReference.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGetReference\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGetReference.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGetReference\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGetReference.target_buckets\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGetReference\"], baseName' = FName \"target_buckets\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageGetResponse.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetResponse.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetResponse.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageGetResponse (MontageGetResponse(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageGetStatus as MontageClient (MontageGetStatus) +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageObject as MontageClient (MontageObject) + +data MontageGetResponse = MontageGetResponse{status :: !(P'.Seq MontageClient.MontageGetStatus), + master :: !(P'.Maybe MontageClient.MontageObject), + subs :: !(P'.Seq MontageClient.MontageObject)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageGetResponse where + mergeAppend (MontageGetResponse x'1 x'2 x'3) (MontageGetResponse y'1 y'2 y'3) + = MontageGetResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) + +instance P'.Default MontageGetResponse where + defaultValue = MontageGetResponse P'.defaultValue P'.defaultValue P'.defaultValue + +instance P'.Wire MontageGetResponse where + wireSize ft' self'@(MontageGetResponse x'1 x'2 x'3) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeRep 1 14 x'1 + P'.wireSizeOpt 1 11 x'2 + P'.wireSizeRep 1 11 x'3) + wirePut ft' self'@(MontageGetResponse x'1 x'2 x'3) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutRep 8 14 x'1 + P'.wirePutOpt 18 11 x'2 + P'.wirePutRep 26 11 x'3 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 8 -> Prelude'.fmap (\ !new'Field -> old'Self{status = P'.append (status old'Self) new'Field}) (P'.wireGet 14) + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{status = P'.mergeAppend (status old'Self) new'Field}) + (P'.wireGetPacked 14) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{master = P'.mergeAppend (master old'Self) (Prelude'.Just new'Field)}) + (P'.wireGet 11) + 26 -> Prelude'.fmap (\ !new'Field -> old'Self{subs = P'.append (subs old'Self) new'Field}) (P'.wireGet 11) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageGetResponse) MontageGetResponse where + getVal m' f' = f' m' + +instance P'.GPB MontageGetResponse + +instance P'.ReflectDescriptor MontageGetResponse where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 10, 18, 26]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageGetResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageGetResponse\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageGetResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGetResponse.status\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGetResponse\"], baseName' = FName \"status\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Just (WireTag {getWireTag = 8},WireTag {getWireTag = 10}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageGetStatus\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageGetStatus\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGetResponse.master\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGetResponse\"], baseName' = FName \"master\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageGetResponse.subs\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageGetResponse\"], baseName' = FName \"subs\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageGetStatus.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetStatus.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageGetStatus.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageGetStatus (MontageGetStatus(..)) where +import Prelude ((+), (/), (.)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageGetStatus = EXISTS + | MISSING + | ERROR + deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageGetStatus + +instance Prelude'.Bounded MontageGetStatus where + minBound = EXISTS + maxBound = ERROR + +instance P'.Default MontageGetStatus where + defaultValue = EXISTS + +toMaybe'Enum :: Prelude'.Int -> P'.Maybe MontageGetStatus +toMaybe'Enum 1 = Prelude'.Just EXISTS +toMaybe'Enum 2 = Prelude'.Just MISSING +toMaybe'Enum 3 = Prelude'.Just ERROR +toMaybe'Enum _ = Prelude'.Nothing + +instance Prelude'.Enum MontageGetStatus where + fromEnum EXISTS = 1 + fromEnum MISSING = 2 + fromEnum ERROR = 3 + toEnum + = P'.fromMaybe + (Prelude'.error + "hprotoc generated code: toEnum failure for type Network.Riak.MontageClient.Proto.MontageClient.MontageGetStatus") + . toMaybe'Enum + succ EXISTS = MISSING + succ MISSING = ERROR + succ _ + = Prelude'.error "hprotoc generated code: succ failure for type Network.Riak.MontageClient.Proto.MontageClient.MontageGetStatus" + pred MISSING = EXISTS + pred ERROR = MISSING + pred _ + = Prelude'.error "hprotoc generated code: pred failure for type Network.Riak.MontageClient.Proto.MontageClient.MontageGetStatus" + +instance P'.Wire MontageGetStatus where + wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum) + wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum) + wireGet 14 = P'.wireGetEnum toMaybe'Enum + wireGet ft' = P'.wireGetErr ft' + wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum + wireGetPacked ft' = P'.wireGetErr ft' + +instance P'.GPB MontageGetStatus + +instance P'.MessageAPI msg' (msg' -> MontageGetStatus) MontageGetStatus where + getVal m' f' = f' m' + +instance P'.ReflectEnum MontageGetStatus where + reflectEnum = [(1, "EXISTS", EXISTS), (2, "MISSING", MISSING), (3, "ERROR", ERROR)] + reflectEnumInfo _ + = P'.EnumInfo + (P'.makePNF (P'.pack ".MontageClient.MontageGetStatus") ["Network", "Riak", "MontageClient", "Proto"] ["MontageClient"] + "MontageGetStatus") + ["Network", "Riak", "MontageClient", "Proto", "MontageClient", "MontageGetStatus.hs"] + [(1, "EXISTS"), (2, "MISSING"), (3, "ERROR")] diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageObject.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageObject.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageObject.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageObject (MontageObject(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageObject = MontageObject{vclock :: !(P'.Maybe P'.ByteString), bucket :: !P'.ByteString, key :: !P'.ByteString, + data' :: !P'.ByteString, fetch_resolutions :: !(P'.Maybe P'.Word32)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageObject where + mergeAppend (MontageObject x'1 x'2 x'3 x'4 x'5) (MontageObject y'1 y'2 y'3 y'4 y'5) + = MontageObject (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4) + (P'.mergeAppend x'5 y'5) + +instance P'.Default MontageObject where + defaultValue = MontageObject P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue + +instance P'.Wire MontageObject where + wireSize ft' self'@(MontageObject x'1 x'2 x'3 x'4 x'5) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size + = (P'.wireSizeOpt 1 12 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeReq 1 12 x'3 + P'.wireSizeReq 1 12 x'4 + + P'.wireSizeOpt 1 13 x'5) + wirePut ft' self'@(MontageObject x'1 x'2 x'3 x'4 x'5) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutOpt 10 12 x'1 + P'.wirePutReq 18 12 x'2 + P'.wirePutReq 26 12 x'3 + P'.wirePutReq 34 12 x'4 + P'.wirePutOpt 40 13 x'5 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{vclock = Prelude'.Just new'Field}) (P'.wireGet 12) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12) + 26 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12) + 34 -> Prelude'.fmap (\ !new'Field -> old'Self{data' = new'Field}) (P'.wireGet 12) + 40 -> Prelude'.fmap (\ !new'Field -> old'Self{fetch_resolutions = Prelude'.Just new'Field}) (P'.wireGet 13) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageObject) MontageObject where + getVal m' f' = f' m' + +instance P'.GPB MontageObject + +instance P'.ReflectDescriptor MontageObject where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [18, 26, 34]) (P'.fromDistinctAscList [10, 18, 26, 34, 40]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageObject\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageObject.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageObject.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageObject\"], baseName' = FName \"vclock\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageObject.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageObject\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageObject.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageObject\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageObject.data\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageObject\"], baseName' = FName \"data'\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageObject.fetch_resolutions\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageObject\"], baseName' = FName \"fetch_resolutions\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontagePut.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontagePut.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontagePut.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontagePut (MontagePut(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageObject as MontageClient (MontageObject) + +data MontagePut = MontagePut{object :: !MontageClient.MontageObject} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontagePut where + mergeAppend (MontagePut x'1) (MontagePut y'1) = MontagePut (P'.mergeAppend x'1 y'1) + +instance P'.Default MontagePut where + defaultValue = MontagePut P'.defaultValue + +instance P'.Wire MontagePut where + wireSize ft' self'@(MontagePut x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 11 x'1) + wirePut ft' self'@(MontagePut x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 11 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{object = P'.mergeAppend (object old'Self) (new'Field)}) (P'.wireGet 11) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontagePut) MontagePut where + getVal m' f' = f' m' + +instance P'.GPB MontagePut + +instance P'.ReflectDescriptor MontagePut where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontagePut\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontagePut\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontagePut.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontagePut.object\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontagePut\"], baseName' = FName \"object\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontagePutMany.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontagePutMany.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontagePutMany.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontagePutMany (MontagePutMany(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageObject as MontageClient (MontageObject) + +data MontagePutMany = MontagePutMany{objects :: !(P'.Seq MontageClient.MontageObject)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontagePutMany where + mergeAppend (MontagePutMany x'1) (MontagePutMany y'1) = MontagePutMany (P'.mergeAppend x'1 y'1) + +instance P'.Default MontagePutMany where + defaultValue = MontagePutMany P'.defaultValue + +instance P'.Wire MontagePutMany where + wireSize ft' self'@(MontagePutMany x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeRep 1 11 x'1) + wirePut ft' self'@(MontagePutMany x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutRep 10 11 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{objects = P'.append (objects old'Self) new'Field}) (P'.wireGet 11) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontagePutMany) MontagePutMany where + getVal m' f' = f' m' + +instance P'.GPB MontagePutMany + +instance P'.ReflectDescriptor MontagePutMany where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontagePutMany\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontagePutMany\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontagePutMany.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontagePutMany.objects\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontagePutMany\"], baseName' = FName \"objects\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontagePutManyResponse.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontagePutManyResponse.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontagePutManyResponse.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontagePutManyResponse (MontagePutManyResponse(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontagePutResponse as MontageClient (MontagePutResponse) + +data MontagePutManyResponse = MontagePutManyResponse{objects :: !(P'.Seq MontageClient.MontagePutResponse)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontagePutManyResponse where + mergeAppend (MontagePutManyResponse x'1) (MontagePutManyResponse y'1) = MontagePutManyResponse (P'.mergeAppend x'1 y'1) + +instance P'.Default MontagePutManyResponse where + defaultValue = MontagePutManyResponse P'.defaultValue + +instance P'.Wire MontagePutManyResponse where + wireSize ft' self'@(MontagePutManyResponse x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeRep 1 11 x'1) + wirePut ft' self'@(MontagePutManyResponse x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutRep 10 11 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{objects = P'.append (objects old'Self) new'Field}) (P'.wireGet 11) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontagePutManyResponse) MontagePutManyResponse where + getVal m' f' = f' m' + +instance P'.GPB MontagePutManyResponse + +instance P'.ReflectDescriptor MontagePutManyResponse where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontagePutManyResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontagePutManyResponse\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontagePutManyResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontagePutManyResponse.objects\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontagePutManyResponse\"], baseName' = FName \"objects\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontagePutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontagePutResponse\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontagePutResponse.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontagePutResponse.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontagePutResponse.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontagePutResponse (MontagePutResponse(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import qualified Network.Riak.MontageClient.Proto.MontageClient.MontageObject as MontageClient (MontageObject) + +data MontagePutResponse = MontagePutResponse{modified :: !P'.Bool, object :: !MontageClient.MontageObject} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontagePutResponse where + mergeAppend (MontagePutResponse x'1 x'2) (MontagePutResponse y'1 y'2) + = MontagePutResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) + +instance P'.Default MontagePutResponse where + defaultValue = MontagePutResponse P'.defaultValue P'.defaultValue + +instance P'.Wire MontagePutResponse where + wireSize ft' self'@(MontagePutResponse x'1 x'2) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 8 x'1 + P'.wireSizeReq 1 11 x'2) + wirePut ft' self'@(MontagePutResponse x'1 x'2) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 8 8 x'1 + P'.wirePutReq 18 11 x'2 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 8 -> Prelude'.fmap (\ !new'Field -> old'Self{modified = new'Field}) (P'.wireGet 8) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{object = P'.mergeAppend (object old'Self) (new'Field)}) (P'.wireGet 11) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontagePutResponse) MontagePutResponse where + getVal m' f' = f' m' + +instance P'.GPB MontagePutResponse + +instance P'.ReflectDescriptor MontagePutResponse where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8, 18]) (P'.fromDistinctAscList [8, 18]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontagePutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontagePutResponse\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontagePutResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontagePutResponse.modified\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontagePutResponse\"], baseName' = FName \"modified\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontagePutResponse.object\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontagePutResponse\"], baseName' = FName \"object\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".MontageClient.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageSubrequestSpec.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageSubrequestSpec.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageSubrequestSpec.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageSubrequestSpec (MontageSubrequestSpec(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageSubrequestSpec = MontageSubrequestSpec{sub_spec :: !P'.ByteString, params :: !(P'.Maybe P'.ByteString)} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageSubrequestSpec where + mergeAppend (MontageSubrequestSpec x'1 x'2) (MontageSubrequestSpec y'1 y'2) + = MontageSubrequestSpec (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) + +instance P'.Default MontageSubrequestSpec where + defaultValue = MontageSubrequestSpec P'.defaultValue P'.defaultValue + +instance P'.Wire MontageSubrequestSpec where + wireSize ft' self'@(MontageSubrequestSpec x'1 x'2) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeOpt 1 12 x'2) + wirePut ft' self'@(MontageSubrequestSpec x'1 x'2) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 12 x'1 + P'.wirePutOpt 18 12 x'2 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{sub_spec = new'Field}) (P'.wireGet 12) + 18 -> Prelude'.fmap (\ !new'Field -> old'Self{params = Prelude'.Just new'Field}) (P'.wireGet 12) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> MontageSubrequestSpec) MontageSubrequestSpec where + getVal m' f' = f' m' + +instance P'.GPB MontageSubrequestSpec + +instance P'.ReflectDescriptor MontageSubrequestSpec where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".MontageClient.MontageSubrequestSpec\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule = [MName \"MontageClient\"], baseName = MName \"MontageSubrequestSpec\"}, descFilePath = [\"Network\",\"Riak\",\"MontageClient\",\"Proto\",\"MontageClient\",\"MontageSubrequestSpec.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageSubrequestSpec.sub_spec\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageSubrequestSpec\"], baseName' = FName \"sub_spec\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".MontageClient.MontageSubrequestSpec.params\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"MontageClient\",MName \"Proto\"], parentModule' = [MName \"MontageClient\",MName \"MontageSubrequestSpec\"], baseName' = FName \"params\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/Network/Riak/MontageClient/Proto/MontageClient/MontageWireMessages.hs b/Network/Riak/MontageClient/Proto/MontageClient/MontageWireMessages.hs new file mode 100644 --- /dev/null +++ b/Network/Riak/MontageClient/Proto/MontageClient/MontageWireMessages.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Network.Riak.MontageClient.Proto.MontageClient.MontageWireMessages (MontageWireMessages(..)) where +import Prelude ((+), (/), (.)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data MontageWireMessages = MONTAGE_GET + | MONTAGE_GET_REFERENCE + | MONTAGE_GET_RESPONSE + | MONTAGE_COMMAND + | MONTAGE_COMMAND_RESPONSE + | MONTAGE_PUT + | MONTAGE_PUT_RESPONSE + | MONTAGE_GET_MANY + | DEPRICATED_MONTAGE_SET_REFERENCE + | MONTAGE_PUT_MANY + | MONTAGE_PUT_MANY_RESPONSE + | MONTAGE_ERROR + | MONTAGE_DELETE + | MONTAGE_DELETE_RESPONSE + deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable MontageWireMessages + +instance Prelude'.Bounded MontageWireMessages where + minBound = MONTAGE_GET + maxBound = MONTAGE_DELETE_RESPONSE + +instance P'.Default MontageWireMessages where + defaultValue = MONTAGE_GET + +toMaybe'Enum :: Prelude'.Int -> P'.Maybe MontageWireMessages +toMaybe'Enum 1 = Prelude'.Just MONTAGE_GET +toMaybe'Enum 2 = Prelude'.Just MONTAGE_GET_REFERENCE +toMaybe'Enum 3 = Prelude'.Just MONTAGE_GET_RESPONSE +toMaybe'Enum 4 = Prelude'.Just MONTAGE_COMMAND +toMaybe'Enum 5 = Prelude'.Just MONTAGE_COMMAND_RESPONSE +toMaybe'Enum 6 = Prelude'.Just MONTAGE_PUT +toMaybe'Enum 7 = Prelude'.Just MONTAGE_PUT_RESPONSE +toMaybe'Enum 8 = Prelude'.Just MONTAGE_GET_MANY +toMaybe'Enum 9 = Prelude'.Just DEPRICATED_MONTAGE_SET_REFERENCE +toMaybe'Enum 10 = Prelude'.Just MONTAGE_PUT_MANY +toMaybe'Enum 11 = Prelude'.Just MONTAGE_PUT_MANY_RESPONSE +toMaybe'Enum 12 = Prelude'.Just MONTAGE_ERROR +toMaybe'Enum 13 = Prelude'.Just MONTAGE_DELETE +toMaybe'Enum 14 = Prelude'.Just MONTAGE_DELETE_RESPONSE +toMaybe'Enum _ = Prelude'.Nothing + +instance Prelude'.Enum MontageWireMessages where + fromEnum MONTAGE_GET = 1 + fromEnum MONTAGE_GET_REFERENCE = 2 + fromEnum MONTAGE_GET_RESPONSE = 3 + fromEnum MONTAGE_COMMAND = 4 + fromEnum MONTAGE_COMMAND_RESPONSE = 5 + fromEnum MONTAGE_PUT = 6 + fromEnum MONTAGE_PUT_RESPONSE = 7 + fromEnum MONTAGE_GET_MANY = 8 + fromEnum DEPRICATED_MONTAGE_SET_REFERENCE = 9 + fromEnum MONTAGE_PUT_MANY = 10 + fromEnum MONTAGE_PUT_MANY_RESPONSE = 11 + fromEnum MONTAGE_ERROR = 12 + fromEnum MONTAGE_DELETE = 13 + fromEnum MONTAGE_DELETE_RESPONSE = 14 + toEnum + = P'.fromMaybe + (Prelude'.error + "hprotoc generated code: toEnum failure for type Network.Riak.MontageClient.Proto.MontageClient.MontageWireMessages") + . toMaybe'Enum + succ MONTAGE_GET = MONTAGE_GET_REFERENCE + succ MONTAGE_GET_REFERENCE = MONTAGE_GET_RESPONSE + succ MONTAGE_GET_RESPONSE = MONTAGE_COMMAND + succ MONTAGE_COMMAND = MONTAGE_COMMAND_RESPONSE + succ MONTAGE_COMMAND_RESPONSE = MONTAGE_PUT + succ MONTAGE_PUT = MONTAGE_PUT_RESPONSE + succ MONTAGE_PUT_RESPONSE = MONTAGE_GET_MANY + succ MONTAGE_GET_MANY = DEPRICATED_MONTAGE_SET_REFERENCE + succ DEPRICATED_MONTAGE_SET_REFERENCE = MONTAGE_PUT_MANY + succ MONTAGE_PUT_MANY = MONTAGE_PUT_MANY_RESPONSE + succ MONTAGE_PUT_MANY_RESPONSE = MONTAGE_ERROR + succ MONTAGE_ERROR = MONTAGE_DELETE + succ MONTAGE_DELETE = MONTAGE_DELETE_RESPONSE + succ _ + = Prelude'.error + "hprotoc generated code: succ failure for type Network.Riak.MontageClient.Proto.MontageClient.MontageWireMessages" + pred MONTAGE_GET_REFERENCE = MONTAGE_GET + pred MONTAGE_GET_RESPONSE = MONTAGE_GET_REFERENCE + pred MONTAGE_COMMAND = MONTAGE_GET_RESPONSE + pred MONTAGE_COMMAND_RESPONSE = MONTAGE_COMMAND + pred MONTAGE_PUT = MONTAGE_COMMAND_RESPONSE + pred MONTAGE_PUT_RESPONSE = MONTAGE_PUT + pred MONTAGE_GET_MANY = MONTAGE_PUT_RESPONSE + pred DEPRICATED_MONTAGE_SET_REFERENCE = MONTAGE_GET_MANY + pred MONTAGE_PUT_MANY = DEPRICATED_MONTAGE_SET_REFERENCE + pred MONTAGE_PUT_MANY_RESPONSE = MONTAGE_PUT_MANY + pred MONTAGE_ERROR = MONTAGE_PUT_MANY_RESPONSE + pred MONTAGE_DELETE = MONTAGE_ERROR + pred MONTAGE_DELETE_RESPONSE = MONTAGE_DELETE + pred _ + = Prelude'.error + "hprotoc generated code: pred failure for type Network.Riak.MontageClient.Proto.MontageClient.MontageWireMessages" + +instance P'.Wire MontageWireMessages where + wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum) + wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum) + wireGet 14 = P'.wireGetEnum toMaybe'Enum + wireGet ft' = P'.wireGetErr ft' + wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum + wireGetPacked ft' = P'.wireGetErr ft' + +instance P'.GPB MontageWireMessages + +instance P'.MessageAPI msg' (msg' -> MontageWireMessages) MontageWireMessages where + getVal m' f' = f' m' + +instance P'.ReflectEnum MontageWireMessages where + reflectEnum + = [(1, "MONTAGE_GET", MONTAGE_GET), (2, "MONTAGE_GET_REFERENCE", MONTAGE_GET_REFERENCE), + (3, "MONTAGE_GET_RESPONSE", MONTAGE_GET_RESPONSE), (4, "MONTAGE_COMMAND", MONTAGE_COMMAND), + (5, "MONTAGE_COMMAND_RESPONSE", MONTAGE_COMMAND_RESPONSE), (6, "MONTAGE_PUT", MONTAGE_PUT), + (7, "MONTAGE_PUT_RESPONSE", MONTAGE_PUT_RESPONSE), (8, "MONTAGE_GET_MANY", MONTAGE_GET_MANY), + (9, "DEPRICATED_MONTAGE_SET_REFERENCE", DEPRICATED_MONTAGE_SET_REFERENCE), (10, "MONTAGE_PUT_MANY", MONTAGE_PUT_MANY), + (11, "MONTAGE_PUT_MANY_RESPONSE", MONTAGE_PUT_MANY_RESPONSE), (12, "MONTAGE_ERROR", MONTAGE_ERROR), + (13, "MONTAGE_DELETE", MONTAGE_DELETE), (14, "MONTAGE_DELETE_RESPONSE", MONTAGE_DELETE_RESPONSE)] + reflectEnumInfo _ + = P'.EnumInfo + (P'.makePNF (P'.pack ".MontageClient.MontageWireMessages") ["Network", "Riak", "MontageClient", "Proto"] ["MontageClient"] + "MontageWireMessages") + ["Network", "Riak", "MontageClient", "Proto", "MontageClient", "MontageWireMessages.hs"] + [(1, "MONTAGE_GET"), (2, "MONTAGE_GET_REFERENCE"), (3, "MONTAGE_GET_RESPONSE"), (4, "MONTAGE_COMMAND"), + (5, "MONTAGE_COMMAND_RESPONSE"), (6, "MONTAGE_PUT"), (7, "MONTAGE_PUT_RESPONSE"), (8, "MONTAGE_GET_MANY"), + (9, "DEPRICATED_MONTAGE_SET_REFERENCE"), (10, "MONTAGE_PUT_MANY"), (11, "MONTAGE_PUT_MANY_RESPONSE"), (12, "MONTAGE_ERROR"), + (13, "MONTAGE_DELETE"), (14, "MONTAGE_DELETE_RESPONSE")] diff --git a/README.rst b/README.rst new file mode 100644 --- /dev/null +++ b/README.rst @@ -0,0 +1,95 @@ +======================== +Haskell Client for Montage +======================== + +Install +======= + +Built and tested with ghc 7.4.1 + +Install the non-hackage dependencies:: + + git clone git@github.com:wmoss/StatsWeb.git + cd StatsWeb && cabal install + + git clone git@github.com:bumptech/riak-haskell-client.git + cd riak-haskell-client && cabal install + +From montage-haskell-client/ execute:: + + cabal install + +We recommend using a sandbox, hsenv is particularly good. + +To setup montage itself, see http://github.com/bumptech/montage + +Configuration +======= + +The montage proxy is port configurable (here given the Config handle set to 7078), with riak running on 8087:: + + import Network.Riak (defaultClient, connect, disconnect, Client(port), Connection) + import Data.Conduit.Pool (Pool, createPool) + + import Network.Riak.Montage + + main :: IO () + main = do + mainPool <- createPool + (connect $ defaultClient {port = "8087"}) + disconnect + 1 -- stripes + 10 -- timeout + 300 -- max connections + + let cfg' = cfg { proxyPort = 7078 } + + runDaemon (cfg' :: Config ResObject) mainPool + +See montage for how to define resolutions for a resolution object (ResObject), which is also required to start the proxy. + +Your client's request pool must connect (not bind) to that port:: + + import Data.Conduit.Pool (Pool, createPool) + import System.ZMQ as ZMQ + + import Network.Riak.MontageClient + + montageZpool <- createPool (do + s <- ZMQ.socket ctx Req + ZMQ.connect s "tcp://localhost:7078" + return s + ) ZMQ.close 1 5 1 + + let (bucket, key) = ("u-info", "1") + resp <- montageGet montageZpool bucket key + +See Examples and More for full documentation of client requests. + +Examples +======= +To setup the examples, first download hprotoc:: + + cabal install hprotoc + +Then execute:: + + cd examples && hprotoc user.proto + +You must have montage installed to run the basic proxy which the examples talk with. In your external montage/ directory:: + + cd examples && runhaskell basic_proxy.hs + +See github.com/bumptech/montage for more on the montage haskell setup. + +To run the examples, in examples/ execute:: + + runhaskell Resolution.hs -- a basic last write wins resolution + runhaskell Delete.hs -- tests a delete after a put + runhaskell Many.hs -- asserts the identity of put many -> get many + runhaskell Reference.hs -- a basic, multi-target reference get + +More +=========== + +See the haddock documentation for type-signatures, descriptions, and source of client functions. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Delete.hs b/examples/Delete.hs new file mode 100644 --- /dev/null +++ b/examples/Delete.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +import Data.Conduit.Pool (Pool, createPool) +import Network.Riak (defaultClient, connect, disconnect, + Client(port), Connection) + +import Control.Exception (assert) +import Control.Monad (mapM) +import System.ZMQ as ZMQ +import System.IO +import qualified Data.ByteString.Lazy as BW +import Data.Maybe + +import Network.Riak.MontageClient +import Utils (putDecimal, generateUI) + +threadCount :: Int +threadCount = 1 + +main :: IO () +main = do + ctx <- ZMQ.init 1 + + -- Montage ZeroMQ + montageZpool <- createPool (do + s <- ZMQ.socket ctx Req + ZMQ.connect s "tcp://localhost:7078" + return s + ) ZMQ.close 1 5 threadCount + + let (bucket, key) = ("u-info", 1) :: (BW.ByteString, Int) + let d = generateUI (key,1) + + mr <- montagePut montageZpool d + assert ((data' $ fromMaybe (error "failed put") mr) == data' d) $ return () + + -- test delete + montageDelete montageZpool bucket (putDecimal key) + mr <- montageGet montageZpool bucket (putDecimal key) + assert (isNothing mr) $ return () + + hPutStrLn stdout "\nsuccessfully deleted\n" diff --git a/examples/Many.hs b/examples/Many.hs new file mode 100644 --- /dev/null +++ b/examples/Many.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +import Data.Conduit.Pool (Pool, createPool) +import Network.Riak (defaultClient, connect, disconnect, + Client(port), Connection) + +import Control.Exception (assert) +import Control.Monad (mapM) +import System.ZMQ as ZMQ +import System.IO +import qualified Data.ByteString.Lazy as BW +import Data.Maybe + +import Network.Riak.MontageClient as MO +import Utils (putDecimal, generateUI) + +threadCount :: Int +threadCount = 1 + +eachGet :: (Maybe MontageObject, MontageObject) -> IO () +eachGet (mr, d) = case mr of + Just mo -> assert (comparable d == comparable mo) $ return () + where comparable m = (MO.bucket m, MO.key m, MO.data' m) + Nothing -> error $ "found nothing at bucket " ++ show (bucket d) ++ " key " ++ show (key d) + +main :: IO () +main = do + ctx <- ZMQ.init 1 + + -- Montage ZeroMQ + montageZpool <- createPool (do + s <- ZMQ.socket ctx Req + ZMQ.connect s "tcp://localhost:7078" + return s + ) ZMQ.close 1 5 threadCount + + let (bucket, key) = ("u-info", 1) :: (BW.ByteString, Int) + let ds = map generateUI $ zip [x | x <- [1..3]] [1..3] + + -- test get many + mr <- montagePutMany montageZpool ds + assert (length mr == length ds) $ return () + + mr <- montageGetMany montageZpool $ zip [ bucket | _ <- [1..3]] $ map putDecimal [1..3] + assert (mr /= []) $ return () + mapM_ eachGet $ zip mr ds + + hPutStrLn stdout "\nsuccessfully matched put many with get many\n" diff --git a/examples/Proto/User.hs b/examples/Proto/User.hs new file mode 100644 --- /dev/null +++ b/examples/Proto/User.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module User (protoInfo, fileDescriptorProto) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' +import Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto) +import Text.ProtocolBuffers.Reflections (ProtoInfo) +import qualified Text.ProtocolBuffers.WireMessage as P' (wireGet,getFromBS) + +protoInfo :: ProtoInfo +protoInfo + = Prelude'.read + "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".User\", haskellPrefix = [], parentModule = [], baseName = MName \"User\"}, protoFilePath = [\"User.hs\"], protoSource = \"user.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserInfo\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserInfo\"}, descFilePath = [\"User\",\"UserInfo.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserInfo.uid\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserInfo\"], baseName' = FName \"uid\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserEvent\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserEvent\"}, descFilePath = [\"User\",\"UserEvent.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserEvent.eid\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserEvent\"], baseName' = FName \"eid\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserName\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserName\"}, descFilePath = [\"User\",\"UserName.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserName.name\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserName\"], baseName' = FName \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}], enums = [], knownKeyMap = fromList []}" + +fileDescriptorProto :: FileDescriptorProto +fileDescriptorProto + = P'.getFromBS (P'.wireGet 11) + (P'.pack + "Y\n\nuser.proto\"\ETB\n\bUserInfo\DC2\v\n\ETXuid\CAN\SOH \STX(\r\"\CAN\n\tUserEvent\DC2\v\n\ETXeid\CAN\SOH \STX(\r\"\CAN\n\bUserName\DC2\f\n\EOTname\CAN\SOH \STX(\f") diff --git a/examples/Proto/User/UserEvent.hs b/examples/Proto/User/UserEvent.hs new file mode 100644 --- /dev/null +++ b/examples/Proto/User/UserEvent.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Proto.User.UserEvent (UserEvent(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data UserEvent = UserEvent{eid :: !P'.Word32} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable UserEvent where + mergeAppend (UserEvent x'1) (UserEvent y'1) = UserEvent (P'.mergeAppend x'1 y'1) + +instance P'.Default UserEvent where + defaultValue = UserEvent P'.defaultValue + +instance P'.Wire UserEvent where + wireSize ft' self'@(UserEvent x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 13 x'1) + wirePut ft' self'@(UserEvent x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 8 13 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 8 -> Prelude'.fmap (\ !new'Field -> old'Self{eid = new'Field}) (P'.wireGet 13) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> UserEvent) UserEvent where + getVal m' f' = f' m' + +instance P'.GPB UserEvent + +instance P'.ReflectDescriptor UserEvent where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8]) (P'.fromDistinctAscList [8]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserEvent\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserEvent\"}, descFilePath = [\"User\",\"UserEvent.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserEvent.eid\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserEvent\"], baseName' = FName \"eid\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/examples/Proto/User/UserInfo.hs b/examples/Proto/User/UserInfo.hs new file mode 100644 --- /dev/null +++ b/examples/Proto/User/UserInfo.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Proto.User.UserInfo (UserInfo(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data UserInfo = UserInfo{uid :: !P'.Word32} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable UserInfo where + mergeAppend (UserInfo x'1) (UserInfo y'1) = UserInfo (P'.mergeAppend x'1 y'1) + +instance P'.Default UserInfo where + defaultValue = UserInfo P'.defaultValue + +instance P'.Wire UserInfo where + wireSize ft' self'@(UserInfo x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 13 x'1) + wirePut ft' self'@(UserInfo x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 8 13 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 8 -> Prelude'.fmap (\ !new'Field -> old'Self{uid = new'Field}) (P'.wireGet 13) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> UserInfo) UserInfo where + getVal m' f' = f' m' + +instance P'.GPB UserInfo + +instance P'.ReflectDescriptor UserInfo where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8]) (P'.fromDistinctAscList [8]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserInfo\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserInfo\"}, descFilePath = [\"User\",\"UserInfo.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserInfo.uid\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserInfo\"], baseName' = FName \"uid\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/examples/Proto/User/UserName.hs b/examples/Proto/User/UserName.hs new file mode 100644 --- /dev/null +++ b/examples/Proto/User/UserName.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +module Proto.User.UserName (UserName(..)) where +import Prelude ((+), (/)) +import qualified Prelude as Prelude' +import qualified Data.Typeable as Prelude' +import qualified Data.Data as Prelude' +import qualified Text.ProtocolBuffers.Header as P' + +data UserName = UserName{name :: !P'.ByteString} + deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data) + +instance P'.Mergeable UserName where + mergeAppend (UserName x'1) (UserName y'1) = UserName (P'.mergeAppend x'1 y'1) + +instance P'.Default UserName where + defaultValue = UserName P'.defaultValue + +instance P'.Wire UserName where + wireSize ft' self'@(UserName x'1) + = case ft' of + 10 -> calc'Size + 11 -> P'.prependMessageSize calc'Size + _ -> P'.wireSizeErr ft' self' + where + calc'Size = (P'.wireSizeReq 1 12 x'1) + wirePut ft' self'@(UserName x'1) + = case ft' of + 10 -> put'Fields + 11 -> do + P'.putSize (P'.wireSize 10 self') + put'Fields + _ -> P'.wirePutErr ft' self' + where + put'Fields + = do + P'.wirePutReq 10 12 x'1 + wireGet ft' + = case ft' of + 10 -> P'.getBareMessageWith update'Self + 11 -> P'.getMessageWith update'Self + _ -> P'.wireGetErr ft' + where + update'Self wire'Tag old'Self + = case wire'Tag of + 10 -> Prelude'.fmap (\ !new'Field -> old'Self{name = new'Field}) (P'.wireGet 12) + _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self + +instance P'.MessageAPI msg' (msg' -> UserName) UserName where + getVal m' f' = f' m' + +instance P'.GPB UserName + +instance P'.ReflectDescriptor UserName where + getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10]) + reflectDescriptorInfo _ + = Prelude'.read + "DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserName\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserName\"}, descFilePath = [\"User\",\"UserName.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserName.name\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserName\"], baseName' = FName \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}" diff --git a/examples/Proto/user.proto b/examples/Proto/user.proto new file mode 100644 --- /dev/null +++ b/examples/Proto/user.proto @@ -0,0 +1,11 @@ +message UserInfo { + required uint32 uid = 1; +} + +message UserEvent { + required uint32 eid = 1; +} + +message UserName { + required bytes name = 1; +} diff --git a/examples/Reference.hs b/examples/Reference.hs new file mode 100644 --- /dev/null +++ b/examples/Reference.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +import Data.Conduit.Pool (Pool, createPool) +import Network.Riak (defaultClient, connect, disconnect, + Client(port), Connection) + +import qualified Data.Attoparsec.ByteString.Char8 as AttoC +import qualified Data.ByteString.Char8 as S + +import Control.Monad +import Control.Exception (assert) +import System.ZMQ as ZMQ +import System.IO +import Data.Word (Word8) +import Data.Maybe + +import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.ByteString.Lazy as BW + +import Text.ProtocolBuffers.Basic (toUtf8) +import Text.ProtocolBuffers.WireMessage (messageGet, messagePut, Wire) +import Text.ProtocolBuffers.Reflections (ReflectDescriptor) + +import Network.Riak.MontageClient as MO +import Utils + +import Proto.User.UserInfo as UI +import Proto.User.UserEvent as UE +import Proto.User.UserName as UN + +threadCount :: Int +threadCount = 1 + +main :: IO () +main = do + ctx <- ZMQ.init 1 + + -- Montage ZeroMQ + montageZpool <- createPool (do + s <- ZMQ.socket ctx Req + ZMQ.connect s "tcp://localhost:7078" + return s + ) ZMQ.close 1 5 threadCount + + let ui = generateUI (1,2) + _ <- montagePut montageZpool ui + let ue = generateUE (2,3) + _ <- montagePut montageZpool ue + let un = generateUN (2, "montage") + _ <- montagePut montageZpool un + + (subKey, valuesFound) <- montageGetBy' montageZpool "u-info" (putDecimal 1) ["u-event", "u-name"] + assert ((data' $ fromMaybe (error "failed get subKey") subKey) == data' ui) $ return () + assert (length valuesFound == 2) $ return () + assert (and $ map isJust valuesFound) $ return () + let [Just ueFound, Just unFound] = valuesFound + assert ((data' ueFound == data' ue) && (data' unFound == data' un)) $ return () + + hPutStrLn stdout "\nsuccessfully did reference get\n" diff --git a/examples/Resolution.hs b/examples/Resolution.hs new file mode 100644 --- /dev/null +++ b/examples/Resolution.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +import Data.Conduit.Pool (Pool, createPool) +import Network.Riak (defaultClient, connect, disconnect, + Client(port), Connection) + +import Control.Exception (assert) +import Control.Monad (mapM) +import System.ZMQ as ZMQ +import System.IO +import qualified Data.ByteString.Lazy as BW + +import Network.Riak.MontageClient +import Utils (putDecimal, generateUI) + +threadCount :: Int +threadCount = 1 + +main :: IO () +main = do + ctx <- ZMQ.init 1 + + -- Montage ZeroMQ + montageZpool <- createPool (do + s <- ZMQ.socket ctx Req + ZMQ.connect s "tcp://localhost:7078" + return s + ) ZMQ.close 1 5 threadCount + + let (bucket, key) = ("u-info", 1) :: (BW.ByteString, Int) + let ds = map generateUI $ zip [key | x <- [0..2]] [1..3] + + -- test put + mr <- mapM (montagePut montageZpool) ds + assert (length mr == length ds) $ return () + + -- test get and resolution + mr <- montageGet montageZpool bucket (putDecimal key) + case mr of + Just mo -> assert (data' mo == data' (head $ reverse ds)) $ return () + Nothing -> error "no value found" + + hPutStrLn stdout "\nsuccessfully did last write wins resolution\n" diff --git a/examples/Utils.hs b/examples/Utils.hs new file mode 100644 --- /dev/null +++ b/examples/Utils.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +module Utils where + +import Data.Word (Word8) + +import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.ByteString.Lazy as BW + +import Text.ProtocolBuffers.WireMessage (messageGet, messagePut, Wire) +import Text.ProtocolBuffers.Reflections (ReflectDescriptor) +import Network.Riak.MontageClient (MontageObject(..)) + +import Proto.User.UserInfo +import Proto.User.UserEvent +import Proto.User.UserName + +putDecimal' :: Int -> [Word8] +putDecimal' 0 = [] +putDecimal' i = ((fromIntegral f) + 48) : putDecimal' (fromIntegral r) + where + (r, f) = i `divMod` 10 +{-# INLINE putDecimal' #-} + +putDecimal :: Int -> B.ByteString +putDecimal i | i < 0 = BW.pack $ (45 :: Word8) : (reverse $ putDecimal' $ abs i) + | otherwise = BW.pack $ reverse $ putDecimal' i +{-# INLINE putDecimal #-} + +generateUI :: (Int, Int) -> MontageObject +generateUI (key, uid) = MontageObject Nothing "u-info" key' data' Nothing + where + key' = putDecimal $ fromIntegral key + data' = messagePut $ UserInfo { uid = fromIntegral uid } + +generateUE :: (Int, Int) -> MontageObject +generateUE (key, eid) = MontageObject Nothing "u-event" key' data' Nothing + where + key' = putDecimal $ fromIntegral key + data' = messagePut $ UserEvent { eid = fromIntegral eid } + +generateUN :: (Int, BW.ByteString) -> MontageObject +generateUN (key, nameStr) = MontageObject Nothing "u-name" key' data' Nothing + where + key' = putDecimal $ fromIntegral key + data' = messagePut $ UserName { name = nameStr } + diff --git a/montage-client.cabal b/montage-client.cabal new file mode 100644 --- /dev/null +++ b/montage-client.cabal @@ -0,0 +1,62 @@ +Name: montage-client +Version: 0.1 +Synopsis: Riak Resolution Proxy Client +Homepage: http://github.com/bumptech/montage-haskell-client +License: BSD3 +License-file: LICENSE +Author: Bump Technologies, Inc +Maintainer: dev@bu.mp +Category: Network +Build-type: Simple +Cabal-version: >=1.8 + +Library + Exposed-modules: Network.Riak.MontageClient, + Network.Riak.MontageClient.MontageClient, + Network.Riak.MontageClient.Proto.MontageClient.MontageCommand, + Network.Riak.MontageClient.Proto.MontageClient.MontageCommandResponse, + Network.Riak.MontageClient.Proto.MontageClient.MontageDelete, + Network.Riak.MontageClient.Proto.MontageClient.MontageDeleteResponse, + Network.Riak.MontageClient.Proto.MontageClient.MontageEnvelope, + Network.Riak.MontageClient.Proto.MontageClient.MontageError, + Network.Riak.MontageClient.Proto.MontageClient.MontageGet, + Network.Riak.MontageClient.Proto.MontageClient.MontageGetMany, + Network.Riak.MontageClient.Proto.MontageClient.MontageGetReference, + Network.Riak.MontageClient.Proto.MontageClient.MontageGetResponse, + Network.Riak.MontageClient.Proto.MontageClient.MontageGetStatus, + Network.Riak.MontageClient.Proto.MontageClient.MontageObject, + Network.Riak.MontageClient.Proto.MontageClient.MontagePut, + Network.Riak.MontageClient.Proto.MontageClient.MontagePutMany, + Network.Riak.MontageClient.Proto.MontageClient.MontagePutManyResponse, + Network.Riak.MontageClient.Proto.MontageClient.MontagePutResponse, + Network.Riak.MontageClient.Proto.MontageClient.MontageSubrequestSpec, + Network.Riak.MontageClient.Proto.MontageClient.MontageWireMessages + + -- Packages needed in order to build this package. + Build-depends: base >= 4 && < 5, + mtl >= 2.0 && < 2.2, + bytestring>=0.9, + time>=1.2, + old-locale, + containers, + system-uuid>=2, + aeson>=0.3, + text>=0.11, + text-format, + ListLike, + stm>=2.2, + riak-bump>=0.7.3.4, + pool-conduit>=0.1.0.2&&<0.2, + unordered-containers >= 0.2.1 && < 0.3, + zeromq-haskell>=0.8 && < 0.9, + protocol-buffers >= 2.0.11, + protocol-buffers-descriptor >= 2.0.11, + stats-web, + safe + + Extensions: OverloadedStrings,DeriveDataTypeable + Extensions: FlexibleInstances,DoAndIfThenElse,ScopedTypeVariables + Extensions: BangPatterns,GADTs,MultiParamTypeClasses,FunctionalDependencies + Extensions: RankNTypes,FlexibleContexts,OverlappingInstances,TupleSections + + Ghc-Options: -Wall -O2 -threaded -rtsopts -funfolding-use-threshold=16 -fexcess-precision -feager-blackholing diff --git a/montage-client.proto b/montage-client.proto new file mode 100644 --- /dev/null +++ b/montage-client.proto @@ -0,0 +1,104 @@ +enum MontageWireMessages { + MONTAGE_GET = 1; + MONTAGE_GET_REFERENCE = 2; + MONTAGE_GET_RESPONSE = 3; + MONTAGE_COMMAND = 4; + MONTAGE_COMMAND_RESPONSE = 5; + MONTAGE_PUT = 6; + MONTAGE_PUT_RESPONSE = 7; + MONTAGE_GET_MANY = 8; + DEPRICATED_MONTAGE_SET_REFERENCE = 9; + MONTAGE_PUT_MANY = 10; + MONTAGE_PUT_MANY_RESPONSE = 11; + MONTAGE_ERROR = 12; + MONTAGE_DELETE = 13; + MONTAGE_DELETE_RESPONSE = 14; +} + +message MontageSubrequestSpec { + required bytes sub_spec = 1; + optional bytes params = 2; +} + +message MontageGet { + required bytes bucket = 1; + required bytes key = 2; + optional MontageSubrequestSpec sub = 3; +} + +message MontageGetMany { + /* note: will not execute subrequests! + master document will be None on + MontageGetResponse */ + repeated MontageGet gets = 1; +} + +message MontageGetReference { + required bytes bucket = 1; + required bytes key = 2; + repeated bytes target_buckets = 3; +} + +enum MontageGetStatus { + EXISTS = 1; + MISSING = 2; + ERROR = 3; +} + +message MontageObject { + optional bytes vclock = 1; + required bytes bucket = 2; + required bytes key = 3; + required bytes data = 4; + optional uint32 fetch_resolutions = 5; // informative +} + +message MontageGetResponse { + repeated MontageGetStatus status = 1; + optional MontageObject master = 2; // optional b/c missing + repeated MontageObject subs = 3; +} + +message MontageCommand { + required string command = 1; + optional bytes argument = 2; +} + +message MontageCommandResponse { + required string status = 1; + optional bytes value = 2; +} + +message MontagePut { + required MontageObject object = 1; +} + +message MontagePutResponse { + required bool modified = 1; + required MontageObject object = 2; /* with siblings set */ +} + +message MontagePutMany { + repeated MontageObject objects = 1; +} + +message MontagePutManyResponse { + repeated MontagePutResponse objects = 1; +} + +message MontageDelete { + required bytes bucket = 1; + required bytes key = 2; +} + +message MontageDeleteResponse {} + +message MontageError { + required string error = 1; +} + +message MontageEnvelope { + required MontageWireMessages mtype = 1; + required bytes msg = 2; + optional bytes msgid = 3; +}