| 
 Module : Squeal . PostgreSQL.Session . Transaction . Unsafe 
 Description : unsafe transaction control language 
 Copyright : ( c )   , 2019 
 Maintainer :  
 Stability : experimental 

 transaction control language permitting arbitrary ` IO ` 

Module: Squeal.PostgreSQL.Session.Transaction.Unsafe
Description: unsafe transaction control language
Copyright: (c) Eitan Chatav, 2019
Maintainer: 
Stability: experimental

transaction control language permitting arbitrary `IO`
-}

# LANGUAGE 
     DataKinds 
   , FlexibleContexts 
   , LambdaCase 
   , OverloadedStrings 
   , TypeInType 
 #
    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 . 

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 mode tx = mask $ \restore -> do
  manipulate_ $ begin mode
  result <- restore tx `onException` manipulate_ rollback
  manipulate_ commit
  return result

-- | Run a computation `transactionally_`, in `defaultMode`.
transactionally_
  :: (MonadMask tx, MonadPQ db tx)
  => tx x -- ^ run inside a transaction
  -> tx x
transactionally_ = transactionally 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` 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 mode tx = mask $ \restore ->
  loop . try $ do
    x <- restore tx
    manipulate_ commit
    return x
  where
    loop attempt = do
      manipulate_ $ begin mode
      attempt >>= \case
        Left (SerializationFailure _) -> do
          manipulate_ rollback
          loop attempt
        Left (DeadlockDetected _) -> do
          manipulate_ rollback
          loop attempt
        Left err -> do
          manipulate_ rollback
          throwM err
        Right x -> return x

  | ` transactionallyRetry ` in ` retryMode ` .
transactionallyRetry_
  :: (MonadMask tx, MonadPQ db tx)
  => tx x -- ^ run inside a transaction
  -> tx x
transactionallyRetry_ = transactionallyRetry 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 mode tx = mask $ \restore -> do
  manipulate_ $ begin mode
  result <- restore tx `onException` (manipulate_ rollback)
  manipulate_ rollback
  return result

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

-- | @BEGIN@ a transaction.
begin :: TransactionMode -> Manipulation_ db () ()
begin mode = UnsafeManipulation $ "BEGIN" <+> renderSQL mode

-- | @COMMIT@ a transaction.
commit :: Manipulation_ db () ()
commit = UnsafeManipulation "COMMIT"

-- | @ROLLBACK@ a transaction.
rollback :: Manipulation_ db () ()
rollback = UnsafeManipulation "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 savepoint tx = do
  let svpt = "SAVEPOINT" <+> savepoint
  manipulate_ $ UnsafeManipulation $ svpt
  e_x <- tx
  when (isLeft e_x) $
    manipulate_ $ UnsafeManipulation $ "ROLLBACK TO" <+> svpt
  manipulate_ $ UnsafeManipulation $ "RELEASE" <+> svpt
  return e_x

-- | The available transaction characteristics are the transaction `IsolationLevel`,
  the transaction ` AccessMode ` ( ` ReadWrite ` or ` ReadOnly ` ) , and the ` DeferrableMode ` .
data TransactionMode = TransactionMode
  { isolationLevel :: IsolationLevel
  , accessMode  :: AccessMode
  , deferrableMode :: DeferrableMode
  } deriving (Show, Eq)

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

  | ` TransactionMode ` with a ` Serializable ` ` IsolationLevel ` ,
  ` ReadWrite ` ` AccessMode ` and ` NotDeferrable ` ` DeferrableMode ` ,
-- appropriate for short-lived queries or manipulations.
retryMode :: TransactionMode
retryMode = TransactionMode Serializable ReadWrite 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 Serializable ReadOnly Deferrable

  | Render a ` TransactionMode ` .
instance RenderSQL TransactionMode where
  renderSQL mode =
    "ISOLATION LEVEL"
      <+> renderSQL (isolationLevel mode)
      <+> renderSQL (accessMode mode)
      <+> renderSQL (deferrableMode 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.
--
  _ _  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).
--
  _ _  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 (Show, Eq)

-- | Render an `IsolationLevel`.
instance RenderSQL IsolationLevel where
  renderSQL = \case
    Serializable -> "SERIALIZABLE"
    ReadCommitted -> "READ COMMITTED"
    ReadUncommitted -> "READ UNCOMMITTED"
    RepeatableRead -> "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 (Show, Eq)

  | Render an ` AccessMode ` .
instance RenderSQL AccessMode where
  renderSQL = \case
    ReadWrite -> "READ WRITE"
    ReadOnly -> "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 (Show, Eq)

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

 * Transaction
 * Transaction Mode
 ^ run inside a transaction
 | Run a computation `transactionally_`, in `defaultMode`.
 ^ run inside a transaction
 ^ run inside a transaction
 ^ run inside a transaction
 | Run a computation `ephemerally`;
Like `transactionally` but always `rollback`, useful in testing.

 ^ run inside an ephemeral transaction
 | Run a computation `ephemerally` in `defaultMode`. 
 ^ run inside an ephemeral transaction
 | @BEGIN@ a transaction.
 | @COMMIT@ a transaction.
 | @ROLLBACK@ a transaction.
 | `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.

 ^ savepoint name
 | The available transaction characteristics are the transaction `IsolationLevel`,
 appropriate for short-lived queries or manipulations.
 This mode is well suited for long-running reports or backups.
 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.
 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.

 has been modified by another transaction (that committed since the initial read).

 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.

 This is because it is the only sensible way to map the standard isolation levels to
 PostgreSQL's multiversion concurrency control architecture.
 ^ Dirty read is not possible.
 Serialization anomaly is not possible.
 ^ Dirty read is not possible.
 Serialization anomaly is possible.
 ^ Dirty read is not possible.
 Serialization anomaly is possible.
 ^ Dirty read is not possible.
 Serialization anomaly is possible.
 | Render an `IsolationLevel`.
 the following SQL commands are disallowed:
 if the table they would write to is not a temporary table;
 all @CREATE@, @ALTER@, and @DROP@ commands;
 and @EXPLAIN ANALYZE@ and @EXECUTE@ if the command they would execute is among those listed.
 | The `Deferrable` transaction property has no effect
 unless the transaction is also `Serializable` and `ReadOnly`.
 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.
