{-|
Module: Squeal.PostgreSQL.Session.Transaction.Unsafe
Description: unsafe transaction control language
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

transaction control language permitting arbitrary `IO`
-}

{-# LANGUAGE
    DataKinds
  , FlexibleContexts
  , LambdaCase
  , OverloadedStrings
  , TypeInType
#-}

module Squeal.PostgreSQL.Session.Transaction.Unsafe
  ( -- * Transaction
    transactionally
  , transactionally_
  , transactionallyRetry
  , transactionallyRetry_
  , ephemerally
  , ephemerally_
  , begin
  , commit
  , rollback
  , withSavepoint
    -- * Transaction Mode
  , TransactionMode (..)
  , defaultMode
  , retryMode
  , longRunningMode
  , IsolationLevel (..)
  , AccessMode (..)
  , DeferrableMode (..)
  ) where

import Control.Monad
import Control.Monad.Catch
import Data.ByteString
import Data.Either

import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Session.Exception
import Squeal.PostgreSQL.Session.Monad

{- | Run a computation `transactionally`;
first `begin`,
then run the computation,
`onException` `rollback` and rethrow the exception,
otherwise `commit` and `return` the result.
-}
transactionally
  :: (MonadMask tx, MonadPQ db tx)
  => TransactionMode
  -> tx x -- ^ run inside a transaction
  -> tx x
transactionally :: TransactionMode -> tx x -> tx x
transactionally TransactionMode
mode tx x
tx = ((forall a. tx a -> tx a) -> tx x) -> tx x
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. tx a -> tx a) -> tx x) -> tx x)
-> ((forall a. tx a -> tx a) -> tx x) -> tx x
forall a b. (a -> b) -> a -> b
$ \forall a. tx a -> tx a
restore -> do
  Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ (Manipulation '[] db '[] '[] -> tx ())
-> Manipulation '[] db '[] '[] -> tx ()
forall a b. (a -> b) -> a -> b
$ TransactionMode -> Manipulation_ db () ()
forall (db :: SchemasType).
TransactionMode -> Manipulation_ db () ()
begin TransactionMode
mode
  x
result <- tx x -> tx x
forall a. tx a -> tx a
restore tx x
tx tx x -> tx () -> tx x
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
rollback
  Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
commit
  x -> tx x
forall (m :: * -> *) a. Monad m => a -> m a
return x
result

-- | Run a computation `transactionally_`, in `defaultMode`.
transactionally_
  :: (MonadMask tx, MonadPQ db tx)
  => tx x -- ^ run inside a transaction
  -> tx x
transactionally_ :: tx x -> tx x
transactionally_ = TransactionMode -> tx x -> tx x
forall (tx :: * -> *) (db :: SchemasType) x.
(MonadMask tx, MonadPQ db tx) =>
TransactionMode -> tx x -> tx x
transactionally TransactionMode
defaultMode

{- |
`transactionallyRetry` a computation;

* first `begin`,
* then `try` the computation,
  - if it raises a serialization failure or deadlock detection,
    then `rollback` and restart the transaction,
  - if it raises any other exception then `rollback` and rethrow the exception,
  - otherwise `commit` and `return` the result.
-}
transactionallyRetry
  :: (MonadMask tx, MonadPQ db tx)
  => TransactionMode
  -> tx x -- ^ run inside a transaction
  -> tx x
transactionallyRetry :: TransactionMode -> tx x -> tx x
transactionallyRetry TransactionMode
mode tx x
tx = ((forall a. tx a -> tx a) -> tx x) -> tx x
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. tx a -> tx a) -> tx x) -> tx x)
-> ((forall a. tx a -> tx a) -> tx x) -> tx x
forall a b. (a -> b) -> a -> b
$ \forall a. tx a -> tx a
restore ->
  tx (Either SquealException x) -> tx x
forall (db :: SchemasType) (m :: * -> *) b.
(MonadPQ db m, MonadThrow m) =>
m (Either SquealException b) -> m b
loop (tx (Either SquealException x) -> tx x)
-> (tx x -> tx (Either SquealException x)) -> tx x -> tx x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tx x -> tx (Either SquealException x)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (tx x -> tx x) -> tx x -> tx x
forall a b. (a -> b) -> a -> b
$ do
    x
x <- tx x -> tx x
forall a. tx a -> tx a
restore tx x
tx
    Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
commit
    x -> tx x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
  where
    loop :: m (Either SquealException b) -> m b
loop m (Either SquealException b)
attempt = do
      Manipulation '[] db '[] '[] -> m ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ (Manipulation '[] db '[] '[] -> m ())
