riak 0.7.0.3 → 0.7.2.0

raw patch · 7 files changed

+106/−14 lines, 7 filesdep +QuickCheckdep +monad-controldep +protocol-buffers-forkdep −protocol-buffersdep ~basedep ~resource-pooldep ~riak-protobufPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, monad-control, protocol-buffers-fork, riak, test-framework, test-framework-quickcheck2

Dependencies removed: protocol-buffers

Dependency ranges changed: base, resource-pool, riak-protobuf

API changes (from Hackage documentation)

Files

• README.markdown +2/−3
• riak.cabal +19/−4
• src/Network/Riak/Connection/Pool.hs +27/−1
• src/Network/Riak/Content.hs +1/−0
• src/Network/Riak/Request.hs +7/−4
• src/Network/Riak/Resolvable/Internal.hs +2/−2
• tests/Properties.hs +48/−0

@@ -3,7 +3,7 @@ This library is a fast Haskell client for the [Riak](http://www.basho.com/Riak.html) decentralized key/value data store. -It uses Riak's [protobuf API](http://wiki.basho.com/PBC-API.html) for+It uses Riak's [protobuf API](http://docs.basho.com/riak/latest/dev/references/protocol-buffers/) for optimal performance.  This project was originally the work of Bryan O'Sullivan (<bos@serpentine.com>), and then [Janrain, Inc.](http://janrain.com/), it is now being maintained by Mark Hibberd (<mark@hibberd.id.au>).@@ -14,7 +14,7 @@ and other improvements.  Please report bugs via the-[github issue tracker](http://github.com/markhibberd/riak-haskell- client/issues).+[github issue tracker](http://github.com/markhibberd/riak-haskell-client/issues).  Master [git repository](http://github.com/markhibberd/riak-haskell-client): @@ -26,4 +26,3 @@ # Build  [![Build Status](https://travis-ci.org/markhibberd/riak-haskell-client.svg)](https://travis-ci.org/markhibberd/riak-haskell-client)-

@@ -1,5 +1,5 @@ name:                riak-version:             0.7.0.3+version:             0.7.2.0 synopsis:            A Haskell client for the Riak decentralized data store description:   A Haskell client library for the Riak decentralized data@@ -86,12 +86,13 @@     blaze-builder,     bytestring,     containers,+    monad-control >= 0.2.0.1,     network >= 2.3,-    resource-pool >= 0.1.0.2,-    protocol-buffers >= 2.0.5,+    resource-pool == 0.2.*,+    protocol-buffers-fork == 2.0.*,     pureMD5,     random,-    riak-protobuf >= 0.16.0.1,+    riak-protobuf == 0.18.*,     text >= 0.11.0.6,     time @@ -104,6 +105,20 @@     cpp-options: -DASSERTS -DDEBUG    ghc-options: -Wall++test-suite test+  type: exitcode-stdio-1.0+  main-is: Properties.hs+  hs-source-dirs: tests+  ghc-options: -Wall++  build-depends:+    riak,+    base,+    bytestring,+    QuickCheck,+    test-framework,+    test-framework-quickcheck2  source-repository head   type:     git

@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, NamedFieldPuns, RecordWildCards,-    ScopedTypeVariables #-}+    ScopedTypeVariables, FlexibleContexts #-}  -- | -- Module:      Network.Riak.Connection.Pool@@ -21,8 +21,10 @@     , maxConnections     , numStripes     , withConnection+    , withConnectionM     ) where +import Control.Monad.Trans.Control (MonadBaseControl) import Data.Time.Clock (NominalDiffTime) import Data.Typeable (Typeable) import Network.Riak (Client(clientID), Connection, connect, disconnect)@@ -123,3 +125,27 @@ -- user (who expects the connection to be valid) to throw an exception. withConnection :: Pool -> (Connection -> IO a) -> IO a withConnection = Pool.withResource . pool++-- | Temporarily take a connection from a 'Pool', perform an action+-- with it, and return it to the pool afterwards. This is a+-- generalization of 'withConnection', which remains specialized to+-- prevent breaking source compatibility with existing code.+--+-- * If the pool has a connection available, it is used+--   immediately.+--+-- * Otherwise, if the maximum number of connections has not been+--   reached, a new connection is created and used.+--+-- * If the maximum number of connections has been reached, this+--   function blocks until a connection becomes available, then that+--   connection is used.+--+-- If the action throws an exception of any type, the 'Connection' is+-- destroyed, and not returned to the pool.+--+-- It probably goes without saying that you should never call+-- 'disconnect' on a connection, as doing so will cause a subsequent+-- user (who expects the connection to be valid) to throw an exception.+withConnectionM :: MonadBaseControl IO m => Pool -> (Connection -> m a) -> m a+withConnectionM = Pool.withResource . pool

@@ -47,6 +47,7 @@                 , last_mod_usecs = Nothing                 , usermeta = Seq.empty                 , indexes  = Seq.empty+                , deleted = Nothing                 }  -- | Content encoded as @application/octet-stream@.