| 
 Module : Squeal . PostgreSQL.Session . Transaction . Unsafe 
 Description : unsafe transaction control language 
 Copyright : ( c )   , 2019 
 Maintainer :  
 Stability : experimental 

 transaction control language permitting arbitrary ` IO ` 

Module: Squeal.PostgreSQL.Session.Transaction.Unsafe
Description: unsafe transaction control language
Copyright: (c) Eitan Chatav, 2019
Maintainer: 
Stability: experimental

transaction control language permitting arbitrary `IO`
-}

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

module Squeal.PostgreSQL.Session.Transaction.Unsafe
    transactionally
  , transactionally_
  , transactionallyRetry
  , transactionallyRetry_
  , ephemerally
  , ephemerally_
  , begin
  , commit
  , rollback
  , withSavepoint
  , 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 . 

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
transactionally mode tx = mask $ \restore -> do
  manipulate_ $ begin mode
  result <- restore tx `onException` manipulate_ rollback
  manipulate_ commit
  return result

transactionally_
  :: (MonadMask tx, MonadPQ db tx)
  -> tx x
transactionally_ = transactionally 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` 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
transactionallyRetry mode tx = mask $ \restore ->
  loop . try $ do
    x <- restore tx
    manipulate_ commit
    return x
  where
    loop attempt = do
      manipulate_ $ begin mode
      attempt >>= \case
        Left (SerializationFailure _) -> do
          manipulate_ rollback
          loop attempt
        Left (DeadlockDetected _) -> do
          manipulate_ rollback
          loop attempt
        Left err -> do
          manipulate_ rollback
          throwM err
        Right x -> return x

  | ` transactionallyRetry ` in ` retryMode ` .
transactionallyRetry_
  :: (MonadMask tx, MonadPQ db tx)
  -> tx x
transactionallyRetry_ = transactionallyRetry retryMode

ephemerally
  :: (MonadMask tx, MonadPQ db tx)
  => TransactionMode
  -> tx x
ephemerally mode tx = mask $ \restore -> do
  manipulate_ $ begin mode
  result <- restore tx `onException` (manipulate_ rollback)
  manipulate_ rollback
  return result

ephemerally_
  :: (MonadMask tx, MonadPQ db tx)
  -> tx x
ephemerally_ = ephemerally defaultMode

begin :: TransactionMode -> Manipulation_ db () ()
begin mode = UnsafeManipulation $ "BEGIN" <+> renderSQL mode

commit :: Manipulation_ db () ()
commit = UnsafeManipulation "COMMIT"

rollback :: Manipulation_ db () ()
rollback = UnsafeManipulation "ROLLBACK"

withSavepoint
  :: MonadPQ db tx
  -> tx (Either e x)
  -> tx (Either e x)
withSavepoint savepoint tx = do
  let svpt = "SAVEPOINT" <+> savepoint
  manipulate_ $ UnsafeManipulation $ svpt
  e_x <- tx
  when (isLeft e_x) $
    manipulate_ $ UnsafeManipulation $ "ROLLBACK TO" <+> svpt
  manipulate_ $ UnsafeManipulation $ "RELEASE" <+> svpt
  return e_x

  the transaction ` AccessMode ` ( ` ReadWrite ` or ` ReadOnly ` ) , and the ` DeferrableMode ` .
data TransactionMode = TransactionMode
  { isolationLevel :: IsolationLevel
  , accessMode  :: AccessMode
  , deferrableMode :: DeferrableMode
  } deriving (Show, Eq)

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

  | ` TransactionMode ` with a ` Serializable ` ` IsolationLevel ` ,
  ` ReadWrite ` ` AccessMode ` and ` NotDeferrable ` ` DeferrableMode ` ,
retryMode :: TransactionMode
retryMode = TransactionMode Serializable ReadWrite NotDeferrable

  | ` TransactionMode ` with a ` Serializable ` ` IsolationLevel ` ,
  ` ReadOnly ` ` AccessMode ` and ` Deferrable ` ` DeferrableMode ` .
longRunningMode :: TransactionMode
longRunningMode = TransactionMode Serializable ReadOnly Deferrable

  | Render a ` TransactionMode ` .
instance RenderSQL TransactionMode where
  renderSQL mode =
    "ISOLATION LEVEL"
      <+> renderSQL (isolationLevel mode)
      <+> renderSQL (accessMode mode)
      <+> renderSQL (deferrableMode mode)

  | The SQL standard defines four levels of transaction isolation .
  The other three levels are defined in terms of phenomena , resulting from interaction
  _ _  read _ _ : A transaction re - reads data it has previously read and finds that data
  _ _  read _ _ : A transaction re - executes a query returning a set of rows that satisfy
  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 ` .
