riak 0.3.2.1 → 0.4.0.0

raw patch · 11 files changed

+360/−80 lines, 11 filesdep ~aesondep ~attoparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, attoparsec

API changes (from Hackage documentation)

Files

• riak.cabal +3/−3
• src/Network/Riak.hs +7/−2
• src/Network/Riak/Basic.hs +12/−2
• src/Network/Riak/Connection/Pool.hs +1/−1
• src/Network/Riak/JSON.hs +34/−2
• src/Network/Riak/JSON/Resolvable.hs +84/−24
• src/Network/Riak/Resolvable.hs +3/−1
• src/Network/Riak/Resolvable/Internal.hs +91/−23
• src/Network/Riak/Types/Internal.hs +11/−1
• src/Network/Riak/Value.hs +34/−1
• src/Network/Riak/Value/Resolvable.hs +80/−20

@@ -1,5 +1,5 @@ name:                riak-version:             0.3.2.1+version:             0.4.0.0 synopsis:            A Haskell client for the Riak decentralized data store description:   A Haskell client library for the Riak decentralized data@@ -79,8 +79,8 @@     Network.Riak.Types.Internal      build-depends:       -    aeson >= 0.2.0.0,-    attoparsec >= 0.8.5.0,+    aeson >= 0.3.2.4,+    attoparsec >= 0.8.5.3,     base == 4.*,     binary,     blaze-builder,

@@ -50,11 +50,15 @@     , getServerInfo     -- * Data management     , Quorum(..)+    , Resolvable(..)     , get     , getMany+    , modify+    , modify_+    , delete+    -- ** Low-level modification functions     , put     , putMany-    , delete     -- * Metadata     , listBuckets     , foldKeys@@ -65,4 +69,5 @@     ) where  import Network.Riak.Basic hiding (get, put, put_)-import Network.Riak.JSON.Resolvable (get, getMany, put, putMany)+import Network.Riak.JSON.Resolvable (get, getMany, modify, modify_, put, putMany)+import Network.Riak.Resolvable (Resolvable(..))

@@ -71,8 +71,8 @@ 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.+-- | Retrieve 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)@@ -80,6 +80,11 @@ -- | Store a single value.  This may return multiple conflicting -- siblings.  Choosing among them, and storing a new value, is your -- responsibility.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored. put :: Connection -> T.Bucket -> T.Key -> Maybe T.VClock     -> Content -> W -> DW     -> IO (Seq.Seq Content, VClock)@@ -88,6 +93,11 @@  -- | Store a single value, without the possibility of conflict -- resolution.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored, and you will not be notified. put_ :: Connection -> T.Bucket -> T.Key -> Maybe T.VClock      -> Content -> W -> DW      -> IO ()

@@ -179,7 +179,7 @@ -- -- It probably goes without saying that you should never call -- 'disconnect' on a connection, as doing so will cause a subsequent--- user, expecting the connection to be valid, to throw an exception.+-- user (who expects the connection to be valid) to throw an exception. withConnection :: Pool -> (Connection -> IO a) -> IO a withConnection Pool{..} act = do   i <- ((`mod` numStripes) . hash) <$> myThreadId

