{-# 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 :: Connection -> IO ()
ping Connection
conn = Connection -> RpbPingReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
exchange_ Connection
conn RpbPingReq
Req.ping

-- | Find out from the server what client ID this connection is using.
getClientID :: Connection -> IO ClientID
getClientID :: Connection -> IO ClientID
getClientID Connection
conn = RpbGetClientIdResp -> ClientID
Resp.getClientID (RpbGetClientIdResp -> ClientID)
-> IO RpbGetClientIdResp -> IO ClientID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbGetClientIdReq -> IO RpbGetClientIdResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn RpbGetClientIdReq
Req.getClientID

-- | Retrieve information about the server.
getServerInfo :: Connection -> IO Proto.RpbGetServerInfoResp
getServerInfo :: Connection -> IO RpbGetServerInfoResp
getServerInfo Connection
conn = Connection -> RpbGetServerInfoReq -> IO RpbGetServerInfoResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn RpbGetServerInfoReq
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 :: Connection
-> Maybe ClientID
-> ClientID
-> ClientID
-> R
-> IO (Maybe ([RpbContent], VClock))
get Connection
conn Maybe ClientID
btype ClientID
bucket ClientID
key R
r = Maybe RpbGetResp -> Maybe ([RpbContent], VClock)
Resp.get (Maybe RpbGetResp -> Maybe ([RpbContent], VClock))
-> IO (Maybe RpbGetResp) -> IO (Maybe ([RpbContent], VClock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbGetReq -> IO (Maybe RpbGetResp)
forall req resp.
Exchange req resp =>
Connection -> req -> IO (Maybe resp)
exchangeMaybe Connection
conn (Maybe ClientID -> ClientID -> ClientID -> R -> RpbGetReq
Req.get Maybe ClientID
btype ClientID
bucket ClientID
key R
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 :: Connection
-> Maybe ClientID
-> ClientID
-> ClientID
-> Maybe VClock
-> RpbContent
-> R
-> R
-> IO ([RpbContent], VClock)
put Connection
conn Maybe ClientID
btype ClientID
bucket ClientID
key Maybe VClock
mvclock RpbContent
cont R
w R
dw =
  RpbPutResp -> ([RpbContent], VClock)
Resp.put (RpbPutResp -> ([RpbContent], VClock))
-> IO RpbPutResp -> IO ([RpbContent], VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbPutReq -> IO RpbPutResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (Maybe ClientID
-> ClientID
-> ClientID
-> Maybe VClock
-> RpbContent
-> R
-> R
-> Bool
-> RpbPutReq
Req.put Maybe ClientID
btype ClientID
bucket ClientID
key Maybe VClock
mvclock RpbContent
cont R
w R
dw Bool
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_ :: Connection
-> Maybe ClientID
-> ClientID
-> ClientID
-> Maybe VClock
-> RpbContent
-> R
-> R
-> IO ()
put_ Connection
conn Maybe ClientID
btype ClientID
bucket ClientID
key Maybe VClock
mvclock RpbContent
cont R
w R
dw =
  Connection -> RpbPutReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
exchange_ Connection
conn (Maybe ClientID
-> ClientID
-> ClientID
-> Maybe VClock
-> RpbContent
-> R
-> R
-> Bool
-> RpbPutReq
Req.put Maybe ClientID
btype ClientID
bucket ClientID
key Maybe VClock
mvclock RpbContent
cont R
w R
dw Bool
False)

-- | Delete a value.
delete :: Connection -> Maybe T.BucketType -> T.Bucket -> T.Key -> RW -> IO ()
delete :: Connection -> Maybe ClientID -> ClientID -> ClientID -> R -> IO ()
delete Connection
conn Maybe ClientID
btype ClientID
bucket ClientID
key R
rw = Connection -> RpbDelReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
exchange_ Connection
conn (RpbDelReq -> IO ()) -> RpbDelReq -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe ClientID -> ClientID -> ClientID -> R -> RpbDelReq
Req.delete Maybe ClientID
btype ClientID
bucket ClientID
key R
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 :: Connection -> Maybe ClientID -> IO [ClientID]
listBuckets Connection
conn Maybe ClientID
btype = RpbListBucketsResp -> [ClientID]
Resp.listBuckets (RpbListBucketsResp -> [ClientID])
-> IO RpbListBucketsResp -> IO [ClientID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbListBucketsReq -> IO RpbListBucketsResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (Maybe ClientID -> RpbListBucketsReq
Req.listBuckets Maybe ClientID
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 :: Connection
-> Maybe ClientID -> ClientID -> (a -> ClientID -> m a) -> a -> m a
foldKeys Connection
conn Maybe ClientID
btype ClientID
bucket a -> ClientID -> m a
f a
z0 = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> RpbListKeysReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
sendRequest Connection
conn (RpbListKeysReq -> IO ()) -> RpbListKeysReq -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe ClientID -> ClientID -> RpbListKeysReq
Req.listKeys Maybe ClientID
btype ClientID
bucket
  let g :: a -> ClientID -> m a
g a
z = a -> ClientID -> m a
f a
z (ClientID -> m a) -> (ClientID -> ClientID) -> ClientID -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientID -> ClientID
forall e. Escape e => ClientID -> e
unescape
      loop :: a -> m a
loop a
z = do
        RpbListKeysResp
response <- IO RpbListKeysResp -> m RpbListKeysResp
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RpbListKeysResp -> m RpbListKeysResp)
-> IO RpbListKeysResp -> m RpbListKeysResp
forall a b. (a -> b) -> a -> b
$ (Connection -> IO RpbListKeysResp
forall a. Response a => Connection -> IO a
recvResponse Connection
conn :: IO Proto.RpbListKeysResp)
        a
z1 <- (a -> ClientID -> m a) -> a -> [ClientID] -> m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM a -> ClientID -> m a
g a
z (RpbListKeysResp
response RpbListKeysResp -> Lens RpbListKeysResp [ClientID] -> [ClientID]
forall s a. s -> Lens s a -> a
^. Lens RpbListKeysResp [ClientID]
forall (f :: * -> *) s a.
(Functor f, HasField s "keys" a) =>
LensLike' f s a
Proto.keys)
        if RpbListKeysResp
response RpbListKeysResp -> Lens RpbListKeysResp Bool -> Bool
forall s a. s -> Lens s a -> a
^. Lens RpbListKeysResp Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "done" a) =>
LensLike' f s a
Proto.done
          then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z1
          else a -> m a
loop a
z1
  a -> m a
loop a
z0

-- | Retrieve the properties of a bucket.
getBucket :: Connection -> Maybe BucketType -> Bucket -> IO Proto.RpbBucketProps
getBucket :: Connection -> Maybe ClientID -> ClientID -> IO RpbBucketProps
getBucket Connection
conn Maybe ClientID
btype ClientID
bucket = RpbGetBucketResp -> RpbBucketProps
Resp.getBucket (RpbGetBucketResp -> RpbBucketProps)
-> IO RpbGetBucketResp -> IO RpbBucketProps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbGetBucketReq -> IO RpbGetBucketResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (Maybe ClientID -> ClientID -> RpbGetBucketReq
Req.getBucket Maybe ClientID
btype ClientID
bucket)

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

-- | Gets the bucket properties associated with a bucket type.
getBucketType :: Connection -> T.BucketType -> IO Proto.RpbBucketProps
getBucketType :: Connection -> ClientID -> IO RpbBucketProps
getBucketType Connection
conn ClientID
btype = RpbGetBucketResp -> RpbBucketProps
Resp.getBucket (RpbGetBucketResp -> RpbBucketProps)
-> IO RpbGetBucketResp -> IO RpbBucketProps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbGetBucketTypeReq -> IO RpbGetBucketResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (ClientID -> RpbGetBucketTypeReq
Req.getBucketType ClientID
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 :: Connection -> Job -> (a -> RpbMapRedResp -> a) -> a -> IO a
mapReduce Connection
conn Job
job a -> RpbMapRedResp -> a
f a
z0 = a -> RpbMapRedResp -> IO a
loop a
z0 (RpbMapRedResp -> IO a) -> IO RpbMapRedResp -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Connection -> RpbMapRedReq -> IO RpbMapRedResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (RpbMapRedReq -> IO RpbMapRedResp)
-> (Job -> RpbMapRedReq) -> Job -> IO RpbMapRedResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job -> RpbMapRedReq
Req.mapReduce (Job -> IO RpbMapRedResp) -> Job -> IO RpbMapRedResp
forall a b. (a -> b) -> a -> b
$ Job
job)
  where
    loop :: a -> RpbMapRedResp -> IO a
loop a
z RpbMapRedResp
mr = do
      let !z' :: a
z' = a -> RpbMapRedResp -> a
f a
z RpbMapRedResp
mr
      if RpbMapRedResp
mr RpbMapRedResp -> Lens RpbMapRedResp Bool -> Bool
forall s a. s -> Lens s a -> a
^. Lens RpbMapRedResp Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "done" a) =>
LensLike' f s a
Proto.done
        then a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z'
        else a -> RpbMapRedResp -> IO a
loop a
z' (RpbMapRedResp -> IO a) -> IO RpbMapRedResp -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> IO RpbMapRedResp
forall a. Response a => Connection -> IO a
recvResponse Connection
conn