riak 0.9.0.0 → 0.9.1.0

raw patch · 10 files changed

+191/−64 lines, 10 filesdep +enclosed-exceptionsdep +exceptionsdep +mersenne-random-pure64dep −test-frameworkdep −test-framework-hunitdep −test-framework-quickcheck2dep ~aesondep ~monad-controldep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: enclosed-exceptions, exceptions, mersenne-random-pure64, random-shuffle, tasty, tasty-hunit, tasty-quickcheck, vector

Dependencies removed: test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: aeson, monad-control, time

API changes (from Hackage documentation)

Files

• riak.cabal +19/−10
• src/Network/Riak/Basic.hs +3/−1
• src/Network/Riak/Cluster.hs +69/−0
• src/Network/Riak/Escape.hs +5/−1
• src/Network/Riak/JSON.hs +5/−1
• src/Network/Riak/Request.hs +3/−1
• src/Network/Riak/Resolvable/Internal.hs +5/−1
• src/Network/Riak/Response.hs +3/−1
• tests/Properties.hs +20/−48
• tests/Test.hs +59/−0

@@ -1,5 +1,5 @@ name:                riak-version:             0.9.0.0+version:             0.9.1.0 synopsis:            A Haskell client for the Riak decentralized data store description:   A Haskell client library for the Riak decentralized data@@ -32,7 +32,7 @@ license:             OtherLicense license-file:        LICENSE author:              Bryan O'Sullivan <bos@serpentine.com>-maintainer:          Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>+maintainer:          Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>, Tim McGilchrist <timmcgil@gmail.com> copyright:           Copyright 2011 MailRank, Inc.                      Portions copyright 2007-2010 Basho Technologies, Inc. category:            Network@@ -65,6 +65,7 @@   exposed-modules:     Network.Riak     Network.Riak.Basic+    Network.Riak.Cluster     Network.Riak.Connection     Network.Riak.Connection.Pool     Network.Riak.Content@@ -88,23 +89,28 @@     Network.Riak.Types.Internal    build-depends:-                aeson                         >= 0.8 && < 0.10,+                aeson                         >= 0.8 && < 0.11,                 attoparsec                    >= 0.12.1.6 && < 0.14,                 base                          >= 3 && <5,                 binary,                 blaze-builder                 >= 0.3 && <= 0.5,                 bytestring,                 containers,+                enclosed-exceptions           >= 1.0.1.1 && <= 1.1,+                exceptions                    >= 0.8.0.2 && <= 0.9,                 transformers                  >= 0.3 && < 0.5,-                monad-control ,+                mersenne-random-pure64        >= 0.2.0.4 && < 0.3,+                monad-control                 >= 1.0.0.4 && < 1.1,                 network                       >= 2.3,                 resource-pool                 == 0.2.*,-                protocol-buffers >= 2.1.4 && < 2.2,+                protocol-buffers              >= 2.1.4 && < 2.2,                 pureMD5,                 random,+                random-shuffle                >= 0.0.4 && < 0.1,                 riak-protobuf                 == 0.20.*,                 text                          == 1.2.*,-                time+                time                          >= 1.4.2 && < 1.6,+                vector                        >= 0.10.12.3 && < 0.11    if flag(debug)     cpp-options: -DASSERTS -DDEBUG@@ -118,13 +124,16 @@  test-suite test   type: exitcode-stdio-1.0-  main-is: Properties.hs+  main-is: Test.hs   hs-source-dirs: tests   ghc-options: -Wall    if flag(test2i)     cpp-options: -DTEST2I +  other-modules:+    Properties+   build-depends:     base,     riak,@@ -132,7 +141,7 @@     containers,     HUnit,     QuickCheck,-    test-framework,-    test-framework-hunit,-    test-framework-quickcheck2,+    tasty,+    tasty-hunit,+    tasty-quickcheck,     text

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards, CPP #-}  -- | -- Module:      Network.Riak.Basic@@ -43,7 +43,9 @@     , mapReduce     ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))+#endif import Control.Monad.IO.Class import Data.Maybe (fromMaybe) import Network.Riak.Connection.Internal

