-- |
-- Module:      Network.Riak.CRDT.Riak
-- Copyright:   (c) 2016 Sentenai
-- Author:      Antonio Nikishaev <me@lelf.lu>
-- License:     Apache
-- Maintainer:  Tim McGilchrist <timmcgil@gmail.com>, Mark Hibberd <mark@hibberd.id.au>
-- Stability:   experimental
-- Portability: portable
--
-- CRDT operations
--
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Network.Riak.CRDT.Riak (
    counterSendUpdate
  , setSendUpdate
  , mapSendUpdate
  , get
  ) where

#if __GLASGOW_HASKELL__ <= 708
import           Control.Applicative
import           Data.Int
#endif

import           Control.Exception (catchJust)

import qualified Data.ByteString as BS

import qualified Data.Riak.Proto as Proto
import qualified Network.Riak.CRDT.Request as Req
import qualified Network.Riak.CRDT.Response as Resp
import qualified Network.Riak.CRDT.Types as CRDT
import qualified Network.Riak.Connection as Conn
import           Network.Riak.Lens
import           Network.Riak.Types


counterSendUpdate :: Connection -> BucketType -> Bucket -> Key
                  -> [CRDT.CounterOp] -> IO ()
counterSendUpdate :: Connection
-> BucketType -> BucketType -> BucketType -> [CounterOp] -> IO ()
counterSendUpdate Connection
conn BucketType
t BucketType
b BucketType
k [CounterOp]
ops = Connection -> DtUpdateReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
Conn.exchange_ Connection
conn (DtUpdateReq -> IO ()) -> DtUpdateReq -> IO ()
forall a b. (a -> b) -> a -> b
$ [CounterOp]
-> BucketType -> BucketType -> BucketType -> DtUpdateReq
Req.counterUpdate [CounterOp]
ops BucketType
t BucketType
b BucketType
k


setSendUpdate :: Connection -> BucketType -> Bucket -> Key
              -> [CRDT.SetOp] -> IO ()
setSendUpdate :: Connection
-> BucketType -> BucketType -> BucketType -> [SetOp] -> IO ()
setSendUpdate Connection
conn BucketType
t BucketType
b BucketType
k [SetOp]
ops = IO () -> IO ()
handleEmpty (IO () -> IO ()) -> (DtUpdateReq -> IO ()) -> DtUpdateReq -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> DtUpdateReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
Conn.exchange_ Connection
conn (DtUpdateReq -> IO ()) -> DtUpdateReq -> IO ()
forall a b. (a -> b) -> a -> b
$ [SetOp] -> BucketType -> BucketType -> BucketType -> DtUpdateReq
Req.setUpdate [SetOp]
ops BucketType
t BucketType
b BucketType
k


mapSendUpdate :: Connection -> BucketType -> Bucket -> Key
              -> [CRDT.MapOp] -> IO ()
mapSendUpdate :: Connection
-> BucketType -> BucketType -> BucketType -> [MapOp] -> IO ()
mapSendUpdate Connection
conn BucketType
t BucketType
b BucketType
k [MapOp]
ops = IO () -> IO ()
handleEmpty (IO () -> IO ()) -> (DtUpdateReq -> IO ()) -> DtUpdateReq -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> DtUpdateReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
Conn.exchange_ Connection
conn (DtUpdateReq -> IO ()) -> DtUpdateReq -> IO ()
forall a b. (a -> b) -> a -> b
$ [MapOp] -> BucketType -> BucketType -> BucketType -> DtUpdateReq
Req.mapUpdate [MapOp]
ops BucketType
t BucketType
b BucketType
k


get :: Connection -> BucketType -> Bucket -> Key
    -> IO (Maybe CRDT.DataType)
get :: Connection
-> BucketType -> BucketType -> BucketType -> IO (Maybe DataType)
get Connection
conn BucketType
t BucketType
b BucketType
k = DtFetchResp -> Maybe DataType
Resp.get (DtFetchResp -> Maybe DataType)
-> IO DtFetchResp -> IO (Maybe DataType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> DtFetchReq -> IO DtFetchResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
Conn.exchange Connection
conn (BucketType -> BucketType -> BucketType -> DtFetchReq
Req.get BucketType
t BucketType
b BucketType
k)


-- | Ignore a ‘not_present’ error on update.
--
-- This is a bit hacky, but that's the behaviour we want.
--
-- TODO: Add custom exceptions to riak-haskell-client and just catch a
-- NotPresent exception here
handleEmpty :: IO () -> IO ()
handleEmpty :: IO () -> IO ()
handleEmpty IO ()
act = (RpbErrorResp -> Maybe ()) -> IO () -> (() -> IO ()) -> IO ()
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust
                  (\(RpbErrorResp
e :: Proto.RpbErrorResp) ->
                       if | BucketType
"{precondition,{not_present,"
                               BucketType -> BucketType -> Bool
`BS.isPrefixOf` (RpbErrorResp
e RpbErrorResp -> Lens RpbErrorResp BucketType -> BucketType
forall s a. s -> Lens s a -> a
^. Lens RpbErrorResp BucketType
forall (f :: * -> *) s a.
(Functor f, HasField s "errmsg" a) =>
LensLike' f s a
Proto.errmsg) -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
                          | Bool
otherwise                              -> Maybe ()
forall a. Maybe a
Nothing
                  )
                  IO ()
act
                  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure