Basic.hs

{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

-- |
-- Module:      Network.Riak.Basic
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>
-- Stability:   experimental
-- Portability: portable
--
-- Basic support for the Riak decentralized data store.
--
-- When storing and retrieving data, the functions in this module do
-- not perform any encoding or decoding of data, nor do they resolve
-- conflicts.

module Network.Riak.Basic
    (
    -- * Client configuration and identification
      ClientID
    , Client(..)
    , defaultClient
    -- * Connection management
    , Connection(..)
    , connect
    , disconnect
    , ping
    , getClientID
    , setClientID
    , getServerInfo
    -- * Data management
    , Quorum(..)
    , get
    , put
    , put_
    , delete
    -- * Metadata
    , listBuckets
    , foldKeys
    , getBucket
    , setBucket
    , getBucketType
    -- * Map/reduce
    , mapReduce
    ) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative                    ((<$>))
#endif
import           Control.Monad.IO.Class
import           Network.Riak.Connection.Internal
import           Network.Riak.Escape (unescape)
import           Network.Riak.Lens
import           Network.Riak.Types.Internal hiding (MessageTag(..))
import qualified Data.Foldable as F
import qualified Data.Riak.Proto as Proto
import qualified Network.Riak.Request as Req
import qualified Network.Riak.Response as Resp
import qualified Network.Riak.Types.Internal as T

-- | Check to see if the connection to the server is alive.
ping :: Connection -> IO ()
ping conn = exchange_ conn Req.ping

-- | Find out from the server what client ID this connection is using.
getClientID :: Connection -> IO ClientID
getClientID conn = Resp.getClientID <$> exchange conn Req.getClientID

-- | Retrieve information about the server.
getServerInfo :: Connection -> IO Proto.RpbGetServerInfoResp
getServerInfo conn = exchange conn Req.getServerInfo

-- | Retrieve a value.  This may return multiple conflicting siblings.
-- Choosing among them is your responsibility.
get :: Connection -> Maybe T.BucketType -> T.Bucket -> T.Key -> R
    -> IO (Maybe ([Proto.RpbContent], VClock))
get conn btype bucket key r = Resp.get <$> exchangeMaybe conn (Req.get btype bucket key 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 type+bucket+key combination does not already exist.
-- If you omit a 'T.VClock' but the type+bucket+key /does/ exist, your
-- value will not be stored.
put :: Connection -> Maybe T.BucketType -> T.Bucket -> T.Key -> Maybe T.VClock
    -> Proto.RpbContent -> W -> DW
    -> IO ([Proto.RpbContent], VClock)
put conn btype bucket key mvclock cont w dw =
  Resp.put <$> exchange conn (Req.put btype bucket key mvclock cont w dw True)

-- | 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 type+bucket+key combination does not already exist.
-- If you omit a 'T.VClock' but the type+bucket+key /does/ exist, your
-- value will not be stored, and you will not be notified.
put_ :: Connection -> Maybe T.BucketType -> T.Bucket -> T.Key -> Maybe T.VClock
     -> Proto.RpbContent -> W -> DW
     -> IO ()
put_ conn btype bucket key mvclock cont w dw =
  exchange_ conn (Req.put btype bucket key mvclock cont w dw False)

-- | Delete a value.
delete :: Connection -> Maybe T.BucketType -> T.Bucket -> T.Key -> RW -> IO ()
delete conn btype bucket key rw = exchange_ conn $ Req.delete btype bucket key rw

-- | List the buckets in the cluster.
--
-- /Note/: this operation is expensive.  Do not use it in production.
listBuckets :: Connection -> Maybe BucketType -> IO [T.Bucket]
listBuckets conn btype = Resp.listBuckets <$> exchange conn (Req.listBuckets btype)

-- | Fold over the keys in a bucket.
--
-- /Note/: this operation is expensive.  Do not use it in production.
foldKeys :: (MonadIO m) => Connection -> Maybe BucketType -> Bucket
         -> (a -> Key -> m a) -> a -> m a
foldKeys conn btype bucket f z0 = do
  liftIO $ sendRequest conn $ Req.listKeys btype bucket
  let g z = f z . unescape
      loop z = do
        response <- liftIO $ (recvResponse conn :: IO Proto.RpbListKeysResp)
        z1 <- F.foldlM g z (response ^. Proto.keys)
        if response ^. Proto.done
          then return z1
          else loop z1
  loop z0

-- | Retrieve the properties of a bucket.
getBucket :: Connection -> Maybe BucketType -> Bucket -> IO Proto.RpbBucketProps
getBucket conn btype bucket = Resp.getBucket <$> exchange conn (Req.getBucket btype bucket)

-- | Store new properties for a bucket.
setBucket :: Connection -> Maybe BucketType -> Bucket -> Proto.RpbBucketProps -> IO ()
setBucket conn btype bucket props = exchange_ conn $ Req.setBucket btype bucket props

-- | Gets the bucket properties associated with a bucket type.
getBucketType :: Connection -> T.BucketType -> IO Proto.RpbBucketProps
getBucketType conn btype = Resp.getBucket <$> exchange conn (Req.getBucketType btype)

-- | Run a 'MapReduce' job.  Its result is consumed via a strict left
-- fold.
mapReduce :: Connection -> Job -> (a -> Proto.RpbMapRedResp -> a) -> a -> IO a
mapReduce conn job f z0 = loop z0 =<< (exchange conn . Req.mapReduce $ job)
  where
    loop z mr = do
      let !z' = f z mr
      if mr ^. Proto.done
        then return z'
        else loop z' =<< recvResponse conn