-> Manipulation '[] db '[] '[] -> m ()
forall a b. (a -> b) -> a -> b
$ TransactionMode -> Manipulation_ db () ()
forall (db :: SchemasType).
TransactionMode -> Manipulation_ db () ()
begin TransactionMode
mode
      m (Either SquealException b)
attempt m (Either SquealException b)
-> (Either SquealException b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left (SerializationFailure ByteString
_) -> do
          Manipulation '[] db '[] '[] -> m ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
rollback
          m (Either SquealException b) -> m b
loop m (Either SquealException b)
attempt
        Left (DeadlockDetected ByteString
_) -> do
          Manipulation '[] db '[] '[] -> m ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
rollback
          m (Either SquealException b) -> m b
loop m (Either SquealException b)
attempt
        Left SquealException
err -> do
          Manipulation '[] db '[] '[] -> m ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
rollback
          SquealException -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SquealException
err
        Right b
x -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x

{- | `transactionallyRetry` in `retryMode`. -}
transactionallyRetry_
  :: (MonadMask tx, MonadPQ db tx)
  => tx x -- ^ run inside a transaction
  -> tx x
transactionallyRetry_ :: tx x -> tx x
transactionallyRetry_ = TransactionMode -> tx x -> tx x
forall (tx :: * -> *) (db :: SchemasType) x.
(MonadMask tx, MonadPQ db tx) =>
TransactionMode -> tx x -> tx x
transactionallyRetry TransactionMode
retryMode

{- | Run a computation `ephemerally`;
Like `transactionally` but always `rollback`, useful in testing.
-}
ephemerally
  :: (MonadMask tx, MonadPQ db tx)
  => TransactionMode
  -> tx x -- ^ run inside an ephemeral transaction
  -> tx x
ephemerally :: TransactionMode -> tx x -> tx x
ephemerally TransactionMode
mode tx x
tx = ((forall a. tx a -> tx a) -> tx x) -> tx x
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. tx a -> tx a) -> tx x) -> tx x)
-> ((forall a. tx a -> tx a) -> tx x) -> tx x
forall a b. (a -> b) -> a -> b
$ \forall a. tx a -> tx a
restore -> do
  Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ (Manipulation '[] db '[] '[] -> tx ())
-> Manipulation '[] db '[] '[] -> tx ()
forall a b. (a -> b) -> a -> b
$ TransactionMode -> Manipulation_ db () ()
forall (db :: SchemasType).
TransactionMode -> Manipulation_ db () ()
begin TransactionMode
mode
  x
result <- tx x -> tx x
forall a. tx a -> tx a
restore tx x
tx tx x -> tx () -> tx x
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` (Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
rollback)
  Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ Manipulation '[] db '[] '[]
forall (db :: SchemasType). Manipulation_ db () ()
rollback
  x -> tx x
forall (m :: * -> *) a. Monad m => a -> m a
return x
result

{- | Run a computation `ephemerally` in `defaultMode`. -}
ephemerally_
  :: (MonadMask tx, MonadPQ db tx)
  => tx x -- ^ run inside an ephemeral transaction
  -> tx x
ephemerally_ :: tx x -> tx x
ephemerally_ = TransactionMode -> tx x -> tx x
forall (tx :: * -> *) (db :: SchemasType) x.
(MonadMask tx, MonadPQ db tx) =>
TransactionMode -> tx x -> tx x
ephemerally TransactionMode
defaultMode

-- | @BEGIN@ a transaction.
begin :: TransactionMode -> Manipulation_ db () ()
begin :: TransactionMode -> Manipulation_ db () ()
begin TransactionMode
mode = ByteString -> Manipulation '[] db '[] '[]
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation (ByteString -> Manipulation '[] db '[] '[])
-> ByteString -> Manipulation '[] db '[] '[]
forall a b. (a -> b) -> a -> b
$ ByteString
"BEGIN" ByteString -> ByteString -> ByteString
<+> TransactionMode -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TransactionMode
mode

-- | @COMMIT@ a transaction.
commit :: Manipulation_ db () ()
commit :: Manipulation_ db () ()
commit = ByteString -> Manipulation '[] db '[] '[]
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation ByteString
"COMMIT"

-- | @ROLLBACK@ a transaction.
rollback :: Manipulation_ db () ()
rollback :: Manipulation_ db () ()
rollback = ByteString -> Manipulation '[] db '[] '[]
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation ByteString
"ROLLBACK"

{- | `withSavepoint`, used in a transaction block,
allows a form of nested transactions,
creating a savepoint, then running a transaction,
rolling back to the savepoint if it returned `Left`,
then releasing the savepoint and returning transaction's result.

Make sure to run `withSavepoint` in a transaction block,
not directly or you will provoke a SQL exception.
-}
withSavepoint
  :: MonadPQ db tx
  => ByteString -- ^ savepoint name
  -> tx (Either e x)
  -> tx (Either e x)
withSavepoint :: ByteString -> tx (Either e x) -> tx (Either e x)
withSavepoint ByteString
savepoint tx (Either e x)
tx = do
  let svpt :: ByteString
svpt = ByteString
"SAVEPOINT" ByteString -> ByteString -> ByteString
<+> ByteString
savepoint
  Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ (Manipulation '[] db '[] '[] -> tx ())
-> Manipulation '[] db '[] '[] -> tx ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Manipulation '[] db '[] '[]
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation (ByteString -> Manipulation '[] db '[] '[])
-> ByteString -> Manipulation '[] db '[] '[]
forall a b. (a -> b) -> a -> b
$ ByteString
svpt
  Either e x
e_x <- tx (Either e x)
tx
  Bool -> tx () -> tx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either e x -> Bool
forall a b. Either a b -> Bool
isLeft Either e x
e_x) (tx () -> tx ()) -> tx () -> tx ()
forall a b. (a -> b) -> a -> b
$
    Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ (Manipulation '[] db '[] '[] -> tx ())
-> Manipulation '[] db '[] '[] -> tx ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Manipulation '[] db '[] '[]
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation (ByteString -> Manipulation '[] db '[] '[])
-> ByteString -> Manipulation '[] db '[] '[]
forall a b. (a -> b) -> a -> b
$ ByteString
"ROLLBACK TO" ByteString -> ByteString -> ByteString
<+> ByteString
svpt
  Manipulation '[] db '[] '[] -> tx ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ (Manipulation '[] db '[] '[] -> tx ())
-> Manipulation '[] db '[] '[] -> tx ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Manipulation '[] db '[] '[]
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation (ByteString -> Manipulation '[] db '[] '[])
-> ByteString -> Manipulation '[] db '[] '[]
forall a b. (a -> b) -> a -> b
$ ByteString
"RELEASE" ByteString -> ByteString -> ByteString
<+> ByteString
svpt
  Either e x -> tx (Either e x)
forall (m :: * -> *) a. Monad m => a -> m a
return Either e x
e_x

-- | The available transaction characteristics are the transaction `IsolationLevel`,
-- the transaction `AccessMode` (`ReadWrite` or `ReadOnly`), and the `DeferrableMode`.
data TransactionMode = TransactionMode
  { TransactionMode -> IsolationLevel
isolationLevel :: IsolationLevel
  , TransactionMode -> AccessMode
accessMode  :: AccessMode
  , TransactionMode -> DeferrableMode
deferrableMode :: DeferrableMode
  } deriving (Int -> TransactionMode -> ShowS
[TransactionMode] -> ShowS
TransactionMode -> String
(Int -> TransactionMode -> ShowS)
-> (TransactionMode -> String)
-> ([TransactionMode] -> ShowS)
-> Show TransactionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionMode] -> ShowS
$cshowList :: [TransactionMode] -> ShowS
show :: TransactionMode -> String
$cshow :: TransactionMode -> String
showsPrec :: Int -> TransactionMode -> ShowS
$cshowsPrec :: Int -> TransactionMode -> ShowS
Show, TransactionMode -> TransactionMode -> Bool
(TransactionMode -> TransactionMode -> Bool)
-> (TransactionMode -> TransactionMode -> Bool)
-> Eq TransactionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionMode -> TransactionMode -> Bool
$c/= :: TransactionMode -> TransactionMode -> Bool
== :: TransactionMode -> TransactionMode -> Bool
$c== :: TransactionMode -> TransactionMode -> Bool
Eq)

-- | `TransactionMode` with a `ReadCommitted` `IsolationLevel`,
-- `ReadWrite` `AccessMode` and `NotDeferrable` `DeferrableMode`.
defaultMode :: TransactionMode
defaultMode :: TransactionMode
defaultMode = IsolationLevel -> AccessMode -> DeferrableMode -> TransactionMode
TransactionMode IsolationLevel
ReadCommitted AccessMode
ReadWrite DeferrableMode
NotDeferrable

-- | `TransactionMode` with a `Serializable` `IsolationLevel`,
-- `ReadWrite` `AccessMode` and `NotDeferrable` `DeferrableMode`,
-- appropriate for short-lived queries or manipulations.
retryMode :: TransactionMode
retryMode :: TransactionMode
retryMode = IsolationLevel -> AccessMode -> DeferrableMode -> TransactionMode
TransactionMode IsolationLevel
Serializable AccessMode
ReadWrite DeferrableMode
NotDeferrable

-- | `TransactionMode` with a `Serializable` `IsolationLevel`,
-- `ReadOnly` `AccessMode` and `Deferrable` `DeferrableMode`.
-- This mode is well suited for long-running reports or backups.
longRunningMode :: TransactionMode
longRunningMode :: TransactionMode
longRunningMode = IsolationLevel -> AccessMode -> DeferrableMode -> TransactionMode
TransactionMode IsolationLevel
Serializable AccessMode
ReadOnly DeferrableMode
Deferrable

-- | Render a `TransactionMode`.
instance RenderSQL TransactionMode where
  renderSQL :: TransactionMode -> ByteString
renderSQL TransactionMode
mode =
    ByteString
"ISOLATION LEVEL"
      ByteString -> ByteString -> ByteString
<+> IsolationLevel -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL (TransactionMode -> IsolationLevel
isolationLevel TransactionMode
mode)
      ByteString -> ByteString -> ByteString
<+> AccessMode -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL (TransactionMode -> AccessMode
accessMode TransactionMode
mode)
      ByteString -> ByteString -> ByteString
<+> DeferrableMode -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL (TransactionMode -> DeferrableMode
deferrableMode TransactionMode
mode)

-- | The SQL standard defines four levels of transaction isolation.
-- The most strict is `Serializable`, which is defined by the standard in a paragraph
-- which says that any concurrent execution of a set of `Serializable` transactions is
-- guaranteed to produce the same effect as running them one at a time in some order.
-- The other three levels are defined in terms of phenomena, resulting from interaction
-- between concurrent transactions, which must not occur at each level.
-- The phenomena which are prohibited at various levels are:
--
-- __Dirty read__: A transaction reads data written by a concurrent uncommitted transaction.
--
-- __Nonrepeatable read__: A transaction re-reads data it has previously read and finds that data
-- has been modified by another transaction (that committed since the initial read).
--
-- __Phantom read__: A transaction re-executes a query returning a set of rows that satisfy
-- a search condition and finds that the set of rows satisfying the condition
-- has changed due to another recently-committed transaction.
--
-- __Serialization anomaly__: The result of successfully committing a group of transactions is inconsistent
-- with all possible orderings of running those transactions one at a time.
--
-- In PostgreSQL, you can request any of the four standard transaction
-- isolation levels, but internally only three distinct isolation levels are implemented,
-- i.e. PostgreSQL's `ReadUncommitted` mode behaves like `ReadCommitted`.
-- This is because it is the only sensible way to map the standard isolation levels to
-- PostgreSQL's multiversion concurrency control architecture.
data IsolationLevel
  = Serializable
  -- ^ Dirty read is not possible.
  -- Nonrepeatable read is not possible.
  -- Phantom read is not possible.
  -- Serialization anomaly is not possible.
  | RepeatableRead
  -- ^ Dirty read is not possible.
  -- Nonrepeatable read is not possible.
  -- Phantom read is not possible.
  -- Serialization anomaly is possible.
  | ReadCommitted
  -- ^ Dirty read is not possible.
  -- Nonrepeatable read is possible.
  -- Phantom read is possible.
  -- Serialization anomaly is possible.
  | ReadUncommitted
  -- ^ Dirty read is not possible.
  -- Nonrepeatable read is possible.
  -- Phantom read is possible.
  -- Serialization anomaly is possible.
  deriving (Int -> IsolationLevel -> ShowS
[IsolationLevel] -> ShowS
IsolationLevel -> String
(Int -> IsolationLevel -> ShowS)
-> (IsolationLevel -> String)
-> ([IsolationLevel] -> ShowS)
-> Show IsolationLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsolationLevel] -> ShowS
$cshowList :: [IsolationLevel] -> ShowS
show :: IsolationLevel -> String
$cshow :: IsolationLevel -> String
showsPrec :: Int -> IsolationLevel -> ShowS
$cshowsPrec :: Int -> IsolationLevel -> ShowS
Show, IsolationLevel -> IsolationLevel -> Bool
(IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool) -> Eq IsolationLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsolationLevel -> IsolationLevel -> Bool
$c/= :: IsolationLevel -> IsolationLevel -> Bool
== :: IsolationLevel -> IsolationLevel -> Bool
$c== :: IsolationLevel -> IsolationLevel -> Bool
Eq)

-- | Render an `IsolationLevel`.
instance RenderSQL IsolationLevel where
  renderSQL :: IsolationLevel -> ByteString
renderSQL = \case
    IsolationLevel
Serializable -> ByteString
"SERIALIZABLE"
    IsolationLevel
ReadCommitted -> ByteString
"READ COMMITTED"
    IsolationLevel
ReadUncommitted -> ByteString
"READ UNCOMMITTED"
    IsolationLevel
RepeatableRead -> ByteString
"REPEATABLE READ"

-- | The transaction access mode determines whether the transaction is `ReadWrite` or `ReadOnly`.
-- `ReadWrite` is the default. When a transaction is `ReadOnly`,
-- the following SQL commands are disallowed:
-- @INSERT@, @UPDATE@, @DELETE@, and @COPY FROM@
-- if the table they would write to is not a temporary table;
-- all @CREATE@, @ALTER@, and @DROP@ commands;
-- @COMMENT@, @GRANT@, @REVOKE@, @TRUNCATE@;
-- and @EXPLAIN ANALYZE@ and @EXECUTE@ if the command they would execute is among those listed.
-- This is a high-level notion of `ReadOnly` that does not prevent all writes to disk.
data AccessMode
  = ReadWrite
  | ReadOnly
  deriving (Int -> AccessMode -> ShowS
[AccessMode] -> ShowS
AccessMode -> String
(Int -> AccessMode -> ShowS)
-> (AccessMode -> String)
-> ([AccessMode] -> ShowS)
-> Show AccessMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessMode] -> ShowS
$cshowList :: [AccessMode] -> ShowS
show :: AccessMode -> String
$cshow :: AccessMode -> String
showsPrec :: Int -> AccessMode -> ShowS
$cshowsPrec :: Int -> AccessMode -> ShowS
Show, AccessMode -> AccessMode -> Bool
(AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> Bool) -> Eq AccessMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessMode -> AccessMode -> Bool
$c/= :: AccessMode -> AccessMode -> Bool
== :: AccessMode -> AccessMode -> Bool
$c== :: AccessMode -> AccessMode -> Bool
Eq)

-- | Render an `AccessMode`.
instance RenderSQL AccessMode where
  renderSQL :: AccessMode -> ByteString
renderSQL = \case
    AccessMode
ReadWrite -> ByteString
"READ WRITE"
    AccessMode
ReadOnly -> ByteString
"READ ONLY"

-- | The `Deferrable` transaction property has no effect
-- unless the transaction is also `Serializable` and `ReadOnly`.
-- When all three of these properties are selected for a transaction,
-- the transaction may block when first acquiring its snapshot,
-- after which it is able to run without the normal overhead of a
-- `Serializable` transaction and without any risk of contributing
-- to or being canceled by a serialization failure.
-- This `longRunningMode` is well suited for long-running reports or backups.
data DeferrableMode
  = Deferrable
  | NotDeferrable
  deriving (Int -> DeferrableMode -> ShowS
[DeferrableMode] -> ShowS
DeferrableMode -> String
(Int -> DeferrableMode -> ShowS)
-> (DeferrableMode -> String)
-> ([DeferrableMode] -> ShowS)
-> Show DeferrableMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeferrableMode] -> ShowS
$cshowList :: [DeferrableMode] -> ShowS
show :: DeferrableMode -> String
$cshow :: DeferrableMode -> String
showsPrec :: Int -> DeferrableMode -> ShowS
$cshowsPrec :: Int -> DeferrableMode -> ShowS
Show, DeferrableMode -> DeferrableMode -> Bool
(DeferrableMode -> DeferrableMode -> Bool)
-> (DeferrableMode -> DeferrableMode -> Bool) -> Eq DeferrableMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeferrableMode -> DeferrableMode -> Bool
$c/= :: DeferrableMode -> DeferrableMode -> Bool
== :: DeferrableMode -> DeferrableMode -> Bool
$c== :: DeferrableMode -> DeferrableMode -> Bool
Eq)

-- | Render a `DeferrableMode`.
instance RenderSQL DeferrableMode where
  renderSQL :: DeferrableMode -> ByteString
renderSQL = \case
    DeferrableMode
Deferrable -> ByteString
"DEFERRABLE"
    DeferrableMode
NotDeferrable -> ByteString
"NOT DEFERRABLE"