diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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 + diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -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, +. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/proto.sh b/proto.sh new file mode 100644 --- /dev/null +++ b/proto.sh @@ -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 diff --git a/riak.cabal b/riak.cabal new file mode 100644 --- /dev/null +++ b/riak.cabal @@ -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 +maintainer: Bryan O'Sullivan +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 diff --git a/src/Network/Riak.hs b/src/Network/Riak.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak.hs @@ -0,0 +1,70 @@ +-- | +-- Module: Network.Riak +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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) diff --git a/src/Network/Riak/Basic.hs b/src/Network/Riak/Basic.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Basic.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} + +-- | +-- Module: Network.Riak.Basic +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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 diff --git a/src/Network/Riak/Connection.hs b/src/Network/Riak/Connection.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Connection.hs @@ -0,0 +1,30 @@ +-- | +-- Module: Network.Riak.Connection +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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 diff --git a/src/Network/Riak/Connection/Internal.hs b/src/Network/Riak/Connection/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Connection/Internal.hs @@ -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 +-- 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" diff --git a/src/Network/Riak/Connection/NoPush.hsc b/src/Network/Riak/Connection/NoPush.hsc new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Connection/NoPush.hsc @@ -0,0 +1,44 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | +-- Module: Network.Riak.Connection.NoPush +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- TCP madness. + +module Network.Riak.Connection.NoPush (setNoPush) where + +#include +#include +#include + +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 diff --git a/src/Network/Riak/Content.hs b/src/Network/Riak/Content.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Content.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Network.Riak.Content +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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" + } diff --git a/src/Network/Riak/Debug.hs b/src/Network/Riak/Debug.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Debug.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE CPP, ScopedTypeVariables #-} + +-- | +-- Module: Network.Riak.Debug +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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) diff --git a/src/Network/Riak/JSON.hs b/src/Network/Riak/JSON.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/JSON.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} + +-- | +-- Module: Network.Riak.JSON +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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) diff --git a/src/Network/Riak/JSON/Monoid.hs b/src/Network/Riak/JSON/Monoid.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/JSON/Monoid.hs @@ -0,0 +1,127 @@ +-- | +-- Module: Network.Riak.JSON.Monoid +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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_ #-} diff --git a/src/Network/Riak/Monoid.hs b/src/Network/Riak/Monoid.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Monoid.hs @@ -0,0 +1,83 @@ +-- | +-- Module: Network.Riak.Monoid +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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_ #-} diff --git a/src/Network/Riak/Protocol.hs b/src/Network/Riak/Protocol.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol.hs @@ -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") diff --git a/src/Network/Riak/Protocol/BucketProps.hs b/src/Network/Riak/Protocol/BucketProps.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/BucketProps.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/Content.hs b/src/Network/Riak/Protocol/Content.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/Content.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/DeleteRequest.hs b/src/Network/Riak/Protocol/DeleteRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/DeleteRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/ErrorResponse.hs b/src/Network/Riak/Protocol/ErrorResponse.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/ErrorResponse.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/GetBucketRequest.hs b/src/Network/Riak/Protocol/GetBucketRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/GetBucketRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/GetBucketResponse.hs b/src/Network/Riak/Protocol/GetBucketResponse.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/GetBucketResponse.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/GetClientIDRequest.hs b/src/Network/Riak/Protocol/GetClientIDRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/GetClientIDRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/GetClientIDResponse.hs b/src/Network/Riak/Protocol/GetClientIDResponse.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/GetClientIDResponse.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/GetRequest.hs b/src/Network/Riak/Protocol/GetRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/GetRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/GetResponse.hs b/src/Network/Riak/Protocol/GetResponse.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/GetResponse.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/GetServerInfoRequest.hs b/src/Network/Riak/Protocol/GetServerInfoRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/GetServerInfoRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/Link.hs b/src/Network/Riak/Protocol/Link.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/Link.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/ListBucketsRequest.hs b/src/Network/Riak/Protocol/ListBucketsRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/ListBucketsRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/ListBucketsResponse.hs b/src/Network/Riak/Protocol/ListBucketsResponse.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/ListBucketsResponse.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/ListKeysRequest.hs b/src/Network/Riak/Protocol/ListKeysRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/ListKeysRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/ListKeysResponse.hs b/src/Network/Riak/Protocol/ListKeysResponse.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/ListKeysResponse.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/MapReduce.hs b/src/Network/Riak/Protocol/MapReduce.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/MapReduce.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/MapReduceRequest.hs b/src/Network/Riak/Protocol/MapReduceRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/MapReduceRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/Pair.hs b/src/Network/Riak/Protocol/Pair.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/Pair.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/PingRequest.hs b/src/Network/Riak/Protocol/PingRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/PingRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/PutRequest.hs b/src/Network/Riak/Protocol/PutRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/PutRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/PutResponse.hs b/src/Network/Riak/Protocol/PutResponse.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/PutResponse.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/ServerInfo.hs b/src/Network/Riak/Protocol/ServerInfo.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/ServerInfo.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/SetBucketRequest.hs b/src/Network/Riak/Protocol/SetBucketRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/SetBucketRequest.hs @@ -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}" diff --git a/src/Network/Riak/Protocol/SetClientIDRequest.hs b/src/Network/Riak/Protocol/SetClientIDRequest.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Protocol/SetClientIDRequest.hs @@ -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}" diff --git a/src/Network/Riak/Request.hs b/src/Network/Riak/Request.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Request.hs @@ -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" diff --git a/src/Network/Riak/Response.hs b/src/Network/Riak/Response.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Response.hs @@ -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 #-} diff --git a/src/Network/Riak/Tag.hs b/src/Network/Riak/Tag.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Tag.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +-- | +-- Module: Network.Riak.Content +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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" diff --git a/src/Network/Riak/Types.hs b/src/Network/Riak/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Types.hs @@ -0,0 +1,40 @@ +-- | +-- Module: Network.Riak.Types +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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 diff --git a/src/Network/Riak/Types/Internal.hs b/src/Network/Riak/Types/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Types/Internal.hs @@ -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 +-- 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 +-- for details. +type Tag = ByteString + +-- | A specification of a MapReduce +-- job. . +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 #-} diff --git a/src/Network/Riak/Value.hs b/src/Network/Riak/Value.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Value.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} + +-- | +-- Module: Network.Riak.Value +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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 diff --git a/src/Network/Riak/Value/Monoid.hs b/src/Network/Riak/Value/Monoid.hs new file mode 100644 --- /dev/null +++ b/src/Network/Riak/Value/Monoid.hs @@ -0,0 +1,105 @@ +-- | +-- Module: Network.Riak.Value.Monoid +-- Copyright: (c) 2011 MailRank, Inc. +-- License: Apache +-- Maintainer: Bryan O'Sullivan +-- 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_ #-} diff --git a/src/riakclient.proto b/src/riakclient.proto new file mode 100644 --- /dev/null +++ b/src/riakclient.proto @@ -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 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; +} diff --git a/src/riakextra.proto b/src/riakextra.proto new file mode 100644 --- /dev/null +++ b/src/riakextra.proto @@ -0,0 +1,4 @@ +message RpbPingReq { } +message RpbGetClientIdReq { } +message RpbGetServerInfoReq { } +message RpbListBucketsReq { }