{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module contains the core of the FoundationDB transaction API,
-- including all the basic functionality to create and run transactions.
-- 'Transaction' is a monad, and you will generally want to use it with
-- do-notation.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import FoundationDB.Transaction
-- > import Data.ByteString
-- >
-- > -- | Sets and gets a key in one transaction. Returns the ByteString
-- > -- "world".
-- > myTransaction :: Transaction ByteString
-- > myTransaction = do
-- >   let mykey = "hello"
-- >   set mykey "world"
-- >   get mykey
--
-- Run your transactions with 'runTransaction' in the IO monad.
--
-- The documentation in this library assumes that you already have some
-- understanding of how to work with FoundationDB. If you don't, check out
-- the <https://apple.github.io/foundationdb/class-scheduling.html official tutorial>.
module FoundationDB.Transaction
  ( -- * Transactions
    Transaction,
    runTransaction,
    runTransaction',
    TransactionConfig (..),
    defaultConfig,
    runTransactionWithConfig,
    runTransactionWithConfig',
    cancel,
    reset,
    withSnapshot,
    setOption,
    getReadVersion,
    setReadVersion,
    getVersionstamp,
#if FDB_API_VERSION >= 620
    getApproximateSize,
#endif
    get,
    set,
    clear,
    clearRange,
    addConflictRange,
    FDB.FDBConflictRangeType (..),
    addReadConflictKey,
    addWriteConflictKey,
    getKey,
    getKeyAddresses,
    atomicOp,
    getRange,
    getRange',
    FDB.FDBStreamingMode (..),
    getEntireRange,
    getEntireRange',
    isRangeEmpty,
    RangeQuery (..),
    rangeKeys,
    keyRangeQuery,
    keyRangeQueryInclusive,
    prefixRange,
    prefixRangeEnd,
    RangeResult (..),
    watch,
#if FDB_API_VERSION >= 710
    -- * Mapped ranges
    FDB.MappedKeyValue (..),
    MappedRangeResult (..),
    Mapper (..),
    getMappedRange,
    getMappedRange',
    getEntireMappedRange,
    getEntireMappedRange',
#endif

    -- * Futures
    Future,
    await,
    awaitInterruptible,
    cancelFuture,
    futureIsReady,
    FutureIO,
    awaitIO,
    awaitInterruptibleIO,
    cancelFutureIO,
    futureIsReadyIO,

    -- * Key selectors
    FDB.KeySelector
      ( LastLessThan,
        LastLessOrEq,
        FirstGreaterThan,
        FirstGreaterOrEq
      ),
    FDB.keySelectorBytes,
    offset,

    -- * Advanced Usage
    -- $advanced
    TransactionEnv (envConf),
    createTransactionEnv,
    onEnv,
    commitFuture,
    onError,
    getCommittedVersion,
  )
where

import Control.Concurrent (threadDelay)
import Control.Exception (throwIO)
import Control.Monad (when)
import Control.Monad.Base (MonadBase (..))
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Error.Class (MonadError (..))
import Control.Monad.Except (ExceptT (..), runExceptT)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, local, runReaderT)
import Control.Monad.Trans.Control
  ( MonadBaseControl (..),
    liftBaseOp,
  )
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Foldable (toList)
import Data.Maybe (fromJust, fromMaybe)
import Data.Sequence (Seq (Empty, (:|>)))
import qualified Data.Sequence as Seq
import Data.Word (Word64)
import Foreign.ForeignPtr
  ( ForeignPtr,
    finalizeForeignPtr,
    newForeignPtr,
    withForeignPtr,
  )
import Foreign.Ptr (Ptr, castPtr)
import FoundationDB.Error.Internal
import qualified FoundationDB.Internal.Bindings as FDB
import qualified FoundationDB.Internal.Database as DB
import FoundationDB.Options.MutationType (MutationType)
import qualified FoundationDB.Options.TransactionOption as TransactionOpt
import FoundationDB.Versionstamp

withForeignPtr' :: MonadBaseControl IO m => ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtr' :: ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtr' ForeignPtr a
fp = ((Ptr a -> IO (StM m b)) -> IO (StM m b)) -> (Ptr a -> m b) -> m b
forall (b :: * -> *) (m :: * -> *) a c d.
MonadBaseControl b m =>
((a -> b (StM m c)) -> b (StM m d)) -> (a -> m c) -> m d
liftBaseOp (ForeignPtr a -> (Ptr a -> IO (StM m b)) -> IO (StM m b)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp)

withTransactionPtr :: (FDB.Transaction -> Transaction b) -> Transaction b
withTransactionPtr :: (Transaction -> Transaction b) -> Transaction b
withTransactionPtr Transaction -> Transaction b
m = do
  ForeignPtr Transaction
ft <- (TransactionEnv -> ForeignPtr Transaction)
-> Transaction (ForeignPtr Transaction)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TransactionEnv -> ForeignPtr Transaction
cTransaction
  ForeignPtr Transaction
-> (Ptr Transaction -> Transaction b) -> Transaction b
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtr' ForeignPtr Transaction
ft ((Ptr Transaction -> Transaction b) -> Transaction b)
-> (Ptr Transaction -> Transaction b) -> Transaction b
forall a b. (a -> b) -> a -> b
$ \Ptr Transaction
t -> Transaction -> Transaction b
m (Ptr Transaction -> Transaction
FDB.Transaction (Ptr Transaction -> Transaction) -> Ptr Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Ptr Transaction -> Ptr Transaction
forall a b. Ptr a -> Ptr b
castPtr Ptr Transaction
t)

-- | A transaction monad. This is currently exported with a 'MonadIO' instance,
-- but using it comes with caveats:
--
--   - 'runTransaction' will retry your transaction in some cases, which means
--     any IO in your transaction will be repeated. You can disable retries by
--     setting 'maxRetries' in 'TransactionConfig' to 0.
--
--   - Transactions have strict time limits, so slow IO operations should be
--     avoided.
newtype Transaction a = Transaction
  {Transaction a -> ReaderT TransactionEnv (ExceptT Error IO) a
unTransaction :: ReaderT TransactionEnv (ExceptT Error IO) a}
  deriving
    ( Functor Transaction
a -> Transaction a
Functor Transaction
-> (forall a. a -> Transaction a)
-> (forall a b.
    Transaction (a -> b) -> Transaction a -> Transaction b)
-> (forall a b c.
    (a -> b -> c) -> Transaction a -> Transaction b -> Transaction c)
-> (forall a b. Transaction a -> Transaction b -> Transaction b)
-> (forall a b. Transaction a -> Transaction b -> Transaction a)
-> Applicative Transaction
Transaction a -> Transaction b -> Transaction b
Transaction a -> Transaction b -> Transaction a
Transaction (a -> b) -> Transaction a -> Transaction b
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
forall a. a -> Transaction a
forall a b. Transaction a -> Transaction b -> Transaction a
forall a b. Transaction a -> Transaction b -> Transaction b
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Transaction a -> Transaction b -> Transaction a
$c<* :: forall a b. Transaction a -> Transaction b -> Transaction a
*> :: Transaction a -> Transaction b -> Transaction b
$c*> :: forall a b. Transaction a -> Transaction b -> Transaction b
liftA2 :: (a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
<*> :: Transaction (a -> b) -> Transaction a -> Transaction b
$c<*> :: forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
pure :: a -> Transaction a
$cpure :: forall a. a -> Transaction a
$cp1Applicative :: Functor Transaction
Applicative,
      a -> Transaction b -> Transaction a
(a -> b) -> Transaction a -> Transaction b
(forall a b. (a -> b) -> Transaction a -> Transaction b)
-> (forall a b. a -> Transaction b -> Transaction a)
-> Functor Transaction
forall a b. a -> Transaction b -> Transaction a
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Transaction b -> Transaction a
$c<$ :: forall a b. a -> Transaction b -> Transaction a
fmap :: (a -> b) -> Transaction a -> Transaction b
$cfmap :: forall a b. (a -> b) -> Transaction a -> Transaction b
Functor,
      Applicative Transaction
a -> Transaction a
Applicative Transaction
-> (forall a b.
    Transaction a -> (a -> Transaction b) -> Transaction b)
-> (forall a b. Transaction a -> Transaction b -> Transaction b)
-> (forall a. a -> Transaction a)
-> Monad Transaction
Transaction a -> (a -> Transaction b) -> Transaction b
Transaction a -> Transaction b -> Transaction b
forall a. a -> Transaction a
forall a b. Transaction a -> Transaction b -> Transaction b
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Transaction a
$creturn :: forall a. a -> Transaction a
>> :: Transaction a -> Transaction b -> Transaction b
$c>> :: forall a b. Transaction a -> Transaction b -> Transaction b
>>= :: Transaction a -> (a -> Transaction b) -> Transaction b
$c>>= :: forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
$cp1Monad :: Applicative Transaction
Monad,
      Monad Transaction
Monad Transaction
-> (forall a. IO a -> Transaction a) -> MonadIO Transaction
IO a -> Transaction a
forall a. IO a -> Transaction a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Transaction a
$cliftIO :: forall a. IO a -> Transaction a
$cp1MonadIO :: Monad Transaction
MonadIO,
      Monad Transaction
e -> Transaction a
Monad Transaction
-> (forall e a. Exception e => e -> Transaction a)
-> MonadThrow Transaction
forall e a. Exception e => e -> Transaction a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Transaction a
$cthrowM :: forall e a. Exception e => e -> Transaction a
$cp1MonadThrow :: Monad Transaction
MonadThrow,
      MonadThrow Transaction
MonadThrow Transaction
-> (forall e a.
    Exception e =>
    Transaction a -> (e -> Transaction a) -> Transaction a)
-> MonadCatch Transaction
Transaction a -> (e -> Transaction a) -> Transaction a
forall e a.
Exception e =>
Transaction a -> (e -> Transaction a) -> Transaction a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: Transaction a -> (e -> Transaction a) -> Transaction a
$ccatch :: forall e a.
Exception e =>
Transaction a -> (e -> Transaction a) -> Transaction a
$cp1MonadCatch :: MonadThrow Transaction
MonadCatch,
      MonadCatch Transaction
MonadCatch Transaction
-> (forall b.
    ((forall a. Transaction a -> Transaction a) -> Transaction b)
    -> Transaction b)
-> (forall b.
    ((forall a. Transaction a -> Transaction a) -> Transaction b)
    -> Transaction b)
-> (forall a b c.
    Transaction a
    -> (a -> ExitCase b -> Transaction c)
    -> (a -> Transaction b)
    -> Transaction (b, c))
-> MonadMask Transaction
Transaction a
-> (a -> ExitCase b -> Transaction c)
-> (a -> Transaction b)
-> Transaction (b, c)
((forall a. Transaction a -> Transaction a) -> Transaction b)
-> Transaction b
((forall a. Transaction a -> Transaction a) -> Transaction b)
-> Transaction b
forall b.
((forall a. Transaction a -> Transaction a) -> Transaction b)
-> Transaction b
forall a b c.
Transaction a
-> (a -> ExitCase b -> Transaction c)
-> (a -> Transaction b)
-> Transaction (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: Transaction a
-> (a -> ExitCase b -> Transaction c)
-> (a -> Transaction b)
-> Transaction (b, c)
$cgeneralBracket :: forall a b c.
Transaction a
-> (a -> ExitCase b -> Transaction c)
-> (a -> Transaction b)
-> Transaction (b, c)
uninterruptibleMask :: ((forall a. Transaction a -> Transaction a) -> Transaction b)
-> Transaction b
$cuninterruptibleMask :: forall b.
((forall a. Transaction a -> Transaction a) -> Transaction b)
-> Transaction b
mask :: ((forall a. Transaction a -> Transaction a) -> Transaction b)
-> Transaction b
$cmask :: forall b.
((forall a. Transaction a -> Transaction a) -> Transaction b)
-> Transaction b
$cp1MonadMask :: MonadCatch Transaction
MonadMask
    )

deriving instance MonadError Error Transaction

deriving instance MonadReader TransactionEnv Transaction

deriving instance MonadBase IO Transaction

deriving instance MonadBaseControl IO Transaction

-- | A future result of a FoundationDB call. You can block on a future with
-- 'await'.
-- WARNING: returning a value of this type from 'runTransaction' and then
-- calling 'await' on the value in another transaction will cause a segfault!
-- Future versions of this library may use more sophisticated types to prevent
-- this.
data Future a
  = -- | For applicative and monad instances
    PureFuture a
  | Future
      -- Note: the C future is closed over by _extractValue. It's only included in
      -- this record so that we can print the pointer in the Show instance.
      { Future a -> ForeignPtr ()
_cFuture :: ForeignPtr (),
        Future a -> Transaction a
_extractValue :: Transaction a
      }

instance Show a => Show (Future a) where
  show :: Future a -> String
show (PureFuture a
x) = ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"PureFuture (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (Future ForeignPtr ()
c Transaction a
_) = ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Future " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ForeignPtr () -> String
forall a. Show a => a -> String
show ForeignPtr ()
c

instance Functor Future where
  fmap :: (a -> b) -> Future a -> Future b
fmap a -> b
f (PureFuture a
x) = b -> Future b
forall a. a -> Future a
PureFuture (a -> b
f a
x)
  fmap a -> b
f (Future ForeignPtr ()
cf Transaction a
e) = ForeignPtr () -> Transaction b -> Future b
forall a. ForeignPtr () -> Transaction a -> Future a
Future ForeignPtr ()
cf ((a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Transaction a
e)

instance Applicative Future where
  pure :: a -> Future a
pure = a -> Future a
forall a. a -> Future a
PureFuture
  (PureFuture a -> b
f) <*> :: Future (a -> b) -> Future a -> Future b
<*> (PureFuture a
x) = b -> Future b
forall a. a -> Future a
PureFuture (a -> b
f a
x)
  (PureFuture a -> b
f) <*> fut :: Future a
fut@(Future ForeignPtr ()
_ Transaction a
_) = (a -> b) -> Future a -> Future b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Future a
fut
  fut :: Future (a -> b)
fut@(Future ForeignPtr ()
_ Transaction (a -> b)
_) <*> (PureFuture a
x) = ((a -> b) -> b) -> Future (a -> b) -> Future b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) Future (a -> b)
fut
  fut :: Future (a -> b)
fut@(Future ForeignPtr ()
_ Transaction (a -> b)
_) <*> (Future ForeignPtr ()
cf Transaction a
e) = ForeignPtr () -> Transaction b -> Future b
forall a. ForeignPtr () -> Transaction a -> Future a
Future ForeignPtr ()
cf (Future (a -> b) -> Transaction (a -> b)
forall a. Future a -> Transaction a
await Future (a -> b)
fut Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Transaction a
e)

fromCExtractor ::
  ForeignPtr () -> (FDB.Future b -> Transaction a) -> Transaction (Future a)
fromCExtractor :: ForeignPtr ()
-> (Future b -> Transaction a) -> Transaction (Future a)
fromCExtractor ForeignPtr ()
fp Future b -> Transaction a
extract =
  Future a -> Transaction (Future a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future a -> Transaction (Future a))
-> Future a -> Transaction (Future a)
forall a b. (a -> b) -> a -> b
$
    ForeignPtr () -> Transaction a -> Future a
forall a. ForeignPtr () -> Transaction a -> Future a
Future ForeignPtr ()
fp (Transaction a -> Future a) -> Transaction a -> Future a
forall a b. (a -> b) -> a -> b
$ do
      Either CFDBError a
fpResult <- ForeignPtr ()
-> (Ptr () -> Transaction (Either CFDBError a))
-> Transaction (Either CFDBError a)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtr' ForeignPtr ()
fp ((Ptr () -> Transaction (Either CFDBError a))
 -> Transaction (Either CFDBError a))
-> (Ptr () -> Transaction (Either CFDBError a))
-> Transaction (Either CFDBError a)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
f -> do
        CFDBError
futErr <- IO CFDBError -> Transaction CFDBError
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CFDBError -> Transaction CFDBError)
-> IO CFDBError -> Transaction CFDBError
forall a b. (a -> b) -> a -> b
$ Future Any -> IO CFDBError
forall a. Future a -> IO CFDBError
FDB.futureGetError (Ptr (Future Any) -> Future Any
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))
        case CFDBError -> Maybe CError