@@ -54,6 +54,8 @@     toContent (J a) = V.toContent (toJSON a)     {-# INLINE toContent #-} +-- | Retrieve a value.  This may return multiple conflicting siblings.+-- Choosing among them is your responsibility. 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@@ -62,25 +64,55 @@     -> IO [Maybe ([c], VClock)] getMany conn bucket ks r = map (fmap convert) <$> V.getMany conn bucket ks r +-- | Store a single value.  This may return multiple conflicting+-- siblings.  Choosing among them, and storing a new value, is your+-- responsibility.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored. 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 +-- | Store a single value, without the possibility of conflict+-- resolution.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored, and you will not be notified. 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 +-- | Store many values.  This may return multiple conflicting siblings+-- for each value stored.  Choosing among them, and storing a new+-- value in each case, is your responsibility.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored. putMany :: (FromJSON c, ToJSON c) =>-       Connection -> Bucket -> [(Key, Maybe VClock, c)]-    -> W -> DW -> IO [([c], VClock)]+           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) +-- | Store many values, without the possibility of conflict+-- resolution.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored, and you will not be notified. putMany_ :: (FromJSON c, ToJSON c) =>             Connection -> Bucket -> [(Key, Maybe VClock, c)]          -> W -> DW -> IO ()

@@ -8,16 +8,22 @@ -- -- This module allows storage and retrieval of JSON-encoded data. ----- Functions automatically resolve conflicts using 'Resolvable' 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.+-- Functions automatically resolve conflicts using 'Resolvable'+-- instances.  For instance, if a 'get' returns three siblings, a+-- winner will be chosen using 'resolve'.  If a 'put' results in a+-- conflict, a winner will be chosen using 'resolve', and the winner+-- will be 'put'; this will be repeated until either no conflict+-- occurs or the process has been repeated too many times.  module Network.Riak.JSON.Resolvable     (-      get+      Resolvable(..)+    , ResolutionFailure(..)+    , get     , getMany+    , modify+    , modify_+    -- * Low-level modification functions     , put     , put_     , putMany@@ -25,36 +31,77 @@     ) where  import Data.Aeson.Types (FromJSON(..), ToJSON(..))-import Network.Riak.Resolvable.Internal (Resolvable)+import Network.Riak.Resolvable.Internal (ResolutionFailure(..), Resolvable(..)) import Network.Riak.Types.Internal hiding (MessageTag(..)) import qualified Network.Riak.JSON as J import qualified Network.Riak.Resolvable.Internal as R --- | Retrieve a single value.  If conflicting values are returned, the--- 'Resolvable' is used to choose a winner.+-- | Retrieve a single value.  If conflicting values are returned,+-- 'resolve' is used to choose a winner. get :: (FromJSON c, ToJSON c, Resolvable c) =>        Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock)) get = R.get J.get {-# INLINE get #-}  -- | Retrieve multiple values.  If conflicting values are returned for--- a key, the 'Resolvable' is used to choose a winner.+-- a key, 'resolve' is used to choose a winner. getMany :: (FromJSON c, ToJSON c, Resolvable c)            => Connection -> Bucket -> [Key] -> R -> IO [Maybe (c, VClock)] getMany = R.getMany J.getMany {-# INLINE getMany #-} +-- | Modify a single value.  The value, if any, is retrieved using+-- 'get'; conflict resolution is performed if necessary.  The+-- modification function is called on the resulting value, and its+-- result is stored using 'put', which may again perform conflict+-- resolution.+--+-- The result of this function is whatever was returned by 'put',+-- along with the auxiliary value returned by the modification+-- function.+--+-- If the 'put' phase of this function gives up due to apparently+-- being stuck in a conflict resolution loop, it will throw a+-- 'ResolutionFailure' exception.+modify :: (FromJSON a, ToJSON a, Resolvable a) =>+          Connection -> Bucket -> Key -> R -> W -> DW+       -> (Maybe a -> IO (a,b))+       -- ^ Modification function.  Called with 'Just' the value if+       -- the key is present, 'Nothing' otherwise.+       -> IO (a,b)+modify = R.modify J.get J.put+{-# INLINE modify #-}++-- | Modify a single value.  The value, if any, is retrieved using+-- 'get'; conflict resolution is performed if necessary.  The+-- modification function is called on the resulting value, and its+-- result is stored using 'put', which may again perform conflict+-- resolution.+--+-- The result of this function is whatever was returned by 'put'.+--+-- If the 'put' phase of this function gives up due to apparently+-- being stuck in a conflict resolution loop, it will throw a+-- 'ResolutionFailure' exception.+modify_ :: (FromJSON a, ToJSON a, Resolvable a) =>+           Connection -> Bucket -> Key -> R -> W -> DW+        -> (Maybe a -> IO a) -> IO a+modify_ = R.modify_ J.get J.put+{-# INLINE modify_ #-}+ -- | 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+-- If a conflict arises, a winner will be chosen using 'resolve', and -- the winner will be stored; this will be repeated until no conflict--- occurs.+-- occurs or a (fairly large) number of retries has been attempted+-- without success. ----- The final value to be stored at the end of any conflict resolution--- is returned.-put :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>+-- If this function gives up due to apparently being stuck in a+-- conflict resolution loop, it will throw a 'ResolutionFailure'+-- exception.+put :: (FromJSON c, ToJSON c, Resolvable c) =>        Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW     -> IO (c, VClock) put = R.put J.put@@ -64,10 +111,15 @@ -- 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+-- If a conflict arises, a winner will be chosen using 'resolve', and -- the winner will be stored; this will be repeated until no conflict--- occurs.-put_ :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>+-- occurs or a (fairly large) number of retries has been attempted+-- without success.+--+-- If this function gives up due to apparently being stuck in a+-- conflict resolution loop, it will throw a 'ResolutionFailure'+-- exception.+put_ :: (FromJSON c, ToJSON c, Resolvable c) =>         Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW      -> IO () put_ = R.put_ J.put@@ -78,12 +130,16 @@ -- 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.+-- 'resolve', and the winners will be stored; this will be repeated+-- until either no conflicts occur or a (fairly large) number of+-- retries has been attempted without success. -- -- For each original value to be stored, the final value that was -- stored at the end of any conflict resolution is returned.-putMany :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>+--+-- If this function gives up due to apparently being stuck in a loop,+-- it will throw a 'ResolutionFailure' exception.+putMany :: (FromJSON c, ToJSON c, Resolvable c) =>            Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW         -> IO [(c, VClock)] putMany = R.putMany J.putMany@@ -94,9 +150,13 @@ -- 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_ :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>+-- 'resolve', and the winners will be stored; this will be repeated+-- until either no conflicts occur or a (fairly large) number of+-- retries has been attempted without success.+--+-- If this function gives up due to apparently being stuck in a loop,+-- it will throw a 'ResolutionFailure' exception.+putMany_ :: (FromJSON c, ToJSON c, Resolvable c) =>             Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW          -> IO () putMany_ = R.putMany_ J.putMany

@@ -12,6 +12,8 @@     (       Resolvable(..)     , ResolvableMonoid(..)+    , ResolutionFailure(..)     ) where -import Network.Riak.Resolvable.Internal (Resolvable(..), ResolvableMonoid(..))+import Network.Riak.Resolvable.Internal+    (ResolutionFailure(..), Resolvable(..), ResolvableMonoid(..))

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} -- | -- Module:      Network.Riak.Resolvable.Internal -- Copyright:   (c) 2011 MailRank, Inc.@@ -8,31 +8,57 @@ -- Portability: portable -- -- Storage and retrieval of data with automatic conflict resolution.+--+-- The 'put' and 'putMany' functions will attempt to perform automatic+-- conflict resolution a large number of times.  If they give up due+-- to apparently being stuck in a loop, they will throw a+-- 'ResolutionFailure' exception.  module Network.Riak.Resolvable.Internal     (       Resolvable(..)     , ResolvableMonoid(..)+    , ResolutionFailure(..)     , get     , getMany+    , modify+    , modify_     , put     , put_     , putMany     , putMany_     ) where +import Control.Applicative ((<$>)) import Control.Arrow (first)+import Control.Exception (Exception, throwIO) import Control.Monad (unless) import Data.Aeson.Types (FromJSON, ToJSON) import Data.Data (Data) import Data.Either (partitionEithers) import Data.Function (on) import Data.List (foldl', sortBy)+import Data.Maybe (isJust) import Data.Monoid (Monoid(mappend)) import Data.Typeable (Typeable) import Network.Riak.Debug (debugValues) import Network.Riak.Types.Internal hiding (MessageTag(..)) +-- | Automated conflict resolution failed.+data ResolutionFailure = RetriesExceeded+    -- ^ Too many attempts were made to resolve a conflict, with each+    -- attempt resulting in another conflict.+    --+    -- The number of retries that the library will attempt is high+    -- (64). This makes it extremely unlikely that this exception will+    -- be thrown during normal application operation.  Instead, this+    -- exception is most likely to be thrown as a result of a bug in+    -- your application code, for example if your 'resolve' function+    -- is misbehaving.+                         deriving (Eq, Show, Typeable)++instance Exception ResolutionFailure+ -- | A type that can automatically resolve a vector clock conflict -- between two or more versions of a value. --@@ -48,7 +74,7 @@ -- If several conflicting siblings are found, 'resolve' will be -- applied over all of them using a fold, to yield a single -- \"winner\".-class (Eq a, Show a) => Resolvable a where+class (Show a) => Resolvable a where     -- | Resolve a conflict between two values.     resolve :: a -> a -> a @@ -67,9 +93,10 @@     resolve _          b        = b     {-# INLINE resolve #-} -get :: (Resolvable a) =>-       (Connection -> Bucket -> Key -> R -> IO (Maybe ([a], VClock)))-       -> (Connection -> Bucket -> Key -> R -> IO (Maybe (a, VClock)))+type Get a = Connection -> Bucket -> Key -> R -> IO (Maybe ([a], VClock))++get :: (Resolvable a) => Get a+    -> (Connection -> Bucket -> Key -> R -> IO (Maybe (a, VClock))) get doGet conn bucket key r =     fmap (first resolveMany) `fmap` doGet conn bucket key r {-# INLINE get #-}@@ -81,22 +108,40 @@     map (fmap (first resolveMany)) `fmap` doGet conn b ks r {-# INLINE getMany #-} -put :: (Resolvable a) =>-       (Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW-                   -> IO ([a], VClock))+-- If Riak receives a put request with no vclock, and the given+-- bucket+key already exists, it will treat the missing vclock as+-- stale, ignore the put request, and send back whatever values it+-- currently knows about.  The same problem will arise if we send a+-- vclock that really is stale, but that's much less likely to occur.+-- We handle the missing-vclock case in the single-body-response case+-- of both put and putMany below, but we do not (can not?) handle the+-- stale-vclock case.++type Put a = Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW+           -> IO ([a], VClock)++put :: (Resolvable a) => Put a     -> Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW     -> IO (a, 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+  let go !i val mvclock+         | i == maxRetries = throwIO RetriesExceeded+         | otherwise       = do+        (xs, vclock) <- doPut conn bucket key mvclock val w dw         case xs of-          []             -> return (val, vclock) -- not observed in the wild-          [v] | v == val -> return (val, vclock)-          ys             -> do debugValues "put" "conflict" ys-                               go (resolveMany' val ys) (Just vclock)-  go val0 mvclock0+          [x] | i > 0 || isJust mvclock -> return (x, vclock)+          (_:_) -> do debugValues "put" "conflict" xs+                      go (i+1) (resolveMany' val xs) (Just vclock)+          []    -> unexError "Network.Riak.Resolvable" "put"+                   "received empty response from server"+  go (0::Int) val0 mvclock0 {-# INLINE put #-} +-- | The maximum number of times to retry conflict resolution.+maxRetries :: Int+maxRetries = 64+{-# INLINE maxRetries #-}+ put_ :: (Resolvable a) =>         (Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW                     -> IO ([a], VClock))@@ -106,24 +151,47 @@     put doPut conn bucket key mvclock0 val0 w dw >> return () {-# INLINE put_ #-} +modify :: (Resolvable a) => Get a -> Put a+       -> Connection -> Bucket -> Key -> R -> W -> DW -> (Maybe a -> IO (a,b))+       -> IO (a,b)+modify doGet doPut conn bucket key r w dw act = do+  a0 <- get doGet conn bucket key r+  (a,b) <- act (fst <$> a0)+  (a',_) <- put doPut conn bucket key (snd <$> a0) a w dw+  return (a',b)+{-# INLINE modify #-}++modify_ :: (Resolvable a) => Get a -> Put a+        -> Connection -> Bucket -> Key -> R -> W -> DW -> (Maybe a -> IO a)+        -> IO a+modify_ doGet doPut conn bucket key r w dw act = do+  a0 <- get doGet conn bucket key r+  a <- act (fst <$> a0)+  fst <$> put doPut conn bucket key (snd <$> a0) a w dw+{-# INLINE modify_ #-}+ putMany :: (Resolvable a) =>            (Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW                        -> IO [([a], VClock)])         -> Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW         -> IO [(a, 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+putMany doPut conn bucket puts0 w dw = go (0::Int) [] . zip [(0::Int)..] $ puts0+ where+  go _ acc [] = return . map snd . sortBy (compare `on` fst) $ acc+  go !i acc puts+      | i == maxRetries = throwIO RetriesExceeded+      | otherwise = do     rs <- doPut conn bucket (map snd puts) w dw     let (conflicts, ok) = partitionEithers $ zipWith mush puts rs     unless (null conflicts) $       debugValues "putMany" "conflicts" conflicts-    go (ok++acc) conflicts-  mush (i,(k,_,c)) (cs,v) =+    go (i+1) (ok++acc) conflicts+  mush (i,(k,mv,c)) (cs,v) =       case cs of-        []           -> Right (i,(c,v)) -- not observed in the wild-        [x] | x == c -> Right (i,(c,v))-        _            -> Left (i,(k,Just v, resolveMany' c cs))+        [x] | i > 0 || isJust mv -> Right (i,(x,v))+        (_:_) -> Left (i,(k,Just v, resolveMany' c cs))+        []    -> unexError "Network.Riak.Resolvable" "put"+                 "received empty response from server" {-# INLINE putMany #-}  putMany_ :: (Resolvable a) =>

@@ -22,6 +22,7 @@     , RiakException(excModule, excFunction, excMessage)     , netError     , typeError+    , unexError     -- * Data types     , Bucket     , Key@@ -84,13 +85,19 @@       excModule :: String     , excFunction :: String     , excMessage :: String-    } deriving (Eq, Typeable)+    } | UnexpectedResponse {+      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+showRiakException exc@UnexpectedResponse{..} =+    "Riak server sent unexpected response " ++ formatRiakException exc  formatRiakException :: RiakException -> String formatRiakException exc =@@ -106,6 +113,9 @@  typeError :: String -> String -> String -> a typeError modu func msg = throw (TypeException modu func msg)++unexError :: String -> String -> String -> a+unexError modu func msg = throw (UnexpectedResponse modu func msg)  instance Show Connection where     show conn = show "Connection " ++ host c ++ ":" ++ port c

@@ -1,4 +1,5 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, RecordWildCards, StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, RecordWildCards,+    StandaloneDeriving #-}  -- | -- Module:      Network.Riak.Value@@ -79,12 +80,28 @@  deriving instance (IsContent a) => IsContent (ResolvableMonoid a) +-- | Store a single value.  This may return multiple conflicting+-- siblings.  Choosing among them, and storing a new value, is your+-- responsibility.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored. 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) +-- | Store many values.  This may return multiple conflicting siblings+-- for each value stored.  Choosing among them, and storing a new+-- value in each case, is your responsibility.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored. putMany :: (IsContent c) => Connection -> Bucket -> [(Key, Maybe VClock, c)]         -> W -> DW -> IO [([c], VClock)] putMany conn b puts w dw =@@ -98,16 +115,32 @@       c <- convert content       return (c, VClock s) +-- | Store a single value, without the possibility of conflict+-- resolution.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored, and you will not be notified. 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) +-- | Store many values, without the possibility of conflict+-- resolution.+--+-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure+-- that the given bucket+key combination does not already exist.  If+-- you omit a 'T.VClock' but the bucket+key /does/ exist, your value+-- will not be stored, and you will not be notified. 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 +-- | Retrieve a value.  This may return multiple conflicting siblings.+-- Choosing among them is your responsibility. get :: (IsContent c) => Connection -> Bucket -> Key -> R     -> IO (Maybe ([c], VClock)) get conn bucket key r = getResp =<< exchangeMaybe conn (Req.get bucket key r)

@@ -10,24 +10,30 @@ -- 'V.IsContent' typeclass.  This provides access to more of Riak's -- storage features than JSON, e.g. links. ----- Functions automatically resolve conflicts using 'Resolvable' 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.+-- Functions automatically resolve conflicts using 'Resolvable'+-- instances.  For instance, if a 'get' returns three siblings, a+-- winner will be chosen using 'resolve'.  If a 'put' results in a+-- conflict, a winner will be chosen using 'resolve', and the winner+-- will be 'put'; this will be repeated until either no conflict+-- occurs or the process has been repeated too many times.  module Network.Riak.Value.Resolvable     (       V.IsContent(..)+    , Resolvable(..)+    , ResolutionFailure(..)     , get     , getMany+    , modify+    , modify_+    -- * Low-level modification functions     , put     , put_     , putMany     , putMany_     ) where -import Network.Riak.Resolvable.Internal (Resolvable)+import Network.Riak.Resolvable.Internal (ResolutionFailure(..), Resolvable(..)) import Network.Riak.Types.Internal hiding (MessageTag(..)) import qualified Network.Riak.Resolvable.Internal as R import qualified Network.Riak.Value as V@@ -46,17 +52,58 @@ getMany = R.getMany V.getMany {-# INLINE getMany #-} +-- | Modify a single value.  The value, if any, is retrieved using+-- 'get'; conflict resolution is performed if necessary.  The+-- modification function is called on the resulting value, and its+-- result is stored using 'put', which may again perform conflict+-- resolution.+--+-- The result of this function is whatever was returned by 'put',+-- along with the auxiliary value returned by the modification+-- function.+--+-- If the 'put' phase of this function gives up due to apparently+-- being stuck in a conflict resolution loop, it will throw a+-- 'ResolutionFailure' exception.+modify :: (Resolvable a, V.IsContent a) =>+          Connection -> Bucket -> Key -> R -> W -> DW+       -> (Maybe a -> IO (a,b))+       -- ^ Modification function.  Called with 'Just' the value if+       -- the key is present, 'Nothing' otherwise.+       -> IO (a,b)+modify = R.modify V.get V.put+{-# INLINE modify #-}++-- | Modify a single value.  The value, if any, is retrieved using+-- 'get'; conflict resolution is performed if necessary.  The+-- modification function is called on the resulting value, and its+-- result is stored using 'put', which may again perform conflict+-- resolution.+--+-- The result of this function is whatever was returned by 'put'.+--+-- If the 'put' phase of this function gives up due to apparently+-- being stuck in a conflict resolution loop, it will throw a+-- 'ResolutionFailure' exception.+modify_ :: (Resolvable a, V.IsContent a) =>+           Connection -> Bucket -> Key -> R -> W -> DW+        -> (Maybe a -> IO a) -> IO a+modify_ = R.modify_ V.get V.put+{-# INLINE modify_ #-}+ -- | 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+-- If a conflict arises, a winner will be chosen using 'resolve', and -- the winner will be stored; this will be repeated until no conflict--- occurs.+-- occurs or a (fairly large) number of retries has been attempted+-- without success. ----- The final value to be stored at the end of any conflict resolution--- is returned.-put :: (Eq a, Resolvable a, V.IsContent a) =>+-- If this function gives up due to apparently being stuck in a+-- conflict resolution loop, it will throw a 'ResolutionFailure'+-- exception.+put :: (Resolvable a, V.IsContent a) =>        Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW     -> IO (a, VClock) put = R.put V.put @@ -66,10 +113,15 @@ -- 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+-- If a conflict arises, a winner will be chosen using 'resolve', and -- the winner will be stored; this will be repeated until no conflict--- occurs.-put_ :: (Eq a, Resolvable a, V.IsContent a) =>+-- occurs or a (fairly large) number of retries has been attempted+-- without success.+--+-- If this function gives up due to apparently being stuck in a+-- conflict resolution loop, it will throw a 'ResolutionFailure'+-- exception.+put_ :: (Resolvable a, V.IsContent a) =>         Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW      -> IO () put_ = R.put_ V.put @@ -80,12 +132,16 @@ -- 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.+-- 'resolve', and the winners will be stored; this will be repeated+-- until either no conflicts occur or a (fairly large) number of+-- retries has been attempted without success. -- -- For each original value to be stored, the final value that was -- stored at the end of any conflict resolution is returned.-putMany :: (Eq a, Resolvable a, V.IsContent a) =>+--+-- If this function gives up due to apparently being stuck in a loop,+-- it will throw a 'ResolutionFailure' exception.+putMany :: (Resolvable a, V.IsContent a) =>            Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW         -> IO [(a, VClock)] putMany = R.putMany V.putMany@@ -96,9 +152,13 @@ -- 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_ :: (Eq a, Resolvable a, V.IsContent a) =>+-- 'resolve', and the winners will be stored; this will be repeated+-- until either no conflicts occur or a (fairly large) number of+-- retries has been attempted without success.+--+-- If this function gives up due to apparently being stuck in a loop,+-- it will throw a 'ResolutionFailure' exception.+putMany_ :: (Resolvable a, V.IsContent a) =>             Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW -> IO () putMany_ = R.putMany_ V.putMany {-# INLINE putMany_ #-}