@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Network.Riak.Cluster+    ( Cluster(..)+    , InClusterError(..)+    , connectToCluster+    , inCluster+    , Riak.create+    , Riak.defaultClient+    ) where++import           Control.Exception+import           Control.Exception.Enclosed+import           Control.Monad.Catch           (MonadThrow (..))+import           Control.Monad.Trans.Control   (MonadBaseControl)+import           Data.Typeable+import           Data.Vector                   (Vector)+import qualified Data.Vector                   as V+import           Network.Riak                  (Connection)+import qualified Network.Riak                  as Riak+import qualified Network.Riak.Connection.Pool  as Riak+import           System.Random.Mersenne.Pure64+import           System.Random.Shuffle         (shuffle')++-- | Datatype holding connection-pool with all known cluster nodes+data Cluster = Cluster+    { clusterPools :: Vector Riak.Pool+      -- ^ Vector of connection pools to riak cluster nodes+    , clusterGen   :: PureMT+    }+    deriving (Show)++-- | Error that gets thrown whenever operation couldn't succeed with+-- any node.+data InClusterError = InClusterError [SomeException]+    deriving (Show, Typeable)+instance Exception InClusterError++-- | Function to connect to riak cluster with sane pool defaults+connectToCluster :: [Riak.Client] -> IO Cluster+connectToCluster clients = do+    pools <- mapM (\c -> Riak.create c 1 10 20) clients+    connectToClusterWithPools pools++-- | Function to connect to riak cluster with pre-created list of+-- 'Riak.Pool' objects+connectToClusterWithPools :: [Riak.Pool] -> IO Cluster+connectToClusterWithPools pools = do+    mt <- newPureMT+    return (Cluster (V.fromList pools) mt)++-- | Tries to run some operation for a random riak node. If it fails,+-- tries all other nodes. If all other nodes fail - throws+-- 'InClusterError' exception.+inCluster :: (MonadThrow m, MonadBaseControl IO m)+          => Cluster -> (Connection -> m a) -> m a+inCluster rc f = do+    let pools = shuffle' (V.toList (clusterPools rc))+                         (V.length (clusterPools rc))+                         (clusterGen rc)+    go pools []+  where+    go [] errors = throwM (InClusterError errors)+    go (p:ps) es = Riak.withConnectionM p $ \c -> do+        er <- tryAny (f c)+        either (\err -> go ps (err:es))+               return er

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances, OverloadedStrings, CPP #-}  -- | -- Module:      Network.Riak.Connection@@ -24,12 +24,16 @@  import Blaze.ByteString.Builder (Builder, fromByteString, toByteString, toLazyByteString) import Blaze.ByteString.Builder.Word (fromWord8)+#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))+#endif import Data.Attoparsec.ByteString as A import Data.Attoparsec.Lazy as AL import Data.Bits ((.|.), (.&.), shiftL, shiftR) import Data.ByteString (ByteString)+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (mappend, mempty)+#endif import Data.Text (Text) import Data.Word (Word8) import Network.Riak.Functions (mapEither)

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP #-}  -- | -- Module:      Network.Riak.JSON@@ -26,10 +26,14 @@     , putMany_     ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))+#endif import Control.Arrow (first) import Data.Aeson.Types (FromJSON(..), ToJSON(..))+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid)+#endif import Data.Typeable (Typeable) import Network.Riak.Types.Internal import qualified Network.Riak.Value as V

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, CPP #-}  -- | -- Module:      Network.Riak.Request@@ -46,7 +46,9 @@     , mapReduce     ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))+#endif import qualified Data.ByteString.Char8 as B8 import Data.Monoid import Network.Riak.Protocol.BucketProps hiding (r,rw)

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP #-} -- | -- Module:      Network.Riak.Resolvable.Internal -- Copyright:   (c) 2011 MailRank, Inc.@@ -29,7 +29,9 @@     , putMany_     ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))+#endif import Control.Arrow (first) import Control.Exception (Exception, throwIO) import Control.Monad (unless)@@ -40,7 +42,9 @@ import Data.Function (on) import Data.List (foldl', sortBy) import Data.Maybe (isJust)+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid(mappend))+#endif import Data.Typeable (Typeable) import Network.Riak.Debug (debugValues) import Network.Riak.Types.Internal hiding (MessageTag(..))

@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, CPP #-}  -- | -- Module:      Network.Riak.Request@@ -26,7 +26,9 @@     , unescapeLinks     ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))+#endif import Data.Maybe (fromMaybe) import Network.Riak.Escape (unescape) import Network.Riak.Protocol.BucketProps

@@ -1,31 +1,25 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-}-import Control.Applicative ((<$>))-import Control.Exception (finally)-import Control.Monad (forM_)-import Data.IORef (IORef, modifyIORef, newIORef, readIORef)-import Data.Text (Text)-import Network.Riak (getByIndex)-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(..), IndexValue(..),-                           IndexQuery(..))-import Network.Riak.Resolvable (ResolvableMonoid(..))-import System.IO.Unsafe (unsafePerformIO)-import qualified Test.HUnit as HU-import Test.Framework (defaultMain, Test)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(..), (==>))-import Test.QuickCheck.Property (Property)-import Test.QuickCheck.Monadic (assert, monadicIO, run)-import qualified Data.Map as M-import qualified Data.ByteString.Lazy as L-import qualified Network.Riak.Basic as B-import qualified Network.Riak.JSON as J +module Properties where++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative          ((<$>))+#endif+import qualified Data.ByteString.Lazy         as L+import           Data.IORef                   (IORef, modifyIORef, newIORef)+import qualified Network.Riak.Basic           as B+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.QuickCheck.Monadic      (assert, monadicIO, run)+import           Test.Tasty+import           Test.Tasty.QuickCheck+ instance Arbitrary L.ByteString where     arbitrary     = L.pack `fmap` arbitrary @@ -49,27 +43,5 @@             return (p,r)     notempty = not . L.null -t_indexed_put_get :: HU.Assertion-t_indexed_put_get = withConnection pool $ \c -> do-    let b = "riak-haskell-client-test"-        k = "test"-    _ <- J.putIndexed c b k [(IndexInt "someindex" 135)] Nothing-         (RM (M.fromList [("somekey", "someval")] :: M.Map Text Text))-         Default Default-    keys <- getByIndex c b (IndexQueryExactInt "someindex" 135)-    HU.assertEqual "" ["test"] keys--main :: IO ()-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 :: [Test]-tests =-    [ testProperty "t_put_get" t_put_get-#ifdef TEST2I-    , testCase "t_indexed_put_get" t_indexed_put_get-#endif-    ]+tests :: [TestTree]+tests = [ testProperty "t_put_get" t_put_get ]