toError CFDBError
futErr of
          Just CError
x -> Either CFDBError a -> Transaction (Either CFDBError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CFDBError a -> Transaction (Either CFDBError a))
-> Either CFDBError a -> Transaction (Either CFDBError a)
forall a b. (a -> b) -> a -> b
$ CFDBError -> Either CFDBError a
forall a b. a -> Either a b
Left (CFDBError -> Either CFDBError a)
-> CFDBError -> Either CFDBError a
forall a b. (a -> b) -> a -> b
$ CError -> CFDBError
toCFDBError CError
x
          Maybe CError
Nothing -> do
            a
res <- Future b -> Transaction a
extract (Ptr (Future b) -> Future b
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future b)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))
            Either CFDBError a -> Transaction (Either CFDBError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CFDBError a -> Transaction (Either CFDBError a))
-> Either CFDBError a -> Transaction (Either CFDBError a)
forall a b. (a -> b) -> a -> b
$ a -> Either CFDBError a
forall a b. b -> Either a b
Right a
res
      IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fp
      Either CFDBError a -> Transaction a
forall (m :: * -> *) a.
MonadError Error m =>
Either CFDBError a -> m a
liftFDBError Either CFDBError a
fpResult

allocFuture ::
  IO (FDB.Future b) ->
  (FDB.Future b -> Transaction a) ->
  Transaction (Future a)
allocFuture :: IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture IO (Future b)
make Future b -> Transaction a
extract = do
  (FDB.Future Ptr (Future b)
p) <- IO (Future b) -> Transaction (Future b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Future b) -> Transaction (Future b))
-> IO (Future b) -> Transaction (Future b)
forall a b. (a -> b) -> a -> b
$ IO (Future b)
make
  ForeignPtr ()
fp <- IO (ForeignPtr ()) -> Transaction (ForeignPtr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForeignPtr ()) -> Transaction (ForeignPtr ()))
-> IO (ForeignPtr ()) -> Transaction (ForeignPtr ())
forall a b. (a -> b) -> a -> b
$ FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
forall a. FunPtr (Ptr a -> IO ())
FDB.futureDestroyPtr (Ptr (Future b) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Future b)
p)
  ForeignPtr ()
-> (Future b -> Transaction a) -> Transaction (Future a)
forall b a.
ForeignPtr ()
-> (Future b -> Transaction a) -> Transaction (Future a)
fromCExtractor ForeignPtr ()
fp Future b -> Transaction a
extract

-- | Block until a future is ready. Unfortunately, does not seem to be
-- interruptible by SIGPIPE (the interrupt sent by Control.Conccurent.Async to
-- cancel), even when using InterruptibleFFI.
await :: Future a -> Transaction a
await :: Future a -> Transaction a
await (PureFuture a
x) = a -> Transaction a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
await (Future ForeignPtr ()
fp Transaction a
e) = do
  IO CFDBError -> Transaction ()
forall (m :: * -> *).
(MonadError Error m, MonadIO m) =>
IO CFDBError -> m ()
fdbExcept' (IO CFDBError -> Transaction ()) -> IO CFDBError -> Transaction ()
forall a b. (a -> b) -> a -> b
$
    ForeignPtr () -> (Ptr () -> IO CFDBError) -> IO CFDBError
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtr' ForeignPtr ()
fp ((Ptr () -> IO CFDBError) -> IO CFDBError)
-> (Ptr () -> IO CFDBError) -> IO CFDBError
forall a b. (a -> b) -> a -> b
$
      \Ptr ()
f -> Future Any -> IO CFDBError
forall a. Future a -> IO CFDBError
FDB.futureBlockUntilReady (Ptr (Future Any) -> Future Any
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))
  Transaction a
e

-- | Polls a future for readiness roughly every millisecond in a loop until it
-- is ready, then returns the value in the future. This is less resource
-- efficient than 'await', but can be interrupted more easily.
awaitInterruptible :: Future a -> Transaction a
awaitInterruptible :: Future a -> Transaction a
awaitInterruptible (PureFuture a
x) = a -> Transaction a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
awaitInterruptible fut :: Future a
fut@(Future ForeignPtr ()
_f Transaction a
e) =
  Future a -> Transaction Bool
forall a. Future a -> Transaction Bool
futureIsReady Future a
fut Transaction Bool -> (Bool -> Transaction a) -> Transaction a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> Transaction a
e
    Bool
False -> IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay Int
1000) Transaction () -> Transaction a -> Transaction a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Future a -> Transaction a
forall a. Future a -> Transaction a
awaitInterruptible Future a
fut

-- | Cancel a future. Attempting to await the future after cancellation will
-- throw 'OperationCancelled'.
cancelFuture :: Future a -> Transaction ()
cancelFuture :: Future a -> Transaction ()
cancelFuture (PureFuture a
_) = () -> Transaction ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cancelFuture (Future ForeignPtr ()
fp Transaction a
_e) =
  ForeignPtr () -> (Ptr () -> Transaction ()) -> Transaction ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtr' ForeignPtr ()
fp ((Ptr () -> Transaction ()) -> Transaction ())
-> (Ptr () -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
f -> IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Future Any -> IO ()
forall a. Future a -> IO ()
FDB.futureCancel (Ptr (Future Any) -> Future Any
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))

-- | Returns True if the future is ready. If so, calling 'await' will not block.
futureIsReady :: Future a -> Transaction Bool
futureIsReady :: Future a -> Transaction Bool
futureIsReady (PureFuture a
_) = Bool -> Transaction Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
futureIsReady (Future ForeignPtr ()
fp Transaction a
_) =
  ForeignPtr () -> (Ptr () -> Transaction Bool) -> Transaction Bool
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtr' ForeignPtr ()
fp ((Ptr () -> Transaction Bool) -> Transaction Bool)
-> (Ptr () -> Transaction Bool) -> Transaction Bool
forall a b. (a -> b) -> a -> b
$ \Ptr ()
f -> IO Bool -> Transaction Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Transaction Bool) -> IO Bool -> Transaction Bool
forall a b. (a -> b) -> a -> b
$ Future Any -> IO Bool
forall a. Future a -> IO Bool
FDB.futureIsReady (Ptr (Future Any) -> Future Any
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))

-- | A future that can only be awaited after its transaction has committed.
-- That is, in contrast to 'Future', this __must__ be returned from
-- 'runTransaction' before it can safely be awaited. Use 'awaitIO' to await it.
-- This future type is not needed frequently.
--
-- All 'FutureIO' functions work similarly to their 'Future' counterparts.
data FutureIO a = FutureIO
  { FutureIO a -> ForeignPtr ()
_fgnPtr :: ForeignPtr (),
    FutureIO a -> IO a
_extractValueIO :: IO a
  }

instance Show (FutureIO a) where
  show :: FutureIO a -> String
show (FutureIO ForeignPtr ()
p IO a
_) = ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"FutureIO " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ForeignPtr () -> String
forall a. Show a => a -> String
show ForeignPtr ()
p

instance Functor FutureIO where
  fmap :: (a -> b) -> FutureIO a -> FutureIO b