@@ -88,6 +88,9 @@                                   , Get.if_modified = Nothing                                   , Get.head        = Nothing                                   , Get.deletedvclock = Nothing+                                  , Get.timeout = Nothing+                                  , Get.sloppy_quorum = Nothing+                                  , Get.n_val = Nothing                                   } {-# INLINE get #-} @@ -99,7 +102,7 @@ put bucket key mvclock cont mw mdw returnBody =     Put.PutRequest (escape bucket) (Just $ escape key) (fromVClock <$> mvclock)                    cont (fromQuorum mw) (fromQuorum mdw) (Just returnBody)-                   Nothing Nothing Nothing Nothing+                   Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing {-# INLINE put #-}  -- | Create a link.  The bucket and key names are URL-escaped.@@ -111,17 +114,17 @@ delete :: Bucket -> Key -> RW -> Del.DeleteRequest delete bucket key rw = Del.DeleteRequest (escape bucket) (escape key)                                          (fromQuorum rw) Nothing Nothing Nothing-                                         Nothing Nothing Nothing+                                         Nothing Nothing Nothing Nothing Nothing Nothing {-# INLINE delete #-}  -- | Create a list-buckets request. listBuckets :: ListBucketsRequest-listBuckets = ListBucketsRequest+listBuckets = ListBucketsRequest Nothing Nothing {-# INLINE listBuckets #-}  -- | Create a list-keys request.  The bucket name is URL-escaped. listKeys :: Bucket -> Keys.ListKeysRequest-listKeys = Keys.ListKeysRequest . escape+listKeys b = Keys.ListKeysRequest (escape b) Nothing {-# INLINE listKeys #-}  -- | Create a get-bucket request.  The bucket name is URL-escaped.

@@ -131,7 +131,7 @@         case xs of           [x] | i > 0 || isJust mvclock -> return (x, vclock)           (_:_) -> do debugValues "put" "conflict" xs-                      go (i+1) (resolveMany' val xs) (Just vclock)+                      go (i+1) (resolveMany xs) (Just vclock)           []    -> unexError "Network.Riak.Resolvable" "put"                    "received empty response from server"   go (0::Int) val0 mvclock0@@ -189,7 +189,7 @@   mush (i,(k,mv,c)) (cs,v) =       case cs of         [x] | i > 0 || isJust mv -> Right (i,(x,v))-        (_:_) -> Left (i,(k,Just v, resolveMany' c cs))+        (_:_) -> Left (i,(k,Just v, resolveMany cs))         []    -> unexError "Network.Riak.Resolvable" "put"                  "received empty response from server" {-# INLINE putMany #-}

@@ -0,0 +1,48 @@+import Control.Applicative ((<$>))+import Control.Exception (finally)+import Control.Monad (forM_)+import Data.IORef (IORef, modifyIORef, newIORef, readIORef)+import Network.Riak.Connection (defaultClient)+import Network.Riak.Connection.Pool (Pool, create, withConnection)+import Network.Riak.Content (binary)+import Network.Riak.Types (Bucket, Key, Quorum(..))+import System.IO.Unsafe (unsafePerformIO)+import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Arbitrary(..), (==>))+import Test.QuickCheck.Monadic (assert, monadicIO, run)+import qualified Data.ByteString.Lazy as L+import qualified Network.Riak.Basic as B+import qualified Network.Riak.JSON as J+import qualified Network.Riak.Value as V++instance Arbitrary L.ByteString where+    arbitrary     = L.pack `fmap` arbitrary++cruft :: IORef [(Bucket, Key)]+{-# NOINLINE cruft #-}+cruft = unsafePerformIO $ newIORef []++pool :: Pool+{-# NOINLINE pool #-}+pool = unsafePerformIO $+       create defaultClient 1 1 1++t_put_get b k v = notempty b && notempty k ==> monadicIO $ assert . uncurry (==) =<< run act+ where+  act = withConnection pool $ \c -> do+          modifyIORef cruft ((b,k):)+          p <- Just <$> B.put c b k Nothing (binary v) Default Default+          r <- B.get c b k Default+          return (p,r)+  notempty = not . L.null++main = defaultMain tests `finally` cleanup+  where+    cleanup = withConnection pool $ \c -> do+                bks <- readIORef cruft+                forM_ bks $ \(b,k) -> B.delete c b k Default++tests = [+  testProperty "t_put_get" t_put_get+ ]