module Unison.Sqlite.Transaction
  ( -- * Transaction management
    Transaction,
    runTransaction,
    runTransactionWithRollback,
    runReadOnlyTransaction,
    runWriteTransaction,
    cacheTransaction,
    savepoint,

    -- ** Unsafe things
    unsafeIO,
    unsafeGetConnection,
    unsafeUnTransaction,

    -- * Executing queries

    -- ** Without results
    execute,
    executeStatements,

    -- ** With results
    queryStreamRow,
    queryStreamCol,
    queryListRow,
    queryListCol,
    queryMaybeRow,
    queryMaybeCol,
    queryOneRow,
    queryOneCol,

    -- *** With checks
    queryListRowCheck,
    queryListColCheck,
    queryMaybeRowCheck,
    queryMaybeColCheck,
    queryOneRowCheck,
    queryOneColCheck,

    -- * Rows modified
    rowsModified,
  )
where

import Control.Concurrent (threadDelay)
import Control.Exception (Exception (fromException), onException, throwIO)
import Control.Monad.Trans.Reader (ReaderT (..))
import Data.Text qualified as Text
import Data.Unique (Unique, newUnique)
import Database.SQLite.Simple qualified as Sqlite
import Database.SQLite.Simple.FromField qualified as Sqlite
import System.Random qualified as Random
import Unison.Prelude
import Unison.Sqlite.Connection (Connection (..))
import Unison.Sqlite.Connection qualified as Connection
import Unison.Sqlite.Exception (SqliteExceptionReason, SqliteQueryException, pattern SqliteBusyException)
import Unison.Sqlite.Sql (Sql)
import Unison.Util.Cache (Cache)
import Unison.Util.Cache qualified as Cache
import UnliftIO.Exception (bracketOnError_, catchAny, trySyncOrAsync, uninterruptibleMask)
import Unsafe.Coerce (unsafeCoerce)