fmap a -> b
f (FutureIO ForeignPtr ()
cf IO a
e) = ForeignPtr () -> IO b -> FutureIO b
forall a. ForeignPtr () -> IO a -> FutureIO a
FutureIO ForeignPtr ()
cf ((a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IO a
e)

allocFutureIO :: FDB.Future b -> IO a -> IO (FutureIO a)
allocFutureIO :: Future b -> IO a -> IO (FutureIO a)
allocFutureIO (FDB.Future Ptr (Future b)
f) IO a
e = do
  ForeignPtr ()
fp <- FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
forall a. FunPtr (Ptr a -> IO ())
FDB.futureDestroyPtr (Ptr (Future b) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Future b)
f)
  FutureIO a -> IO (FutureIO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FutureIO a -> IO (FutureIO a)) -> FutureIO a -> IO (FutureIO a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> IO a -> FutureIO a
forall a. ForeignPtr () -> IO a -> FutureIO a
FutureIO ForeignPtr ()
fp IO a
e

-- | IO analogue to 'await'.
awaitIO :: FutureIO a -> IO (Either Error a)
awaitIO :: FutureIO a -> IO (Either Error a)
awaitIO (FutureIO ForeignPtr ()
fp IO a
e) = ForeignPtr ()
-> (Ptr () -> IO (Either Error a)) -> IO (Either Error a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fp ((Ptr () -> IO (Either Error a)) -> IO (Either Error a))
-> (Ptr () -> IO (Either Error a)) -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
f ->
  IO CFDBError -> IO (Either Error ())
forall (m :: * -> *).
MonadIO m =>
m CFDBError -> m (Either Error ())
fdbEither' (Future Any -> IO CFDBError
forall a. Future a -> IO CFDBError
FDB.futureBlockUntilReady (Ptr (Future Any) -> Future Any
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))) IO (Either Error ())
-> (Either Error () -> IO (Either Error a)) -> IO (Either Error a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Error
err -> Either Error a -> IO (Either Error a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error a -> IO (Either Error a))
-> Either Error a -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error a
forall a b. a -> Either a b
Left Error
err
    Right () -> a -> Either Error a
forall a b. b -> Either a b
Right (a -> Either Error a) -> IO a -> IO (Either Error a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
e

-- | IO analogue to 'awaitInterruptible'.
awaitInterruptibleIO :: FutureIO a -> IO (Either Error a)
awaitInterruptibleIO :: FutureIO a -> IO (Either Error a)
awaitInterruptibleIO FutureIO a
fut =
  FutureIO a -> IO Bool
forall a. FutureIO a -> IO Bool
futureIsReadyIO FutureIO a
fut IO Bool -> (Bool -> IO (Either Error a)) -> IO (Either Error a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> FutureIO a -> IO (Either Error a)
forall a. FutureIO a -> IO (Either Error a)
awaitIO FutureIO a
fut
    Bool
False -> Int -> IO ()
threadDelay Int
1000 IO () -> IO (Either Error a) -> IO (Either Error a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FutureIO a -> IO (Either Error a)
forall a. FutureIO a -> IO (Either Error a)
awaitInterruptibleIO FutureIO a
fut

-- | Cancel a future. Attempts to await the future after cancellation will throw
-- 'OperationCancelled'.
cancelFutureIO :: FutureIO a -> IO ()
cancelFutureIO :: FutureIO a -> IO ()
cancelFutureIO (FutureIO ForeignPtr ()
fp IO a
_e) = ForeignPtr () -> (Ptr () -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fp ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
f ->
  Future Any -> IO ()
forall a. Future a -> IO ()
FDB.futureCancel (Ptr (Future Any) -> Future Any
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))

-- | Returns 'True' if calling 'awaitIO' will return immediately, without
-- blocking.
futureIsReadyIO :: FutureIO a -> IO Bool
futureIsReadyIO :: FutureIO a -> IO Bool
futureIsReadyIO (FutureIO ForeignPtr ()
fp IO a
_) = ForeignPtr () -> (Ptr () -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fp ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr ()
f ->
  Future Any -> IO Bool
forall a. Future a -> IO Bool
FDB.futureIsReady (Ptr (Future Any) -> Future Any
forall a. Ptr (Future a) -> Future a
FDB.Future (Ptr () -> Ptr (Future Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
f))

-- | Attempts to commit a transaction. If 'await'ing the returned 'Future'
-- works without errors, the transaction was committed.
commitFuture :: Transaction (Future ())
commitFuture :: Transaction (Future ())
commitFuture =
  (Transaction -> Transaction (Future ())) -> Transaction (Future ())
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future ()))
 -> Transaction (Future ()))
-> (Transaction -> Transaction (Future ()))
-> Transaction (Future ())
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO (Future ())
-> (Future () -> Transaction ()) -> Transaction (Future ())
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture
      (Transaction -> IO (Future ())
FDB.transactionCommit Transaction
t)
      (Transaction () -> Future () -> Transaction ()
forall a b. a -> b -> a
const (Transaction () -> Future () -> Transaction ())
-> Transaction () -> Future () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ () -> Transaction ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Get the value of a key. If the key does not exist, returns 'Nothing'.
get :: ByteString -> Transaction (Future (Maybe ByteString))
get :: ByteString -> Transaction (Future (Maybe ByteString))
get ByteString
key = do
  TransactionEnv
t <- Transaction TransactionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  let isSnapshot :: Bool
isSnapshot = TransactionConfig -> Bool
snapshotReads (TransactionEnv -> TransactionConfig
envConf TransactionEnv
t)
  (Transaction -> Transaction (Future (Maybe ByteString)))
-> Transaction (Future (Maybe ByteString))
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future (Maybe ByteString)))
 -> Transaction (Future (Maybe ByteString)))
-> (Transaction -> Transaction (Future (Maybe ByteString)))
-> Transaction (Future (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ \Transaction
tp ->
    IO (Future (Maybe ByteString))
-> (Future (Maybe ByteString) -> Transaction (Maybe ByteString))
-> Transaction (Future (Maybe ByteString))
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture
      (Transaction -> ByteString -> Bool -> IO (Future (Maybe ByteString))
FDB.transactionGet Transaction
tp ByteString
key Bool
isSnapshot)
      (\Future (Maybe ByteString)
f -> IO (Either CFDBError (Maybe ByteString))
-> Transaction (Either CFDBError (Maybe ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Future (Maybe ByteString)
-> IO (Either CFDBError (Maybe ByteString))
FDB.futureGetValue Future (Maybe ByteString)
f) Transaction (Either CFDBError (Maybe ByteString))
-> (Either CFDBError (Maybe ByteString)
    -> Transaction (Maybe ByteString))
-> Transaction (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either CFDBError (Maybe ByteString)
-> Transaction (Maybe ByteString)
forall (m :: * -> *) a.
MonadError Error m =>
Either CFDBError a -> m a
liftFDBError)

-- | Set a bytestring key to a bytestring value.
set :: ByteString -> ByteString -> Transaction ()
set :: ByteString -> ByteString -> Transaction ()
set ByteString
key ByteString
val =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> ByteString -> ByteString -> IO ()
FDB.transactionSet Transaction
t ByteString
key ByteString
val

-- | Delete a key from the DB.
clear :: ByteString -> Transaction ()
clear :: ByteString -> Transaction ()
clear ByteString
k =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> ByteString -> IO ()
FDB.transactionClear Transaction
t ByteString
k

-- | @clearRange k l@ deletes all keys in the half-open range [k,l).
clearRange :: ByteString -> ByteString -> Transaction ()
clearRange :: ByteString -> ByteString -> Transaction ()
clearRange ByteString
k ByteString
l =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> ByteString -> ByteString -> IO ()
FDB.transactionClearRange Transaction
t ByteString
k ByteString
l

-- | Tells FoundationDB to consider the given range to have been read by this
-- transaction.
addConflictRange ::
  ByteString -> ByteString -> FDB.FDBConflictRangeType -> Transaction ()
addConflictRange :: ByteString -> ByteString -> FDBConflictRangeType -> Transaction ()
addConflictRange ByteString
k ByteString
l FDBConflictRangeType
ty =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO CFDBError -> Transaction ()
forall (m :: * -> *).
(MonadError Error m, MonadIO m) =>
IO CFDBError -> m ()
fdbExcept' (IO CFDBError -> Transaction ()) -> IO CFDBError -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction
-> ByteString -> ByteString -> FDBConflictRangeType -> IO CFDBError
FDB.transactionAddConflictRange Transaction
t ByteString
k ByteString
l FDBConflictRangeType
ty

-- | Tells FoundationDB to consider the given key to have been read by this
-- transaction.
addReadConflictKey :: ByteString -> Transaction ()
addReadConflictKey :: ByteString -> Transaction ()
addReadConflictKey ByteString
k =
  ByteString -> ByteString -> FDBConflictRangeType -> Transaction ()
addConflictRange ByteString
k (ByteString -> Word8 -> ByteString
BS.snoc ByteString
k Word8
0x00) FDBConflictRangeType
FDB.ConflictRangeTypeRead

-- | Tells FoundationDB to consider the given key to have been written
-- by this transaction.
addWriteConflictKey :: ByteString -> Transaction ()
addWriteConflictKey :: ByteString -> Transaction ()
addWriteConflictKey ByteString
k =
  ByteString -> ByteString -> FDBConflictRangeType -> Transaction ()
addConflictRange ByteString
k (ByteString -> Word8 -> ByteString
BS.snoc ByteString
k Word8
0x00) FDBConflictRangeType
FDB.ConflictRangeTypeWrite

-- | Increase the offset of the given 'KeySelector'.
offset :: Int -> FDB.KeySelector -> FDB.KeySelector
offset :: Int -> KeySelector -> KeySelector
offset Int
m (FDB.WithOffset Int
n KeySelector
ks) = Int -> KeySelector -> KeySelector
FDB.WithOffset (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m) KeySelector
ks
offset Int
n KeySelector
ks = Int -> KeySelector -> KeySelector
FDB.WithOffset Int
n KeySelector
ks

-- | Gets the key specified by the given 'KeySelector'.
getKey :: FDB.KeySelector -> Transaction (Future ByteString)
getKey :: KeySelector -> Transaction (Future ByteString)
getKey KeySelector
ks = do
  Bool
isSnapshot <- (TransactionEnv -> Bool) -> Transaction Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TransactionConfig -> Bool
snapshotReads (TransactionConfig -> Bool)
-> (TransactionEnv -> TransactionConfig) -> TransactionEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionEnv -> TransactionConfig
envConf)
  let (ByteString
k, Bool
orEqual, Int
offsetN) = KeySelector -> (ByteString, Bool, Int)
FDB.keySelectorTuple KeySelector
ks
  (Transaction -> Transaction (Future ByteString))
-> Transaction (Future ByteString)
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future ByteString))
 -> Transaction (Future ByteString))
-> (Transaction -> Transaction (Future ByteString))
-> Transaction (Future ByteString)
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO (Future ByteString)
-> (Future ByteString -> Transaction ByteString)
-> Transaction (Future ByteString)
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture
      (Transaction
-> ByteString -> Bool -> Int -> Bool -> IO (Future ByteString)
FDB.transactionGetKey Transaction
t ByteString
k Bool
orEqual Int
offsetN Bool
isSnapshot)
      (\Future ByteString
f -> IO (Either CFDBError ByteString)
-> Transaction (Either CFDBError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Future ByteString -> IO (Either CFDBError ByteString)
FDB.futureGetKey Future ByteString
f) Transaction (Either CFDBError ByteString)
-> (Either CFDBError ByteString -> Transaction ByteString)
-> Transaction ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either CFDBError ByteString -> Transaction ByteString
forall (m :: * -> *) a.
MonadError Error m =>
Either CFDBError a -> m a
liftFDBError)

-- | Get the public network addresses of all nodes responsible for storing
-- the given key.
getKeyAddresses :: ByteString -> Transaction (Future [ByteString])
getKeyAddresses :: ByteString -> Transaction (Future [ByteString])
getKeyAddresses ByteString
k =
  (Transaction -> Transaction (Future [ByteString]))
-> Transaction (Future [ByteString])
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future [ByteString]))
 -> Transaction (Future [ByteString]))
-> (Transaction -> Transaction (Future [ByteString]))
-> Transaction (Future [ByteString])
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO (Future [ByteString])
-> (Future [ByteString] -> Transaction [ByteString])
-> Transaction (Future [ByteString])
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture
      (Transaction -> ByteString -> IO (Future [ByteString])
FDB.transactionGetAddressesForKey Transaction
t ByteString
k)
      (\Future [ByteString]
f -> IO (Either CFDBError [ByteString])
-> Transaction (Either CFDBError [ByteString])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Future [ByteString] -> IO (Either CFDBError [ByteString])
FDB.futureGetStringArray Future [ByteString]
f) Transaction (Either CFDBError [ByteString])
-> (Either CFDBError [ByteString] -> Transaction [ByteString])
-> Transaction [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either CFDBError [ByteString] -> Transaction [ByteString]
forall (m :: * -> *) a.
MonadError Error m =>
Either CFDBError a -> m a
liftFDBError)

-- TODO: rename to RangeQuery?

-- | Specifies a range of keys to be iterated over by 'getRange'.
data RangeQuery = RangeQuery
  { -- | The beginning of the range, including the key specified by this
    -- 'KeySelector'.
    RangeQuery -> KeySelector
rangeBegin :: FDB.KeySelector,
    -- | The end of the range, not including the key specified by this
    -- 'KeySelector'.
    RangeQuery -> KeySelector
rangeEnd :: FDB.KeySelector,
    -- | If the range contains more than @n@ items, return only @Just n@.
    -- If @Nothing@ is provided, returns the entire range.
    RangeQuery -> Maybe Int
rangeLimit :: Maybe Int,
    -- | If 'True', return the range in reverse order.
    RangeQuery -> Bool
rangeReverse :: Bool
  }
  deriving (Int -> RangeQuery -> ShowS
[RangeQuery] -> ShowS
RangeQuery -> String
(Int -> RangeQuery -> ShowS)
-> (RangeQuery -> String)
-> ([RangeQuery] -> ShowS)
-> Show RangeQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RangeQuery] -> ShowS
$cshowList :: [RangeQuery] -> ShowS
show :: RangeQuery -> String
$cshow :: RangeQuery -> String
showsPrec :: Int -> RangeQuery -> ShowS
$cshowsPrec :: Int -> RangeQuery -> ShowS
Show, RangeQuery -> RangeQuery -> Bool
(RangeQuery -> RangeQuery -> Bool)
-> (RangeQuery -> RangeQuery -> Bool) -> Eq RangeQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RangeQuery -> RangeQuery -> Bool
$c/= :: RangeQuery -> RangeQuery -> Bool
== :: RangeQuery -> RangeQuery -> Bool
$c== :: RangeQuery -> RangeQuery -> Bool
Eq, Eq RangeQuery
Eq RangeQuery
-> (RangeQuery -> RangeQuery -> Ordering)
-> (RangeQuery -> RangeQuery -> Bool)
-> (RangeQuery -> RangeQuery -> Bool)
-> (RangeQuery -> RangeQuery -> Bool)
-> (RangeQuery -> RangeQuery -> Bool)
-> (RangeQuery -> RangeQuery -> RangeQuery)
-> (RangeQuery -> RangeQuery -> RangeQuery)
-> Ord RangeQuery
RangeQuery -> RangeQuery -> Bool
RangeQuery -> RangeQuery -> Ordering
RangeQuery -> RangeQuery -> RangeQuery
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RangeQuery -> RangeQuery -> RangeQuery
$cmin :: RangeQuery -> RangeQuery -> RangeQuery
max :: RangeQuery -> RangeQuery -> RangeQuery
$cmax :: RangeQuery -> RangeQuery -> RangeQuery
>= :: RangeQuery -> RangeQuery -> Bool
$c>= :: RangeQuery -> RangeQuery -> Bool
> :: RangeQuery -> RangeQuery -> Bool
$c> :: RangeQuery -> RangeQuery -> Bool
<= :: RangeQuery -> RangeQuery -> Bool
$c<= :: RangeQuery -> RangeQuery -> Bool
< :: RangeQuery -> RangeQuery -> Bool
$c< :: RangeQuery -> RangeQuery -> Bool
compare :: RangeQuery -> RangeQuery -> Ordering
$ccompare :: RangeQuery -> RangeQuery -> Ordering
$cp1Ord :: Eq RangeQuery
Ord)