@@ -0,0 +1,59 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Control.Exception            (finally)+import           Control.Monad                (forM_)+import           Data.IORef+import qualified Data.Map                     as M+import           Data.Text                    (Text)+import qualified Network.Riak                 as Riak+import qualified Network.Riak.Basic           as B+import qualified Network.Riak.Cluster         as Riak+import           Network.Riak.Connection.Pool (withConnection)+import qualified Network.Riak.JSON            as J+import           Network.Riak.Resolvable      (ResolvableMonoid (..))+import           Network.Riak.Types+import qualified Properties+import           Test.Tasty+import           Test.Tasty.HUnit++main :: IO ()+main = defaultMain tests `finally` cleanup+  where+    cleanup = withConnection Properties.pool $ \c -> do+                bks <- readIORef Properties.cruft+                forM_ bks $ \(b,k) -> B.delete c b k Default++tests :: TestTree+tests = testGroup "Tests" [properties, integrationalTests]++properties :: TestTree+properties = testGroup "Properties" Properties.tests++integrationalTests :: TestTree+integrationalTests = testGroup "Integrational tests"+  [ testClusterSimple+#ifdef TEST2I+  , testIndexedPutGet+#endif+  ]++testClusterSimple :: TestTree+testClusterSimple = testCase "testClusterSimple" $ do+    rc <- Riak.connectToCluster [Riak.defaultClient]+    Riak.inCluster rc B.ping+++testIndexedPutGet :: TestTree+testIndexedPutGet = testCase "testIndexedPutGet" $ do+    rc <- Riak.connectToCluster [Riak.defaultClient]+    let b = "riak-haskell-client-test"+        k = "test"+    keys <- Riak.inCluster rc $ \c -> do+      _ <- J.putIndexed c b k [(IndexInt "someindex" 135)] Nothing+          (RM (M.fromList [("somekey", "someval")] :: M.Map Text Text))+          Default Default+      Riak.getByIndex c b (IndexQueryExactInt "someindex" 135)+    assertEqual "" ["test"] keys