packages feed

montage-client (empty) → 0.1

raw patch · 35 files changed

+2117/−0 lines, 35 filesdep +ListLikedep +aesondep +basesetup-changed

Dependencies added: ListLike, aeson, base, bytestring, containers, mtl, old-locale, pool-conduit, protocol-buffers, protocol-buffers-descriptor, riak-bump, safe, stats-web, stm, system-uuid, text, text-format, time, unordered-containers, zeromq-haskell

Files

+ LICENSE view
+ Network/Riak/MontageClient.hs view
@@ -0,0 +1,19 @@+-- |+-- Module:      Network.Riak.MontageClient+-- Maintainer:  Erin Dahlgren <edahlgren@bu.mp>+-- 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
+ Network/Riak/MontageClient/MontageClient.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module:      Network.Riak.MontageClient.MontageClient+-- Maintainer:  Erin Dahlgren <edahlgren@bu.mp>+-- 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 <https://github.com/bumptech/montage/blob/master/examples>) 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 []
+ Network/Riak/MontageClient/Proto/MontageClient/MontageCommand.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageCommandResponse.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageDelete.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageDeleteResponse.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageEnvelope.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageError.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageGet.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageGetMany.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageGetReference.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageGetResponse.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageGetStatus.hs view
@@ -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")]
+ Network/Riak/MontageClient/Proto/MontageClient/MontageObject.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontagePut.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontagePutMany.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontagePutManyResponse.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontagePutResponse.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageSubrequestSpec.hs view
@@ -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}"
+ Network/Riak/MontageClient/Proto/MontageClient/MontageWireMessages.hs view
@@ -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")]
+ README.rst view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Delete.hs view
@@ -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"
+ examples/Many.hs view
@@ -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"
+ examples/Proto/User.hs view
@@ -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")
+ examples/Proto/User/UserEvent.hs view
@@ -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}"
+ examples/Proto/User/UserInfo.hs view
@@ -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}"
+ examples/Proto/User/UserName.hs view
@@ -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}"
+ examples/Proto/user.proto view
@@ -0,0 +1,11 @@+message UserInfo {+  required uint32 uid = 1;+}++message UserEvent {+  required uint32 eid = 1;+}++message UserName {+  required bytes name = 1;+}
+ examples/Reference.hs view
@@ -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"
+ examples/Resolution.hs view
@@ -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"
+ examples/Utils.hs view
@@ -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 }+
+ montage-client.cabal view
@@ -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
+ montage-client.proto view
@@ -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;+}