-- | @keyRangeQuery begin end@ is the range of keys @[begin, end)@.
keyRangeQuery :: ByteString -> ByteString -> RangeQuery
keyRangeQuery :: ByteString -> ByteString -> RangeQuery
keyRangeQuery ByteString
begin ByteString
end =
  KeySelector -> KeySelector -> Maybe Int -> Bool -> RangeQuery
RangeQuery (ByteString -> KeySelector
FDB.FirstGreaterOrEq ByteString
begin) (ByteString -> KeySelector
FDB.FirstGreaterOrEq ByteString
end) Maybe Int
forall a. Maybe a
Nothing Bool
False

-- | @keyRangeQuery begin end@ is the range of keys @[begin, end]@.
keyRangeQueryInclusive :: ByteString -> ByteString -> RangeQuery
keyRangeQueryInclusive :: ByteString -> ByteString -> RangeQuery
keyRangeQueryInclusive ByteString
begin ByteString
end =
  KeySelector -> KeySelector -> Maybe Int -> Bool -> RangeQuery
RangeQuery (ByteString -> KeySelector
FDB.FirstGreaterOrEq ByteString
begin) (ByteString -> KeySelector
FDB.FirstGreaterThan ByteString
end) Maybe Int
forall a. Maybe a
Nothing Bool
False

-- | @prefixRange prefix@ is the range of all keys of which @prefix@ is a
--   prefix. Returns @Nothing@ if @prefix@ is empty or contains only @0xff@.
prefixRange :: ByteString -> Maybe RangeQuery
prefixRange :: ByteString -> Maybe RangeQuery
prefixRange ByteString
prefix = do
  ByteString
end <- ByteString -> Maybe ByteString
prefixRangeEnd ByteString
prefix
  RangeQuery -> Maybe RangeQuery
forall (m :: * -> *) a. Monad m => a -> m a
return (RangeQuery -> Maybe RangeQuery) -> RangeQuery -> Maybe RangeQuery
forall a b. (a -> b) -> a -> b
$
    RangeQuery :: KeySelector -> KeySelector -> Maybe Int -> Bool -> RangeQuery
RangeQuery
      { rangeBegin :: KeySelector
rangeBegin = ByteString -> KeySelector
FDB.FirstGreaterOrEq ByteString
prefix,
        rangeEnd :: KeySelector
rangeEnd = ByteString -> KeySelector
FDB.FirstGreaterOrEq ByteString
end,
        rangeLimit :: Maybe Int
rangeLimit = Maybe Int
forall a. Maybe a
Nothing,
        rangeReverse :: Bool
rangeReverse = Bool
False
      }

rangeKeys :: RangeQuery -> (ByteString, ByteString)
rangeKeys :: RangeQuery -> (ByteString, ByteString)
rangeKeys (RangeQuery KeySelector
b KeySelector
e Maybe Int
_ Bool
_) =
  (KeySelector -> ByteString
FDB.keySelectorBytes KeySelector
b, KeySelector -> ByteString
FDB.keySelectorBytes KeySelector
e)

-- | Structure for returning the result of 'getRange' in chunks.
data RangeResult
  = RangeDone (Seq (ByteString, ByteString))
  | RangeMore (Seq (ByteString, ByteString)) (Future RangeResult)
  deriving (Int -> RangeResult -> ShowS
[RangeResult] -> ShowS
RangeResult -> String
(Int -> RangeResult -> ShowS)
-> (RangeResult -> String)
-> ([RangeResult] -> ShowS)
-> Show RangeResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RangeResult] -> ShowS
$cshowList :: [RangeResult] -> ShowS
show :: RangeResult -> String
$cshow :: RangeResult -> String
showsPrec :: Int -> RangeResult -> ShowS
$cshowsPrec :: Int -> RangeResult -> ShowS
Show)

-- | Like 'getRange', but allows you to specify the streaming mode as desired.
getRange' :: RangeQuery -> FDB.FDBStreamingMode -> Transaction (Future RangeResult)
getRange' :: RangeQuery -> FDBStreamingMode -> Transaction (Future RangeResult)
getRange' RangeQuery {Bool
Maybe Int
KeySelector
rangeReverse :: Bool
rangeLimit :: Maybe Int
rangeEnd :: KeySelector
rangeBegin :: KeySelector
rangeReverse :: RangeQuery -> Bool
rangeLimit :: RangeQuery -> Maybe Int
rangeEnd :: RangeQuery -> KeySelector
rangeBegin :: RangeQuery -> KeySelector
..} FDBStreamingMode
mode = do
  Bool
isSnapshot <- (TransactionEnv -> Bool) -> Transaction Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TransactionConfig -> Bool
snapshotReads (TransactionConfig -> Bool)
-> (TransactionEnv -> TransactionConfig) -> TransactionEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionEnv -> TransactionConfig
envConf)
  (Transaction -> Transaction (Future RangeResult))
-> Transaction (Future RangeResult)
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future RangeResult))
 -> Transaction (Future RangeResult))
-> (Transaction -> Transaction (Future RangeResult))
-> Transaction (Future RangeResult)
forall a b. (a -> b) -> a -> b
$ \Transaction
t -> do
    let getR :: KeySelector
-> KeySelector
-> Int
-> Int
-> IO (Future [(ByteString, ByteString)])
getR KeySelector
b KeySelector
e Int
lim Int
i = Transaction
-> KeySelector
-> KeySelector
-> Int
-> Int
-> FDBStreamingMode
-> Int
-> Bool
-> Bool
-> IO (Future [(ByteString, ByteString)])
FDB.transactionGetRange Transaction
t KeySelector
b KeySelector
e Int
lim Int
0 FDBStreamingMode
mode Int
i Bool
isSnapshot Bool
rangeReverse
    let mk :: IO (Future [(ByteString, ByteString)])
mk = KeySelector
-> KeySelector
-> Int
-> Int
-> IO (Future [(ByteString, ByteString)])
getR KeySelector
rangeBegin KeySelector
rangeEnd (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
rangeLimit) Int
1
    let handler :: KeySelector
-> KeySelector
-> Int
-> Maybe Int
-> Future [(ByteString, ByteString)]
-> Transaction RangeResult
handler KeySelector
bsel KeySelector
esel Int
i Maybe Int
lim Future [(ByteString, ByteString)]
fut = do
          -- more doesn't take into account our count limit, so we check below
          ([(ByteString, ByteString)]
kvs, Bool
more) <- IO (Either CFDBError ([(ByteString, ByteString)], Bool))
-> Transaction
     (Either CFDBError ([(ByteString, ByteString)], Bool))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Future [(ByteString, ByteString)]
-> IO (Either CFDBError ([(ByteString, ByteString)], Bool))
FDB.futureGetKeyValueArray Future [(ByteString, ByteString)]
fut) Transaction (Either CFDBError ([(ByteString, ByteString)], Bool))
-> (Either CFDBError ([(ByteString, ByteString)], Bool)
    -> Transaction ([(ByteString, ByteString)], Bool))
-> Transaction ([(ByteString, ByteString)], Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either CFDBError ([(ByteString, ByteString)], Bool)
-> Transaction ([(ByteString, ByteString)], Bool)
forall (m :: * -> *) a.
MonadError Error m =>
Either CFDBError a -> m a
liftFDBError
          let kvs' :: Seq (ByteString, ByteString)
kvs' = [(ByteString, ByteString)] -> Seq (ByteString, ByteString)
forall a. [a] -> Seq a
Seq.fromList [(ByteString, ByteString)]
kvs
          case Seq (ByteString, ByteString)
kvs' of
            (Seq (ByteString, ByteString)
_ :|> (ByteString
lstK, ByteString
_)) | Bool
more Bool -> Bool -> Bool
&& Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Seq (ByteString, ByteString) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (ByteString, ByteString)
kvs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) Maybe Int
lim -> do
              let bsel' :: KeySelector
bsel' = if Bool -> Bool
not Bool
rangeReverse then ByteString -> KeySelector
FDB.FirstGreaterThan ByteString
lstK else KeySelector
bsel
              let esel' :: KeySelector
esel' = if Bool
rangeReverse then ByteString -> KeySelector
FDB.FirstGreaterOrEq ByteString
lstK else KeySelector
esel
              let lim' :: Maybe Int
lim' = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Seq (ByteString, ByteString) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (ByteString, ByteString)
kvs') Maybe Int
lim
              let mk' :: IO (Future [(ByteString, ByteString)])
mk' = KeySelector
-> KeySelector
-> Int
-> Int
-> IO (Future [(ByteString, ByteString)])
getR KeySelector
bsel' KeySelector
esel' (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
lim') (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Future RangeResult
res <- IO (Future [(ByteString, ByteString)])
-> (Future [(ByteString, ByteString)] -> Transaction RangeResult)
-> Transaction (Future RangeResult)
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture IO (Future [(ByteString, ByteString)])
mk' (KeySelector
-> KeySelector
-> Int
-> Maybe Int
-> Future [(ByteString, ByteString)]
-> Transaction RangeResult
handler KeySelector
bsel' KeySelector
esel' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
lim')
              RangeResult -> Transaction RangeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (RangeResult -> Transaction RangeResult)
-> RangeResult -> Transaction RangeResult
forall a b. (a -> b) -> a -> b
$ Seq (ByteString, ByteString) -> Future RangeResult -> RangeResult
RangeMore Seq (ByteString, ByteString)
kvs' Future RangeResult
res
            Seq (ByteString, ByteString)
_ -> RangeResult -> Transaction RangeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (RangeResult -> Transaction RangeResult)
-> RangeResult -> Transaction RangeResult
forall a b. (a -> b) -> a -> b
$
              Seq (ByteString, ByteString) -> RangeResult
RangeDone (Seq (ByteString, ByteString) -> RangeResult)
-> Seq (ByteString, ByteString) -> RangeResult
forall a b. (a -> b) -> a -> b
$ case Maybe Int
lim of
                Maybe Int
Nothing -> Seq (ByteString, ByteString)
kvs'
                Just Int
n -> Int -> Seq (ByteString, ByteString) -> Seq (ByteString, ByteString)
forall a. Int -> Seq a -> Seq a
Seq.take Int
n Seq (ByteString, ByteString)
kvs'
    IO (Future [(ByteString, ByteString)])
-> (Future [(ByteString, ByteString)] -> Transaction RangeResult)
-> Transaction (Future RangeResult)
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture IO (Future [(ByteString, ByteString)])
mk (KeySelector
-> KeySelector
-> Int
-> Maybe Int
-> Future [(ByteString, ByteString)]
-> Transaction RangeResult
handler KeySelector
rangeBegin KeySelector
rangeEnd Int
1 Maybe Int
rangeLimit)

-- | Reads all key-value pairs in the specified 'Range' which are
--   lexicographically greater than or equal to the 'rangeBegin' 'KeySelector'
--   and lexicographically less than the 'rangeEnd' 'KeySelector'.
--   Uses 'StreamingModeIterator', which assumes that you don't know ahead of
--   time exactly how many pairs in the range you actually need. If you need
--   them all (and they are expected to fit in memory), use 'getEntireRange'.
--   For more advanced usage, use 'getRange''.
getRange :: RangeQuery -> Transaction (Future RangeResult)
getRange :: RangeQuery -> Transaction (Future RangeResult)
getRange RangeQuery
r = RangeQuery -> FDBStreamingMode -> Transaction (Future RangeResult)
getRange' RangeQuery
r FDBStreamingMode
FDB.StreamingModeIterator

getEntireRange' ::
  FDB.FDBStreamingMode ->
  RangeQuery ->
  Transaction (Seq (ByteString, ByteString))
getEntireRange' :: FDBStreamingMode
-> RangeQuery -> Transaction (Seq (ByteString, ByteString))
getEntireRange' FDBStreamingMode
mode RangeQuery
r = do
  RangeResult
rr <- RangeQuery -> FDBStreamingMode -> Transaction (Future RangeResult)
getRange' RangeQuery
r FDBStreamingMode
mode Transaction (Future RangeResult)
-> (Future RangeResult -> Transaction RangeResult)
-> Transaction RangeResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Future RangeResult -> Transaction RangeResult
forall a. Future a -> Transaction a
await
  RangeResult -> Transaction (Seq (ByteString, ByteString))
go RangeResult
rr
  where
    go :: RangeResult -> Transaction (Seq (ByteString, ByteString))
