riak-1.2.0.0: tests/Properties.hs

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}

module Properties where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative          ((<$>))
#endif
import           Data.ByteString              (ByteString)
import qualified Data.ByteString              as BS
import           Data.Maybe
import qualified Network.Riak.Basic           as B
import           Network.Riak.Content         (binary)
import           Network.Riak.Types           as Riak
import           Test.QuickCheck.Monadic      (assert, monadicIO, run)
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Utils

instance Arbitrary ByteString where
    arbitrary     = BS.pack `fmap` arbitrary

newtype QCBucket = QCBucket Riak.Bucket deriving Show

instance Arbitrary QCBucket where
    arbitrary = QCBucket <$> arbitrary `suchThat` (not . BS.null)

newtype QCKey = QCKey Riak.Key deriving Show

instance Arbitrary QCKey where
    arbitrary = QCKey <$> arbitrary `suchThat` (not . BS.null)


t_put_get :: QCBucket -> QCKey -> ByteString -> Property
t_put_get (QCBucket b) (QCKey k) v =
    monadicIO $ assert . uncurry (==) =<< run act
  where
    act = withGlobalConn $ \c -> do
            p <- Just <$> B.put c btype b k Nothing (binary v) Default Default
            r <- B.get c btype b k Default
            return (p,r)
    btype = Nothing

put_delete_get :: QCBucket -> QCKey -> ByteString -> Property
put_delete_get (QCBucket b) (QCKey k) v
    = monadicIO $ do
        r <- run act
        assert $ isNothing r
    where
      act = withGlobalConn $ \c -> do
              _ <- B.put c bt b k Nothing (binary v) Default Default
              B.delete c bt b k Default
              B.get c bt b k Default
      bt = Nothing :: Maybe BucketType

tests :: [TestTree]
tests = [
 testProperty "t_put_get" t_put_get,
 testProperty "put_delete_get" put_delete_get
 ]