riak 0.7.2.1 → 0.8.0.0

raw patch · 11 files changed

+212/−27 lines, 11 filesdep +HUnitdep +test-framework-hunitdep ~basedep ~riak-protobufdep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, test-framework-hunit

Dependency ranges changed: base, riak-protobuf, text

API changes (from Hackage documentation)

Files

• riak.cabal +16/−8
• src/Network/Riak.hs +12/−2
• src/Network/Riak/JSON.hs +9/−0
• src/Network/Riak/JSON/Resolvable.hs +12/−0
• src/Network/Riak/Request.hs +41/−1
• src/Network/Riak/Resolvable/Internal.hs +1/−1
• src/Network/Riak/Tag.hs +19/−1
• src/Network/Riak/Types.hs +2/−0
• src/Network/Riak/Types/Internal.hs +21/−0
• src/Network/Riak/Value.hs +38/−0
• tests/Properties.hs +41/−14

@@ -1,5 +1,5 @@ name:                riak-version:             0.7.2.1+version:             0.8.0.0 synopsis:            A Haskell client for the Riak decentralized data store description:   A Haskell client library for the Riak decentralized data@@ -49,7 +49,12 @@ flag developer   description: operate in developer mode   default: False+  manual: True +flag test2i+  description: test secondary indexes (requires default riak engine to have that support)+  default: False+ library   hs-source-dirs: src @@ -92,7 +97,7 @@     protocol-buffers-fork == 2.0.*,     pureMD5,     random,-    riak-protobuf == 0.18.*,+    riak-protobuf == 0.19.*,     text >= 0.11.0.6,     time @@ -112,14 +117,17 @@   hs-source-dirs: tests   ghc-options: -Wall +  if flag(test2i)+    cpp-options: -DTEST2I+   build-depends:-    riak,     base,+    riak,     bytestring,+    containers,+    HUnit,     QuickCheck,     test-framework,-    test-framework-quickcheck2--source-repository head-  type:     git-  location: http://github.com/markhibberd/riak-haskell-client+    test-framework-hunit,+    test-framework-quickcheck2,+    text

@@ -34,7 +34,9 @@ -- This is the most demanding module to work with, as you must encode -- and decode data yourself, and handle all conflict resolution -- yourself.-+--+-- A short getting started guide is available at <http://docs.basho.com/riak/latest/dev/taste-of-riak/haskell/>+-- module Network.Riak     (     -- * Client configuration and identification@@ -53,11 +55,14 @@     , Resolvable(..)     , get     , getMany+    , getByIndex+    , addIndexes     , modify     , modify_     , delete     -- ** Low-level modification functions     , put+    , putIndexed     , putMany     -- * Metadata     , listBuckets@@ -66,8 +71,13 @@     , setBucket     -- * Map/reduce     , mapReduce+    -- * Types+    , IndexQuery(..)+    , IndexValue(..)     ) where  import Network.Riak.Basic hiding (get, put, put_)-import Network.Riak.JSON.Resolvable (get, getMany, modify, modify_, put, putMany)+import Network.Riak.JSON.Resolvable (get, getMany, modify, modify_, put, putIndexed, putMany) import Network.Riak.Resolvable (Resolvable(..))+import Network.Riak.Value (getByIndex, addIndexes)+import Network.Riak.Types.Internal (IndexQuery(..), IndexValue(..))

@@ -20,6 +20,7 @@     , get     , getMany     , put+    , putIndexed     , put_     , putMany     , putMany_@@ -77,6 +78,14 @@     -> 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 indexed.+putIndexed :: (FromJSON c, ToJSON c)+           => Connection -> Bucket -> Key -> [IndexValue]+           -> Maybe VClock -> c+           -> W -> DW -> IO ([c], VClock)+putIndexed conn bucket key ixs mvclock val w dw =+    convert <$> V.putIndexed conn bucket key ixs mvclock (json val) w dw  -- | Store a single value, without the possibility of conflict -- resolution.

@@ -25,6 +25,7 @@     , modify_     -- * Low-level modification functions     , put+    , putIndexed     , put_     , putMany     , putMany_@@ -106,6 +107,17 @@     -> IO (c, VClock) put = R.put J.put {-# INLINE put #-}++-- | Store a single value indexed.+putIndexed :: (FromJSON c, ToJSON c, Resolvable c)+           => Connection -> Bucket -> Key -> [IndexValue]+           -> Maybe VClock -> c -> W -> DW+           -> IO (c, VClock)+putIndexed c b k ixs vc cont w' dw' =+    R.put (\conn bucket key mvclock val w dw ->+               J.putIndexed conn bucket key ixs mvclock val w dw)+          c b k vc cont w' dw'+{-# INLINE putIndexed #-}  -- | Store a single value, automatically resolving any vector clock -- conflicts that arise.  A single invocation of this function may

@@ -24,6 +24,8 @@     -- * Data management     , Get.GetRequest     , get+    , getByIndex+    , Index.IndexRequest     , Put.PutRequest     , put     , Del.DeleteRequest@@ -45,7 +47,9 @@     ) where  import Control.Applicative ((<$>))-import Network.Riak.Protocol.BucketProps+import qualified Data.ByteString.Char8 as B8+import Data.Monoid+import Network.Riak.Protocol.BucketProps hiding (r,rw) import Network.Riak.Protocol.Content import Network.Riak.Protocol.GetClientIDRequest import Network.Riak.Protocol.GetServerInfoRequest@@ -58,6 +62,8 @@ import qualified Network.Riak.Protocol.Link as Link import qualified Network.Riak.Protocol.GetBucketRequest as GetBucket import qualified Network.Riak.Protocol.GetRequest as Get+import qualified Network.Riak.Protocol.IndexRequest as Index+import qualified Network.Riak.Protocol.IndexRequest.IndexQueryType as IndexQueryType import qualified Network.Riak.Protocol.ListKeysRequest as Keys import qualified Network.Riak.Protocol.PutRequest as Put import qualified Network.Riak.Protocol.SetBucketRequest as SetBucket@@ -93,6 +99,40 @@                                   , Get.n_val = Nothing                                   } {-# INLINE get #-}++-- | Create a secondary index request. Bucket, key and index names and+-- values are URL-escaped.+getByIndex :: Bucket -> IndexQuery+           -> Index.IndexRequest+getByIndex bucket q =+    case q of+      IndexQueryExactInt index key ->+          req (index <> "_int") (showIntKey key)+              IndexQueryType.Eq Nothing Nothing+      IndexQueryExactBin index key ->+          req (index <> "_bin") (showBsKey $ key)+              IndexQueryType.Eq Nothing Nothing+      IndexQueryRangeInt index from to ->+          req (index <> "_int") Nothing+              IndexQueryType.Range (showIntKey from) (showIntKey to)+      IndexQueryRangeBin index from to ->+          req (index <> "_bin") Nothing+              IndexQueryType.Range (showBsKey from) (showBsKey to)+  where+    showIntKey = Just . escape . B8.pack . show+    showBsKey = Just . escape+    req i k qt rmin rmax =+      Index.IndexRequest { Index.bucket = escape bucket+                         , Index.index = escape i+                         , Index.qtype = qt+                         , Index.key = k+                         , Index.range_min = rmin+                         , Index.range_max = rmax+                         , Index.return_terms = Nothing+                         , Index.stream = Nothing+                         , Index.max_results = Nothing+                         , Index.continuation = Nothing+                         , Index.timeout = Nothing }  -- | Create a put request.  The bucket and key names are URL-escaped. -- Any 'Link' values inside the 'Content' are assumed to have been

@@ -186,7 +186,7 @@     unless (null conflicts) $       debugValues "putMany" "conflicts" conflicts     go (i+1) (ok++acc) conflicts-  mush (i,(k,mv,c)) (cs,v) =+  mush (i,(k,mv,_)) (cs,v) =       case cs of         [x] | i > 0 || isJust mv -> Right (i,(x,v))         (_:_) -> Left (i,(k,Just v, resolveMany cs))

@@ -26,6 +26,8 @@ import Network.Riak.Protocol.GetClientIDResponse import Network.Riak.Protocol.GetRequest import Network.Riak.Protocol.GetResponse+import Network.Riak.Protocol.IndexRequest+import Network.Riak.Protocol.IndexResponse import Network.Riak.Protocol.GetServerInfoRequest import Network.Riak.Protocol.ListBucketsRequest import Network.Riak.Protocol.ListBucketsResponse@@ -100,18 +102,34 @@     messageTag _ = Types.GetRequest     {-# INLINE messageTag #-} +instance Tagged IndexRequest where+    messageTag _ = Types.IndexRequest+    {-# INLINE messageTag #-}+ instance Request GetRequest where     expectedResponse _ = Types.GetResponse     {-# INLINE expectedResponse #-} +instance Request IndexRequest where+    expectedResponse _ = Types.IndexResponse+    {-# INLINE expectedResponse #-}+ instance Tagged GetResponse where     messageTag _ = Types.GetResponse     {-# INLINE messageTag #-} +instance Tagged IndexResponse where+    messageTag _ = Types.IndexResponse+    {-# INLINE messageTag #-}+ instance Response GetResponse +instance Response IndexResponse+ instance Exchange GetRequest GetResponse +instance Exchange IndexRequest IndexResponse+ instance Tagged PutRequest where     messageTag _ = Types.PutRequest     {-# INLINE messageTag #-}@@ -213,7 +231,7 @@ getTag :: Get MessageTag getTag = do   n <- getWord8-  if n > 24+  if n > 26     then moduleError "getTag" $ "invalid riak message code: " ++ show n     else return .  toEnum . fromIntegral $ n {-# INLINE getTag #-}

@@ -35,6 +35,8 @@     , Exchange     , MessageTag(..)     , Tagged(..)+    , IndexValue(..)+    , IndexQuery(..)     ) where  import Network.Riak.Types.Internal

@@ -26,6 +26,9 @@     -- * Data types     , Bucket     , Key+    , Index+    , IndexQuery(..)+    , IndexValue(..)     , Tag     , VClock(..)     , Job(..)@@ -130,6 +133,22 @@ -- buckets. type Key = ByteString +-- | Name of a secondary index+type Index = ByteString++-- | Index query. Can be exact or range, int or bin. Index name should+-- not contain the "_bin" or "_int" part, since it's determined from+-- data constructor.+data IndexQuery = IndexQueryExactInt !Index !Int+                | IndexQueryExactBin !Index !ByteString+                | IndexQueryRangeInt !Index !Int !Int+                | IndexQueryRangeBin !Index !ByteString !ByteString+    deriving (Show, Eq)++data IndexValue = IndexInt !Index !Int+                | IndexBin !Index !ByteString+    deriving (Show, Eq)+ -- | An application-specific identifier for a link.  See -- <http://wiki.basho.com/Links.html> for details. type Tag = ByteString@@ -166,6 +185,8 @@                 | SetBucketResponse                 | MapReduceRequest                 | MapReduceResponse+                | IndexRequest+                | IndexResponse                   deriving (Eq, Show, Enum, Typeable)  -- | Messages are tagged.

@@ -21,7 +21,10 @@     , fromContent     , get     , getMany+    , getByIndex+    , addIndexes     , put+    , putIndexed     , put_     , putMany     , putMany_@@ -30,17 +33,21 @@ import Control.Applicative import Data.Aeson.Types (Parser, Result(..), parse) import Data.Foldable (toList)+import Data.Monoid ((<>)) import Network.Riak.Connection.Internal import Network.Riak.Protocol.Content (Content(..)) import Network.Riak.Protocol.GetResponse (GetResponse(..))+import Network.Riak.Protocol.IndexResponse (IndexResponse(..)) import Network.Riak.Protocol.PutResponse (PutResponse(..)) import Network.Riak.Resolvable (ResolvableMonoid(..)) import Network.Riak.Response (unescapeLinks) import Network.Riak.Types.Internal hiding (MessageTag(..))+import qualified Network.Riak.Protocol.Pair as Pair import qualified Data.Aeson.Parser as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.Attoparsec.Lazy as A import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as CL8 import qualified Data.Sequence as Seq import qualified Network.Riak.Content as C import qualified Network.Riak.Request as Req@@ -80,6 +87,15 @@  deriving instance (IsContent a) => IsContent (ResolvableMonoid a) +-- | Add indexes to a content value for a further put request.+addIndexes :: [IndexValue] -> Content -> Content+addIndexes ix c =+    c { C.indexes = Seq.fromList . map toPair $ ix }+  where+    toPair (IndexInt k v) = Pair.Pair (k <> "_int")+                                      (Just . CL8.pack . show $ v)+    toPair (IndexBin k v) = Pair.Pair (k <> "_bin") (Just v)+ -- | Store a single value.  This may return multiple conflicting -- siblings.  Choosing among them, and storing a new value, is your -- responsibility.@@ -94,6 +110,16 @@   putResp =<< exchange conn               (Req.put bucket key mvclock (toContent val) w dw True) +-- | Store an indexed value.+putIndexed :: (IsContent c) => Connection -> Bucket -> Key+           -> [IndexValue]+           -> Maybe VClock -> c+           -> W -> DW -> IO ([c], VClock)+putIndexed conn b k inds mvclock val w dw =+    putResp =<< exchange conn+                  (Req.put b k mvclock (addIndexes inds (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.@@ -145,6 +171,12 @@     -> IO (Maybe ([c], VClock)) get conn bucket key r = getResp =<< exchangeMaybe conn (Req.get bucket key r) +-- | Retrieve list of keys matching some index query.+getByIndex :: Connection -> Bucket -> IndexQuery+           -> IO [Key]+getByIndex conn b indq =+    getByIndexResp =<< exchangeMaybe conn (Req.getByIndex b indq)+ getMany :: (IsContent c) => Connection -> Bucket -> [Key] -> R         -> IO [Maybe ([c], VClock)] getMany conn b ks r =@@ -157,6 +189,12 @@            c <- convert content            return $ Just (c, VClock s)     _   -> return Nothing++getByIndexResp :: Maybe IndexResponse -> IO [Key]+getByIndexResp resp =+    case resp of+      Just (IndexResponse keys _ _ _) -> return (toList keys)+      Nothing -> return []  convert :: IsContent v => Seq.Seq Content -> IO [v] convert = go [] [] . toList

@@ -1,20 +1,30 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+ 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(..))+import Network.Riak.Types (Bucket, Key, Quorum(..), IndexValue(..),+                           IndexQuery(..))+import Network.Riak.Resolvable (ResolvableMonoid(..)) import System.IO.Unsafe (unsafePerformIO)-import Test.Framework (defaultMain, testGroup)+import qualified Test.HUnit as HU+import Test.Framework (defaultMain, Test) import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit (testCase) 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-import qualified Network.Riak.Value as V  instance Arbitrary L.ByteString where     arbitrary     = L.pack `fmap` arbitrary@@ -28,21 +38,38 @@ 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+t_put_get :: Bucket -> Key -> L.ByteString -> Property+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 +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 = [-  testProperty "t_put_get" t_put_get- ]+tests :: [Test]+tests =+    [ testProperty "t_put_get" t_put_get+#ifdef TEST2I+    , testCase "t_indexed_put_get" t_indexed_put_get+#endif+    ]