go (RangeDone Seq (ByteString, ByteString)
xs) = Seq (ByteString, ByteString)
-> Transaction (Seq (ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Seq (ByteString, ByteString)
xs
    go (RangeMore Seq (ByteString, ByteString)
xs Future RangeResult
fut) = do
      RangeResult
more <- Future RangeResult -> Transaction RangeResult
forall a. Future a -> Transaction a
await Future RangeResult
fut
      Seq (ByteString, ByteString)
ys <- RangeResult -> Transaction (Seq (ByteString, ByteString))
go RangeResult
more
      Seq (ByteString, ByteString)
-> Transaction (Seq (ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq (ByteString, ByteString)
xs Seq (ByteString, ByteString)
-> Seq (ByteString, ByteString) -> Seq (ByteString, ByteString)
forall a. Semigroup a => a -> a -> a
<> Seq (ByteString, ByteString)
ys)

-- | Wrapper around 'getRange' that reads the entire range into memory.
getEntireRange :: RangeQuery -> Transaction (Seq (ByteString, ByteString))
getEntireRange :: RangeQuery -> Transaction (Seq (ByteString, ByteString))
getEntireRange = FDBStreamingMode
-> RangeQuery -> Transaction (Seq (ByteString, ByteString))
getEntireRange' FDBStreamingMode
FDB.StreamingModeWantAll

-- | Return True iff the given range is empty.
isRangeEmpty :: RangeQuery -> Transaction Bool
isRangeEmpty :: RangeQuery -> Transaction Bool
isRangeEmpty RangeQuery
r = do
  RangeResult
rr <- RangeQuery -> Transaction (Future RangeResult)
getRange RangeQuery
r Transaction (Future RangeResult)
-> (Future RangeResult -> Transaction RangeResult)
-> Transaction RangeResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Future RangeResult -> Transaction RangeResult
forall a. Future a -> Transaction a
await
  case RangeResult
rr of
    RangeDone Seq (ByteString, ByteString)
Empty -> Bool -> Transaction Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    RangeResult
_ -> Bool -> Transaction Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

#if FDB_API_VERSION >= 710

-- | Structure for returning the result of 'getRange' in chunks.
data MappedRangeResult
  = MappedRangeDone (Seq FDB.MappedKeyValue)
  | MappedRangeMore (Seq FDB.MappedKeyValue) (Future MappedRangeResult)
  deriving (Int -> MappedRangeResult -> ShowS
[MappedRangeResult] -> ShowS
MappedRangeResult -> String
(Int -> MappedRangeResult -> ShowS)
-> (MappedRangeResult -> String)
-> ([MappedRangeResult] -> ShowS)
-> Show MappedRangeResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MappedRangeResult] -> ShowS
$cshowList :: [MappedRangeResult] -> ShowS
show :: MappedRangeResult -> String
$cshow :: MappedRangeResult -> String
showsPrec :: Int -> MappedRangeResult -> ShowS
$cshowsPrec :: Int -> MappedRangeResult -> ShowS
Show)

newtype Mapper = Mapper ByteString
  deriving (Int -> Mapper -> ShowS
[Mapper] -> ShowS
Mapper -> String
(Int -> Mapper -> ShowS)
-> (Mapper -> String) -> ([Mapper] -> ShowS) -> Show Mapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mapper] -> ShowS
$cshowList :: [Mapper] -> ShowS
show :: Mapper -> String
$cshow :: Mapper -> String
showsPrec :: Int -> Mapper -> ShowS
$cshowsPrec :: Int -> Mapper -> ShowS
Show, Mapper -> Mapper -> Bool
(Mapper -> Mapper -> Bool)
-> (Mapper -> Mapper -> Bool) -> Eq Mapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mapper -> Mapper -> Bool
$c/= :: Mapper -> Mapper -> Bool
== :: Mapper -> Mapper -> Bool
$c== :: Mapper -> Mapper -> Bool
Eq, Eq Mapper
Eq Mapper
-> (Mapper -> Mapper -> Ordering)
-> (Mapper -> Mapper -> Bool)
-> (Mapper -> Mapper -> Bool)
-> (Mapper -> Mapper -> Bool)
-> (Mapper -> Mapper -> Bool)
-> (Mapper -> Mapper -> Mapper)
-> (Mapper -> Mapper -> Mapper)
-> Ord Mapper
Mapper -> Mapper -> Bool
Mapper -> Mapper -> Ordering
Mapper -> Mapper -> Mapper
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mapper -> Mapper -> Mapper
$cmin :: Mapper -> Mapper -> Mapper
max :: Mapper -> Mapper -> Mapper
$cmax :: Mapper -> Mapper -> Mapper
>= :: Mapper -> Mapper -> Bool
$c>= :: Mapper -> Mapper -> Bool
> :: Mapper -> Mapper -> Bool
$c> :: Mapper -> Mapper -> Bool
<= :: Mapper -> Mapper -> Bool
$c<= :: Mapper -> Mapper -> Bool
< :: Mapper -> Mapper -> Bool
$c< :: Mapper -> Mapper -> Bool
compare :: Mapper -> Mapper -> Ordering
$ccompare :: Mapper -> Mapper -> Ordering
$cp1Ord :: Eq Mapper
Ord)

-- | Given a range of keys in a secondary index, fetc the corresponding
-- key/values they refer to by using a mapper.
-- See <https://github.com/apple/foundationdb/wiki/Everything-about-GetMappedRange the docs>
-- for more information.
--
-- Important: you must have read-your-writes enabled, but you must not read
-- anything you have written in the same transaction. Snapshot isolation is not
-- supported. See the docs linked above.
--
-- These functions are only available for FDB >= 7.1
getMappedRange' :: RangeQuery -> Mapper -> FDB.FDBStreamingMode -> Transaction (Future MappedRangeResult)
getMappedRange' :: RangeQuery
-> Mapper
-> FDBStreamingMode
-> Transaction (Future MappedRangeResult)
getMappedRange' RangeQuery {Bool
Maybe Int
KeySelector
rangeReverse :: Bool
rangeLimit :: Maybe Int
rangeEnd :: KeySelector
rangeBegin :: KeySelector
rangeReverse :: RangeQuery -> Bool
rangeLimit :: RangeQuery -> Maybe Int
rangeEnd :: RangeQuery -> KeySelector
rangeBegin :: RangeQuery -> KeySelector
..} (Mapper ByteString
mapper) FDBStreamingMode
mode = do
  Bool
isSnapshot <- (TransactionEnv -> Bool) -> Transaction Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TransactionConfig -> Bool
snapshotReads (TransactionConfig -> Bool)
-> (TransactionEnv -> TransactionConfig) -> TransactionEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionEnv -> TransactionConfig
envConf)
  (Transaction -> Transaction (Future MappedRangeResult))
-> Transaction (Future MappedRangeResult)
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future MappedRangeResult))
 -> Transaction (Future MappedRangeResult))
-> (Transaction -> Transaction (Future MappedRangeResult))
-> Transaction (Future MappedRangeResult)
forall a b. (a -> b) -> a -> b
$ \Transaction
t -> do
    let getR :: KeySelector
-> KeySelector -> Int -> Int -> IO (Future [MappedKeyValue])
getR KeySelector
b KeySelector
e Int
lim Int
i = Transaction
-> KeySelector
-> KeySelector
-> ByteString
-> Int
-> Int
-> FDBStreamingMode
-> Int
-> Bool
-> Bool
-> IO (Future [MappedKeyValue])
FDB.transactionGetMappedRange Transaction
t KeySelector
b KeySelector
e ByteString
mapper Int
lim Int
0 FDBStreamingMode
mode Int
i Bool
isSnapshot Bool
rangeReverse
    let mk :: IO (Future [MappedKeyValue])
mk = KeySelector
-> KeySelector -> Int -> Int -> IO (Future [MappedKeyValue])
getR KeySelector
rangeBegin KeySelector
rangeEnd (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
rangeLimit) Int
1
    let handler :: KeySelector
-> KeySelector
-> Int
-> Maybe Int
-> Future [MappedKeyValue]
-> Transaction MappedRangeResult
handler KeySelector
bsel KeySelector
esel Int
i Maybe Int
lim Future [MappedKeyValue]
fut = do
          -- more doesn't take into account our count limit, so we check below
          ([MappedKeyValue]
kvs, Bool
more) <- IO (Either CFDBError ([MappedKeyValue], Bool))
-> Transaction (Either CFDBError ([MappedKeyValue], Bool))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Future [MappedKeyValue]
-> IO (Either CFDBError ([MappedKeyValue], Bool))
FDB.getMappedRangeResult Future [MappedKeyValue]
fut) Transaction (Either CFDBError ([MappedKeyValue], Bool))
-> (Either CFDBError ([MappedKeyValue], Bool)
    -> Transaction ([MappedKeyValue], Bool))
-> Transaction ([MappedKeyValue], Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either CFDBError ([MappedKeyValue], Bool)
-> Transaction ([MappedKeyValue], Bool)
forall (m :: * -> *) a.
MonadError Error m =>
Either CFDBError a -> m a
liftFDBError
          let kvs' :: Seq MappedKeyValue
kvs' = [MappedKeyValue] -> Seq MappedKeyValue
forall a. [a] -> Seq a
Seq.fromList [MappedKeyValue]
kvs
          case Seq MappedKeyValue
kvs' of
            (Seq MappedKeyValue
_ :|> MappedKeyValue
mkv) | Bool
more Bool -> Bool -> Bool
&& Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Seq MappedKeyValue -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq MappedKeyValue
kvs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) Maybe Int
lim -> do
              let parentK :: ByteString
parentK = MappedKeyValue -> ByteString
FDB.parentKey MappedKeyValue
mkv
              let bsel' :: KeySelector
bsel' = if Bool -> Bool
not Bool
rangeReverse then ByteString -> KeySelector
FDB.FirstGreaterThan ByteString
parentK else KeySelector
bsel
              let esel' :: KeySelector
esel' = if Bool
rangeReverse then ByteString -> KeySelector
FDB.FirstGreaterOrEq ByteString
parentK else KeySelector
esel
              let lim' :: Maybe Int
lim' = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Seq MappedKeyValue -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq MappedKeyValue
kvs') Maybe Int
lim
              let mk' :: IO (Future [MappedKeyValue])
mk' = KeySelector
-> KeySelector -> Int -> Int -> IO (Future [MappedKeyValue])
getR KeySelector
bsel' KeySelector
esel' (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
lim') (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Future MappedRangeResult
res <- IO (Future [MappedKeyValue])
-> (Future [MappedKeyValue] -> Transaction MappedRangeResult)
-> Transaction (Future MappedRangeResult)
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture IO (Future [MappedKeyValue])
mk' (KeySelector
-> KeySelector
-> Int
-> Maybe Int
-> Future [MappedKeyValue]
-> Transaction MappedRangeResult
handler KeySelector
bsel' KeySelector
esel' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
lim')
              MappedRangeResult -> Transaction MappedRangeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (MappedRangeResult -> Transaction MappedRangeResult)
-> MappedRangeResult -> Transaction MappedRangeResult
forall a b. (a -> b) -> a -> b
$ Seq MappedKeyValue -> Future MappedRangeResult -> MappedRangeResult
MappedRangeMore Seq MappedKeyValue
kvs' Future MappedRangeResult
res
            Seq MappedKeyValue
_ -> MappedRangeResult -> Transaction MappedRangeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (MappedRangeResult -> Transaction MappedRangeResult)
-> MappedRangeResult -> Transaction MappedRangeResult
forall a b. (a -> b) -> a -> b
$
              Seq MappedKeyValue -> MappedRangeResult
MappedRangeDone (Seq MappedKeyValue -> MappedRangeResult)
-> Seq MappedKeyValue -> MappedRangeResult
forall a b. (a -> b) -> a -> b
$ case Maybe Int
lim of
                Maybe Int
Nothing -> Seq MappedKeyValue
kvs'
                Just Int
n -> Int -> Seq MappedKeyValue -> Seq MappedKeyValue
forall a. Int -> Seq a -> Seq a
Seq.take Int
n Seq MappedKeyValue
kvs'
    IO (Future [MappedKeyValue])
-> (Future [MappedKeyValue] -> Transaction MappedRangeResult)
-> Transaction (Future MappedRangeResult)
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture IO (Future [MappedKeyValue])
mk (KeySelector
-> KeySelector
-> Int
-> Maybe Int
-> Future [MappedKeyValue]
-> Transaction MappedRangeResult
handler KeySelector
rangeBegin KeySelector
rangeEnd Int
1 Maybe Int
rangeLimit)

getMappedRange :: RangeQuery -> Mapper -> Transaction (Future MappedRangeResult)
getMappedRange :: RangeQuery -> Mapper -> Transaction (Future MappedRangeResult)
getMappedRange RangeQuery
r Mapper
mapper = RangeQuery
-> Mapper
-> FDBStreamingMode
-> Transaction (Future MappedRangeResult)
getMappedRange' RangeQuery
r Mapper
mapper FDBStreamingMode
FDB.StreamingModeIterator

getEntireMappedRange' ::
  FDB.FDBStreamingMode ->
  RangeQuery ->
  Mapper ->
  Transaction (Seq FDB.MappedKeyValue)
