Commits

Bryan O'Sullivan committed e42792a

Implement getBucket, setBucket, and mapReduce.

  • Participants
  • Parent commits 3c0b4c3

Comments (0)

Files changed (3)

src/Network/Riak.hs

     , delete
     , listBuckets
     , listKeys
+    , getBucket
+    , setBucket
+    , mapReduce
     ) where
 
 import qualified Data.ByteString.Char8 as B
 import Network.Riakclient.RpbGetServerInfoResp
 import Network.Riakclient.RpbListBucketsResp
 import Network.Riakclient.RpbListKeysReq
+import Network.Riakclient.RpbSetBucketReq
 import Network.Riakclient.RpbListKeysResp
 import Network.Riakextra.RpbPingReq
 import Network.Riakextra.RpbGetClientIdReq
 import System.Random
 import Network.Riakclient.RpbGetReq as GetReq
 import Network.Riakclient.RpbGetResp
+import Network.Riakclient.RpbGetBucketReq
+import Network.Riakclient.RpbMapRedReq
+import Network.Riakclient.RpbMapRedResp
+import Network.Riakclient.RpbGetBucketResp as GetBucketResp
 import Network.Riakclient.RpbSetClientIdReq
 import Network.Riakclient.RpbGetClientIdResp as GetClientIdResp
 import Network.Riak.Message
   sendRequest conn $ RpbListKeysReq bucket
   RpbListKeysResp{..} <- recvResponse conn
   return (keys, done)
+
+getBucket :: Connection -> T.Bucket -> IO BucketProps
+getBucket conn bucket = do
+  sendRequest conn $ RpbGetBucketReq bucket
+  GetBucketResp.props <$> recvResponse conn
+
+setBucket :: Connection -> T.Bucket -> BucketProps -> IO ()
+setBucket conn bucket props = do
+  sendRequest conn $ RpbSetBucketReq bucket props
+  recvResponse_ conn SetBucketResp
+
+mapReduce :: Connection -> Job -> IO MapReduce
+mapReduce conn job = do
+  sendRequest conn $ case job of
+                       JSON bs -> RpbMapRedReq bs "application/json"
+                       Erlang bs -> RpbMapRedReq bs "application/x-erlang-binary"
+  recvResponse conn

src/Network/Riak/Message/Tag.hs

 import Network.Riakclient.RpbSetBucketReq
 import Network.Riakclient.RpbListBucketsResp
 import Network.Riakclient.RpbMapRedReq
+import Network.Riakclient.RpbMapRedResp
 import Network.Riakextra.RpbPingReq
 import Network.Riakextra.RpbGetClientIdReq
 import Network.Riakextra.RpbListBucketsReq
 
 instance Request RpbMapRedReq
 
+instance Tagged RpbMapRedResp where
+    messageTag _ = MapRedResp
+    {-# INLINE messageTag #-}
+
+instance Response RpbMapRedResp
+
 putTag :: MessageTag -> Put
 putTag = putWord8 . fromIntegral . fromEnum
 {-# INLINE putTag #-}

src/Network/Riak/Types.hs

     , Client(..)
     , Content
     , ServerInfo
+    , BucketProps
+    , MapReduce
+    , Job(..)
     , Connection(..)
     , Bucket
     , Key
 import Network.Socket
 import Network.Riakclient.RpbContent
 import Network.Riakclient.RpbGetServerInfoResp
+import Network.Riakclient.RpbBucketProps
+import Network.Riakclient.RpbMapRedResp
 import Network.Riak.Types.Internal
     
 type ClientID = L.ByteString
 type Content = RpbContent
 
 type ServerInfo = RpbGetServerInfoResp
+
+type BucketProps = RpbBucketProps
+  
+type MapReduce = RpbMapRedResp
+
+data Job = JSON L.ByteString
+         | Erlang L.ByteString
+           deriving (Eq, Show)