newtype Transaction a
  = Transaction (Connection -> IO a)
  -- Omit MonadIO instance because transactions may be retried
  -- Omit MonadThrow instance so we always throw SqliteException (via *Check) with lots of context
  deriving (Functor Transaction
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
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
$cpure :: forall a. a -> Transaction a
pure :: forall a. a -> Transaction a
$c<*> :: forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
<*> :: forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
liftA2 :: forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
$c*> :: forall a b. Transaction a -> Transaction b -> Transaction b
*> :: forall a b. Transaction a -> Transaction b -> Transaction b
$c<* :: forall a b. Transaction a -> Transaction b -> Transaction a
<* :: forall a b. Transaction a -> Transaction b -> Transaction a
Applicative, (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
$cfmap :: forall a b. (a -> b) -> Transaction a -> Transaction b
fmap :: forall a b. (a -> b) -> Transaction a -> Transaction b
$c<$ :: forall a b. a -> Transaction b -> Transaction a
<$ :: forall a b. a -> Transaction b -> Transaction a
Functor, Applicative Transaction
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
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
$c>>= :: forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
>>= :: forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
$c>> :: forall a b. Transaction a -> Transaction b -> Transaction b
>> :: forall a b. Transaction a -> Transaction b -> Transaction b
$creturn :: forall a. a -> Transaction a
return :: forall a. a -> Transaction a
Monad) via (ReaderT Connection IO)

instance (Monoid a) => Monoid (Transaction a) where
  mempty :: (Monoid a) => Transaction a
  mempty :: Monoid a => Transaction a
mempty = a -> Transaction a
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

instance (Semigroup a) => Semigroup (Transaction a) where
  (<>) :: Transaction a -> Transaction a -> Transaction a
  <> :: Transaction a -> Transaction a -> Transaction a
(<>) = (a -> a -> a) -> Transaction a -> Transaction a -> Transaction a
forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

-- Internal newtype that equips Transaction with a MonadIO instance
newtype TransactionWithMonadIO a
  = TransactionWithMonadIO (Transaction a)
  deriving newtype (Functor TransactionWithMonadIO
Functor TransactionWithMonadIO =>
(forall a. a -> TransactionWithMonadIO a)
-> (forall a b.
    TransactionWithMonadIO (a -> b)
    -> TransactionWithMonadIO a -> TransactionWithMonadIO b)
-> (forall a b c.
    (a -> b -> c)
    -> TransactionWithMonadIO a
    -> TransactionWithMonadIO b
    -> TransactionWithMonadIO c)
-> (forall a b.
    TransactionWithMonadIO a
    -> TransactionWithMonadIO b -> TransactionWithMonadIO b)
-> (forall a b.
    TransactionWithMonadIO a
    -> TransactionWithMonadIO b -> TransactionWithMonadIO a)
-> Applicative TransactionWithMonadIO
forall a. a -> TransactionWithMonadIO a
forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO a
forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO b
forall a b.
TransactionWithMonadIO (a -> b)
-> TransactionWithMonadIO a -> TransactionWithMonadIO b
forall a b c.
(a -> b -> c)
-> TransactionWithMonadIO a
-> TransactionWithMonadIO b
-> TransactionWithMonadIO 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
$cpure :: forall a. a -> TransactionWithMonadIO a
pure :: forall a. a -> TransactionWithMonadIO a
$c<*> :: forall a b.
TransactionWithMonadIO (a -> b)
-> TransactionWithMonadIO a -> TransactionWithMonadIO b
<*> :: forall a b.
TransactionWithMonadIO (a -> b)
-> TransactionWithMonadIO a -> TransactionWithMonadIO b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> TransactionWithMonadIO a
-> TransactionWithMonadIO b
-> TransactionWithMonadIO c
liftA2 :: forall a b c.
(a -> b -> c)
-> TransactionWithMonadIO a
-> TransactionWithMonadIO b
-> TransactionWithMonadIO c
$c*> :: forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO b
*> :: forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO b
$c<* :: forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO a
<* :: forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO a
Applicative, (forall a b.
 (a -> b) -> TransactionWithMonadIO a -> TransactionWithMonadIO b)
-> (forall a b.
    a -> TransactionWithMonadIO b -> TransactionWithMonadIO a)
-> Functor TransactionWithMonadIO
forall a b.
a -> TransactionWithMonadIO b -> TransactionWithMonadIO a
forall a b.
(a -> b) -> TransactionWithMonadIO a -> TransactionWithMonadIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> TransactionWithMonadIO a -> TransactionWithMonadIO b
fmap :: forall a b.
(a -> b) -> TransactionWithMonadIO a -> TransactionWithMonadIO b
$c<$ :: forall a b.
a -> TransactionWithMonadIO b -> TransactionWithMonadIO a
<$ :: forall a b.
a -> TransactionWithMonadIO b -> TransactionWithMonadIO a
Functor, Applicative TransactionWithMonadIO
Applicative TransactionWithMonadIO =>
(forall a b.
 TransactionWithMonadIO a
 -> (a -> TransactionWithMonadIO b) -> TransactionWithMonadIO b)
-> (forall a b.
    TransactionWithMonadIO a
    -> TransactionWithMonadIO b -> TransactionWithMonadIO b)
-> (forall a. a -> TransactionWithMonadIO a)
-> Monad TransactionWithMonadIO
forall a. a -> TransactionWithMonadIO a
forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO b
forall a b.
TransactionWithMonadIO a
-> (a -> TransactionWithMonadIO b) -> TransactionWithMonadIO 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
$c>>= :: forall a b.
TransactionWithMonadIO a
-> (a -> TransactionWithMonadIO b) -> TransactionWithMonadIO b
>>= :: forall a b.
TransactionWithMonadIO a
-> (a -> TransactionWithMonadIO b) -> TransactionWithMonadIO b
$c>> :: forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO b
>> :: forall a b.
TransactionWithMonadIO a
-> TransactionWithMonadIO b -> TransactionWithMonadIO b
$creturn :: forall a. a -> TransactionWithMonadIO a
return :: forall a. a -> TransactionWithMonadIO a
Monad)

unTransactionWithMonadIO :: TransactionWithMonadIO a -> Transaction a
unTransactionWithMonadIO :: forall a. TransactionWithMonadIO a -> Transaction a
unTransactionWithMonadIO (TransactionWithMonadIO Transaction a
m) = Transaction a
m

instance MonadIO TransactionWithMonadIO where
  liftIO :: forall a. IO a -> TransactionWithMonadIO a
  liftIO :: forall a. IO a -> TransactionWithMonadIO a
liftIO =
    forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(IO a -> Transaction a) IO a -> Transaction a
forall a. HasCallStack => IO a -> Transaction a
unsafeIO

-- | Run a transaction on the given connection.
runTransaction :: (MonadIO m, HasCallStack) => Connection -> Transaction a -> m a
runTransaction :: forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Connection -> Transaction a -> m a
runTransaction Connection
conn (Transaction Connection -> IO a
f) = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask \forall a. IO a -> IO a
restore -> do
    Connection -> IO ()
Connection.begin Connection
conn
    -- Catch all exceptions (sync or async), because we want to ROLLBACK the BEGIN no matter what.
    forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
trySyncOrAsync @_ @SomeException (IO a -> IO a
forall a. IO a -> IO a
restore (Connection -> IO a
f Connection
conn)) IO (Either SomeException a)
-> (Either SomeException a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left SomeException
exception -> do
        IO () -> IO ()
ignoringExceptions (Connection -> IO ()
Connection.rollback Connection
conn)
        case SomeException -> Maybe SqliteQueryException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exception of
          Just SqliteQueryException
SqliteBusyException -> do
            IO () -> IO ()
forall a. IO a -> IO a
restore (Int -> IO ()
threadDelay Int
transactionRetryDelay)
            (forall a. IO a -> IO a) -> Connection -> IO a -> IO a
forall a.
HasCallStack =>
(forall a. IO a -> IO a) -> Connection -> IO a -> IO a
runWriteTransaction_ IO x -> IO x
forall a. IO a -> IO a
restore Connection
conn (Connection -> IO a
f Connection
conn)
          Maybe SqliteQueryException
_ -> SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
exception
      Right a
result -> do
        Connection -> IO ()
Connection.commit Connection
conn
        a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
{-# SPECIALIZE runTransaction :: Connection -> Transaction a -> IO a #-}

-- An internal exception type that allows `runTransactionWithRollback`
data RollingBack
  = forall a. RollingBack !Unique !a
  deriving anyclass (Show RollingBack
Typeable RollingBack
(Typeable RollingBack, Show RollingBack) =>
(RollingBack -> SomeException)
-> (SomeException -> Maybe RollingBack)
-> (RollingBack -> String)
-> Exception RollingBack
SomeException -> Maybe RollingBack
RollingBack -> String
RollingBack -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: RollingBack -> SomeException
toException :: RollingBack -> SomeException
$cfromException :: SomeException -> Maybe RollingBack
fromException :: SomeException -> Maybe RollingBack
$cdisplayException :: RollingBack -> String
displayException :: RollingBack -> String
Exception)

instance Show RollingBack where
  show :: RollingBack -> String
show RollingBack
_ = String
""

-- | Run a transaction on the given connection, providing a function that can short-circuit (and roll back) the
-- transaction.
runTransactionWithRollback ::
  (MonadIO m, HasCallStack) =>
  Connection ->
  ((forall void. a -> Transaction void) -> Transaction a) ->
  m a
runTransactionWithRollback :: forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Connection
-> ((forall void. a -> Transaction void) -> Transaction a) -> m a
runTransactionWithRollback Connection
conn (forall void. a -> Transaction void) -> Transaction a
transaction = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Unique
token <- IO Unique
newUnique
  IO a -> IO (Either RollingBack a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (Connection -> Transaction a -> IO a
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Connection -> Transaction a -> m a
runTransaction Connection
conn ((forall void. a -> Transaction void) -> Transaction a
transaction \a
x -> IO void -> Transaction void
forall a. HasCallStack => IO a -> Transaction a
unsafeIO (RollingBack -> IO void
forall e a. Exception e => e -> IO a
throwIO (Unique -> a -> RollingBack
forall a. Unique -> a -> RollingBack
RollingBack Unique
token a
x)))) IO (Either RollingBack a) -> (Either RollingBack a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left exception :: RollingBack
exception@(RollingBack Unique
token2 a
x)
      | Unique
token Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
token2 -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a
forall a b. a -> b
unsafeCoerce a
x)
      | Bool
otherwise -> RollingBack -> IO a
forall e a. Exception e => e -> IO a
throwIO RollingBack
exception
    Right a
x -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# SPECIALIZE runTransactionWithRollback :: Connection -> ((forall void. a -> Transaction void) -> Transaction a) -> IO a #-}

-- | Run a transaction that is known to only perform reads.
--
-- The action is provided a function that peels off the 'Transaction' newtype without sending the corresponding
-- BEGIN/COMMIT statements.
--
-- The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions. If the transaction does
-- attempt a write and gets SQLITE_BUSY, it's your fault!
runReadOnlyTransaction :: (MonadUnliftIO m, HasCallStack) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a
runReadOnlyTransaction :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a
runReadOnlyTransaction Connection
conn (forall x. Transaction x -> m x) -> m a
f =
  ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. m a -> IO a
runInIO ->
    Connection -> IO a -> IO a
forall a. HasCallStack => Connection -> IO a -> IO a
runReadOnlyTransaction_ Connection
conn (m a -> IO a
forall a. m a -> IO a
runInIO ((forall x. Transaction x -> m x) -> m a
f (\Transaction x
transaction -> IO x -> m x
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Transaction x -> Connection -> IO x
forall a. Transaction a -> Connection -> IO a
unsafeUnTransaction Transaction x
transaction Connection
conn))))
{-# SPECIALIZE runReadOnlyTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-}

runReadOnlyTransaction_ :: (HasCallStack) => Connection -> IO a -> IO a
runReadOnlyTransaction_ :: forall a. HasCallStack => Connection -> IO a -> IO a
runReadOnlyTransaction_ Connection
conn IO a
action = do
  IO () -> IO () -> IO a -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracketOnError_
    (Connection -> IO ()
Connection.begin Connection
conn)
    (IO () -> IO ()
ignoringExceptions (Connection -> IO ()
Connection.rollback Connection
conn))
    ( do
        a
result <- IO a
action
        Connection -> IO ()
Connection.commit Connection
conn
        a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
    )

-- | Run a transaction that is known to perform at least one write.
--
-- The action is provided a function that peels off the 'Transaction' newtype without sending the corresponding
-- BEGIN/COMMIT statements.
--
-- The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions.
runWriteTransaction :: (HasCallStack, MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a
runWriteTransaction :: forall (m :: * -> *) a.
(HasCallStack, MonadUnliftIO m) =>
Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a
runWriteTransaction Connection
conn (forall x. Transaction x -> m x) -> m a
f =
  ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. m a -> IO a
runInIO ->
    ((forall a. IO a -> IO a) -> IO a) -> IO a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask \forall a. IO a -> IO a
restore ->
      (forall a. IO a -> IO a) -> Connection -> IO a -> IO a
forall a.
HasCallStack =>
(forall a. IO a -> IO a) -> Connection -> IO a -> IO a
runWriteTransaction_
        IO x -> IO x
forall a. IO a -> IO a
restore
        Connection
conn
        (m a -> IO a
forall a. m a -> IO a
runInIO ((forall x. Transaction x -> m x) -> m a
f (\Transaction x
transaction -> IO x -> m x
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Transaction x -> Connection -> IO x
forall a. Transaction a -> Connection -> IO a
unsafeUnTransaction Transaction x
transaction Connection
conn))))
{-# SPECIALIZE runWriteTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-}

runWriteTransaction_ :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO a -> IO a
runWriteTransaction_ :: forall a.
HasCallStack =>
(forall a. IO a -> IO a) -> Connection -> IO a -> IO a
runWriteTransaction_ forall a. IO a -> IO a
restore Connection
conn IO a
transaction = do
  HasCallStack => (forall a. IO a -> IO a) -> Connection -> IO ()
(forall a. IO a -> IO a) -> Connection -> IO ()
keepTryingToBeginImmediate IO x -> IO x
forall a. IO a -> IO a
restore Connection
conn
  a
result <- IO a -> IO a
forall a. IO a -> IO a
restore IO a
transaction IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ()
ignoringExceptions (Connection -> IO ()
Connection.rollback Connection
conn)
  Connection -> IO ()
Connection.commit Connection
conn
  a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

-- @BEGIN IMMEDIATE@ until success.
keepTryingToBeginImmediate :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO ()
keepTryingToBeginImmediate :: HasCallStack => (forall a. IO a -> IO a) -> Connection -> IO ()
keepTryingToBeginImmediate forall a. IO a -> IO a
restore Connection
conn =
  let loop :: IO ()
loop =
        forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try @_ @SqliteQueryException (Connection -> IO ()
Connection.beginImmediate Connection
conn) IO (Either SqliteQueryException ())
-> (Either SqliteQueryException () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left SqliteQueryException
SqliteBusyException -> do
            IO () -> IO ()
forall a. IO a -> IO a
restore (Int -> IO ()
threadDelay Int
transactionRetryDelay)
            IO ()
loop
          Left SqliteQueryException
exception -> SqliteQueryException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SqliteQueryException
exception
          Right () -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
   in IO ()
loop

ignoringExceptions :: IO () -> IO ()
ignoringExceptions :: IO () -> IO ()
ignoringExceptions IO ()
action =
  IO ()
action IO () -> (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Wrap a transaction with a cache; cache hits will not hit SQLite.
cacheTransaction :: forall k v. Cache k v -> (k -> Transaction v) -> (k -> Transaction v)
cacheTransaction :: forall k v. Cache k v -> (k -> Transaction v) -> k -> Transaction v
cacheTransaction Cache k v
cache k -> Transaction v
f k
k =
  TransactionWithMonadIO v -> Transaction v
forall a. TransactionWithMonadIO a -> Transaction a
unTransactionWithMonadIO (Cache k v
-> (k -> TransactionWithMonadIO v) -> k -> TransactionWithMonadIO v
forall (m :: * -> *) k v.
MonadIO m =>
Cache k v -> (k -> m v) -> k -> m v
Cache.apply Cache k v
cache (Transaction v -> TransactionWithMonadIO v
forall a. Transaction a -> TransactionWithMonadIO a
TransactionWithMonadIO (Transaction v -> TransactionWithMonadIO v)
-> (k -> Transaction v) -> k -> TransactionWithMonadIO v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Transaction v
f) k
k)

-- | Perform an atomic sub-computation within a transaction; if it returns 'Left', it's rolled back.
savepoint :: Transaction (Either a a) -> Transaction a
savepoint :: forall a. Transaction (Either a a) -> Transaction a
savepoint (Transaction Connection -> IO (Either a a)
action) = do
  (Connection -> IO a) -> Transaction a
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> do
    -- Generate a random name for the savepoint, so the caller isn't burdened with coming up with a name. Seems
    -- extremely unlikely for this to go wrong (i.e. some super nested withSavepoint call that ends up generating the
    -- same savepoint name twice in a single scope).
    Text
name <- String -> Text
Text.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Char -> IO String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
10 ((Char, Char) -> IO Char
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
Random.randomRIO (Char
'a', Char
'z'))
    Connection -> Text -> (IO () -> IO a) -> IO a
forall a. Connection -> Text -> (IO () -> IO a) -> IO a
Connection.withSavepointIO Connection
conn Text
name \IO ()
rollback ->
      Connection -> IO (Either a a)
action Connection
conn IO (Either a a) -> (Either a a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left a
result -> do
          IO ()
rollback
          a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
        Right a
result -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

-- | Perform IO inside a transaction, which should be idempotent, because it may be run more than once if the
-- transaction needs to retry.
--
-- /Warning/: attempting to run a transaction inside a transaction will cause an exception!
unsafeIO :: (HasCallStack) => IO a -> Transaction a
unsafeIO :: forall a. HasCallStack => IO a -> Transaction a
unsafeIO IO a
action =
  (Connection -> IO a) -> Transaction a
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
_ -> IO a
action

unsafeGetConnection :: Transaction Connection
unsafeGetConnection :: Transaction Connection
unsafeGetConnection =
  (Connection -> IO Connection) -> Transaction Connection
forall a. (Connection -> IO a) -> Transaction a
Transaction Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Unwrap the transaction newtype, throwing away the sending of BEGIN/COMMIT + automatic retry.
unsafeUnTransaction :: Transaction a -> Connection -> IO a
unsafeUnTransaction :: forall a. Transaction a -> Connection -> IO a
unsafeUnTransaction (Transaction Connection -> IO a
action) =
  Connection -> IO a
action

-- Without results

execute :: (HasCallStack) => Sql -> Transaction ()
execute :: HasCallStack => Sql -> Transaction ()
execute Sql
s =
  (Connection -> IO ()) -> Transaction ()
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
Connection.execute Connection
conn Sql
s

executeStatements :: (HasCallStack) => Text -> Transaction ()
executeStatements :: HasCallStack => Text -> Transaction ()
executeStatements Text
s =
  (Connection -> IO ()) -> Transaction ()
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> HasCallStack => Connection -> Text -> IO ()
Connection -> Text -> IO ()
Connection.executeStatements Connection
conn Text
s

-- With results, without checks

queryStreamRow ::
  (Sqlite.FromRow a, HasCallStack) =>
  Sql ->
  (Transaction (Maybe a) -> Transaction r) ->
  Transaction r
queryStreamRow :: forall a r.
(FromRow a, HasCallStack) =>
Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r
queryStreamRow Sql
sql Transaction (Maybe a) -> Transaction r
callback =
  (Connection -> IO r) -> Transaction r
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn ->
    Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r
forall a r.
(HasCallStack, FromRow a) =>
Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r
Connection.queryStreamRow Connection
conn Sql
sql \IO (Maybe a)
next ->
      Transaction r -> Connection -> IO r
forall a. Transaction a -> Connection -> IO a
unsafeUnTransaction (Transaction (Maybe a) -> Transaction r
callback (IO (Maybe a) -> Transaction (Maybe a)
forall a. HasCallStack => IO a -> Transaction a
unsafeIO IO (Maybe a)
next)) Connection
conn

queryStreamCol ::
  forall a r.
  (Sqlite.FromField a, HasCallStack) =>
  Sql ->
  (Transaction (Maybe a) -> Transaction r) ->
  Transaction r
queryStreamCol :: forall a r.
(FromField a, HasCallStack) =>
Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r
queryStreamCol =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce
    @(Sql -> (Transaction (Maybe (Sqlite.Only a)) -> Transaction r) -> Transaction r)
    @(Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r)
    Sql
-> (Transaction (Maybe (Only a)) -> Transaction r) -> Transaction r
forall a r.
(FromRow a, HasCallStack) =>
Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r
queryStreamRow

queryListRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction [a]
queryListRow :: forall a. (FromRow a, HasCallStack) => Sql -> Transaction [a]
queryListRow Sql
s =
  (Connection -> IO [a]) -> Transaction [a]
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> IO [a]
forall a. (FromRow a, HasCallStack) => Connection -> Sql -> IO [a]
Connection.queryListRow Connection
conn Sql
s

queryListCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction [a]
queryListCol :: forall a. (FromField a, HasCallStack) => Sql -> Transaction [a]
queryListCol Sql
s =
  (Connection -> IO [a]) -> Transaction [a]
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> IO [a]
forall a.
(FromField a, HasCallStack) =>
Connection -> Sql -> IO [a]
Connection.queryListCol Connection
conn Sql
s

queryMaybeRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction (Maybe a)
queryMaybeRow :: forall a. (FromRow a, HasCallStack) => Sql -> Transaction (Maybe a)
queryMaybeRow Sql
s =
  (Connection -> IO (Maybe a)) -> Transaction (Maybe a)
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> IO (Maybe a)
forall a.
(FromRow a, HasCallStack) =>
Connection -> Sql -> IO (Maybe a)
Connection.queryMaybeRow Connection
conn Sql
s

queryMaybeCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction (Maybe a)
queryMaybeCol :: forall a.
(FromField a, HasCallStack) =>
Sql -> Transaction (Maybe a)
queryMaybeCol Sql
s =
  (Connection -> IO (Maybe a)) -> Transaction (Maybe a)
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> IO (Maybe a)
forall a.
(FromField a, HasCallStack) =>
Connection -> Sql -> IO (Maybe a)
Connection.queryMaybeCol Connection
conn Sql
s

queryOneRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction a
queryOneRow :: forall a. (FromRow a, HasCallStack) => Sql -> Transaction a
queryOneRow Sql
s =
  (Connection -> IO a) -> Transaction a
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> IO a
forall a. (FromRow a, HasCallStack) => Connection -> Sql -> IO a
Connection.queryOneRow Connection
conn Sql
s

queryOneCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction a
queryOneCol :: forall a. (FromField a, HasCallStack) => Sql -> Transaction a
queryOneCol Sql
s =
  (Connection -> IO a) -> Transaction a
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> IO a
forall a. (FromField a, HasCallStack) => Connection -> Sql -> IO a
Connection.queryOneCol Connection
conn Sql
s

-- With results, with parameters, with checks

queryListRowCheck ::
  (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) =>
  Sql ->
  ([a] -> Either e r) ->
  Transaction r
queryListRowCheck :: forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Sql -> ([a] -> Either e r) -> Transaction r
queryListRowCheck Sql
sql [a] -> Either e r
check =
  (Connection -> IO r) -> Transaction r
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> ([a] -> Either e r) -> IO r
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> ([a] -> Either e r) -> IO r
Connection.queryListRowCheck Connection
conn Sql
sql [a] -> Either e r
check

queryListColCheck ::
  (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) =>
  Sql ->
  ([a] -> Either e r) ->
  Transaction r
queryListColCheck :: forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Sql -> ([a] -> Either e r) -> Transaction r
queryListColCheck Sql
sql [a] -> Either e r
check =
  (Connection -> IO r) -> Transaction r
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> ([a] -> Either e r) -> IO r
forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> ([a] -> Either e r) -> IO r
Connection.queryListColCheck Connection
conn Sql
sql [a] -> Either e r
check

queryMaybeRowCheck ::
  (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) =>
  Sql ->
  (a -> Either e r) ->
  Transaction (Maybe r)
queryMaybeRowCheck :: forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Sql -> (a -> Either e r) -> Transaction (Maybe r)
queryMaybeRowCheck Sql
s a -> Either e r
check =
  (Connection -> IO (Maybe r)) -> Transaction (Maybe r)
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> (a -> Either e r) -> IO (Maybe r)
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO (Maybe r)
Connection.queryMaybeRowCheck Connection
conn Sql
s a -> Either e r
check

queryMaybeColCheck ::
  (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) =>
  Sql ->
  (a -> Either e r) ->
  Transaction (Maybe r)
queryMaybeColCheck :: forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Sql -> (a -> Either e r) -> Transaction (Maybe r)
queryMaybeColCheck Sql
s a -> Either e r
check =
  (Connection -> IO (Maybe r)) -> Transaction (Maybe r)
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> (a -> Either e r) -> IO (Maybe r)
forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO (Maybe r)
Connection.queryMaybeColCheck Connection
conn Sql
s a -> Either e r
check

queryOneRowCheck ::
  (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) =>
  Sql ->
  (a -> Either e r) ->
  Transaction r
queryOneRowCheck :: forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Sql -> (a -> Either e r) -> Transaction r
queryOneRowCheck Sql
s a -> Either e r
check =
  (Connection -> IO r) -> Transaction r
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> (a -> Either e r) -> IO r
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO r
Connection.queryOneRowCheck Connection
conn Sql
s a -> Either e r
check

queryOneColCheck ::
  (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) =>
  Sql ->
  (a -> Either e r) ->
  Transaction r
queryOneColCheck :: forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Sql -> (a -> Either e r) -> Transaction r
queryOneColCheck Sql
s a -> Either e r
check =
  (Connection -> IO r) -> Transaction r
forall a. (Connection -> IO a) -> Transaction a
Transaction \Connection
conn -> Connection -> Sql -> (a -> Either e r) -> IO r
forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO r
Connection.queryOneColCheck Connection
conn Sql
s a -> Either e r
check

-- Rows modified

rowsModified :: Transaction Int
rowsModified :: Transaction Int
rowsModified =
  (Connection -> IO Int) -> Transaction Int
forall a. (Connection -> IO a) -> Transaction a
Transaction Connection -> IO Int
Connection.rowsModified

transactionRetryDelay :: Int
transactionRetryDelay :: Int
transactionRetryDelay = Int
100_000