getEntireMappedRange' :: FDBStreamingMode
-> RangeQuery -> Mapper -> Transaction (Seq MappedKeyValue)
getEntireMappedRange' FDBStreamingMode
mode RangeQuery
r Mapper
mapper = do
  MappedRangeResult
rr <- RangeQuery
-> Mapper
-> FDBStreamingMode
-> Transaction (Future MappedRangeResult)
getMappedRange' RangeQuery
r Mapper
mapper FDBStreamingMode
mode Transaction (Future MappedRangeResult)
-> (Future MappedRangeResult -> Transaction MappedRangeResult)
-> Transaction MappedRangeResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Future MappedRangeResult -> Transaction MappedRangeResult
forall a. Future a -> Transaction a
await
  MappedRangeResult -> Transaction (Seq MappedKeyValue)
go MappedRangeResult
rr
  where
    go :: MappedRangeResult -> Transaction (Seq MappedKeyValue)
go (MappedRangeDone Seq MappedKeyValue
xs) = Seq MappedKeyValue -> Transaction (Seq MappedKeyValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq MappedKeyValue
xs
    go (MappedRangeMore Seq MappedKeyValue
xs Future MappedRangeResult
fut) = do
      MappedRangeResult
more <- Future MappedRangeResult -> Transaction MappedRangeResult
forall a. Future a -> Transaction a
await Future MappedRangeResult
fut
      Seq MappedKeyValue
ys <- MappedRangeResult -> Transaction (Seq MappedKeyValue)
go MappedRangeResult
more
      Seq MappedKeyValue -> Transaction (Seq MappedKeyValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq MappedKeyValue
xs Seq MappedKeyValue -> Seq MappedKeyValue -> Seq MappedKeyValue
forall a. Semigroup a => a -> a -> a
<> Seq MappedKeyValue
ys)

-- | Wrapper around 'getRange' that reads the entire range into memory.
getEntireMappedRange :: RangeQuery -> Mapper -> Transaction (Seq FDB.MappedKeyValue)
getEntireMappedRange :: RangeQuery -> Mapper -> Transaction (Seq MappedKeyValue)
getEntireMappedRange = FDBStreamingMode
-> RangeQuery -> Mapper -> Transaction (Seq MappedKeyValue)
getEntireMappedRange' FDBStreamingMode
FDB.StreamingModeWantAll

#endif

-- | Perform an atomic operation of 'MutationType' on the given key. A
-- transaction that performs only atomic operations is guaranteed not to
-- conflict. However, it may cause other concurrent transactions to conflict.
atomicOp :: ByteString -> MutationType -> Transaction ()
atomicOp :: ByteString -> MutationType -> Transaction ()
atomicOp ByteString
k MutationType
op =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> ByteString -> MutationType -> IO ()
FDB.transactionAtomicOp Transaction
t ByteString
k MutationType
op

-- | Attempts to commit a transaction against the given database. If an
-- unretryable error occurs, throws an 'Error'. Attempts to retry the
-- transaction for retryable errors.
runTransaction :: DB.Database -> Transaction a -> IO a
runTransaction :: Database -> Transaction a -> IO a
runTransaction = TransactionConfig -> Database -> Transaction a -> IO a
forall a. TransactionConfig -> Database -> Transaction a -> IO a
runTransactionWithConfig TransactionConfig
defaultConfig

-- | Like 'runTransaction', but returns a sum instead of throwing an exception
-- on errors.
runTransaction' :: DB.Database -> Transaction a -> IO (Either Error a)
runTransaction' :: Database -> Transaction a -> IO (Either Error a)
runTransaction' = TransactionConfig
-> Database -> Transaction a -> IO (Either Error a)
forall a.
TransactionConfig
-> Database -> Transaction a -> IO (Either Error a)
runTransactionWithConfig' TransactionConfig
defaultConfig

-- | A config for a non-idempotent transaction, allowing 5 retries, with a time
-- limit of 500 milliseconds.
defaultConfig :: TransactionConfig
defaultConfig :: TransactionConfig
defaultConfig = Bool -> Bool -> Bool -> Int -> Int -> TransactionConfig
TransactionConfig Bool
False Bool
False Bool
False Int
5 Int
500

-- | Contains useful options that are not directly exposed by the C API (for
--   options that are, see 'setOption').
data TransactionConfig = TransactionConfig
  { -- | When set to 'True' (default is 'False'), running the transaction will
    -- retry even on errors where the transaction may have completed successfully.
    -- When 'False', the transaction will retry only when it is guaranteed that
    -- the transaction was not committed.
    TransactionConfig -> Bool
idempotent :: Bool,
    -- | When set to 'True' (default is 'False'), reads will see the effects of
    -- concurrent transactions, removing the default serializable isolation
    -- guarantee. To enable this feature selectively within a transaction,
    -- see 'withSnapshot'.
    TransactionConfig -> Bool
snapshotReads :: Bool,
    -- | When set to 'True' (default is 'False'), if a transaction fails due to
    -- a conflict, the returned 'NotCommittedException' will include a list of
    -- key ranges that caused the transaction to conflict. This has a
    -- performance impact on both the client and the cluster. Only
    -- supported on clients and clusters running v 6.3 and later. On earlier
    -- versions, the list will always be empty.
    TransactionConfig -> Bool
getConflictingKeys :: Bool,
    -- | Max number of times to retry retryable errors. After this many retries,
    -- 'MaxRetriesExceeded' will be thrown to the caller of 'runTransaction'.
    TransactionConfig -> Int
maxRetries :: Int,
    -- | Max number of milliseconds the transaction is allowed to run. If this
    -- number is exceeded, the transaction fails with an error.
    TransactionConfig -> Int
timeout :: Int
  }
  deriving (Int -> TransactionConfig -> ShowS
[TransactionConfig] -> ShowS
TransactionConfig -> String
(Int -> TransactionConfig -> ShowS)
-> (TransactionConfig -> String)
-> ([TransactionConfig] -> ShowS)
-> Show TransactionConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionConfig] -> ShowS
$cshowList :: [TransactionConfig] -> ShowS
show :: TransactionConfig -> String
$cshow :: TransactionConfig -> String
showsPrec :: Int -> TransactionConfig -> ShowS
$cshowsPrec :: Int -> TransactionConfig -> ShowS
Show, ReadPrec [TransactionConfig]
ReadPrec TransactionConfig
Int -> ReadS TransactionConfig
ReadS [TransactionConfig]
(Int -> ReadS TransactionConfig)
-> ReadS [TransactionConfig]
-> ReadPrec TransactionConfig
-> ReadPrec [TransactionConfig]
-> Read TransactionConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransactionConfig]
$creadListPrec :: ReadPrec [TransactionConfig]
readPrec :: ReadPrec TransactionConfig
$creadPrec :: ReadPrec TransactionConfig
readList :: ReadS [TransactionConfig]
$creadList :: ReadS [TransactionConfig]
readsPrec :: Int -> ReadS TransactionConfig
$creadsPrec :: Int -> ReadS TransactionConfig
Read, TransactionConfig -> TransactionConfig -> Bool
(TransactionConfig -> TransactionConfig -> Bool)
-> (TransactionConfig -> TransactionConfig -> Bool)
-> Eq TransactionConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionConfig -> TransactionConfig -> Bool
$c/= :: TransactionConfig -> TransactionConfig -> Bool
== :: TransactionConfig -> TransactionConfig -> Bool
$c== :: TransactionConfig -> TransactionConfig -> Bool
Eq, Eq TransactionConfig
Eq TransactionConfig
-> (TransactionConfig -> TransactionConfig -> Ordering)
-> (TransactionConfig -> TransactionConfig -> Bool)
-> (TransactionConfig -> TransactionConfig -> Bool)
-> (TransactionConfig -> TransactionConfig -> Bool)
-> (TransactionConfig -> TransactionConfig -> Bool)
-> (TransactionConfig -> TransactionConfig -> TransactionConfig)
-> (TransactionConfig -> TransactionConfig -> TransactionConfig)
-> Ord TransactionConfig
TransactionConfig -> TransactionConfig -> Bool
TransactionConfig -> TransactionConfig -> Ordering
TransactionConfig -> TransactionConfig -> TransactionConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TransactionConfig -> TransactionConfig -> TransactionConfig
$cmin :: TransactionConfig -> TransactionConfig -> TransactionConfig
max :: TransactionConfig -> TransactionConfig -> TransactionConfig
$cmax :: TransactionConfig -> TransactionConfig -> TransactionConfig
>= :: TransactionConfig -> TransactionConfig -> Bool
$c>= :: TransactionConfig -> TransactionConfig -> Bool
> :: TransactionConfig -> TransactionConfig -> Bool
$c> :: TransactionConfig -> TransactionConfig -> Bool
<= :: TransactionConfig -> TransactionConfig -> Bool
$c<= :: TransactionConfig -> TransactionConfig -> Bool
< :: TransactionConfig -> TransactionConfig -> Bool
$c< :: TransactionConfig -> TransactionConfig -> Bool
compare :: TransactionConfig -> TransactionConfig -> Ordering
$ccompare :: TransactionConfig -> TransactionConfig -> Ordering
$cp1Ord :: Eq TransactionConfig
Ord)

-- | Attempt to commit a transaction against the given database. If an
-- unretryable error occurs, throws an 'Error'. Attempts to retry the
-- transaction for retryable errors according to the 'maxRetries' setting
-- in the provided 'TransactionConfig'.
runTransactionWithConfig ::
  TransactionConfig -> DB.Database -> Transaction a -> IO a
runTransactionWithConfig :: TransactionConfig -> Database -> Transaction a -> IO a
runTransactionWithConfig TransactionConfig
conf Database
db Transaction a
t = do
  Either Error a
res <- TransactionConfig
-> Database -> Transaction a -> IO (Either Error a)
forall a.
TransactionConfig
-> Database -> Transaction a -> IO (Either Error a)
runTransactionWithConfig' TransactionConfig
conf Database
db Transaction a
t
  case Either Error a
res of
    Left Error
err -> Error -> IO a
forall e a. Exception e => e -> IO a
throwIO Error
err
    Right a
x -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

setConflictingKeysOption :: Transaction ()
setConflictingKeysOption :: Transaction ()
setConflictingKeysOption
  | Int
FDB.currentAPIVersion Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
630 =
    TransactionOption -> Transaction ()
setOption (TransactionOption
TransactionOpt.reportConflictingKeys)
  | Bool
otherwise = () -> Transaction ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

conflictingKeysPrefix :: ByteString
conflictingKeysPrefix :: ByteString
conflictingKeysPrefix = ByteString
"\xff\xff/transaction/conflicting_keys/"

-- | Parse a sequence of key/value pairs in the format of the transaction
-- module of the special keys space. See
-- <https://apple.github.io/foundationdb/developer-guide.html#special-keys the official docs>
-- for details. The docs say that an even number of k/vs will always be
-- returned. If that is not the case, this function returns 'Nothing'.
parseConflictRanges :: [(ByteString, ByteString)] -> Maybe [ConflictRange]
parseConflictRanges :: [(ByteString, ByteString)] -> Maybe [ConflictRange]
parseConflictRanges [(ByteString, ByteString)]
rawKVs = case ([(ByteString, ByteString)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ByteString, ByteString)]
rawKVs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2, [(ByteString, ByteString)]
rawKVs) of
  (Int
_, []) -> [ConflictRange] -> Maybe [ConflictRange]
forall a. a -> Maybe a
Just []
  (Int
0, [(ByteString, ByteString)]
_) -> [ConflictRange] -> Maybe [ConflictRange]
forall a. a -> Maybe a
Just ([(ByteString, ByteString)] -> [ConflictRange]
go [(ByteString, ByteString)]
rawKVs)
  (Int
_, [(ByteString, ByteString)]
_) -> Maybe [ConflictRange]
forall a. Maybe a
Nothing
  where
    go :: [(ByteString, ByteString)] -> [ConflictRange]
    go :: [(ByteString, ByteString)] -> [ConflictRange]
go [] = []
    go ((ByteString
k1, ByteString
_) : (ByteString
k2, ByteString
_) : [(ByteString, ByteString)]
xs) =
      ByteString -> ByteString -> ConflictRange
ConflictRange (Int -> ByteString -> ByteString
BS.drop Int
prefixLen ByteString
k1) (Int -> ByteString -> ByteString
BS.drop Int
prefixLen ByteString
k2) ConflictRange -> [ConflictRange] -> [ConflictRange]
forall a. a -> [a] -> [a]
: [(ByteString, ByteString)] -> [ConflictRange]
go [(ByteString, ByteString)]
xs
    go [(ByteString, ByteString)]
_ = [] -- impossible
    prefixLen :: Int
prefixLen = ByteString -> Int
BS.length ByteString
conflictingKeysPrefix

fetchConflictingKeys :: DB.Database -> Transaction [ConflictRange]
fetchConflictingKeys :: Database -> Transaction [ConflictRange]
fetchConflictingKeys Database
db
  | Int
FDB.currentAPIVersion Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
630
      Bool -> Bool -> Bool