data IsolationLevel
  = Serializable
  Nonrepeatable read is not possible .
  Phantom read is not possible .
  | RepeatableRead
  Nonrepeatable read is not possible .
  Phantom read is not possible .
  | ReadCommitted
  Nonrepeatable read is possible .
  Phantom read is possible .
  | ReadUncommitted
  Nonrepeatable read is possible .
  Phantom read is possible .
  deriving (Show, Eq)

instance RenderSQL IsolationLevel where
  renderSQL = \case
    Serializable -> "SERIALIZABLE"
    ReadCommitted -> "READ COMMITTED"
    ReadUncommitted -> "READ UNCOMMITTED"
    RepeatableRead -> "REPEATABLE READ"

  | The transaction access mode determines whether the transaction is ` ReadWrite ` or ` ReadOnly ` .
  ` ReadWrite ` is the default . When a transaction is ` ReadOnly ` ,
  @INSERT@ , @UPDATE@ , @DELETE@ , and @COPY FROM@
  @COMMENT@ , @GRANT@ , @REVOKE@ , @TRUNCATE@ ;
  This is a high - level notion of ` ReadOnly ` that does not prevent all writes to disk .
data AccessMode
  = ReadWrite
  | ReadOnly
  deriving (Show, Eq)

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

  When all three of these properties are selected for a transaction ,
  the transaction may block when first acquiring its snapshot ,
data DeferrableMode
  = Deferrable
  | NotDeferrable
  deriving (Show, Eq)

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