packages feed

riak (empty) → 0.1.0.0

raw patch · 50 files changed

+4148/−0 lines, 50 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, binary, bytestring, containers, network, protocol-buffers, protocol-buffers-descriptor, pureMD5, random

Files

+ LICENSE view
@@ -0,0 +1,178 @@++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS+
+ README.markdown view
@@ -0,0 +1,31 @@+# Welcome to riak-haskell-client++This library is a fast Haskell client for the+[Riak](http://www.basho.com/Riak.html) decentralized data store.++It uses Riak's [protobuf API](http://wiki.basho.com/PBC-API.html) for+optimal performance.++# Join in!++We are happy to receive bug reports, fixes, documentation enhancements,+and other improvements.++Please report bugs via the+[github issue tracker](http://github.com/mailrank/riak-haskell-client/issues).++Master [git repository](http://github.com/mailrank/riak-haskell-client):++* `git clone git://github.com/mailrank/riak-haskell-client.git`++There's also a [Mercurial mirror](http://bitbucket.org/bos/riak-haskell-client):++* `hg clone http://bitbucket.org/bos/riak-haskell-client`++(You can create and contribute changes using either git or Mercurial.)++Authors+-------++This library is written and maintained by Bryan O'Sullivan,+<bos@mailrank.com>.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ proto.sh view
@@ -0,0 +1,40 @@+#!/bin/bash++root="$(hg root)"++if [[ -z "$root" ]]; then+    echo "error: don't know where we are!" 1>&2+    exit 1+fi++cd "$root"++hprotoc="$(which hprotoc)"++if [[ -z "$hprotoc" ]]; then+    echo "error: can't continue without hprotoc" 1>&2+    echo "to fix:" 1>&2+    echo 1>&2+    echo "cabal install hprotoc" 1>&2+    exit 1+fi++sed -e 's/Rpb//g' -e 's/Req\>/Request/g' -e 's/Resp\>/Response/g' \+    -e 's/MapRedR/MapReduceR/g' -e 's/DelR/DeleteR/' -e 's/ClientId/ClientID/' \+    -e 's/GetServerInfoResponse/ServerInfo/g' \+    -e 's/MapReduceResponse/MapReduce/g' \+    src/riakclient.proto src/riakextra.proto > src/Protocol.proto++(cd src && hprotoc -p Network.Riak Protocol.proto)+for i in $(find src/Network/Riak/Protocol -name '*.hs';+           echo src/Network/Riak/Protocol.hs); do+    cp /dev/null $i.$$+    echo '{-# LANGUAGE DeriveDataTypeable #-}' >> $i.$$+    echo '{-# LANGUAGE FlexibleInstances #-}' >> $i.$$+    echo '{-# LANGUAGE MultiParamTypeClasses #-}' >> $i.$$+    echo '{-# OPTIONS_GHC -fno-warn-unused-imports #-}' >> $i.$$+    cat $i >> $i.$$+    mv $i.$$ $i+done++rm src/Protocol.proto
+ riak.cabal view
@@ -0,0 +1,131 @@+name:                riak+version:             0.1.0.0+synopsis:            A Haskell client for the Riak decentralized data store+description:+  A Haskell client library for the Riak decentralized data+  store, designed for efficiency, ease of use, and flexibility.  Uses+  the Riak protocol buffers API for speed.+  .+  This library is organized to allow a tradeoff between power+  and ease of use.  If you would like a different degree of+  automation with storage and conflict resolution, you may want to+  use one of the following modules (ranked from easiest to most+  tricky to use):+  .+  [Network.Riak] JSON for storage, automatic conflict resolution.+  This is the easiest module to work with.+  .+  [Network.Riak.JSON] JSON for storage, manual conflict resolution.+  .+  [Network.Riak.Value.Monoid] More complex (but still automatic)+  storage, automatic conflict resolution.+  .+  [Network.Riak.Value] More complex (but still automatic) storage,+  manual conflict resolution.+  .+  [Network.Riak.Basic] manual storage, manual conflict resolution.+  This is the most demanding module to work with, as you must encode+  and decode data yourself, and handle all conflict resolution+  yourself.++homepage:            http://github.com/mailrank/riak-haskell-client+license:             OtherLicense+license-file:        LICENSE+author:              Bryan O'Sullivan <bos@mailrank.com>+maintainer:          Bryan O'Sullivan <bos@mailrank.com>+copyright:           Copyright 2011 MailRank, Inc.+                     Portions copyright 2007-2010 Basho Technologies, Inc.+category:            Network+build-type:          Simple+extra-source-files:+  README.markdown+  proto.sh+  src/riakclient.proto+  src/riakextra.proto++cabal-version:       >=1.8++flag debug+  description: allow debug logging+  default: True++flag developer+  description: operate in developer mode+  default: False++library+  hs-source-dirs: src++  exposed-modules:     +    Network.Riak+    Network.Riak.Connection+    Network.Riak.Content+    Network.Riak.Debug+    Network.Riak.Request+    Network.Riak.Response+    Network.Riak.Basic+    Network.Riak.Types+    Network.Riak.JSON+    Network.Riak.JSON.Monoid+    Network.Riak.Value+    Network.Riak.Value.Monoid+    Network.Riak.Protocol.ServerInfo+    Network.Riak.Protocol.BucketProps+    Network.Riak.Protocol.DeleteRequest+    Network.Riak.Protocol.ErrorResponse+    Network.Riak.Protocol.GetBucketRequest+    Network.Riak.Protocol.GetBucketResponse+    Network.Riak.Protocol.GetClientIDResponse+    Network.Riak.Protocol.GetRequest+    Network.Riak.Protocol.GetResponse+    Network.Riak.Protocol.ListBucketsResponse+    Network.Riak.Protocol.ListKeysRequest+    Network.Riak.Protocol.ListKeysResponse+    Network.Riak.Protocol.MapReduceRequest+    Network.Riak.Protocol.MapReduce+    Network.Riak.Protocol.Pair+    Network.Riak.Protocol.PutRequest+    Network.Riak.Protocol.PutResponse+    Network.Riak.Protocol.SetBucketRequest+    Network.Riak.Protocol.SetClientIDRequest+    Network.Riak.Protocol.PingRequest+    Network.Riak.Protocol.GetClientIDRequest+    Network.Riak.Protocol.GetServerInfoRequest+    Network.Riak.Protocol.ListBucketsRequest++  other-modules:       +    Network.Riak.Monoid+    Network.Riak.Protocol.Link+    Network.Riak.Connection.Internal+    Network.Riak.Connection.NoPush+    Network.Riak.Protocol.Content+    Network.Riak.Tag+    Network.Riak.Types.Internal+    Network.Riak.Protocol+  +  build-depends:       +    aeson,+    attoparsec >= 0.8.4.0,+    base == 4.*,+    binary,+    bytestring,+    containers,+    network >= 2.3,+    protocol-buffers >= 1.8.0,+    protocol-buffers-descriptor >= 1.8.1,+    pureMD5,+    random++  if flag(debug)+    cpp-options: -DASSERTS -DDEBUG++  if flag(developer)+    ghc-options: -Werror+    ghc-prof-options: -auto-all+    cpp-options: -DASSERTS -DDEBUG++  ghc-options: -Wall -fno-warn-orphans++source-repository head+  type:     git+  location: http://github.com/mailrank/riak-haskell-client
+ src/Network/Riak.hs view
@@ -0,0 +1,70 @@+-- |+-- Module:      Network.Riak+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- A client for the Riak decentralized data store.+--+-- The functions in this module use JSON as the storage+-- representation, and automatically perform conflict resolution+-- during storage and retrieval.+--+-- This library is organized to allow a tradeoff between power+-- and ease of use.  If you would like a different degree of+-- automation with storage and conflict resolution, you may want to+-- use one of the following modules (ranked from easiest to most+-- tricky to use):+--+-- [Network.Riak.JSON.Monoid] JSON for storage, automatic conflict+-- resolution.  (This module actually re-exports its definitions.)+-- This is the easiest module to work with.+--+-- [Network.Riak.JSON] JSON for storage, manual conflict resolution.+--+-- [Network.Riak.Value.Monoid] More complex (but still automatic)+-- storage, automatic conflict resolution.+--+-- [Network.Riak.Value] More complex (but still automatic) storage,+-- manual conflict resolution.+--+-- [Network.Riak.Basic] manual storage, manual conflict resolution.+-- This is the most demanding module to work with, as you must encode+-- and decode data yourself, and handle all conflict resolution+-- yourself.++module Network.Riak+    (+    -- * Client configuration and identification+      ClientID+    , Client(..)+    , defaultClient+    , getClientID+    -- * Connection management+    , Connection(..)+    , connect+    , disconnect+    , ping+    , getServerInfo+    -- * Data management+    , Quorum(..)+    , get+    , getMany+    , put+    , putMany+    , delete+    -- * Metadata+    , listBuckets+    , foldKeys+    , getBucket+    , setBucket+    -- * Map/reduce+    , mapReduce+    ) where++import Network.Riak.Connection+import Network.Riak.Types+import Network.Riak.Basic hiding (get, put, put_)+import Network.Riak.JSON.Monoid (get, getMany, put, putMany)
+ src/Network/Riak/Basic.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}++-- |+-- Module:      Network.Riak.Basic+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Basic support for the Riak decentralized data store.+--+-- When storing and retrieving data, the functions in this module do+-- not perform any encoding or decoding of data, nor do they resolve+-- conflicts.++module Network.Riak.Basic+    (+    -- * Client configuration and identification+      ClientID+    , Client(..)+    , defaultClient+    -- * Connection management+    , Connection(..)+    , connect+    , disconnect+    , ping+    , getClientID+    , setClientID+    , getServerInfo+    -- * Data management+    , Quorum(..)+    , get+    , put+    , put_+    , delete+    -- * Metadata+    , listBuckets+    , foldKeys+    , getBucket+    , setBucket+    -- * Map/reduce+    , mapReduce+    ) where++import Control.Applicative ((<$>))+import Network.Riak.Connection.Internal+import Network.Riak.Protocol.BucketProps+import Network.Riak.Protocol.Content+import Network.Riak.Protocol.ListKeysResponse+import Network.Riak.Protocol.MapReduce+import Network.Riak.Protocol.ServerInfo+import Network.Riak.Types.Internal hiding (MessageTag(..))+import qualified Data.Foldable as F+import qualified Data.Sequence as Seq+import qualified Network.Riak.Request as Req+import qualified Network.Riak.Response as Resp+import qualified Network.Riak.Types.Internal as T++-- | Check to see if the connection to the server is alive.+ping :: Connection -> IO ()+ping conn = exchange_ conn Req.ping++-- | Find out from the server what client ID this connection is using.+getClientID :: Connection -> IO ClientID+getClientID conn = Resp.getClientID <$> exchange conn Req.getClientID++-- | Retrieve information about the server.+getServerInfo :: Connection -> IO ServerInfo+getServerInfo conn = exchange conn Req.getServerInfo++-- | Retrieve up a value.  This may return multiple conflicting+-- siblings.  Choosing among them is your responsibility.+get :: Connection -> T.Bucket -> T.Key -> R+    -> IO (Maybe (Seq.Seq Content, VClock))+get conn bucket key r = Resp.get <$> exchangeMaybe conn (Req.get bucket key r)++-- | Store a single value.  This may return multiple conflicting+-- siblings.  Choosing among them, and storing a new value, is your+-- responsibility.+put :: Connection -> T.Bucket -> T.Key -> Maybe T.VClock+    -> Content -> W -> DW+    -> IO (Seq.Seq Content, VClock)+put conn bucket key mvclock cont w dw =+  Resp.put <$> exchange conn (Req.put bucket key mvclock cont w dw True)++-- | Store a single value, without the possibility of conflict+-- resolution.+put_ :: Connection -> T.Bucket -> T.Key -> Maybe T.VClock+     -> Content -> W -> DW+     -> IO ()+put_ conn bucket key mvclock cont w dw =+  exchange_ conn (Req.put bucket key mvclock cont w dw False)++-- | Delete a value.+delete :: Connection -> T.Bucket -> T.Key -> RW -> IO ()+delete conn bucket key rw = exchange_ conn $ Req.delete bucket key rw++-- List the buckets in the cluster.+--+-- /Note/: this operation is expensive.  Do not use it in production.+listBuckets :: Connection -> IO (Seq.Seq T.Bucket)+listBuckets conn = Resp.listBuckets <$> exchange conn Req.listBuckets++-- Fold over the buckets in the cluster.+--+-- /Note/: this operation is expensive.  Do not use it in production.+foldKeys :: Connection -> T.Bucket -> (a -> Key -> IO a) -> a -> IO a+foldKeys conn bucket f z0 = do+  sendRequest conn $ Req.listKeys bucket+  let loop z = do+        ListKeysResponse{..} <- recvResponse conn+        z1 <- F.foldlM f z keys+        if maybe False id done+          then return z1+          else loop z1+  loop z0++-- | Retrieve the properties of a bucket.+getBucket :: Connection -> T.Bucket -> IO BucketProps+getBucket conn bucket = Resp.getBucket <$> exchange conn (Req.getBucket bucket)++-- | Store new properties for a bucket.+setBucket :: Connection -> T.Bucket -> BucketProps -> IO ()+setBucket conn bucket props = exchange_ conn $ Req.setBucket bucket props++-- | Launch a 'MapReduce' job.+mapReduce :: Connection -> Job -> IO MapReduce+mapReduce conn = exchange conn . Req.mapReduce
+ src/Network/Riak/Connection.hs view
@@ -0,0 +1,30 @@+-- |+-- Module:      Network.Riak.Connection+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Low-level network connection management.++module Network.Riak.Connection+    (+    -- * Connection management+      connect+    , disconnect+    -- * Client configuration+    , defaultClient+    , makeClientID+    -- * Requests and responses+    -- ** Sending and receiving+    , exchange+    , exchangeMaybe+    , exchange_+    -- ** Pipelining many requests+    , pipeline+    , pipelineMaybe+    , pipeline_+    ) where++import Network.Riak.Connection.Internal
+ src/Network/Riak/Connection/Internal.hs view
@@ -0,0 +1,339 @@+{-# LANGUAGE CPP, OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}++-- |+-- Module:      Network.Riak.Connection.Internal+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Low-level network connection management.++module Network.Riak.Connection.Internal+    (+    -- * Connection management+      Network.Riak.Connection.Internal.connect+    , disconnect+    , setClientID+    -- * Client configuration+    , defaultClient+    , makeClientID+    -- * Requests and responses+    -- ** Sending and receiving requests and responses+    , exchange+    , exchangeMaybe+    , exchange_+    -- ** Pipelining many requests+    , pipeline+    , pipelineMaybe+    , pipeline_+    -- * Low-level protocol operations+    -- ** Sending and receiving+    , sendRequest+    , recvResponse+    , recvMaybeResponse+    , recvResponse_+    ) where++import Control.Concurrent+import Control.Exception (Exception, IOException, throw)+import Control.Monad (forM_, replicateM, replicateM_, unless)+import Data.Binary.Put (Put, putWord32be, runPut)+import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)+import Data.Int (Int64)+import Network.Riak.Connection.NoPush (setNoPush)+import Network.Riak.Debug as Debug+import Network.Riak.Protocol.ErrorResponse+import Network.Riak.Protocol.SetClientIDRequest+import Network.Riak.Tag (getTag, putTag)+import Network.Riak.Types.Internal hiding (MessageTag(..))+import Network.Socket as Socket+import Numeric (showHex)+import System.Random (randomIO)+import Text.ProtocolBuffers (messageGetM, messagePutM, messageSize)+import Text.ProtocolBuffers.Get (Get, Result(..), getWord32be, runGet)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Network.Riak.Types.Internal as T+import qualified Network.Socket.ByteString as B+import qualified Network.Socket.ByteString.Lazy as L++-- | Default client configuration.  Talks to localhost, port 8087,+-- with a randomly chosen client ID.+defaultClient :: Client+defaultClient = Client {+                  host = "127.0.0.1"+                , port = "8087"+                , clientID = L.empty+                }++-- | Tell the server our client ID.+setClientID :: Connection -> ClientID -> IO ()+setClientID conn i = do+  sendRequest conn $ SetClientIDRequest i+  recvResponse_ conn T.SetClientIDResponse++-- | Generate a random client ID.+makeClientID :: IO ClientID+makeClientID = do+  r <- randomIO :: IO Int+  return . L.append "hs_" . L.pack . showHex (abs r) $ ""++-- | Add a random 'ClientID' to a 'Client' if the 'Client' doesn't+-- already have one.+addClientID :: Client -> IO Client+addClientID client+  | L.null (clientID client) = do+    i <- makeClientID+    return client { clientID = i }+  | otherwise = return client++-- | Connect to a server.+connect :: Client -> IO Connection+connect cli0 = do+  client@Client{..} <- addClientID cli0+  let hints = defaultHints {+                addrFlags = [AI_ADDRCONFIG]+              , addrSocketType = Stream+              }+  debug "connect" $ "server " ++ host ++ ":" ++ port ++ ", client ID " +++                    L.unpack clientID+  ais <- getAddrInfo (Just hints) (Just host) (Just port)+  let ai = case ais of+             (a:_) -> a+             _     -> moduleError "connect" $+                      "could not look up server " ++ host ++ ":" ++ port+  onIOException "connect" $ do+    sock <- socket (addrFamily ai) (addrSocketType ai) (addrProtocol ai)+    Socket.connect sock (addrAddress ai)+    buf <- newIORef L.empty+    let conn = Connection sock client buf+    setClientID conn clientID+    return conn++-- | Disconnect from a server.+disconnect :: Connection -> IO ()+disconnect Connection{..} = onIOException "disconnect" $ do+  debug "disconnect" $ "server " ++ host connClient ++ ":" ++ port connClient +++                       ", client ID " ++ L.unpack (clientID connClient)+  sClose connSock+  writeIORef connBuffer L.empty++recvWith :: (L.ByteString -> IO L.ByteString) -> Connection -> Int64+         -> IO L.ByteString+recvWith onError Connection{..} n0+    | n0 <= 0 = return L.empty+    | otherwise = do+  bs <- readIORef connBuffer+  let (h,t) = L.splitAt n0 bs+      len = L.length h+  if len == n0+    then writeIORef connBuffer t >> return h+    else if len == 0+         then go [] n0+         else go (reverse (L.toChunks t)) (n0-len)+  where+    maxInt = fromIntegral (maxBound :: Int)+    go acc n+        | n <= 0 = return (L.fromChunks (reverse acc))+        | otherwise = do+      let n' = min n maxInt+      bs <- B.recv connSock (fromIntegral n')+      let len = B.length bs+      if len == 0+        then onError (L.fromChunks (reverse acc))+        else go (bs:acc) (n' - fromIntegral len)++recvExactly :: Connection -> Int64 -> IO L.ByteString+recvExactly = recvWith $ \_ ->+              moduleError "recvExactly" "short read from network"++recvGet :: Connection -> Get a -> IO a+recvGet Connection{..} get = do+  let refill = do+        bs <- L.recv connSock 16384+        if L.null bs+          then shutdown connSock ShutdownReceive >> return Nothing+          else return (Just bs)+      step (Failed _ err)    = moduleError "recvGet" err+      step (Finished bs _ r) = writeIORef connBuffer bs >> return r+      step (Partial k)       = (step . k) =<< refill+  mbs <- do+    buf <- readIORef connBuffer+    if L.null buf+      then refill+      else return (Just buf)+  case mbs of+    Just bs -> step $ runGet get bs+    Nothing -> moduleError "recvGet" "socket closed"+  +recvGetN :: Connection -> Int64 -> Get a -> IO a+recvGetN conn n get = do+  bs <- recvExactly conn n+  let finish bs' r = do+        unless (L.null bs') $ modifyIORef (connBuffer conn) (`L.append` bs')+        return r+  case runGet get bs of+    Finished bs' _ r -> finish bs' r+    Partial k    -> case k Nothing of+                      Finished bs' _ r -> finish bs' r+                      Failed _ err -> moduleError "recvGetN" err+                      Partial _    -> moduleError "recvGetN"+                                      "parser wants more input!?"+    Failed _ err -> moduleError "recvGetN" err++putRequest :: (Request req) => req -> Put+putRequest req = do+  putWord32be (fromIntegral (1 + messageSize req))+  putTag (messageTag req)+  messagePutM req++instance Exception ErrorResponse++throwError :: ErrorResponse -> a+throwError = throw++getResponse :: (Response a) => T.MessageTag -> Get a+getResponse expected = do+  tag <- getTag+  case undefined of+   _| tag == expected        -> messageGetM+    | tag == T.ErrorResponse -> throwError `fmap` messageGetM+    | otherwise ->+        moduleError "getResponse" $ "received unexpected response: expected " +++                                    show expected ++ ", received " ++ show tag++-- | Send a request to the server, and receive its response.+exchange :: Exchange req resp => Connection -> req -> IO resp+exchange conn@Connection{..} req = do+  debug "exchange" $ ">>> " ++ showM req+  onIOException ("exchange " ++ show (messageTag req)) $ do+    sendRequest conn req+    recvResponse conn++-- | Send a request to the server, and receive its response (which may+-- be empty).+exchangeMaybe :: Exchange req resp => Connection -> req -> IO (Maybe resp)+exchangeMaybe conn@Connection{..} req = do+  debug "exchangeMaybe" $ ">>> " ++ showM req+  onIOException ("exchangeMaybe " ++ show (messageTag req)) $ do+    sendRequest conn req+    recvMaybeResponse conn++-- | Send a request to the server, and receive its response, but do+-- not decode it.+exchange_ :: Request req => Connection -> req -> IO ()+exchange_ conn req = do+  debug "exchange_" $ ">>> " ++ showM req+  onIOException ("exchange_ " ++ show (messageTag req)) $ do+    sendRequest conn req+    recvResponse_ conn (expectedResponse req)++sendAll :: Socket -> L.ByteString -> IO ()+sendAll sock bs = do+  setNoPush sock True+  L.sendAll sock bs+  setNoPush sock False++sendRequest :: (Request req) => Connection -> req -> IO ()+sendRequest Connection{..} = sendAll connSock . runPut . putRequest++recvResponse :: (Response a) => Connection -> IO a+recvResponse conn = debugRecv showM $ go undefined where+  go :: Response b => b -> IO b+  go dummy = do+    len <- fromIntegral `fmap` recvGet conn getWord32be+    recvGetN conn len (getResponse (messageTag dummy))++recvResponse_ :: Connection -> T.MessageTag -> IO ()+recvResponse_ conn expected = debugRecv show $ do+  len <- fromIntegral `fmap` recvGet conn getWord32be+  recvCorrectTag "recvResponse_" conn expected (len-1) ()++recvMaybeResponse :: (Response a) => Connection -> IO (Maybe a)+recvMaybeResponse conn = debugRecv (maybe "Nothing" (("Just " ++) . showM)) $+                         go undefined where+  go :: Response b => b -> IO (Maybe b)+  go dummy = do+    len <- fromIntegral `fmap` recvGet conn getWord32be+    let tag = messageTag dummy+    if len == 1+      then recvCorrectTag "recvMaybeResponse" conn tag 1 Nothing+      else Just `fmap` recvGetN conn len (getResponse tag)++recvCorrectTag :: String -> Connection -> T.MessageTag -> Int64 -> a -> IO a+recvCorrectTag func conn expected len v = do+  tag <- recvGet conn getTag+  case undefined of+   _| tag == expected -> recvExactly conn (len-1) >> return v+    | tag == T.ErrorResponse -> throwError `fmap` recvGetN conn len messageGetM+    | otherwise -> moduleError func $+                   "received unexpected response: expected " +++                   show expected ++ ", received " ++ show tag++debugRecv :: (a -> String) -> IO a -> IO a+#ifdef DEBUG+debugRecv f act = do+  r <- act+  debug "recv" $ "<<< " ++ f r+  return r+#else+debugRecv _ act = act+{-# INLINE debugRecv #-}+#endif++pipe :: (Request req, Show resp) =>+        (Connection -> IO resp) -> Connection -> [req] -> IO [resp]+pipe receive conn@Connection{..} reqs = do+  ch <- newChan+  let numReqs = length reqs+  _ <- forkIO . replicateM_ numReqs $ writeChan ch =<< receive conn+  let tag = show (messageTag (head reqs))+  if Debug.level > 1+    then forM_ reqs $ \req -> debug "pipe" $ ">>> " ++ showM req+    else debug "pipe" $ ">>> " ++ show numReqs ++ "x " ++ tag+  onIOException ("pipe " ++ tag) .+    sendAll connSock . runPut . mapM_ putRequest $ reqs+  replicateM numReqs $ readChan ch++-- | Send a series of requests to the server, back to back, and+-- receive a response for each request sent.  The sending and+-- receiving will be overlapped if possible, to improve concurrency+-- and reduce latency.+pipeline :: (Exchange req resp) => Connection -> [req] -> IO [resp]+pipeline = pipe recvResponse++-- | Send a series of requests to the server, back to back, and+-- receive a response for each request sent (the responses may be+-- empty).  The sending and receiving will be overlapped if possible,+-- to improve concurrency and reduce latency.+pipelineMaybe :: (Exchange req resp) => Connection -> [req] -> IO [Maybe resp]+pipelineMaybe = pipe recvMaybeResponse++-- | Send a series of requests to the server, back to back, and+-- receive (but do not decode) a response for each request sent.  The+-- sending and receiving will be overlapped if possible, to improve+-- concurrency and reduce latency.+pipeline_ :: (Request req) => Connection -> [req] -> IO ()+pipeline_ conn@Connection{..} reqs = do+  done <- newEmptyMVar+  _ <- forkIO $ do+         forM_ reqs (recvResponse_ conn . expectedResponse)+         putMVar done ()+  if Debug.level > 1+    then forM_ reqs $ \req -> debug "pipe" $ ">>> " ++ showM req+    else debug "pipe" $ ">>> " ++ show (length reqs) ++ "x " +++                        show (messageTag (head reqs))+  sendAll connSock . runPut . mapM_ putRequest $ reqs+  takeMVar done++onIOException :: String -> IO a -> IO a+onIOException func act =+    act `catch` \(e::IOException) -> do+      let s = show e+      debug func $ "caught IO exception: " ++ s+      moduleError func s++moduleError :: String -> String -> a+moduleError = netError "Network.Riak.Connection.Internal"
+ src/Network/Riak/Connection/NoPush.hsc view
@@ -0,0 +1,44 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Module:      Network.Riak.Connection.NoPush+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- TCP madness.++module Network.Riak.Connection.NoPush (setNoPush) where++#include <sys/socket.h>+#include <netinet/tcp.h>+#include <netinet/in.h>++import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.Types (CInt)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr)+import Foreign.Storable (sizeOf)+import Network.Socket (Socket(..))++noPush :: CInt+#if defined(TCP_NOPUSH)+noPush = #const TCP_NOPUSH+#elif defined(TCP_CORK)+noPush = #const TCP_CORK+#else+noPush = 0+#endif++setNoPush :: Socket -> Bool -> IO ()+setNoPush _ _ | noPush == 0 = return ()+setNoPush (MkSocket fd _ _ _ _) onOff = do+  let v = if onOff then 1 else 0+  with v $ \ptr ->+    throwErrnoIfMinus1_ "setNoPush" $+      c_setsockopt fd (#const IPPROTO_TCP) noPush ptr (fromIntegral (sizeOf v))++foreign import ccall unsafe "setsockopt"+  c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
+ src/Network/Riak/Content.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module:      Network.Riak.Content+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Low-level content and link types and functions.++module Network.Riak.Content+    (+    -- * Types+      Content(..)+    , Link.Link(..)+    -- * Functions+    , empty+    , binary+    , json+    , link+    ) where++import Data.Aeson.Encode (encode)+import Data.Aeson.Types (ToJSON)+import Network.Riak.Protocol.Content (Content(..))+import Network.Riak.Types.Internal (Bucket, Key, Tag)+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.Sequence as Seq+import qualified Network.Riak.Protocol.Link as Link++-- | Create a link.+link :: Bucket -> Key -> Tag -> Link.Link+link bucket key tag = Link.Link (Just bucket) (Just key) (Just tag)+{-# INLINE link #-}++-- | An empty piece of content.+empty :: Content+empty = Content { value = L.empty+                , content_type = Nothing+                , charset = Nothing+                , content_encoding = Nothing+                , vtag = Nothing+                , links = Seq.empty+                , last_mod = Nothing+                , last_mod_usecs = Nothing+                , usermeta = Seq.empty+                }++-- | Content encoded as @application/octet-stream@.+binary :: L.ByteString -> Content+binary bs = empty { value = bs+                  , content_type = Just "application/octet-stream"+                  }++-- | Content encoded as @application/json@.+json :: ToJSON a => a -> Content+json j = empty { value = encode j+               , content_type = Just "application/json"+               }
+ src/Network/Riak/Debug.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP, ScopedTypeVariables #-}++-- |+-- Module:      Network.Riak.Debug+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Support for debug logging.  The code in this package only works if+-- the package was built with the @-fdebug@ flag.  Otherwise, they are+-- all no-ops.++module Network.Riak.Debug+    (+      level+    , debug+    , setHandle+    , showM+    ) where++import Control.Exception hiding (handle)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Network.Riak.Types.Internal+import System.Environment (getEnv)+import System.IO (Handle, hPutStrLn, stderr)+import System.IO.Unsafe (unsafePerformIO)++-- | The current debugging level.  This is established once by reading+-- the @RIAK_DEBUG@ environment variable.+level :: Int+#ifdef DEBUG+level = unsafePerformIO $ do+          es <- try $ getEnv "RIAK_DEBUG"+          case es of+            Left (_::SomeException)   -> return 0+            Right "on" -> return 1+            Right s    -> case reads s of+                            ((n,_):_) -> return n+                            _         -> return 1+{-# NOINLINE level #-}+#else+level = 0+{-# INLINE level #-}+#endif++#ifdef DEBUG+handle :: IORef Handle+handle = unsafePerformIO $ newIORef stderr+{-# NOINLINE handle #-}+#endif++-- | Set the 'Handle' to log to ('stderr' is the default).+setHandle :: Handle -> IO ()+#ifdef DEBUG+setHandle = writeIORef handle+#else+setHandle _ = return ()+{-# INLINE setHandle #-}+#endif++debug :: String -> String -> IO ()+#ifdef DEBUG+debug func str+    | level == 0 = return ()+    | otherwise  = do+  h <- readIORef handle+  hPutStrLn h $ str ++ " [" ++ func ++ "]"+#else+debug _ _ = return ()+{-# INLINE debug #-}+#endif++-- | Show a 'Tagged' value.  Show the entire value if the debug level+-- is above 1, just the tag otherwise.+showM :: (Show a, Tagged a) => a -> String+showM m | level > 1 = show m+        | otherwise = show (messageTag m)
+ src/Network/Riak/JSON.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}++-- |+-- Module:      Network.Riak.JSON+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- This module allows storage and retrieval of JSON-encoded data.+--+-- The functions in this module do not perform any conflict resolution.++module Network.Riak.JSON+    (+      JSON+    , json+    , plain+    , get+    , getMany+    , put+    , put_+    , putMany+    , putMany_+    ) where++import Control.Applicative ((<$>))+import Control.Arrow (first)+import Data.Monoid (Monoid)+import Data.Typeable (Typeable)+import Network.Riak.Types.Internal+import Data.Aeson.Types (FromJSON(..), ToJSON(..))+import qualified Network.Riak.Value as V++newtype JSON a = J {+      plain :: a -- ^ Unwrap a 'JSON'-wrapped value.+    } deriving (Eq, Ord, Show, Read, Bounded, Typeable, Monoid)++-- | Wrap up a value so that it will be encoded and decoded as JSON+-- when converted to/from 'Content'.+json :: (FromJSON a, ToJSON a) => a -> JSON a+json = J+{-# INLINE json #-}++instance Functor JSON where+    fmap f (J a) = J (f a)+    {-# INLINE fmap #-}++instance (FromJSON a, ToJSON a) => V.IsContent (JSON a) where+    fromContent c = J `fmap` (V.fromContent c >>= fromJSON)+    {-# INLINE fromContent #-}++    toContent (J a) = V.toContent (toJSON a)+    {-# INLINE toContent #-}++get :: (FromJSON c, ToJSON c) => Connection -> Bucket -> Key -> R+    -> IO (Maybe ([c], VClock))+get conn bucket key r = fmap convert <$> V.get conn bucket key r++getMany :: (FromJSON c, ToJSON c) => Connection -> Bucket -> [Key] -> R+    -> IO [Maybe ([c], VClock)]+getMany conn bucket ks r = map (fmap convert) <$> V.getMany conn bucket ks r++put :: (FromJSON c, ToJSON c) =>+       Connection -> Bucket -> Key -> Maybe VClock -> c+    -> W -> DW -> IO ([c], VClock)+put conn bucket key mvclock val w dw =+    convert <$> V.put conn bucket key mvclock (json val) w dw++put_ :: (FromJSON c, ToJSON c) =>+       Connection -> Bucket -> Key -> Maybe VClock -> c+    -> W -> DW -> IO ()+put_ conn bucket key mvclock val w dw =+    V.put_ conn bucket key mvclock (json val) w dw++putMany :: (FromJSON c, ToJSON c) =>+       Connection -> Bucket -> [(Key, Maybe VClock, c)]+    -> W -> DW -> IO [([c], VClock)]+putMany conn bucket puts w dw =+    map convert <$> V.putMany conn bucket (map f puts) w dw+  where f (k,v,c) = (k,v,json c)++putMany_ :: (FromJSON c, ToJSON c) =>+            Connection -> Bucket -> [(Key, Maybe VClock, c)]+         -> W -> DW -> IO ()+putMany_ conn bucket puts w dw = V.putMany_ conn bucket (map f puts) w dw+  where f (k,v,c) = (k,v,json c)++convert :: ([JSON a], VClock) -> ([a], VClock)+convert = first (map plain)
+ src/Network/Riak/JSON/Monoid.hs view
@@ -0,0 +1,127 @@+-- |+-- Module:      Network.Riak.JSON.Monoid+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- This module allows storage and retrieval of JSON-encoded data.+--+-- Functions automatically resolve conflicts using 'Monoid' instances.+-- For instance, if a 'get' returns three siblings, a winner will be+-- chosen using 'mconcat'.  If a 'put' results in a conflict, a winner+-- will be chosen using 'mconcat', and the winner will be 'put'; this+-- will be repeated until no conflict occurs.++module Network.Riak.JSON.Monoid+    (+      get+    , getMany+    , put+    , put_+    , putMany+    , putMany_+    ) where++import Data.Aeson.Types (FromJSON(..), ToJSON(..))+import Data.Monoid (Dual(..), First(..), Last(..), Monoid)+import Network.Riak.Types.Internal hiding (MessageTag(..))+import qualified Network.Riak.JSON as J+import qualified Network.Riak.Monoid as M++instance ToJSON a => ToJSON (Dual a) where+    toJSON = toJSON . getDual+    {-# INLINE toJSON #-}++instance FromJSON a => FromJSON (Dual a) where+    fromJSON = fmap Dual . fromJSON+    {-# INLINE fromJSON #-}++instance ToJSON a => ToJSON (First a) where+    toJSON = toJSON . getFirst+    {-# INLINE toJSON #-}++instance FromJSON a => FromJSON (First a) where+    fromJSON = fmap First . fromJSON+    {-# INLINE fromJSON #-}++instance ToJSON a => ToJSON (Last a) where+    toJSON = toJSON . getLast+    {-# INLINE toJSON #-}++instance FromJSON a => FromJSON (Last a) where+    fromJSON = fmap Last . fromJSON+    {-# INLINE fromJSON #-}++-- | Retrieve a single value.  If conflicting values are returned, the+-- 'Monoid' is used to choose a winner.+get :: (FromJSON c, ToJSON c, Monoid c) =>+       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))+get = M.get J.get+{-# INLINE get #-}++-- | Retrieve multiple values.  If conflicting values are returned for+-- a key, the 'Monoid' is used to choose a winner.+getMany :: (FromJSON c, ToJSON c, Monoid c)+           => Connection -> Bucket -> [Key] -> R -> IO [Maybe (c, VClock)]+getMany = M.getMany J.getMany+{-# INLINE getMany #-}++-- | Store a single value, automatically resolving any vector clock+-- conflicts that arise.  A single invocation of this function may+-- involve several roundtrips to the server to resolve conflicts.+--+-- If a conflict arises, a winner will be chosen using 'mconcat', and+-- the winner will be stored; this will be repeated until no conflict+-- occurs.+--+-- The final value to be stored at the end of any conflict resolution+-- is returned.+put :: (FromJSON c, ToJSON c, Monoid c) =>+       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+    -> IO (c, VClock)+put = M.put J.put+{-# INLINE put #-}++-- | Store a single value, automatically resolving any vector clock+-- conflicts that arise.  A single invocation of this function may+-- involve several roundtrips to the server to resolve conflicts.+--+-- If a conflict arises, a winner will be chosen using 'mconcat', and+-- the winner will be stored; this will be repeated until no conflict+-- occurs.+put_ :: (FromJSON c, ToJSON c, Monoid c) =>+       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+    -> IO ()+put_ = M.put_ J.put+{-# INLINE put_ #-}++-- | Store multiple values, resolving any vector clock conflicts that+-- arise.  A single invocation of this function may involve several+-- roundtrips to the server to resolve conflicts.+--+-- If any conflicts arise, a winner will be chosen in each case using+-- 'mconcat', and the winners will be stored; this will be repeated+-- until no conflicts occur.+--+-- For each original value to be stored, the final value that was+-- stored at the end of any conflict resolution is returned.+putMany :: (FromJSON c, ToJSON c, Monoid c) =>+           Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+        -> IO [(c, VClock)]+putMany = M.putMany J.putMany+{-# INLINE putMany #-}++-- | Store multiple values, resolving any vector clock conflicts that+-- arise.  A single invocation of this function may involve several+-- roundtrips to the server to resolve conflicts.+--+-- If any conflicts arise, a winner will be chosen in each case using+-- 'mconcat', and the winners will be stored; this will be repeated+-- until no conflicts occur.+putMany_ :: (FromJSON c, ToJSON c, Monoid c) =>+            Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+         -> IO ()+putMany_ = M.putMany_ J.putMany+{-# INLINE putMany_ #-}
+ src/Network/Riak/Monoid.hs view
@@ -0,0 +1,83 @@+-- |+-- Module:      Network.Riak.Monoid+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Storage and retrieval of monoidal data with automatic conflict resolution.++module Network.Riak.Monoid+    (+      get+    , getMany+    , put+    , put_+    , putMany+    , putMany_+    ) where++import Control.Arrow (first, second)+import Data.Function (on)+import Data.List (partition, sortBy)+import Data.Monoid (Monoid(..))+import Network.Riak.Types.Internal hiding (MessageTag(..))+import qualified Data.IntMap as M++get :: (Monoid c) =>+       (Connection -> Bucket -> Key -> R -> IO (Maybe ([c], VClock)))+       -> (Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock)))+get doGet conn bucket key r =+    fmap (first mconcat) `fmap` doGet conn bucket key r++getMany :: (Monoid c) =>+           (Connection -> Bucket -> [Key] -> R -> IO [Maybe ([c], VClock)])+        -> Connection -> Bucket -> [Key] -> R -> IO [Maybe (c, VClock)]+getMany doGet conn b ks r = map (fmap (first mconcat)) `fmap` doGet conn b ks r++put :: Monoid c => (Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+                               -> IO ([c], VClock))+    -> Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+    -> IO (c, VClock)+put doPut conn bucket key mvclock0 val0 w dw = do+  let go val mvclock1 = do+        (xs, vclock) <- doPut conn bucket key mvclock1 val w dw+        case xs of+          [c] -> return (c, vclock)+          _   -> go (mconcat xs) (Just vclock)+  go val0 mvclock0++put_ :: Monoid c => (Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+                                -> IO ([c], VClock))+     -> Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+     -> IO ()+put_ doPut conn bucket key mvclock0 val0 w dw =+    put doPut conn bucket key mvclock0 val0 w dw >> return ()+{-# INLINE put_ #-}++putMany :: (Monoid c) =>+           (Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+                       -> IO [([c], VClock)])+        -> Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+        -> IO [(c, VClock)]+putMany doPut conn bucket puts0 w dw = go [] . zip [(0::Int)..] $ puts0 where+  go acc [] = return . map snd . sortBy (compare `on` fst) $ acc+  go acc puts = do+    rs <- doPut conn bucket (map snd puts) w dw+    let (conflicts, ok) = partition isConflict $ zip (map fst puts) rs+        isConflict (_,(_:_:_,_)) = True+        isConflict  _            = False+    go (map (second (first mconcat)) ok++acc) (map asPut conflicts)+  asPut (i,(c,v)) = (i,(keys M.! i, Just v, mconcat c))+  keys = M.fromAscList (zip [(0::Int)..] (map fst3 puts0))+  fst3 (a,_,_) = a++putMany_ :: (Monoid c) =>+           (Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+                       -> IO [([c], VClock)])+        -> Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+        -> IO ()+putMany_ doPut conn bucket puts0 w dw =+    putMany doPut conn bucket puts0 w dw >> return ()+{-# INLINE putMany_ #-}
+ src/Network/Riak/Protocol.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol (protoInfo, fileDescriptorProto) where+import Prelude ((+))+import qualified Prelude as P'+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+ = P'.read+    "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".Protocol\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [], baseName = MName \"Protocol\"}, protoFilePath = [\"Network\",\"Riak\",\"Protocol.hs\"], protoSource = \"Protocol.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ErrorResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ErrorResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ErrorResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ErrorResponse.errmsg\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ErrorResponse\"], baseName' = FName \"errmsg\"}, 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 \".Protocol.ErrorResponse.errcode\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ErrorResponse\"], baseName' = FName \"errcode\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetClientIDResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetClientIDResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetClientIDResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetClientIDResponse.client_id\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetClientIDResponse\"], baseName' = FName \"client_id\"}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.SetClientIDRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"SetClientIDRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"SetClientIDRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.SetClientIDRequest.client_id\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"SetClientIDRequest\"], baseName' = FName \"client_id\"}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ServerInfo\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ServerInfo\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ServerInfo.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ServerInfo.node\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ServerInfo\"], baseName' = FName \"node\"}, 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 \".Protocol.ServerInfo.server_version\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ServerInfo\"], baseName' = FName \"server_version\"}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetRequest\"], 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 \".Protocol.GetRequest.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetRequest\"], 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 \".Protocol.GetRequest.r\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetRequest\"], baseName' = FName \"r\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetResponse.content\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetResponse\"], baseName' = FName \"content\"}, 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 \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetResponse.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetResponse\"], baseName' = FName \"vclock\"}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.PutRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"PutRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"PutRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], 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 \".Protocol.PutRequest.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], 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 \".Protocol.PutRequest.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"vclock\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.content\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"content\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.w\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"w\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.dw\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"dw\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 48}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.return_body\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"return_body\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.PutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"PutResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"PutResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutResponse.content\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutResponse\"], baseName' = FName \"content\"}, 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 \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutResponse.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutResponse\"], baseName' = FName \"vclock\"}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.DeleteRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"DeleteRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"DeleteRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.DeleteRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"DeleteRequest\"], 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 \".Protocol.DeleteRequest.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"DeleteRequest\"], 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 \".Protocol.DeleteRequest.rw\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"DeleteRequest\"], baseName' = FName \"rw\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListBucketsResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListBucketsResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListBucketsResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListBucketsResponse.buckets\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListBucketsResponse\"], baseName' = FName \"buckets\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListKeysRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListKeysRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListKeysRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListKeysRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListKeysRequest\"], 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}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListKeysResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListKeysResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListKeysResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListKeysResponse.keys\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListKeysResponse\"], baseName' = FName \"keys\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListKeysResponse.done\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListKeysResponse\"], baseName' = FName \"done\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetBucketRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetBucketRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetBucketRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetBucketRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetBucketRequest\"], 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}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetBucketResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetBucketResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetBucketResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetBucketResponse.props\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetBucketResponse\"], baseName' = FName \"props\"}, 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 \".Protocol.BucketProps\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"BucketProps\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.SetBucketRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"SetBucketRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"SetBucketRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.SetBucketRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"SetBucketRequest\"], 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 \".Protocol.SetBucketRequest.props\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"SetBucketRequest\"], baseName' = FName \"props\"}, 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 \".Protocol.BucketProps\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"BucketProps\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.MapReduceRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"MapReduceRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"MapReduceRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduceRequest.request\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduceRequest\"], baseName' = FName \"request\"}, 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 \".Protocol.MapReduceRequest.content_type\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduceRequest\"], baseName' = FName \"content_type\"}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.MapReduce\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"MapReduce\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"MapReduce.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduce.phase\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduce\"], baseName' = FName \"phase\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduce.response\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduce\"], baseName' = FName \"response\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduce.done\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduce\"], baseName' = FName \"done\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"Content.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.value\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"value\"}, 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 \".Protocol.Content.content_type\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"content_type\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.charset\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"charset\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.content_encoding\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"content_encoding\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, 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 \".Protocol.Content.vtag\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"vtag\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, 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 \".Protocol.Content.links\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"links\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Protocol.Link\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Link\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.last_mod\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"last_mod\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.last_mod_usecs\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"last_mod_usecs\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 64}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.usermeta\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"usermeta\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Protocol.Pair\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Pair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.Pair\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Pair\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"Pair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Pair.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Pair\"], baseName' = FName \"key\"}, 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 \".Protocol.Pair.value\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Pair\"], 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.Link\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Link\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"Link.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Link.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Link\"], baseName' = FName \"bucket\"}, 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 \".Protocol.Link.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Link\"], baseName' = FName \"key\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Link.tag\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Link\"], baseName' = FName \"tag\"}, 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},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.BucketProps\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"BucketProps\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"BucketProps.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.BucketProps.n_val\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"BucketProps\"], baseName' = FName \"n_val\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.BucketProps.allow_mult\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"BucketProps\"], baseName' = FName \"allow_mult\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.PingRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"PingRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"PingRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.PingResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"PingResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"PingResponse.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetClientIDRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetClientIDRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetClientIDRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.SetClientIDResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"SetClientIDResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"SetClientIDResponse.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetServerInfoRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetServerInfoRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetServerInfoRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListBucketsRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListBucketsRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListBucketsRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}], enums = [], knownKeyMap = fromList []}"+ +fileDescriptorProto :: FileDescriptorProto+fileDescriptorProto+ = P'.getFromBS (P'.wireGet 11)+    (P'.pack+      "\189\v\n\SOProtocol.proto\"0\n\rErrorResponse\DC2\SO\n\ACKerrmsg\CAN\SOH \STX(\f\DC2\SI\n\aerrcode\CAN\STX \STX(\r\"(\n\DC3GetClientIDResponse\DC2\DC1\n\tclient_id\CAN\SOH \STX(\f\"'\n\DC2SetClientIDRequest\DC2\DC1\n\tclient_id\CAN\SOH \STX(\f\"2\n\nServerInfo\DC2\f\n\EOTnode\CAN\SOH \SOH(\f\DC2\SYN\n\SOserver_version\CAN\STX \SOH(\f\"4\n\nGetRequest\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\DC2\v\n\ETXkey\CAN\STX \STX(\f\DC2\t\n\SOHr\CAN\ETX \SOH(\r\"A\n\vGetResponse\DC2\"\n\acontent\CAN\SOH \ETX(\v2\DC1.Protocol.Content\DC2\SO\n\ACKvclock\CAN\STX \SOH(\f\"\137\SOH\n\nPutRequest\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\DC2\v\n\ETXkey\CAN\STX \STX(\f\DC2\SO\n\ACKvclock\CAN\ETX \SOH(\f\DC2\"\n\acontent\CAN\EOT \STX(\v2\DC1.Protocol.Content\DC2\t\n\SOHw\CAN\ENQ \SOH(\r\DC2\n\n\STXdw\CAN\ACK \SOH(\r\DC2\DC3\n\vreturn_body\CAN\a \SOH(\b\"A\n\vPutResponse\DC2\"\n\acontent\CAN\SOH \ETX(\v2\DC1.Protocol.Content\DC2\SO\n\ACKvclock\CAN\STX \SOH(\f\"8\n\rDeleteRequest\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\DC2\v\n\ETXkey\CAN\STX \STX(\f\DC2\n\n\STXrw\CAN\ETX \SOH(\r\"&\n\DC3ListBucketsResponse\DC2\SI\n\abuckets\CAN\SOH \ETX(\f\"!\n\SIListKeysRequest\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\".\n\DLEListKeysResponse\DC2\f\n\EOTkeys\CAN\SOH \ETX(\f\DC2\f\n\EOTdone\CAN\STX \SOH(\b\"\"\n\DLEGetBucketRequest\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\"9\n\DC1GetBucketResponse\DC2$\n\ENQprops\CAN\SOH \STX(\v2\NAK.Protocol.BucketProps\"H\n\DLESetBucketRequest\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\DC2$\n\ENQprops\CAN\STX \STX(\v2\NAK.Protocol.BucketProps\"9\n\DLEMapReduceRequest\DC2\SI\n\arequest\CAN\SOH \STX(\f\DC2\DC4\n\fcontent_type\CAN\STX \STX(\f\":\n\tMapReduce\DC2\r\n\ENQphase\CAN\SOH \SOH(\r\DC2\DLE\n\bresponse\CAN\STX \SOH(\f\DC2\f\n\EOTdone\CAN\ETX \SOH(\b\"\210\SOH\n\aContent\DC2\r\n\ENQvalue\CAN\SOH \STX(\f\DC2\DC4\n\fcontent_type\CAN\STX \SOH(\f\DC2\SI\n\acharset\CAN\ETX \SOH(\f\DC2\CAN\n\DLEcontent_encoding\CAN\EOT \SOH(\f\DC2\f\n\EOTvtag\CAN\ENQ \SOH(\f\DC2\GS\n\ENQlinks\CAN\ACK \ETX(\v2\SO.Protocol.Link\DC2\DLE\n\blast_mod\CAN\a \SOH(\r\DC2\SYN\n\SOlast_mod_usecs\CAN\b \SOH(\r\DC2 \n\busermeta\CAN\t \ETX(\v2\SO.Protocol.Pair\"\"\n\EOTPair\DC2\v\n\ETXkey\CAN\SOH \STX(\f\DC2\r\n\ENQvalue\CAN\STX \SOH(\f\"0\n\EOTLink\DC2\SO\n\ACKbucket\CAN\SOH \SOH(\f\DC2\v\n\ETXkey\CAN\STX \SOH(\f\DC2\v\n\ETXtag\CAN\ETX \SOH(\f\"0\n\vBucketProps\DC2\r\n\ENQn_val\CAN\SOH \SOH(\r\DC2\DC2\n\nallow_mult\CAN\STX \SOH(\b\"\r\n\vPingRequest\"\SO\n\fPingResponse\"\DC4\n\DC2GetClientIDRequest\"\NAK\n\DC3SetClientIDResponse\"\SYN\n\DC4GetServerInfoRequest\"\DC4\n\DC2ListBucketsRequest")
+ src/Network/Riak/Protocol/BucketProps.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.BucketProps (BucketProps(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data BucketProps = BucketProps{n_val :: P'.Maybe P'.Word32, allow_mult :: P'.Maybe P'.Bool}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable BucketProps where+  mergeEmpty = BucketProps P'.mergeEmpty P'.mergeEmpty+  mergeAppend (BucketProps x'1 x'2) (BucketProps y'1 y'2) = BucketProps (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default BucketProps where+  defaultValue = BucketProps P'.defaultValue P'.defaultValue+ +instance P'.Wire BucketProps where+  wireSize ft' self'@(BucketProps x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 13 x'1 + P'.wireSizeOpt 1 8 x'2)+  wirePut ft' self'@(BucketProps 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'.wirePutOpt 8 13 x'1+             P'.wirePutOpt 16 8 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 -> P'.fmap (\ new'Field -> old'Self{n_val = P'.Just new'Field}) (P'.wireGet 13)+             16 -> P'.fmap (\ new'Field -> old'Self{allow_mult = P'.Just new'Field}) (P'.wireGet 8)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> BucketProps) BucketProps where+  getVal m' f' = f' m'+ +instance P'.GPB BucketProps+ +instance P'.ReflectDescriptor BucketProps where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 16])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.BucketProps\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"BucketProps\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"BucketProps.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.BucketProps.n_val\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"BucketProps\"], baseName' = FName \"n_val\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.BucketProps.allow_mult\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"BucketProps\"], baseName' = FName \"allow_mult\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/Content.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.Content (Content(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Protocol.Link as Protocol (Link)+import qualified Network.Riak.Protocol.Pair as Protocol (Pair)+ +data Content = Content{value :: P'.ByteString, content_type :: P'.Maybe P'.ByteString, charset :: P'.Maybe P'.ByteString,+                       content_encoding :: P'.Maybe P'.ByteString, vtag :: P'.Maybe P'.ByteString, links :: P'.Seq Protocol.Link,+                       last_mod :: P'.Maybe P'.Word32, last_mod_usecs :: P'.Maybe P'.Word32, usermeta :: P'.Seq Protocol.Pair}+             deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable Content where+  mergeEmpty+   = Content P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+      P'.mergeEmpty+  mergeAppend (Content x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9) (Content y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9)+   = Content (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)+      (P'.mergeAppend x'6 y'6)+      (P'.mergeAppend x'7 y'7)+      (P'.mergeAppend x'8 y'8)+      (P'.mergeAppend x'9 y'9)+ +instance P'.Default Content where+  defaultValue+   = Content P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+      P'.defaultValue+      P'.defaultValue+ +instance P'.Wire Content where+  wireSize ft' self'@(Content x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9)+   = 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 + P'.wireSizeOpt 1 12 x'3 + P'.wireSizeOpt 1 12 x'4 ++             P'.wireSizeOpt 1 12 x'5+             + P'.wireSizeRep 1 11 x'6+             + P'.wireSizeOpt 1 13 x'7+             + P'.wireSizeOpt 1 13 x'8+             + P'.wireSizeRep 1 11 x'9)+  wirePut ft' self'@(Content x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9)+   = 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+             P'.wirePutOpt 26 12 x'3+             P'.wirePutOpt 34 12 x'4+             P'.wirePutOpt 42 12 x'5+             P'.wirePutRep 50 11 x'6+             P'.wirePutOpt 56 13 x'7+             P'.wirePutOpt 64 13 x'8+             P'.wirePutRep 74 11 x'9+  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 -> P'.fmap (\ new'Field -> old'Self{value = new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{content_type = P'.Just new'Field}) (P'.wireGet 12)+             26 -> P'.fmap (\ new'Field -> old'Self{charset = P'.Just new'Field}) (P'.wireGet 12)+             34 -> P'.fmap (\ new'Field -> old'Self{content_encoding = P'.Just new'Field}) (P'.wireGet 12)+             42 -> P'.fmap (\ new'Field -> old'Self{vtag = P'.Just new'Field}) (P'.wireGet 12)+             50 -> P'.fmap (\ new'Field -> old'Self{links = P'.append (links old'Self) new'Field}) (P'.wireGet 11)+             56 -> P'.fmap (\ new'Field -> old'Self{last_mod = P'.Just new'Field}) (P'.wireGet 13)+             64 -> P'.fmap (\ new'Field -> old'Self{last_mod_usecs = P'.Just new'Field}) (P'.wireGet 13)+             74 -> P'.fmap (\ new'Field -> old'Self{usermeta = P'.append (usermeta 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' -> Content) Content where+  getVal m' f' = f' m'+ +instance P'.GPB Content+ +instance P'.ReflectDescriptor Content where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18, 26, 34, 42, 50, 56, 64, 74])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"Content.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.value\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"value\"}, 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 \".Protocol.Content.content_type\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"content_type\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.charset\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"charset\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.content_encoding\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"content_encoding\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, 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 \".Protocol.Content.vtag\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"vtag\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, 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 \".Protocol.Content.links\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"links\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Protocol.Link\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Link\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.last_mod\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"last_mod\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.last_mod_usecs\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"last_mod_usecs\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 64}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Content.usermeta\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Content\"], baseName' = FName \"usermeta\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Protocol.Pair\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Pair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/DeleteRequest.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.DeleteRequest (DeleteRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data DeleteRequest = DeleteRequest{bucket :: P'.ByteString, key :: P'.ByteString, rw :: P'.Maybe P'.Word32}+                   deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable DeleteRequest where+  mergeEmpty = DeleteRequest P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (DeleteRequest x'1 x'2 x'3) (DeleteRequest y'1 y'2 y'3)+   = DeleteRequest (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default DeleteRequest where+  defaultValue = DeleteRequest P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire DeleteRequest where+  wireSize ft' self'@(DeleteRequest 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 13 x'3)+  wirePut ft' self'@(DeleteRequest 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 24 13 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 -> P'.fmap (\ new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             24 -> P'.fmap (\ new'Field -> old'Self{rw = P'.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' -> DeleteRequest) DeleteRequest where+  getVal m' f' = f' m'+ +instance P'.GPB DeleteRequest+ +instance P'.ReflectDescriptor DeleteRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18, 24])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.DeleteRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"DeleteRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"DeleteRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.DeleteRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"DeleteRequest\"], 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 \".Protocol.DeleteRequest.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"DeleteRequest\"], 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 \".Protocol.DeleteRequest.rw\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"DeleteRequest\"], baseName' = FName \"rw\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, 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}"
+ src/Network/Riak/Protocol/ErrorResponse.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.ErrorResponse (ErrorResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ErrorResponse = ErrorResponse{errmsg :: P'.ByteString, errcode :: P'.Word32}+                   deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ErrorResponse where+  mergeEmpty = ErrorResponse P'.mergeEmpty P'.mergeEmpty+  mergeAppend (ErrorResponse x'1 x'2) (ErrorResponse y'1 y'2) = ErrorResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default ErrorResponse where+  defaultValue = ErrorResponse P'.defaultValue P'.defaultValue+ +instance P'.Wire ErrorResponse where+  wireSize ft' self'@(ErrorResponse 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 13 x'2)+  wirePut ft' self'@(ErrorResponse 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 16 13 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 -> P'.fmap (\ new'Field -> old'Self{errmsg = new'Field}) (P'.wireGet 12)+             16 -> P'.fmap (\ new'Field -> old'Self{errcode = 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' -> ErrorResponse) ErrorResponse where+  getVal m' f' = f' m'+ +instance P'.GPB ErrorResponse+ +instance P'.ReflectDescriptor ErrorResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 16]) (P'.fromDistinctAscList [10, 16])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ErrorResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ErrorResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ErrorResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ErrorResponse.errmsg\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ErrorResponse\"], baseName' = FName \"errmsg\"}, 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 \".Protocol.ErrorResponse.errcode\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ErrorResponse\"], baseName' = FName \"errcode\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, 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}"
+ src/Network/Riak/Protocol/GetBucketRequest.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.GetBucketRequest (GetBucketRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data GetBucketRequest = GetBucketRequest{bucket :: P'.ByteString}+                      deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable GetBucketRequest where+  mergeEmpty = GetBucketRequest P'.mergeEmpty+  mergeAppend (GetBucketRequest x'1) (GetBucketRequest y'1) = GetBucketRequest (P'.mergeAppend x'1 y'1)+ +instance P'.Default GetBucketRequest where+  defaultValue = GetBucketRequest P'.defaultValue+ +instance P'.Wire GetBucketRequest where+  wireSize ft' self'@(GetBucketRequest 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'@(GetBucketRequest 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 -> P'.fmap (\ new'Field -> old'Self{bucket = 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' -> GetBucketRequest) GetBucketRequest where+  getVal m' f' = f' m'+ +instance P'.GPB GetBucketRequest+ +instance P'.ReflectDescriptor GetBucketRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetBucketRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetBucketRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetBucketRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetBucketRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetBucketRequest\"], 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}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/GetBucketResponse.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.GetBucketResponse (GetBucketResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Protocol.BucketProps as Protocol (BucketProps)+ +data GetBucketResponse = GetBucketResponse{props :: Protocol.BucketProps}+                       deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable GetBucketResponse where+  mergeEmpty = GetBucketResponse P'.mergeEmpty+  mergeAppend (GetBucketResponse x'1) (GetBucketResponse y'1) = GetBucketResponse (P'.mergeAppend x'1 y'1)+ +instance P'.Default GetBucketResponse where+  defaultValue = GetBucketResponse P'.defaultValue+ +instance P'.Wire GetBucketResponse where+  wireSize ft' self'@(GetBucketResponse 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'@(GetBucketResponse 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 -> P'.fmap (\ new'Field -> old'Self{props = P'.mergeAppend (props 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' -> GetBucketResponse) GetBucketResponse where+  getVal m' f' = f' m'+ +instance P'.GPB GetBucketResponse+ +instance P'.ReflectDescriptor GetBucketResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetBucketResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetBucketResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetBucketResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetBucketResponse.props\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetBucketResponse\"], baseName' = FName \"props\"}, 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 \".Protocol.BucketProps\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"BucketProps\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/GetClientIDRequest.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.GetClientIDRequest (GetClientIDRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data GetClientIDRequest = GetClientIDRequest{}+                        deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable GetClientIDRequest where+  mergeEmpty = GetClientIDRequest+  mergeAppend (GetClientIDRequest) (GetClientIDRequest) = GetClientIDRequest+ +instance P'.Default GetClientIDRequest where+  defaultValue = GetClientIDRequest+ +instance P'.Wire GetClientIDRequest where+  wireSize ft' self'@(GetClientIDRequest)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(GetClientIDRequest)+   = 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'.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' -> GetClientIDRequest) GetClientIDRequest where+  getVal m' f' = f' m'+ +instance P'.GPB GetClientIDRequest+ +instance P'.ReflectDescriptor GetClientIDRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetClientIDRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetClientIDRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetClientIDRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/GetClientIDResponse.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.GetClientIDResponse (GetClientIDResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data GetClientIDResponse = GetClientIDResponse{client_id :: P'.ByteString}+                         deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable GetClientIDResponse where+  mergeEmpty = GetClientIDResponse P'.mergeEmpty+  mergeAppend (GetClientIDResponse x'1) (GetClientIDResponse y'1) = GetClientIDResponse (P'.mergeAppend x'1 y'1)+ +instance P'.Default GetClientIDResponse where+  defaultValue = GetClientIDResponse P'.defaultValue+ +instance P'.Wire GetClientIDResponse where+  wireSize ft' self'@(GetClientIDResponse 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'@(GetClientIDResponse 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 -> P'.fmap (\ new'Field -> old'Self{client_id = 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' -> GetClientIDResponse) GetClientIDResponse where+  getVal m' f' = f' m'+ +instance P'.GPB GetClientIDResponse+ +instance P'.ReflectDescriptor GetClientIDResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetClientIDResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetClientIDResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetClientIDResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetClientIDResponse.client_id\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetClientIDResponse\"], baseName' = FName \"client_id\"}, 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}"
+ src/Network/Riak/Protocol/GetRequest.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.GetRequest (GetRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data GetRequest = GetRequest{bucket :: P'.ByteString, key :: P'.ByteString, r :: P'.Maybe P'.Word32}+                deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable GetRequest where+  mergeEmpty = GetRequest P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (GetRequest x'1 x'2 x'3) (GetRequest y'1 y'2 y'3)+   = GetRequest (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default GetRequest where+  defaultValue = GetRequest P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire GetRequest where+  wireSize ft' self'@(GetRequest 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 13 x'3)+  wirePut ft' self'@(GetRequest 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 24 13 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 -> P'.fmap (\ new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             24 -> P'.fmap (\ new'Field -> old'Self{r = P'.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' -> GetRequest) GetRequest where+  getVal m' f' = f' m'+ +instance P'.GPB GetRequest+ +instance P'.ReflectDescriptor GetRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18, 24])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetRequest\"], 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 \".Protocol.GetRequest.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetRequest\"], 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 \".Protocol.GetRequest.r\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetRequest\"], baseName' = FName \"r\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, 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}"
+ src/Network/Riak/Protocol/GetResponse.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.GetResponse (GetResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Protocol.Content as Protocol (Content)+ +data GetResponse = GetResponse{content :: P'.Seq Protocol.Content, vclock :: P'.Maybe P'.ByteString}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable GetResponse where+  mergeEmpty = GetResponse P'.mergeEmpty P'.mergeEmpty+  mergeAppend (GetResponse x'1 x'2) (GetResponse y'1 y'2) = GetResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default GetResponse where+  defaultValue = GetResponse P'.defaultValue P'.defaultValue+ +instance P'.Wire GetResponse where+  wireSize ft' self'@(GetResponse x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 11 x'1 + P'.wireSizeOpt 1 12 x'2)+  wirePut ft' self'@(GetResponse 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'.wirePutRep 10 11 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 -> P'.fmap (\ new'Field -> old'Self{content = P'.append (content old'Self) new'Field}) (P'.wireGet 11)+             18 -> P'.fmap (\ new'Field -> old'Self{vclock = P'.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' -> GetResponse) GetResponse where+  getVal m' f' = f' m'+ +instance P'.GPB GetResponse+ +instance P'.ReflectDescriptor GetResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetResponse.content\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetResponse\"], baseName' = FName \"content\"}, 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 \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.GetResponse.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"GetResponse\"], baseName' = FName \"vclock\"}, 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}"
+ src/Network/Riak/Protocol/GetServerInfoRequest.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.GetServerInfoRequest (GetServerInfoRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data GetServerInfoRequest = GetServerInfoRequest{}+                          deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable GetServerInfoRequest where+  mergeEmpty = GetServerInfoRequest+  mergeAppend (GetServerInfoRequest) (GetServerInfoRequest) = GetServerInfoRequest+ +instance P'.Default GetServerInfoRequest where+  defaultValue = GetServerInfoRequest+ +instance P'.Wire GetServerInfoRequest where+  wireSize ft' self'@(GetServerInfoRequest)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(GetServerInfoRequest)+   = 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'.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' -> GetServerInfoRequest) GetServerInfoRequest where+  getVal m' f' = f' m'+ +instance P'.GPB GetServerInfoRequest+ +instance P'.ReflectDescriptor GetServerInfoRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.GetServerInfoRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"GetServerInfoRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"GetServerInfoRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/Link.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.Link (Link(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data Link = Link{bucket :: P'.Maybe P'.ByteString, key :: P'.Maybe P'.ByteString, tag :: P'.Maybe P'.ByteString}+          deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable Link where+  mergeEmpty = Link P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (Link x'1 x'2 x'3) (Link y'1 y'2 y'3)+   = Link (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default Link where+  defaultValue = Link P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire Link where+  wireSize ft' self'@(Link 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'.wireSizeOpt 1 12 x'1 + P'.wireSizeOpt 1 12 x'2 + P'.wireSizeOpt 1 12 x'3)+  wirePut ft' self'@(Link 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'.wirePutOpt 10 12 x'1+             P'.wirePutOpt 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+             10 -> P'.fmap (\ new'Field -> old'Self{bucket = P'.Just new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{key = P'.Just new'Field}) (P'.wireGet 12)+             26 -> P'.fmap (\ new'Field -> old'Self{tag = P'.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' -> Link) Link where+  getVal m' f' = f' m'+ +instance P'.GPB Link+ +instance P'.ReflectDescriptor Link where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 18, 26])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.Link\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Link\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"Link.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Link.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Link\"], baseName' = FName \"bucket\"}, 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 \".Protocol.Link.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Link\"], baseName' = FName \"key\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Link.tag\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Link\"], baseName' = FName \"tag\"}, 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}"
+ src/Network/Riak/Protocol/ListBucketsRequest.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.ListBucketsRequest (ListBucketsRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ListBucketsRequest = ListBucketsRequest{}+                        deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ListBucketsRequest where+  mergeEmpty = ListBucketsRequest+  mergeAppend (ListBucketsRequest) (ListBucketsRequest) = ListBucketsRequest+ +instance P'.Default ListBucketsRequest where+  defaultValue = ListBucketsRequest+ +instance P'.Wire ListBucketsRequest where+  wireSize ft' self'@(ListBucketsRequest)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(ListBucketsRequest)+   = 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'.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' -> ListBucketsRequest) ListBucketsRequest where+  getVal m' f' = f' m'+ +instance P'.GPB ListBucketsRequest+ +instance P'.ReflectDescriptor ListBucketsRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListBucketsRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListBucketsRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListBucketsRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/ListBucketsResponse.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.ListBucketsResponse (ListBucketsResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ListBucketsResponse = ListBucketsResponse{buckets :: P'.Seq P'.ByteString}+                         deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ListBucketsResponse where+  mergeEmpty = ListBucketsResponse P'.mergeEmpty+  mergeAppend (ListBucketsResponse x'1) (ListBucketsResponse y'1) = ListBucketsResponse (P'.mergeAppend x'1 y'1)+ +instance P'.Default ListBucketsResponse where+  defaultValue = ListBucketsResponse P'.defaultValue+ +instance P'.Wire ListBucketsResponse where+  wireSize ft' self'@(ListBucketsResponse x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 12 x'1)+  wirePut ft' self'@(ListBucketsResponse 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 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 -> P'.fmap (\ new'Field -> old'Self{buckets = P'.append (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' -> ListBucketsResponse) ListBucketsResponse where+  getVal m' f' = f' m'+ +instance P'.GPB ListBucketsResponse+ +instance P'.ReflectDescriptor ListBucketsResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListBucketsResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListBucketsResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListBucketsResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListBucketsResponse.buckets\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListBucketsResponse\"], baseName' = FName \"buckets\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, 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}"
+ src/Network/Riak/Protocol/ListKeysRequest.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.ListKeysRequest (ListKeysRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ListKeysRequest = ListKeysRequest{bucket :: P'.ByteString}+                     deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ListKeysRequest where+  mergeEmpty = ListKeysRequest P'.mergeEmpty+  mergeAppend (ListKeysRequest x'1) (ListKeysRequest y'1) = ListKeysRequest (P'.mergeAppend x'1 y'1)+ +instance P'.Default ListKeysRequest where+  defaultValue = ListKeysRequest P'.defaultValue+ +instance P'.Wire ListKeysRequest where+  wireSize ft' self'@(ListKeysRequest 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'@(ListKeysRequest 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 -> P'.fmap (\ new'Field -> old'Self{bucket = 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' -> ListKeysRequest) ListKeysRequest where+  getVal m' f' = f' m'+ +instance P'.GPB ListKeysRequest+ +instance P'.ReflectDescriptor ListKeysRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListKeysRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListKeysRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListKeysRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListKeysRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListKeysRequest\"], 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}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/ListKeysResponse.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.ListKeysResponse (ListKeysResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ListKeysResponse = ListKeysResponse{keys :: P'.Seq P'.ByteString, done :: P'.Maybe P'.Bool}+                      deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ListKeysResponse where+  mergeEmpty = ListKeysResponse P'.mergeEmpty P'.mergeEmpty+  mergeAppend (ListKeysResponse x'1 x'2) (ListKeysResponse y'1 y'2)+   = ListKeysResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default ListKeysResponse where+  defaultValue = ListKeysResponse P'.defaultValue P'.defaultValue+ +instance P'.Wire ListKeysResponse where+  wireSize ft' self'@(ListKeysResponse x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 12 x'1 + P'.wireSizeOpt 1 8 x'2)+  wirePut ft' self'@(ListKeysResponse 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'.wirePutRep 10 12 x'1+             P'.wirePutOpt 16 8 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 -> P'.fmap (\ new'Field -> old'Self{keys = P'.append (keys old'Self) new'Field}) (P'.wireGet 12)+             16 -> P'.fmap (\ new'Field -> old'Self{done = P'.Just new'Field}) (P'.wireGet 8)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> ListKeysResponse) ListKeysResponse where+  getVal m' f' = f' m'+ +instance P'.GPB ListKeysResponse+ +instance P'.ReflectDescriptor ListKeysResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 16])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ListKeysResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ListKeysResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ListKeysResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListKeysResponse.keys\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListKeysResponse\"], baseName' = FName \"keys\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ListKeysResponse.done\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ListKeysResponse\"], baseName' = FName \"done\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/MapReduce.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.MapReduce (MapReduce(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data MapReduce = MapReduce{phase :: P'.Maybe P'.Word32, response :: P'.Maybe P'.ByteString, done :: P'.Maybe P'.Bool}+               deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable MapReduce where+  mergeEmpty = MapReduce P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (MapReduce x'1 x'2 x'3) (MapReduce y'1 y'2 y'3)+   = MapReduce (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default MapReduce where+  defaultValue = MapReduce P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire MapReduce where+  wireSize ft' self'@(MapReduce 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'.wireSizeOpt 1 13 x'1 + P'.wireSizeOpt 1 12 x'2 + P'.wireSizeOpt 1 8 x'3)+  wirePut ft' self'@(MapReduce 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'.wirePutOpt 8 13 x'1+             P'.wirePutOpt 18 12 x'2+             P'.wirePutOpt 24 8 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 -> P'.fmap (\ new'Field -> old'Self{phase = P'.Just new'Field}) (P'.wireGet 13)+             18 -> P'.fmap (\ new'Field -> old'Self{response = P'.Just new'Field}) (P'.wireGet 12)+             24 -> P'.fmap (\ new'Field -> old'Self{done = P'.Just new'Field}) (P'.wireGet 8)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MapReduce) MapReduce where+  getVal m' f' = f' m'+ +instance P'.GPB MapReduce+ +instance P'.ReflectDescriptor MapReduce where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 18, 24])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.MapReduce\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"MapReduce\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"MapReduce.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduce.phase\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduce\"], baseName' = FName \"phase\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduce.response\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduce\"], baseName' = FName \"response\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduce.done\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduce\"], baseName' = FName \"done\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/MapReduceRequest.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.MapReduceRequest (MapReduceRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data MapReduceRequest = MapReduceRequest{request :: P'.ByteString, content_type :: P'.ByteString}+                      deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable MapReduceRequest where+  mergeEmpty = MapReduceRequest P'.mergeEmpty P'.mergeEmpty+  mergeAppend (MapReduceRequest x'1 x'2) (MapReduceRequest y'1 y'2)+   = MapReduceRequest (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default MapReduceRequest where+  defaultValue = MapReduceRequest P'.defaultValue P'.defaultValue+ +instance P'.Wire MapReduceRequest where+  wireSize ft' self'@(MapReduceRequest 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'@(MapReduceRequest 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 -> P'.fmap (\ new'Field -> old'Self{request = new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{content_type = 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' -> MapReduceRequest) MapReduceRequest where+  getVal m' f' = f' m'+ +instance P'.GPB MapReduceRequest+ +instance P'.ReflectDescriptor MapReduceRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.MapReduceRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"MapReduceRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"MapReduceRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.MapReduceRequest.request\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduceRequest\"], baseName' = FName \"request\"}, 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 \".Protocol.MapReduceRequest.content_type\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"MapReduceRequest\"], baseName' = FName \"content_type\"}, 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}"
+ src/Network/Riak/Protocol/Pair.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.Pair (Pair(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data Pair = Pair{key :: P'.ByteString, value :: P'.Maybe P'.ByteString}+          deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable Pair where+  mergeEmpty = Pair P'.mergeEmpty P'.mergeEmpty+  mergeAppend (Pair x'1 x'2) (Pair y'1 y'2) = Pair (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default Pair where+  defaultValue = Pair P'.defaultValue P'.defaultValue+ +instance P'.Wire Pair where+  wireSize ft' self'@(Pair 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'@(Pair 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 -> P'.fmap (\ new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{value = P'.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' -> Pair) Pair where+  getVal m' f' = f' m'+ +instance P'.GPB Pair+ +instance P'.ReflectDescriptor Pair where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.Pair\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Pair\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"Pair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.Pair.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Pair\"], baseName' = FName \"key\"}, 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 \".Protocol.Pair.value\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"Pair\"], 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}"
+ src/Network/Riak/Protocol/PingRequest.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.PingRequest (PingRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data PingRequest = PingRequest{}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable PingRequest where+  mergeEmpty = PingRequest+  mergeAppend (PingRequest) (PingRequest) = PingRequest+ +instance P'.Default PingRequest where+  defaultValue = PingRequest+ +instance P'.Wire PingRequest where+  wireSize ft' self'@(PingRequest)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(PingRequest)+   = 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'.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' -> PingRequest) PingRequest where+  getVal m' f' = f' m'+ +instance P'.GPB PingRequest+ +instance P'.ReflectDescriptor PingRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.PingRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"PingRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"PingRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/PutRequest.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.PutRequest (PutRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Protocol.Content as Protocol (Content)+ +data PutRequest = PutRequest{bucket :: P'.ByteString, key :: P'.ByteString, vclock :: P'.Maybe P'.ByteString,+                             content :: Protocol.Content, w :: P'.Maybe P'.Word32, dw :: P'.Maybe P'.Word32,+                             return_body :: P'.Maybe P'.Bool}+                deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable PutRequest where+  mergeEmpty = PutRequest P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (PutRequest x'1 x'2 x'3 x'4 x'5 x'6 x'7) (PutRequest y'1 y'2 y'3 y'4 y'5 y'6 y'7)+   = PutRequest (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)+      (P'.mergeAppend x'6 y'6)+      (P'.mergeAppend x'7 y'7)+ +instance P'.Default PutRequest where+  defaultValue+   = PutRequest P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire PutRequest where+  wireSize ft' self'@(PutRequest x'1 x'2 x'3 x'4 x'5 x'6 x'7)+   = 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 12 x'3 + P'.wireSizeReq 1 11 x'4 ++             P'.wireSizeOpt 1 13 x'5+             + P'.wireSizeOpt 1 13 x'6+             + P'.wireSizeOpt 1 8 x'7)+  wirePut ft' self'@(PutRequest x'1 x'2 x'3 x'4 x'5 x'6 x'7)+   = 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 12 x'3+             P'.wirePutReq 34 11 x'4+             P'.wirePutOpt 40 13 x'5+             P'.wirePutOpt 48 13 x'6+             P'.wirePutOpt 56 8 x'7+  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 -> P'.fmap (\ new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             26 -> P'.fmap (\ new'Field -> old'Self{vclock = P'.Just new'Field}) (P'.wireGet 12)+             34 -> P'.fmap (\ new'Field -> old'Self{content = P'.mergeAppend (content old'Self) (new'Field)}) (P'.wireGet 11)+             40 -> P'.fmap (\ new'Field -> old'Self{w = P'.Just new'Field}) (P'.wireGet 13)+             48 -> P'.fmap (\ new'Field -> old'Self{dw = P'.Just new'Field}) (P'.wireGet 13)+             56 -> P'.fmap (\ new'Field -> old'Self{return_body = P'.Just new'Field}) (P'.wireGet 8)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> PutRequest) PutRequest where+  getVal m' f' = f' m'+ +instance P'.GPB PutRequest+ +instance P'.ReflectDescriptor PutRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18, 34]) (P'.fromDistinctAscList [10, 18, 26, 34, 40, 48, 56])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.PutRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"PutRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"PutRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], 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 \".Protocol.PutRequest.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], 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 \".Protocol.PutRequest.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"vclock\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.content\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"content\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.w\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"w\"}, 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},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.dw\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"dw\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 48}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutRequest.return_body\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutRequest\"], baseName' = FName \"return_body\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/PutResponse.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.PutResponse (PutResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Protocol.Content as Protocol (Content)+ +data PutResponse = PutResponse{content :: P'.Seq Protocol.Content, vclock :: P'.Maybe P'.ByteString}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable PutResponse where+  mergeEmpty = PutResponse P'.mergeEmpty P'.mergeEmpty+  mergeAppend (PutResponse x'1 x'2) (PutResponse y'1 y'2) = PutResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default PutResponse where+  defaultValue = PutResponse P'.defaultValue P'.defaultValue+ +instance P'.Wire PutResponse where+  wireSize ft' self'@(PutResponse x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 11 x'1 + P'.wireSizeOpt 1 12 x'2)+  wirePut ft' self'@(PutResponse 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'.wirePutRep 10 11 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 -> P'.fmap (\ new'Field -> old'Self{content = P'.append (content old'Self) new'Field}) (P'.wireGet 11)+             18 -> P'.fmap (\ new'Field -> old'Self{vclock = P'.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' -> PutResponse) PutResponse where+  getVal m' f' = f' m'+ +instance P'.GPB PutResponse+ +instance P'.ReflectDescriptor PutResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.PutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"PutResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"PutResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutResponse.content\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutResponse\"], baseName' = FName \"content\"}, 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 \".Protocol.Content\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"Content\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.PutResponse.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"PutResponse\"], baseName' = FName \"vclock\"}, 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}"
+ src/Network/Riak/Protocol/ServerInfo.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.ServerInfo (ServerInfo(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ServerInfo = ServerInfo{node :: P'.Maybe P'.ByteString, server_version :: P'.Maybe P'.ByteString}+                deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ServerInfo where+  mergeEmpty = ServerInfo P'.mergeEmpty P'.mergeEmpty+  mergeAppend (ServerInfo x'1 x'2) (ServerInfo y'1 y'2) = ServerInfo (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default ServerInfo where+  defaultValue = ServerInfo P'.defaultValue P'.defaultValue+ +instance P'.Wire ServerInfo where+  wireSize ft' self'@(ServerInfo x'1 x'2)+   = 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'.wireSizeOpt 1 12 x'2)+  wirePut ft' self'@(ServerInfo 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'.wirePutOpt 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 -> P'.fmap (\ new'Field -> old'Self{node = P'.Just new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{server_version = P'.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' -> ServerInfo) ServerInfo where+  getVal m' f' = f' m'+ +instance P'.GPB ServerInfo+ +instance P'.ReflectDescriptor ServerInfo where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.ServerInfo\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"ServerInfo\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"ServerInfo.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.ServerInfo.node\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ServerInfo\"], baseName' = FName \"node\"}, 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 \".Protocol.ServerInfo.server_version\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"ServerInfo\"], baseName' = FName \"server_version\"}, 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}"
+ src/Network/Riak/Protocol/SetBucketRequest.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.SetBucketRequest (SetBucketRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Protocol.BucketProps as Protocol (BucketProps)+ +data SetBucketRequest = SetBucketRequest{bucket :: P'.ByteString, props :: Protocol.BucketProps}+                      deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable SetBucketRequest where+  mergeEmpty = SetBucketRequest P'.mergeEmpty P'.mergeEmpty+  mergeAppend (SetBucketRequest x'1 x'2) (SetBucketRequest y'1 y'2)+   = SetBucketRequest (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default SetBucketRequest where+  defaultValue = SetBucketRequest P'.defaultValue P'.defaultValue+ +instance P'.Wire SetBucketRequest where+  wireSize ft' self'@(SetBucketRequest 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 11 x'2)+  wirePut ft' self'@(SetBucketRequest 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 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+             10 -> P'.fmap (\ new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             18 -> P'.fmap (\ new'Field -> old'Self{props = P'.mergeAppend (props 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' -> SetBucketRequest) SetBucketRequest where+  getVal m' f' = f' m'+ +instance P'.GPB SetBucketRequest+ +instance P'.ReflectDescriptor SetBucketRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.SetBucketRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"SetBucketRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"SetBucketRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.SetBucketRequest.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"SetBucketRequest\"], 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 \".Protocol.SetBucketRequest.props\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"SetBucketRequest\"], baseName' = FName \"props\"}, 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 \".Protocol.BucketProps\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"BucketProps\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False}"
+ src/Network/Riak/Protocol/SetClientIDRequest.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Network.Riak.Protocol.SetClientIDRequest (SetClientIDRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data SetClientIDRequest = SetClientIDRequest{client_id :: P'.ByteString}+                        deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable SetClientIDRequest where+  mergeEmpty = SetClientIDRequest P'.mergeEmpty+  mergeAppend (SetClientIDRequest x'1) (SetClientIDRequest y'1) = SetClientIDRequest (P'.mergeAppend x'1 y'1)+ +instance P'.Default SetClientIDRequest where+  defaultValue = SetClientIDRequest P'.defaultValue+ +instance P'.Wire SetClientIDRequest where+  wireSize ft' self'@(SetClientIDRequest 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'@(SetClientIDRequest 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 -> P'.fmap (\ new'Field -> old'Self{client_id = 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' -> SetClientIDRequest) SetClientIDRequest where+  getVal m' f' = f' m'+ +instance P'.GPB SetClientIDRequest+ +instance P'.ReflectDescriptor SetClientIDRequest where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = P'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Protocol.SetClientIDRequest\", haskellPrefix = [MName \"Network\",MName \"Riak\"], parentModule = [MName \"Protocol\"], baseName = MName \"SetClientIDRequest\"}, descFilePath = [\"Network\",\"Riak\",\"Protocol\",\"SetClientIDRequest.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Protocol.SetClientIDRequest.client_id\", haskellPrefix' = [MName \"Network\",MName \"Riak\"], parentModule' = [MName \"Protocol\",MName \"SetClientIDRequest\"], baseName' = FName \"client_id\"}, 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}"
+ src/Network/Riak/Request.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Riak.Request+    (+    -- * Connection management+      PingRequest+    , ping+    , GetClientIDRequest+    , getClientID+    , GetServerInfoRequest+    , getServerInfo+    -- * Data management+    , Get.GetRequest+    , get+    , Put.PutRequest+    , put+    , Del.DeleteRequest+    , delete+    -- * Metadata+    , ListBucketsRequest+    , listBuckets+    , Keys.ListKeysRequest+    , listKeys+    , GetBucket.GetBucketRequest+    , getBucket+    , SetBucket.SetBucketRequest+    , setBucket+    -- * Map/reduce+    , MapReduceRequest+    , mapReduce+    ) where++import Control.Applicative ((<$>))+import Network.Riak.Protocol.PingRequest+import qualified Network.Riak.Protocol.DeleteRequest as Del+import Network.Riak.Protocol.GetClientIDRequest+import Network.Riak.Protocol.GetServerInfoRequest+import Network.Riak.Protocol.ListBucketsRequest+import qualified Network.Riak.Protocol.ListKeysRequest as Keys+import qualified Network.Riak.Protocol.PutRequest as Put+import Network.Riak.Protocol.Content+import qualified Network.Riak.Protocol.GetRequest as Get+import qualified Network.Riak.Protocol.GetBucketRequest as GetBucket+import qualified Network.Riak.Protocol.SetBucketRequest as SetBucket+import Network.Riak.Protocol.MapReduceRequest+import Network.Riak.Protocol.BucketProps+import Network.Riak.Types.Internal hiding (MessageTag(..))++ping :: PingRequest+ping = PingRequest+{-# INLINE ping #-}++getClientID :: GetClientIDRequest+getClientID = GetClientIDRequest+{-# INLINE getClientID #-}++getServerInfo :: GetServerInfoRequest+getServerInfo = GetServerInfoRequest+{-# INLINE getServerInfo #-}++get :: Bucket -> Key -> R -> Get.GetRequest+get bucket key r = Get.GetRequest { Get.bucket = bucket+                                  , Get.key = key+                                  , Get.r = fromQuorum r }+{-# INLINE get #-}++put :: Bucket -> Key -> Maybe VClock -> Content -> W -> DW -> Bool+    -> Put.PutRequest+put bucket key mvclock cont mw mdw returnBody =+    Put.PutRequest bucket key (fromVClock <$> mvclock) cont+                   (fromQuorum mw) (fromQuorum mdw) (Just returnBody)+{-# INLINE put #-}++delete :: Bucket -> Key -> RW -> Del.DeleteRequest+delete bucket key rw = Del.DeleteRequest bucket key (fromQuorum rw)+{-# INLINE delete #-}++listBuckets :: ListBucketsRequest+listBuckets = ListBucketsRequest+{-# INLINE listBuckets #-}++listKeys :: Bucket -> Keys.ListKeysRequest+listKeys = Keys.ListKeysRequest+{-# INLINE listKeys #-}++getBucket :: Bucket -> GetBucket.GetBucketRequest+getBucket bucket = GetBucket.GetBucketRequest bucket+{-# INLINE getBucket #-}++setBucket :: Bucket -> BucketProps -> SetBucket.SetBucketRequest+setBucket bucket props = SetBucket.SetBucketRequest bucket props+{-# INLINE setBucket #-}++mapReduce :: Job -> MapReduceRequest+mapReduce (JSON bs)   = MapReduceRequest bs "application/json"+mapReduce (Erlang bs) = MapReduceRequest bs "application/x-erlang-binary"
+ src/Network/Riak/Response.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE RecordWildCards #-}++module Network.Riak.Response+    (+    -- * Connection management+      getClientID+    -- * Data management+    , get+    , put+    -- * Metadata+    , listBuckets+    , getBucket+    ) where++import Network.Riak.Protocol.BucketProps+import Network.Riak.Protocol.Content+import Network.Riak.Protocol.GetBucketResponse+import Network.Riak.Protocol.GetClientIDResponse+import Network.Riak.Protocol.GetResponse+import Network.Riak.Protocol.ListBucketsResponse+import Network.Riak.Protocol.PutResponse+import Network.Riak.Types.Internal hiding (MessageTag(..))+import qualified Data.ByteString.Lazy as L+import qualified Data.Sequence as Seq++getClientID :: GetClientIDResponse -> ClientID+getClientID = client_id+{-# INLINE getClientID #-}++get :: Maybe GetResponse -> Maybe (Seq.Seq Content, VClock)+get (Just (GetResponse content (Just vclock)))+      = Just (content, VClock vclock)+get _ = Nothing+{-# INLINE get #-}++put :: PutResponse -> (Seq.Seq Content, VClock)+put PutResponse{..} = (content, VClock (maybe L.empty id vclock))+{-# INLINE put #-}++listBuckets :: ListBucketsResponse -> (Seq.Seq Bucket)+listBuckets = buckets+{-# INLINE listBuckets #-}++getBucket :: GetBucketResponse -> BucketProps+getBucket = props+{-# INLINE getBucket #-}
+ src/Network/Riak/Tag.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module:      Network.Riak.Content+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- im in ur msg system taggin ur msg types++module Network.Riak.Tag+    (+      putTag+    , getTag+    ) where++import Data.Binary.Put (Put, putWord8)+import Network.Riak.Protocol.DeleteRequest+import Network.Riak.Protocol.ErrorResponse+import Network.Riak.Protocol.GetBucketRequest+import Network.Riak.Protocol.GetBucketResponse+import Network.Riak.Protocol.GetClientIDRequest+import Network.Riak.Protocol.GetClientIDResponse+import Network.Riak.Protocol.GetRequest+import Network.Riak.Protocol.GetResponse+import Network.Riak.Protocol.GetServerInfoRequest+import Network.Riak.Protocol.ListBucketsRequest+import Network.Riak.Protocol.ListBucketsResponse+import Network.Riak.Protocol.ListKeysRequest+import Network.Riak.Protocol.ListKeysResponse+import Network.Riak.Protocol.MapReduce+import Network.Riak.Protocol.MapReduceRequest+import Network.Riak.Protocol.PingRequest+import Network.Riak.Protocol.PutRequest+import Network.Riak.Protocol.PutResponse+import Network.Riak.Protocol.ServerInfo+import Network.Riak.Protocol.SetBucketRequest+import Network.Riak.Protocol.SetClientIDRequest+import Network.Riak.Types.Internal as Types+import Text.ProtocolBuffers.Get (Get, getWord8)++instance Tagged ErrorResponse where+    messageTag _ = Types.ErrorResponse+    {-# INLINE messageTag #-}++instance Response ErrorResponse++instance Tagged PingRequest where+    messageTag _ = Types.PingRequest+    {-# INLINE messageTag #-}++instance Request PingRequest where+    expectedResponse _ = Types.PingResponse+    {-# INLINE expectedResponse #-}++instance Tagged GetClientIDRequest where+    messageTag _ = Types.GetClientIDRequest+    {-# INLINE messageTag #-}++instance Request GetClientIDRequest where+    expectedResponse _ = Types.GetClientIDResponse+    {-# INLINE expectedResponse #-}++instance Tagged GetClientIDResponse where+    messageTag _ = Types.GetClientIDResponse+    {-# INLINE messageTag #-}++instance Response GetClientIDResponse++instance Exchange GetClientIDRequest GetClientIDResponse++instance Tagged SetClientIDRequest where+    messageTag _ = Types.SetClientIDRequest+    {-# INLINE messageTag #-}++instance Request SetClientIDRequest where+    expectedResponse _ = Types.SetClientIDResponse+    {-# INLINE expectedResponse #-}++instance Tagged GetServerInfoRequest where+    messageTag _ = Types.GetServerInfoRequest+    {-# INLINE messageTag #-}++instance Request GetServerInfoRequest where+    expectedResponse _ = Types.GetServerInfoResponse+    {-# INLINE expectedResponse #-}++instance Tagged ServerInfo where+    messageTag _ = Types.GetServerInfoResponse+    {-# INLINE messageTag #-}++instance Response ServerInfo++instance Exchange GetServerInfoRequest ServerInfo++instance Tagged GetRequest where+    messageTag _ = Types.GetRequest+    {-# INLINE messageTag #-}++instance Request GetRequest where+    expectedResponse _ = Types.GetResponse+    {-# INLINE expectedResponse #-}++instance Tagged GetResponse where+    messageTag _ = Types.GetResponse+    {-# INLINE messageTag #-}++instance Response GetResponse++instance Exchange GetRequest GetResponse++instance Tagged PutRequest where+    messageTag _ = Types.PutRequest+    {-# INLINE messageTag #-}++instance Request PutRequest where+    expectedResponse _ = Types.PutResponse+    {-# INLINE expectedResponse #-}++instance Tagged PutResponse where+    messageTag _ = Types.PutResponse+    {-# INLINE messageTag #-}++instance Response PutResponse++instance Exchange PutRequest PutResponse++instance Tagged DeleteRequest where+    messageTag _ = Types.DeleteRequest+    {-# INLINE messageTag #-}++instance Request DeleteRequest where+    expectedResponse _ = Types.DeleteResponse+    {-# INLINE expectedResponse #-}++instance Tagged ListBucketsRequest where+    messageTag _ = Types.ListBucketsRequest+    {-# INLINE messageTag #-}++instance Request ListBucketsRequest where+    expectedResponse _ = Types.ListBucketsResponse+    {-# INLINE expectedResponse #-}++instance Tagged ListBucketsResponse where+    messageTag _ = Types.ListBucketsResponse+    {-# INLINE messageTag #-}++instance Response ListBucketsResponse++instance Exchange ListBucketsRequest ListBucketsResponse++instance Tagged ListKeysRequest where+    messageTag _ = Types.ListKeysRequest+    {-# INLINE messageTag #-}++instance Request ListKeysRequest where+    expectedResponse _ = Types.ListKeysResponse+    {-# INLINE expectedResponse #-}++instance Tagged ListKeysResponse where+    messageTag _ = Types.ListKeysResponse+    {-# INLINE messageTag #-}++instance Response ListKeysResponse++instance Tagged GetBucketRequest where+    messageTag _ = Types.GetBucketRequest+    {-# INLINE messageTag #-}++instance Request GetBucketRequest where+    expectedResponse _ = Types.GetBucketResponse+    {-# INLINE expectedResponse #-}++instance Tagged GetBucketResponse where+    messageTag _ = Types.GetBucketResponse+    {-# INLINE messageTag #-}++instance Response GetBucketResponse++instance Exchange GetBucketRequest GetBucketResponse++instance Tagged SetBucketRequest where+    messageTag _ = Types.SetBucketRequest+    {-# INLINE messageTag #-}++instance Request SetBucketRequest where+    expectedResponse _ = Types.SetBucketResponse+    {-# INLINE expectedResponse #-}++instance Tagged MapReduceRequest where+    messageTag _ = Types.MapReduceRequest+    {-# INLINE messageTag #-}++instance Request MapReduceRequest where+    expectedResponse _ = Types.MapReduceResponse+    {-# INLINE expectedResponse #-}++instance Tagged MapReduce where+    messageTag _ = Types.MapReduceResponse+    {-# INLINE messageTag #-}++instance Response MapReduce++instance Exchange MapReduceRequest MapReduce++putTag :: MessageTag -> Put+putTag = putWord8 . fromIntegral . fromEnum+{-# INLINE putTag #-}++getTag :: Get MessageTag+getTag = do+  n <- getWord8+  if n > 24+    then moduleError "getTag" $ "invalid riak message code: " ++ show n+    else return .  toEnum . fromIntegral $ n+{-# INLINE getTag #-}++moduleError :: String -> String -> a+moduleError = netError "Network.Riak.Tag"
+ src/Network/Riak/Types.hs view
@@ -0,0 +1,40 @@+-- |+-- Module:      Network.Riak.Types+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Basic types.++module Network.Riak.Types+    (+    -- * Client management+      ClientID+    , Client(..)+    -- * Connection management+    , Connection(connClient)+    -- * Errors+    , RiakException(excModule, excFunction, excMessage)+    -- * Data types+    , Bucket+    , Key+    , Tag+    , VClock(..)+    , Job(..)+    -- * Quorum management+    , Quorum(..)+    , RW+    , R+    , W+    , DW+    -- * Message identification+    , Request+    , Response+    , Exchange+    , MessageTag(..)+    , Tagged(..)+    ) where++import Network.Riak.Types.Internal
+ src/Network/Riak/Types/Internal.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE DeriveDataTypeable, FunctionalDependencies, MultiParamTypeClasses,+    RecordWildCards #-}++-- |+-- Module:      Network.Riak.Types.Internal+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Basic types.++module Network.Riak.Types.Internal+    (+    -- * Client management+      ClientID+    , Client(..)+    -- * Connection management+    , Connection(..)+    -- * Errors+    , RiakException(excModule, excFunction, excMessage)+    , netError+    , typeError+    -- * Data types+    , Bucket+    , Key+    , Tag+    , VClock(..)+    , Job(..)+    -- * Quorum management+    , Quorum(..)+    , DW+    , R+    , RW+    , W+    , fromQuorum+    , toQuorum+    -- * Message identification+    , Request(..)+    , Response+    , Exchange+    , MessageTag(..)+    , Tagged(..)+    ) where++import Control.Exception (Exception, throw)+import Data.ByteString.Lazy (ByteString)+import Data.Digest.Pure.MD5 (md5)+import Data.IORef (IORef)+import Data.Typeable (Typeable)+import Data.Word (Word32)+import Network.Socket (HostName, ServiceName, Socket)+import Text.ProtocolBuffers (ReflectDescriptor, Wire)+    +-- | A client identifier.  This is used by the Riak cluster when+-- logging vector clock changes, and should be unique for each client.+type ClientID = ByteString++data Client = Client {+      host :: HostName+    -- ^ Name of the server to connect to.+    , port :: ServiceName+    -- ^ Port number to connect to (default is 8087).+    , clientID :: ClientID+    -- ^ Client identifier.+    } deriving (Eq, Show, Typeable)++-- | A connection to a Riak server.+data Connection = Connection {+      connSock :: Socket+    , connClient :: Client+    -- ^ The configuration we connected with.+    , connBuffer :: IORef ByteString+    -- ^ Received data that has not yet been consumed.+    } deriving (Eq)++-- | The main Riak exception type.+data RiakException = NetException {+      excModule :: String+    , excFunction :: String+    , excMessage :: String+    } | TypeException {+      excModule :: String+    , excFunction :: String+    , excMessage :: String+    } deriving (Eq, Typeable)++showRiakException :: RiakException -> String+showRiakException exc@NetException{..} =+    "Riak network error " ++ formatRiakException exc+showRiakException exc@TypeException{..} =+    "Riak type error " ++ formatRiakException exc++formatRiakException :: RiakException -> String+formatRiakException exc =+    "(" ++ excModule exc ++ "." ++ excFunction exc ++ "): " ++ excMessage exc++instance Show RiakException where+    show = showRiakException++instance Exception RiakException ++netError :: String -> String -> String -> a+netError modu func msg = throw (NetException modu func msg)++typeError :: String -> String -> String -> a+typeError modu func msg = throw (TypeException modu func msg)++instance Show Connection where+    show conn = show "Connection " ++ host c ++ ":" ++ port c+        where c = connClient conn++-- | A Bucket is a container and keyspace for data stored in Riak,+-- with a set of common properties for its contents (the number of+-- replicas, for instance).+type Bucket = ByteString++-- | Keys are unique object identifiers in Riak and are scoped within+-- buckets.+type Key = ByteString++-- | An application-specific identifier for a link.  See+-- <http://wiki.basho.com/Links.html> for details.+type Tag = ByteString++-- | A specification of a MapReduce+-- job. <http://wiki.basho.com/MapReduce.html>.+data Job = JSON ByteString+         | Erlang ByteString+           deriving (Eq, Show, Typeable)++-- | An identifier for an inbound or outbound message.+data MessageTag = ErrorResponse+                | PingRequest+                | PingResponse+                | GetClientIDRequest+                | GetClientIDResponse+                | SetClientIDRequest+                | SetClientIDResponse+                | GetServerInfoRequest+                | GetServerInfoResponse+                | GetRequest+                | GetResponse+                | PutRequest+                | PutResponse+                | DeleteRequest+                | DeleteResponse+                | ListBucketsRequest+                | ListBucketsResponse+                | ListKeysRequest+                | ListKeysResponse+                | GetBucketRequest+                | GetBucketResponse+                | SetBucketRequest+                | SetBucketResponse+                | MapReduceRequest+                | MapReduceResponse+                  deriving (Eq, Show, Enum, Typeable)++-- | Messages are tagged.+class Tagged msg where+    messageTag :: msg -> MessageTag -- ^ Retrieve a message's tag.++instance Tagged MessageTag where+    messageTag m = m+    {-# INLINE messageTag #-}++-- | A message representing a request from client to server.+class (Tagged msg, ReflectDescriptor msg, Show msg, Wire msg) => Request msg+    where expectedResponse :: msg -> MessageTag++-- | A message representing a response from server to client.+class (Tagged msg, ReflectDescriptor msg, Show msg, Wire msg) => Response msg++class (Request req, Response resp) => Exchange req resp+    | req -> resp, resp -> req++instance (Tagged a, Tagged b) => Tagged (Either a b) where+    messageTag (Left l)  = messageTag l+    messageTag (Right r) = messageTag r+    {-# INLINE messageTag #-}++-- | A wrapper that keeps Riak vector clocks opaque.+newtype VClock = VClock {+      fromVClock :: ByteString+    -- ^ Unwrap the 'ByteString'.  (This is really only useful for+    -- printing the raw vclock string.)+    } deriving (Eq, Typeable)++instance Show VClock where+    show (VClock s) = "VClock " ++ show (md5 s)++-- | A read/write quorum.  The quantity of replicas that must respond+-- to a read or write request before it is considered successful. This+-- is defined as a bucket property or as one of the relevant+-- parameters to a single request ('R','W','DW','RW').+data Quorum = Default   -- ^ Use the default quorum settings for the bucket.+            | One       -- ^ Success after one server has responded.+            | Quorum    -- ^ Success after a quorum of servers has responded.+            | All       -- ^ Success after all servers have responded.+              deriving (Bounded, Eq, Enum, Ord, Show, Typeable)++-- | Read/write quorum.  How many replicas need to collaborate when+-- deleting a value.+type RW = Quorum++-- | Read quorum.  How many replicas need to agree when retrieving a+-- value.+type R  = Quorum++-- | Write quorum.  How many replicas to write to before returning a+-- successful response.+type W  = Quorum++-- | Durable write quorum.  How many replicas to commit to durable+-- storage before returning a successful response.+type DW = Quorum++fromQuorum :: Quorum -> Maybe Word32+fromQuorum Default = Just 4294967291+fromQuorum One     = Just 4294967294+fromQuorum Quorum  = Just 4294967293+fromQuorum All     = Just 4294967292+{-# INLINE fromQuorum #-}++toQuorum :: Word32 -> Maybe Quorum+toQuorum 4294967294 = Just One+toQuorum 4294967293 = Just Quorum+toQuorum 4294967292 = Just All+toQuorum 4294967291 = Just Default+toQuorum v          = error $ "invalid quorum value " ++ show v+{-# INLINE toQuorum #-}
+ src/Network/Riak/Value.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}++-- |+-- Module:      Network.Riak.Value+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- This module allows storage and retrieval of data using the+-- 'IsContent' typeclass.  This provides access to more of Riak's+-- storage features than JSON, e.g. links.+--+-- The functions in this module do not perform any conflict resolution.++module Network.Riak.Value+    (+      IsContent(..)+    , get+    , getMany+    , put+    , put_+    , putMany+    , putMany_+    ) where++import Data.Attoparsec.Lazy (maybeResult, parse)+import Data.Foldable (toList)+import Network.Riak.Connection.Internal+import Network.Riak.Protocol.Content (Content(..))+import Network.Riak.Protocol.GetResponse (GetResponse(..))+import Network.Riak.Protocol.PutResponse (PutResponse(..))+import Network.Riak.Types.Internal hiding (MessageTag(..))+import qualified Data.Aeson.Parser as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.ByteString.Lazy as L+import qualified Data.Sequence as Seq+import qualified Network.Riak.Content as C+import qualified Network.Riak.Request as Req++class IsContent c where+    fromContent :: Content -> Maybe c+    toContent :: c -> Content++instance IsContent Content where+    fromContent = Just+    {-# INLINE fromContent #-}++    toContent v = v+    {-# INLINE toContent #-}++instance IsContent () where+    fromContent c | c == C.empty = Just ()+                  | otherwise    = Nothing+    {-# INLINE fromContent #-}++    toContent _ = C.empty+    {-# INLINE toContent #-}++instance IsContent Aeson.Value where+    fromContent c | content_type c == Just "application/json" =+                      maybeResult (parse Aeson.json (value c))+                  | otherwise = Nothing++    toContent = C.json+    {-# INLINE toContent #-}++put :: (IsContent c) => Connection -> Bucket -> Key -> Maybe VClock -> c+    -> W -> DW -> IO ([c], VClock)+put conn bucket key mvclock val w dw =+  putResp =<< exchange conn+              (Req.put bucket key mvclock (toContent val) w dw True)++putMany :: (IsContent c) => Connection -> Bucket -> [(Key, Maybe VClock, c)]+        -> W -> DW -> IO [([c], VClock)]+putMany conn b puts w dw =+  mapM putResp =<< pipeline conn (map (\(k,v,c) -> Req.put b k v (toContent c) w dw True) puts)++putResp :: (IsContent c) => PutResponse -> IO ([c], VClock)+putResp PutResponse{..} = do+  case vclock of+    Nothing -> return ([], VClock L.empty)+    Just s  -> do+      c <- convert content+      return (c, VClock s)++put_ :: (IsContent c) => Connection -> Bucket -> Key -> Maybe VClock -> c+    -> W -> DW -> IO ()+put_ conn bucket key mvclock val w dw =+  exchange_ conn (Req.put bucket key mvclock (toContent val) w dw False)++putMany_ :: (IsContent c) => Connection -> Bucket -> [(Key, Maybe VClock, c)]+         -> W -> DW -> IO ()+putMany_ conn b puts w dw =+  pipeline_ conn . map (\(k,v,c) -> Req.put b k v (toContent c) w dw False) $ puts++get :: (IsContent c) => Connection -> Bucket -> Key -> R+    -> IO (Maybe ([c], VClock))+get conn bucket key r = getResp =<< exchangeMaybe conn (Req.get bucket key r)++getMany :: (IsContent c) => Connection -> Bucket -> [Key] -> R+        -> IO [Maybe ([c], VClock)]+getMany conn b ks r =+    mapM getResp =<< pipelineMaybe conn (map (\k -> Req.get b k r) ks)++getResp :: (IsContent c) => Maybe GetResponse -> IO (Maybe ([c], VClock))+getResp resp =+  case resp of+    Just (GetResponse content (Just s)) -> do+           c <- convert content+           return $ Just (c, VClock s)+    _   -> return Nothing++convert :: IsContent v => Seq.Seq Content -> IO [v]+convert = go [] [] . toList+    where go cs vs (x:xs) = case fromContent x of+                              Just v -> go cs (v:vs) xs+                              _      -> go (x:cs) vs xs+          go [] vs _      = return (reverse vs)+          go cs _  _      = typeError "Network.Riak.Value" "convert" $+                            show (length cs) ++ " values failed conversion: " +++                            show cs
+ src/Network/Riak/Value/Monoid.hs view
@@ -0,0 +1,105 @@+-- |+-- Module:      Network.Riak.Value.Monoid+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- This module allows storage and retrieval of data encoded using the+-- 'V.IsContent' typeclass.  This provides access to more of Riak's+-- storage features than JSON, e.g. links.+--+-- Functions automatically resolve conflicts using 'Monoid' instances.+-- For instance, if a 'get' returns three siblings, a winner will be+-- chosen using 'mconcat'.  If a 'put' results in a conflict, a winner+-- will be chosen using 'mconcat', and the winner will be 'put'; this+-- will be repeated until no conflict occurs.++module Network.Riak.Value.Monoid+    (+      V.IsContent(..)+    , get+    , getMany+    , put+    , put_+    , putMany+    , putMany_+    ) where++import Data.Monoid (Monoid(..))+import Network.Riak.Types.Internal hiding (MessageTag(..))+import qualified Network.Riak.Monoid as M+import qualified Network.Riak.Value as V++-- | Retrieve a single value.  If conflicting values are returned, the+-- 'Monoid' is used to choose a winner.+get :: (Monoid c, V.IsContent c) =>+       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))+get = M.get V.get+{-# INLINE get #-}++-- | Retrieve multiple values.  If conflicting values are returned for+-- a key, the 'Monoid' is used to choose a winner.+getMany :: (Monoid c, V.IsContent c) => Connection -> Bucket -> [Key] -> R+        -> IO [Maybe (c, VClock)]+getMany = M.getMany V.getMany+{-# INLINE getMany #-}++-- | Store a single value, automatically resolving any vector clock+-- conflicts that arise.  A single invocation of this function may+-- involve several roundtrips to the server to resolve conflicts.+--+-- If a conflict arises, a winner will be chosen using 'mconcat', and+-- the winner will be stored; this will be repeated until no conflict+-- occurs.+--+-- The final value to be stored at the end of any conflict resolution+-- is returned.+put :: (Monoid c, V.IsContent c) =>+       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+    -> IO (c, VClock)+put = M.put V.put +{-# INLINE put #-}++-- | Store a single value, automatically resolving any vector clock+-- conflicts that arise.  A single invocation of this function may+-- involve several roundtrips to the server to resolve conflicts.+--+-- If a conflict arises, a winner will be chosen using 'mconcat', and+-- the winner will be stored; this will be repeated until no conflict+-- occurs.+put_ :: (Monoid c, V.IsContent c) =>+        Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW+     -> IO ()+put_ = M.put_ V.put +{-# INLINE put_ #-}++-- | Store multiple values, resolving any vector clock conflicts that+-- arise.  A single invocation of this function may involve several+-- roundtrips to the server to resolve conflicts.+--+-- If any conflicts arise, a winner will be chosen in each case using+-- 'mconcat', and the winners will be stored; this will be repeated+-- until no conflicts occur.+--+-- For each original value to be stored, the final value that was+-- stored at the end of any conflict resolution is returned.+putMany :: (Monoid c, V.IsContent c) =>+           Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+        -> IO [(c, VClock)]+putMany = M.putMany V.putMany+{-# INLINE putMany #-}++-- | Store multiple values, resolving any vector clock conflicts that+-- arise.  A single invocation of this function may involve several+-- roundtrips to the server to resolve conflicts.+--+-- If any conflicts arise, a winner will be chosen in each case using+-- 'mconcat', and the winners will be stored; this will be repeated+-- until no conflicts occur.+putMany_ :: (Monoid c, V.IsContent c) =>+           Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW+        -> IO ()+putMany_ = M.putMany_ V.putMany+{-# INLINE putMany_ #-}
+ src/riakclient.proto view
@@ -0,0 +1,246 @@+/* -------------------------------------------------------------------+**+** riakclient.proto: Protocol buffers for riak+**+** Copyright (c) 2007-2010 Basho Technologies, Inc.  All Rights Reserved.+**+** This file is provided to you under the Apache License,+** Version 2.0 (the "License"); you may not use this file+** except in compliance with the License.  You may obtain+** a copy of the License at+**+**   http://www.apache.org/licenses/LICENSE-2.0+**+** Unless required by applicable law or agreed to in writing,+** software distributed under the License is distributed on an+** "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY+** KIND, either express or implied.  See the License for the+** specific language governing permissions and limitations+** under the License.+**+** -------------------------------------------------------------------+*/+/*+** Revision: 1.1+**+** Lowest Common Denominator Protocol Buffers Client+**   - no ENUM (protobuffs_erlang does not support)+**+** Protocol +**+**   The protocol encodes requests and responses as protocol buffer messages.+**   Each request message results in one or more response messages.+**   As message type and length are not encoded by PB they are sent+**   on the wire as+**+**     <length:32>  <msg_code:8> <pbmsg>+**+**     length is the length of msg_code (1 byte) plus the message length+**     in bytes encoded in network order (big endian)+**+**     msg_code indicates what is encoded as pbmsg+**+**     pbmsg is the encoded protocol buffer message+**+**   On connect, the client can make requests and will receive responses.+**   For each request message there is a corresponding response message,+**   or the server will respond with an error message if something has+**   gone wrong.+**+**   The client should be prepared to handle messages without any pbmsg+**   (i.e. length==1) for requests like ping or a put without return_body set.+**   +**   RpbGetClientIdReq -> RpbGetClientIdResp+**   RpbSetClientIdReq -> RpbSetClientIdResp+**   RpbGetServerInfoReq -> RpbGetServerInfoResp+**   RpbPingReq -> RpbPingResp+**   RpbGetReq -> RpbErrorResp | RbpGetResp+**   RpbPutReq -> RpbErrorResp | RpbPutResp+**   RpbDelReq -> RpbErrorResp | RpbDelResp+**   RpbListBucketsReq -> RpbErrorResp | RpbListBucketsResp+**   RpbListKeysReq -> RpbErrorResp | RpbListKeysResp{1,}+**   RpbGetBucketReq -> RpbErrorResp | RpbGetBucketResp+**+**+** Message Codes+**  0 - RpbErrorResp+**  1 - RpbPingReq - 0 length+**  2 - RpbPingResp (pong) - 0 length+**  3 - RpbGetClientIdReq+**  4 - RpbGetClientIdResp+**  5 - RpbSetClientIdReq+**  6 - RpbSetClientIdResp+**  7 - RpbGetServerInfoReq+**  8 - RpbGetServerInfoResp+**  9 - RpbGetReq +** 10 - RpbGetResp+** 11 - RpbPutReq +** 12 - RpbPutResp - 0 length+** 13 - RpbDelReq +** 14 - RpbDelResp+** 15 - RpbListBucketsReq+** 16 - RpbListBucketsResp+** 17 - RpbListKeysReq+** 18 - RpbListKeysResp{1,}+** 19 - RpbGetBucketReq+** 20 - RpbGetBucketResp+** 21 - RpbSetBucketReq+** 22 - RpbSetBucketResp+** 23 - RpbMapRedReq+** 24 - RpbMapRedResp{1,}+**+*/++// Error response - may be generated for any Req+message RpbErrorResp {+    required bytes errmsg = 1;+    required uint32 errcode = 2;+}++// Get ClientId Request - no message defined, just send RpbGetClientIdReq message code+message RpbGetClientIdResp {+    required bytes client_id = 1; // Client id in use for this connection+}++message RpbSetClientIdReq {+    required bytes client_id = 1; // Client id to use for this connection+}+// Set ClientId Request - no message defined, just send RpbSetClientIdReq message code++// Get server info request - no message defined, just send RpbGetServerInfoReq message code++message RpbGetServerInfoResp {+    optional bytes node = 1;+    optional bytes server_version = 2;+}+++// Get Request - retrieve bucket/key+message RpbGetReq {+    required bytes bucket = 1;+    required bytes key = 2;+    optional uint32 r = 3;+}++// Get Response - if the record was not found there will be no content/vclock+message RpbGetResp {+    repeated RpbContent content = 1;+    optional bytes vclock = 2;        // the opaque vector clock for the object+}+++// Put request - if options.return_body is set then the updated metadata/data for+//               the key will be returned.+message RpbPutReq {+    required bytes bucket = 1;+    required bytes key = 2;+    optional bytes vclock = 3;+    required RpbContent content = 4;+    optional uint32 w = 5;+    optional uint32 dw = 6;+    optional bool return_body = 7;+}++// Put response - same as get response+message RpbPutResp {+    repeated RpbContent content = 1;+    optional bytes vclock = 2;        // the opaque vector clock for the object+}+++// Delete request+message RpbDelReq {+    required bytes bucket = 1;+    required bytes key = 2;+    optional uint32 rw = 3;+}++// Delete response - not defined, will return a RpbDelResp on success or RpbErrorResp on failure++// List buckets request - no message defined, just send RpbListBucketsReq++// List buckets response+message RpbListBucketsResp {+    repeated bytes buckets = 1;+}+++// List keys in bucket request+message RpbListKeysReq {+    required bytes bucket = 1;+}++// List keys in bucket response - one or more of these packets will be sent+// the last one will have done set true (and may not have any keys in it)+message RpbListKeysResp {+    repeated bytes keys = 1;+    optional bool done = 2;+}++// Get bucket properties request+message RpbGetBucketReq {+    required bytes bucket = 1;+}++// Get bucket properties response+message RpbGetBucketResp {+    required RpbBucketProps props = 1;    +}++// Set bucket properties request+message RpbSetBucketReq {+    required bytes bucket = 1;+    required RpbBucketProps props = 2;+}+++// Set bucket properties response - no message defined, just send RpbSetBucketResp+++// Map/Reduce request+message RpbMapRedReq {+    required bytes request = 1;+    required bytes content_type = 2;+}++// Map/Reduce response+// one or more of these packets will be sent the last one will have done set+// true (and may not have phase/data in it)+message RpbMapRedResp {+    optional uint32 phase = 1;+    optional bytes response = 2;+    optional bool done = 3;+}++// Content message included in get/put responses+// Holds the value and associated metadata+message RpbContent {+    required bytes value = 1;+    optional bytes content_type = 2;     // the media type/format+    optional bytes charset = 3;          +    optional bytes content_encoding = 4; +    optional bytes vtag = 5;+    repeated RpbLink links = 6;          // links to other resources+    optional uint32 last_mod = 7;+    optional uint32 last_mod_usecs = 8;+    repeated RpbPair usermeta = 9;       // user metadata stored with the object+}++// Key/value pair - used for user metadata+message RpbPair {+    required bytes key = 1;+    optional bytes value = 2;+}++// Link metadata+message RpbLink {+    optional bytes bucket = 1;+    optional bytes key = 2;+    optional bytes tag = 3;+}++// Bucket properties+message RpbBucketProps {+    optional uint32 n_val = 1;+    optional bool allow_mult = 2;+}
+ src/riakextra.proto view
@@ -0,0 +1,4 @@+message RpbPingReq { }+message RpbGetClientIdReq { }+message RpbGetServerInfoReq { }+message RpbListBucketsReq { }