&& Database -> Int
DB.apiVersionInUse Database
db Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
630 = do
    let r :: RangeQuery
r = Maybe RangeQuery -> RangeQuery
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe RangeQuery -> RangeQuery) -> Maybe RangeQuery -> RangeQuery
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe RangeQuery
prefixRange ByteString
conflictingKeysPrefix
    [(ByteString, ByteString)]
rawKVs <- Seq (ByteString, ByteString) -> [(ByteString, ByteString)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (ByteString, ByteString) -> [(ByteString, ByteString)])
-> Transaction (Seq (ByteString, ByteString))
-> Transaction [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RangeQuery -> Transaction (Seq (ByteString, ByteString))
getEntireRange RangeQuery
r
    case [(ByteString, ByteString)] -> Maybe [ConflictRange]
parseConflictRanges [(ByteString, ByteString)]
rawKVs of
      Just [ConflictRange]
ranges -> [ConflictRange] -> Transaction [ConflictRange]
forall (m :: * -> *) a. Monad m => a -> m a
return [ConflictRange]
ranges
      Maybe [ConflictRange]
Nothing -> Error -> Transaction [ConflictRange]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FDBHsError -> Error
Error ([(ByteString, ByteString)] -> FDBHsError
ConflictRangeParseFailure [(ByteString, ByteString)]
rawKVs))
  | Bool
otherwise = [ConflictRange] -> Transaction [ConflictRange]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Handles the retry logic described in the FDB docs.
-- https://apple.github.io/foundationdb/api-c.html#c.fdb_transaction_on_error
withRetry :: DB.Database -> Transaction a -> Transaction a
withRetry :: Database -> Transaction a -> Transaction a
withRetry Database
db Transaction a
t = Transaction a -> (Error -> Transaction a) -> Transaction a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError Transaction a
t ((Error -> Transaction a) -> Transaction a)
-> (Error -> Transaction a) -> Transaction a
forall a b. (a -> b) -> a -> b
$ \Error
err -> do
  Bool
idem <- (TransactionEnv -> Bool) -> Transaction Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TransactionConfig -> Bool
idempotent (TransactionConfig -> Bool)
-> (TransactionEnv -> TransactionConfig) -> TransactionEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionEnv -> TransactionConfig
envConf)
  Bool
getConflicts <- (TransactionEnv -> Bool) -> Transaction Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TransactionConfig -> Bool
getConflictingKeys (TransactionConfig -> Bool)
-> (TransactionEnv -> TransactionConfig) -> TransactionEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionEnv -> TransactionConfig
envConf)
  Int
retriesRemaining <- (TransactionEnv -> Int) -> Transaction Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TransactionConfig -> Int
maxRetries (TransactionConfig -> Int)
-> (TransactionEnv -> TransactionConfig) -> TransactionEnv -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionEnv -> TransactionConfig
envConf)
  let shouldRetry :: Error -> Bool
shouldRetry = if Bool
idem then Error -> Bool
retryable else Error -> Bool
retryableNotCommitted
  if Error -> Bool
shouldRetry Error
err Bool -> Bool -> Bool
&& Int
retriesRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then do
      Error -> Transaction ()
onError Error
err
      -- onError re-throws unretryable errors, so if we reach here, we can retry
      (TransactionEnv -> TransactionEnv)
-> Transaction a -> Transaction a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
        (\TransactionEnv
e -> TransactionEnv
e {envConf :: TransactionConfig
envConf = (TransactionEnv -> TransactionConfig
envConf TransactionEnv
e) {maxRetries :: Int
maxRetries = Int
retriesRemaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1}})
        (Database -> Transaction a -> Transaction a
forall a. Database -> Transaction a -> Transaction a
withRetry Database
db Transaction a
t)
    else do
      Error
err' <- Bool -> Error -> Transaction Error
addConflictRanges Bool
getConflicts Error
err
      if Int
retriesRemaining Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Error -> Transaction a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> Transaction a) -> Error -> Transaction a
forall a b. (a -> b) -> a -> b
$ FDBHsError -> Error
Error (FDBHsError -> Error) -> FDBHsError -> Error
forall a b. (a -> b) -> a -> b
$ Error -> FDBHsError
MaxRetriesExceeded Error
err'
        else Error -> Transaction a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Error
err'
  where
    addConflictRanges :: Bool -> Error -> Transaction Error
    addConflictRanges :: Bool -> Error -> Transaction Error
addConflictRanges Bool
True (CError (NotCommitted [ConflictRange]
_)) = do
      [ConflictRange]
conflicts <- Database -> Transaction [ConflictRange]
fetchConflictingKeys Database
db
      Error -> Transaction Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> Transaction Error) -> Error -> Transaction Error
forall a b. (a -> b) -> a -> b
$ CError -> Error
CError (CError -> Error) -> CError -> Error
forall a b. (a -> b) -> a -> b
$ [ConflictRange] -> CError
NotCommitted [ConflictRange]
conflicts
    addConflictRanges Bool
_ Error
err = Error -> Transaction Error
forall (m :: * -> *) a. Monad m => a -> m a
return Error
err

-- | Attempt to commit a transaction against the given database. If an unretryable
-- error occurs, returns 'Left'. Attempts to retry the transaction for retryable
-- errors.
runTransactionWithConfig' ::
  TransactionConfig -> DB.Database -> Transaction a -> IO (Either Error a)
runTransactionWithConfig' :: TransactionConfig
-> Database -> Transaction a -> IO (Either Error a)
runTransactionWithConfig' TransactionConfig
conf Database
db Transaction a
t = ExceptT Error IO a -> IO (Either Error a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO a -> IO (Either Error a))
-> ExceptT Error IO a -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ do
  TransactionEnv
trans <- Database -> TransactionConfig -> ExceptT Error IO TransactionEnv
createTransactionEnv Database
db TransactionConfig
conf
  (ReaderT TransactionEnv (ExceptT Error IO) a
 -> TransactionEnv -> ExceptT Error IO a)
-> TransactionEnv
-> ReaderT TransactionEnv (ExceptT Error IO) a
-> ExceptT Error IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT TransactionEnv (ExceptT Error IO) a
-> TransactionEnv -> ExceptT Error IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT TransactionEnv
trans (ReaderT TransactionEnv (ExceptT Error IO) a -> ExceptT Error IO a)
-> ReaderT TransactionEnv (ExceptT Error IO) a
-> ExceptT Error IO a
forall a b. (a -> b) -> a -> b
$
    Transaction a -> ReaderT TransactionEnv (ExceptT Error IO) a
forall a.
Transaction a -> ReaderT TransactionEnv (ExceptT Error IO) a
unTransaction (Transaction a -> ReaderT TransactionEnv (ExceptT Error IO) a)
-> Transaction a -> ReaderT TransactionEnv (ExceptT Error IO) a
forall a b. (a -> b) -> a -> b
$
      Database -> Transaction a -> Transaction a
forall a. Database -> Transaction a -> Transaction a
withRetry Database
db (Transaction a -> Transaction a) -> Transaction a -> Transaction a
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TransactionConfig -> Bool
getConflictingKeys TransactionConfig
conf) Transaction ()
setConflictingKeysOption
        TransactionOption -> Transaction ()
setOption (Int -> TransactionOption
TransactionOpt.timeout (TransactionConfig -> Int
timeout TransactionConfig
conf))
        a
res <- Transaction a
t
        Future ()
commit <- Transaction (Future ())
commitFuture
        Future () -> Transaction ()
forall a. Future a -> Transaction a
await Future ()
commit
        a -> Transaction a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

-- | Cancel a transaction. The transaction will not be committed, and
-- will throw 'TransactionCanceled'.
cancel :: Transaction ()
cancel :: Transaction ()
cancel =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t -> do
    IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> IO ()
FDB.transactionCancel Transaction
t
    Error -> Transaction ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CError -> Error
CError CError
TransactionCanceled)

-- | Reset the transaction. All operations prior to this will be discarded.
reset :: Transaction ()
reset :: Transaction ()
reset =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> IO ()
FDB.transactionReset Transaction
t

-- | Runs a transaction using snapshot reads, which means that the transaction
-- will see the results of concurrent transactions, removing the default
-- serializable isolation guarantee.
withSnapshot :: Transaction a -> Transaction a
withSnapshot :: Transaction a -> Transaction a
withSnapshot = (TransactionEnv -> TransactionEnv)
-> Transaction a -> Transaction a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((TransactionEnv -> TransactionEnv)
 -> Transaction a -> Transaction a)
-> (TransactionEnv -> TransactionEnv)
-> Transaction a
-> Transaction a
forall a b. (a -> b) -> a -> b
$ \TransactionEnv
s ->
  ForeignPtr Transaction -> TransactionConfig -> TransactionEnv
TransactionEnv (TransactionEnv -> ForeignPtr Transaction
cTransaction TransactionEnv
s) ((TransactionEnv -> TransactionConfig
envConf TransactionEnv
s) {snapshotReads :: Bool
snapshotReads = Bool
True})

-- | Sets the read version on the current transaction. As the FoundationDB docs
-- state, "this is not needed in simple cases".
setReadVersion :: Word64 -> Transaction ()
setReadVersion :: Word64 -> Transaction ()
setReadVersion Word64
v =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO () -> Transaction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Int64 -> IO ()
FDB.transactionSetReadVersion Transaction
t (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v)

-- | Gets the read version of the current transaction, representing all
-- transactions that were reported committed before this one.
getReadVersion :: Transaction (Future Word64)
getReadVersion :: Transaction (Future Word64)
getReadVersion =
  (Transaction -> Transaction (Future Word64))
-> Transaction (Future Word64)
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future Word64))
 -> Transaction (Future Word64))
-> (Transaction -> Transaction (Future Word64))
-> Transaction (Future Word64)
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO (Future Int64)
-> (Future Int64 -> Transaction Word64)
-> Transaction (Future Word64)
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture
      (Transaction -> IO (Future Int64)
FDB.transactionGetReadVersion Transaction
t)
      (\Future Int64
f -> Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Transaction Int64 -> Transaction Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (CFDBError, Int64) -> Transaction Int64
forall (m :: * -> *) a.
(MonadError Error m, MonadIO m) =>
IO (CFDBError, a) -> m a
fdbExcept (Future Int64 -> IO (CFDBError, Int64)
FDB.futureGetInt64 Future Int64
f))

-- | Returns a 'FutureIO' that will resolve to the versionstamp of the committed
-- transaction. Most applications won't need this.
getVersionstamp ::
  Transaction (FutureIO (Either Error TransactionVersionstamp))
getVersionstamp :: Transaction (FutureIO (Either Error TransactionVersionstamp))
getVersionstamp = (Transaction
 -> Transaction (FutureIO (Either Error TransactionVersionstamp)))
-> Transaction (FutureIO (Either Error TransactionVersionstamp))
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction
  -> Transaction (FutureIO (Either Error TransactionVersionstamp)))
 -> Transaction (FutureIO (Either Error TransactionVersionstamp)))
-> (Transaction
    -> Transaction (FutureIO (Either Error TransactionVersionstamp)))
-> Transaction (FutureIO (Either Error TransactionVersionstamp))
forall a b. (a -> b) -> a -> b
$ \Transaction
t -> do
  Future ByteString
f <- IO (Future ByteString) -> Transaction (Future ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Future ByteString) -> Transaction (Future ByteString))
-> IO (Future ByteString) -> Transaction (Future ByteString)
forall a b. (a -> b) -> a -> b
$ Transaction -> IO (Future ByteString)
FDB.transactionGetVersionstamp Transaction
t
  IO (FutureIO (Either Error TransactionVersionstamp))
-> Transaction (FutureIO (Either Error TransactionVersionstamp))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FutureIO (Either Error TransactionVersionstamp))
 -> Transaction (FutureIO (Either Error TransactionVersionstamp)))
-> IO (FutureIO (Either Error TransactionVersionstamp))
-> Transaction (FutureIO (Either Error TransactionVersionstamp))
forall a b. (a -> b) -> a -> b
$
    Future ByteString
-> IO (Either Error TransactionVersionstamp)
-> IO (FutureIO (Either Error TransactionVersionstamp))
forall b a. Future b -> IO a -> IO (FutureIO a)
allocFutureIO Future ByteString
f (IO (Either Error TransactionVersionstamp)
 -> IO (FutureIO (Either Error TransactionVersionstamp)))
-> IO (Either Error TransactionVersionstamp)
-> IO (FutureIO (Either Error TransactionVersionstamp))
forall a b. (a -> b) -> a -> b
$
      Future ByteString -> IO (Either CFDBError ByteString)
FDB.futureGetKey Future ByteString
f IO (Either CFDBError ByteString)
-> (Either CFDBError ByteString
    -> IO (Either Error TransactionVersionstamp))
-> IO (Either Error TransactionVersionstamp)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left CFDBError
err -> Either Error TransactionVersionstamp
-> IO (Either Error TransactionVersionstamp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error TransactionVersionstamp
 -> IO (Either Error TransactionVersionstamp))
-> Either Error TransactionVersionstamp
-> IO (Either Error TransactionVersionstamp)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error TransactionVersionstamp
forall a b. a -> Either a b
Left (CError -> Error
CError (CError -> Error) -> CError -> Error
forall a b. (a -> b) -> a -> b
$ Maybe CError -> CError
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe CError -> CError) -> Maybe CError -> CError
forall a b. (a -> b) -> a -> b
$ CFDBError -> Maybe CError
toError CFDBError
err)
        Right ByteString
bs -> case ByteString -> Maybe TransactionVersionstamp
decodeTransactionVersionstamp ByteString
bs of
          Maybe TransactionVersionstamp
Nothing ->
            Either Error TransactionVersionstamp
-> IO (Either Error TransactionVersionstamp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error TransactionVersionstamp
 -> IO (Either Error TransactionVersionstamp))
-> Either Error TransactionVersionstamp
-> IO (Either Error TransactionVersionstamp)
forall a b. (a -> b) -> a -> b
$
              Error -> Either Error TransactionVersionstamp
forall a b. a -> Either a b
Left (Error -> Either Error TransactionVersionstamp)
-> Error -> Either Error TransactionVersionstamp
forall a b. (a -> b) -> a -> b
$
                FDBHsError -> Error
Error (FDBHsError -> Error) -> FDBHsError -> Error
forall a b. (a -> b) -> a -> b
$
                  String -> FDBHsError
ParseError (String -> FDBHsError) -> String -> FDBHsError
forall a b. (a -> b) -> a -> b
$
                    String
"Failed to parse versionstamp: "
                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
BS.unpack ByteString
bs)
          Just TransactionVersionstamp
vs -> Either Error TransactionVersionstamp
-> IO (Either Error TransactionVersionstamp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error TransactionVersionstamp
 -> IO (Either Error TransactionVersionstamp))
-> Either Error TransactionVersionstamp
-> IO (Either Error TransactionVersionstamp)
forall a b. (a -> b) -> a -> b
$ TransactionVersionstamp -> Either Error TransactionVersionstamp
forall a b. b -> Either a b
Right TransactionVersionstamp
vs

#if FDB_API_VERSION >= 620
-- | Returns a future that will return the size, in bytes, of the transaction so
-- far, as a summation of the estimated size of mutations, read conflict ranges,
-- and write conflict ranges. This can be used to decide how to split a large
-- task into smaller transactions.
getApproximateSize :: Transaction (Future Word64)
getApproximateSize :: Transaction (Future Word64)
getApproximateSize = (Transaction -> Transaction (Future Word64))
-> Transaction (Future Word64)
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (Future Word64))
 -> Transaction (Future Word64))
-> (Transaction -> Transaction (Future Word64))
-> Transaction (Future Word64)
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
  IO (Future Int64)
-> (Future Int64 -> Transaction Word64)
-> Transaction (Future Word64)
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture (Transaction -> IO (Future Int64)
FDB.transactionGetApproximateSize Transaction
t)
              ((Int64 -> Word64) -> Transaction Int64 -> Transaction Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Transaction Int64 -> Transaction Word64)
-> (Future Int64 -> Transaction Int64)
-> Future Int64
-> Transaction Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (CFDBError, Int64) -> Transaction Int64
forall (m :: * -> *) a.
(MonadError Error m, MonadIO m) =>
IO (CFDBError, a) -> m a
fdbExcept (IO (CFDBError, Int64) -> Transaction Int64)
-> (Future Int64 -> IO (CFDBError, Int64))
-> Future Int64
-> Transaction Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Future Int64 -> IO (CFDBError, Int64)
FDB.futureGetInt64)
#endif

-- | Creates a future that will be fulfilled when the value
-- associated with the given key is changed, relative to the value
-- it had as of the current transaction's read version, or the last
-- value to which the key was previously set within the current
-- transaction. This future is safe to return from the transaction
-- and await in IO. If the transaction in which it was created
-- fails to commit, awaiting it will return the same error as
-- running the transaction did.
watch :: ByteString -> Transaction (FutureIO ())
watch :: ByteString -> Transaction (FutureIO ())
watch ByteString
k = (Transaction -> Transaction (FutureIO ()))
-> Transaction (FutureIO ())
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction (FutureIO ()))
 -> Transaction (FutureIO ()))
-> (Transaction -> Transaction (FutureIO ()))
-> Transaction (FutureIO ())
forall a b. (a -> b) -> a -> b
$ \Transaction
t -> do
  Future ()
f <- IO (Future ()) -> Transaction (Future ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Future ()) -> Transaction (Future ()))
-> IO (Future ()) -> Transaction (Future ())
forall a b. (a -> b) -> a -> b
$ Transaction -> ByteString -> IO (Future ())
FDB.transactionWatch Transaction
t ByteString
k
  IO (FutureIO ()) -> Transaction (FutureIO ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FutureIO ()) -> Transaction (FutureIO ()))
-> IO (FutureIO ()) -> Transaction (FutureIO ())
forall a b. (a -> b) -> a -> b
$ Future () -> IO () -> IO (FutureIO ())
forall b a. Future b -> IO a -> IO (FutureIO a)
allocFutureIO Future ()
f (IO () -> IO (FutureIO ())) -> IO () -> IO (FutureIO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Set one of the transaction options from the underlying C API.
setOption :: TransactionOpt.TransactionOption -> Transaction ()
setOption :: TransactionOption -> Transaction ()
setOption TransactionOption
opt =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
    IO CFDBError -> Transaction ()
forall (m :: * -> *).
(MonadError Error m, MonadIO m) =>
IO CFDBError -> m ()
fdbExcept' (IO CFDBError -> Transaction ()) -> IO CFDBError -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction -> TransactionOption -> IO CFDBError
FDB.transactionSetOption Transaction
t TransactionOption
opt

-- $advanced
--   The functionality in this section is for more advanced use cases where you
--   need to be able to refer to an in-progress transaction and add operations to
--   it incrementally. This is similar to how the Python bindings work -- you
--   pass around a transaction object and call methods on it one by one before
--   finally calling @.commit()@.
--
--   This functionality was needed to create the bindings tester, which is
--   required to follow the semantics of the bindings for imperative languages
--   more closely. You probably don't need this. In fact, it's not entirely clear
--   that the bindings tester needs it.

-- | The internal state of a transaction as it is being executed by
-- 'runTransaction'.
data TransactionEnv = TransactionEnv
  { TransactionEnv -> ForeignPtr Transaction
cTransaction :: ForeignPtr FDB.Transaction,
    TransactionEnv -> TransactionConfig
envConf :: TransactionConfig
  }
  deriving (Int -> TransactionEnv -> ShowS
[TransactionEnv] -> ShowS
TransactionEnv -> String
(Int -> TransactionEnv -> ShowS)
-> (TransactionEnv -> String)
-> ([TransactionEnv] -> ShowS)
-> Show TransactionEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionEnv] -> ShowS
$cshowList :: [TransactionEnv] -> ShowS
show :: TransactionEnv -> String
$cshow :: TransactionEnv -> String
showsPrec :: Int -> TransactionEnv -> ShowS
$cshowsPrec :: Int -> TransactionEnv -> ShowS
Show)

createTransactionEnv ::
  DB.Database ->
  TransactionConfig ->
  ExceptT Error IO TransactionEnv
createTransactionEnv :: Database -> TransactionConfig -> ExceptT Error IO TransactionEnv
createTransactionEnv DB.Database {DatabasePtr
databasePtr :: Database -> DatabasePtr
databasePtr :: DatabasePtr
databasePtr} TransactionConfig
config =
  IO (Either Error TransactionEnv) -> ExceptT Error IO TransactionEnv
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Error TransactionEnv)
 -> ExceptT Error IO TransactionEnv)
-> IO (Either Error TransactionEnv)
-> ExceptT Error IO TransactionEnv
forall a b. (a -> b) -> a -> b
$
    IO (CFDBError, Transaction) -> IO (Either Error Transaction)
forall (m :: * -> *) a.
MonadIO m =>
m (CFDBError, a) -> m (Either Error a)
fdbEither (DatabasePtr -> IO (CFDBError, Transaction)
FDB.databaseCreateTransaction DatabasePtr
databasePtr) IO (Either Error Transaction)
-> (Either Error Transaction -> IO (Either Error TransactionEnv))
-> IO (Either Error TransactionEnv)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Error
e -> Either Error TransactionEnv -> IO (Either Error TransactionEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error TransactionEnv -> IO (Either Error TransactionEnv))
-> Either Error TransactionEnv -> IO (Either Error TransactionEnv)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error TransactionEnv
forall a b. a -> Either a b
Left Error
e
      Right (FDB.Transaction Ptr Transaction
p) -> do
        ForeignPtr Transaction
fp <- FinalizerPtr Transaction
-> Ptr Transaction -> IO (ForeignPtr Transaction)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Transaction
forall a. FunPtr (Ptr a -> IO ())
FDB.transactionDestroyPtr Ptr Transaction
p
        Either Error TransactionEnv -> IO (Either Error TransactionEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error TransactionEnv -> IO (Either Error TransactionEnv))
-> Either Error TransactionEnv -> IO (Either Error TransactionEnv)
forall a b. (a -> b) -> a -> b
$ TransactionEnv -> Either Error TransactionEnv
forall a b. b -> Either a b
Right (TransactionEnv -> Either Error TransactionEnv)
-> TransactionEnv -> Either Error TransactionEnv
forall a b. (a -> b) -> a -> b
$ ForeignPtr Transaction -> TransactionConfig -> TransactionEnv
TransactionEnv ForeignPtr Transaction
fp TransactionConfig
config

-- | Execute a transactional action on an existing transaction environment.
onEnv :: TransactionEnv -> Transaction a -> IO (Either Error a)
onEnv :: TransactionEnv -> Transaction a -> IO (Either Error a)
onEnv TransactionEnv
env (Transaction ReaderT TransactionEnv (ExceptT Error IO) a
t) = ExceptT Error IO a -> IO (Either Error a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO a -> IO (Either Error a))
-> ExceptT Error IO a -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ ReaderT TransactionEnv (ExceptT Error IO) a
-> TransactionEnv -> ExceptT Error IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT TransactionEnv (ExceptT Error IO) a
t TransactionEnv
env

-- | Calls the C API's @fdb_transaction_on_error@ function. Re-raises
-- unretryable errors.
onError :: Error -> Transaction ()
onError :: Error -> Transaction ()
onError (CError CError
err) =
  (Transaction -> Transaction ()) -> Transaction ()
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction ()) -> Transaction ())
-> (Transaction -> Transaction ()) -> Transaction ()
forall a b. (a -> b) -> a -> b
$ \Transaction
trans -> do
    Future ()
f <-
      IO (Future ())
-> (Future () -> Transaction ()) -> Transaction (Future ())
forall b a.
IO (Future b)
-> (Future b -> Transaction a) -> Transaction (Future a)
allocFuture
        (Transaction -> CFDBError -> IO (Future ())
FDB.transactionOnError Transaction
trans (CError -> CFDBError
toCFDBError CError
err))
        (Transaction () -> Future () -> Transaction ()
forall a b. a -> b -> a
const (Transaction () -> Future () -> Transaction ())
-> Transaction () -> Future () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ () -> Transaction ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Future () -> Transaction ()
forall a. Future a -> Transaction a
await Future ()
f
onError Error
_ = () -> Transaction ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- @prefixRangeEnd prefix@ returns the lexicographically least bytestring
-- greater than @prefix@. This is the first bytestring that is not prefixed by
-- the input. If @prefix@ is empty or contains only @0xff@, returns 'Nothing'.
prefixRangeEnd :: ByteString -> Maybe ByteString
prefixRangeEnd :: ByteString -> Maybe ByteString
prefixRangeEnd ByteString
prefix
  | ByteString -> Bool
BS.null ByteString
prefix = Maybe ByteString
forall a. Maybe a
Nothing
  | (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff) ByteString
prefix = Maybe ByteString
forall a. Maybe a
Nothing
  | Bool
otherwise =
    let (ByteString
prefix', ByteString
_) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff) ByteString
prefix
     in ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Word8 -> ByteString
BS.snoc (ByteString -> ByteString
BS.init ByteString
prefix') (ByteString -> Word8
BS.last ByteString
prefix' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1)

-- | Gets the committed version of a transaction. Can only be called after the
-- transaction has committed, so must be used in conjunction with
-- 'TransactionEnv', since 'runTransaction' and its variants immediately destroy
-- the internal 'TransactionEnv' as soon as they return.
getCommittedVersion :: Transaction Int
getCommittedVersion :: Transaction Int
getCommittedVersion = (Transaction -> Transaction Int) -> Transaction Int
forall b. (Transaction -> Transaction b) -> Transaction b
withTransactionPtr ((Transaction -> Transaction Int) -> Transaction Int)
-> (Transaction -> Transaction Int) -> Transaction Int
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
  IO (CFDBError, Int) -> Transaction Int
forall (m :: * -> *) a.
(MonadError Error m, MonadIO m) =>
IO (CFDBError, a) -> m a
fdbExcept (Transaction -> IO (CFDBError, Int)
FDB.transactionGetCommittedVersion Transaction
t)