module Hasql.Engine.Contexts.Session where

import Hasql.Codecs.Encoders.Params qualified as Params
import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip
import Hasql.Engine.Contexts.Pipeline qualified as Pipeline
import Hasql.Engine.Decoders.Result qualified as Decoders.Result
import Hasql.Engine.Errors qualified as Errors
import Hasql.Engine.Structures.ConnectionState qualified as ConnectionState
import Hasql.Platform.Prelude
import Hasql.Pq qualified as Pq

-- |
-- A sequence of operations to be executed in the context of a single database connection with exclusive access to it.
--
-- Construct sessions using helpers in this module such as
-- 'statement', 'pipeline' and 'script', or use 'onLibpqConnection' for a low-level
-- escape hatch.
--
-- To actually execute a 'Session' use 'Hasql.Connection.use', which manages
-- concurrent access to the shared connection state and returns either a
-- 'Errors.SessionError' or the result:
--
-- > result <- Hasql.Connection.use connection mySession
--
-- Note: while most session errors are returned as values, user code executed
-- inside a session may still throw exceptions; in that case the driver will
-- reset the connection to a clean state.
newtype Session a
  = Session (ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState))
  deriving
    ((forall a b. (a -> b) -> Session a -> Session b)
-> (forall a b. a -> Session b -> Session a) -> Functor Session
forall a b. a -> Session b -> Session a
forall a b. (a -> b) -> Session a -> Session 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) -> Session a -> Session b
fmap :: forall a b. (a -> b) -> Session a -> Session b
$c<$ :: forall a b. a -> Session b -> Session a
<$ :: forall a b. a -> Session b -> Session a
Functor, Functor Session
Functor Session =>
(forall a. a -> Session a)
-> (forall a b. Session (a -> b) -> Session a -> Session b)
-> (forall a b c.
    (a -> b -> c) -> Session a -> Session b -> Session c)
-> (forall a b. Session a -> Session b -> Session b)
-> (forall a b. Session a -> Session b -> Session a)
-> Applicative Session
forall a. a -> Session a
forall a b. Session a -> Session b -> Session a
forall a b. Session a -> Session b -> Session b
forall a b. Session (a -> b) -> Session a -> Session b
forall a b c. (a -> b -> c) -> Session a -> Session b -> Session 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 -> Session a
pure :: forall a. a -> Session a
$c<*> :: forall a b. Session (a -> b) -> Session a -> Session b
<*> :: forall a b. Session (a -> b) -> Session a -> Session b
$cliftA2 :: forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
liftA2 :: forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
$c*> :: forall a b. Session a -> Session b -> Session b
*> :: forall a b. Session a -> Session b -> Session b
$c<* :: forall a b. Session a -> Session b -> Session a
<* :: forall a b. Session a -> Session b -> Session a
Applicative, Applicative Session
Applicative Session =>
(forall a b. Session a -> (a -> Session b) -> Session b)
-> (forall a b. Session a -> Session b -> Session b)
-> (forall a. a -> Session a)
-> Monad Session
forall a. a -> Session a
forall a b. Session a -> Session b -> Session b
forall a b. Session a -> (a -> Session b) -> Session 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. Session a -> (a -> Session b) -> Session b
>>= :: forall a b. Session a -> (a -> Session b) -> Session b
$c>> :: forall a b. Session a -> Session b -> Session b
>> :: forall a b. Session a -> Session b -> Session b
$creturn :: forall a. a -> Session a
return :: forall a. a -> Session a
Monad, MonadError Errors.SessionError, Monad Session
Monad Session => (forall a. IO a -> Session a) -> MonadIO Session
forall a. IO a -> Session a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Session a
liftIO :: forall a. IO a -> Session a
MonadIO)
    via (ExceptT Errors.SessionError (StateT ConnectionState.ConnectionState IO))

run :: Session a -> ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState)
run :: forall a.
Session a
-> ConnectionState -> IO (Either SessionError a, ConnectionState)
run (Session ConnectionState -> IO (Either SessionError a, ConnectionState)
session) ConnectionState
connectionState = ConnectionState -> IO (Either SessionError a, ConnectionState)
session ConnectionState
connectionState

-- |
-- Possibly a multi-statement query,
-- which however cannot be parameterized or prepared,
-- nor can any results of it be collected.
script :: ByteString -> Session ()
script :: ByteString -> Session ()
script ByteString
sql =
  (ConnectionState -> IO (Either SessionError (), ConnectionState))
-> Session ()
forall a.
(ConnectionState -> IO (Either SessionError a, ConnectionState))
-> Session a
Session \ConnectionState
connectionState -> do
    let connection :: Connection
connection = ConnectionState -> Connection
ConnectionState.connection ConnectionState
connectionState
    Either (Error (Maybe ByteString)) ()
result <- Roundtrip (Maybe ByteString) ()
-> Connection -> IO (Either (Error (Maybe ByteString)) ())
forall context a.
Roundtrip context a -> Connection -> IO (Either (Error context) a)
Comms.Roundtrip.toSerialIO (Maybe ByteString -> ByteString -> Roundtrip (Maybe ByteString) ()
forall context. context -> ByteString -> Roundtrip context ()
Comms.Roundtrip.script (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
sql) ByteString
sql) Connection
connection
    case Either (Error (Maybe ByteString)) ()
result of
      Left Error (Maybe ByteString)
err -> case Error (Maybe ByteString)
err of
        Comms.Roundtrip.ClientError Maybe ByteString
_ Maybe ByteString
details -> do
          (Either SessionError (), ConnectionState)
-> IO (Either SessionError (), ConnectionState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( SessionError -> Either SessionError ()
forall a b. a -> Either a b
Left (Text -> SessionError
Errors.ConnectionSessionError (Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ByteString -> Text
decodeUtf8Lenient Maybe ByteString
details)),
              ConnectionState
connectionState
            )
        Comms.Roundtrip.ServerError Error (Maybe ByteString)
recvError ->
          (Either SessionError (), ConnectionState)
-> IO (Either SessionError (), ConnectionState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( SessionError -> Either SessionError ()
forall a b. a -> Either a b
Left (ByteString -> Error (Maybe ByteString) -> SessionError
Errors.fromRecvErrorInScript ByteString
sql Error (Maybe ByteString)
recvError),
              ConnectionState
connectionState
            )
      Right () ->
        (Either SessionError (), ConnectionState)
-> IO (Either SessionError (), ConnectionState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( () -> Either SessionError ()
forall a b. b -> Either a b
Right (),
            ConnectionState
connectionState
          )

-- |
-- Execute a statement by providing parameters to it.
statement ::
  ByteString ->
  Params.Params params ->
  Decoders.Result.Result result ->
  Bool ->
  params ->
  Session result
statement :: forall params result.
ByteString
-> Params params
-> Result result
-> Bool
-> params
-> Session result
statement ByteString
sql Params params
paramsEncoder Result result
decoder Bool
preparable params
params =
  Pipeline result -> Session result
forall result. Pipeline result -> Session result
pipeline (ByteString
-> Params params
-> Result result
-> Bool
-> params
-> Pipeline result
forall params result.
ByteString
-> Params params
-> Result result
-> Bool
-> params
-> Pipeline result
Pipeline.statement ByteString
sql Params params
paramsEncoder Result result
decoder Bool
preparable params
params)

-- |
-- Execute a pipeline.
pipeline :: Pipeline.Pipeline result -> Session result
pipeline :: forall result. Pipeline result -> Session result
pipeline Pipeline result
pipeline = (ConnectionState
 -> IO (Either SessionError result, ConnectionState))
-> Session result
forall a.
(ConnectionState -> IO (Either SessionError a, ConnectionState))
-> Session a
Session \ConnectionState
connectionState -> do
  let usePreparedStatements :: Bool
usePreparedStatements = ConnectionState -> Bool
ConnectionState.preparedStatements ConnectionState
connectionState
      statementCache :: StatementCache
statementCache = ConnectionState -> StatementCache
ConnectionState.statementCache ConnectionState
connectionState
      oidCache :: OidCache
oidCache = ConnectionState -> OidCache
ConnectionState.oidCache ConnectionState
connectionState
      pqConnection :: Connection
pqConnection = ConnectionState -> Connection
ConnectionState.connection ConnectionState
connectionState
   in do
        (Either SessionError result
result, OidCache
newOidCache, StatementCache
newStatementCache) <- Pipeline result
-> Bool
-> Connection
-> OidCache
-> StatementCache
-> IO (Either SessionError result, OidCache, StatementCache)
forall a.
Pipeline a
-> Bool
-> Connection
-> OidCache
-> StatementCache
-> IO (Either SessionError a, OidCache, StatementCache)
Pipeline.run Pipeline result
pipeline Bool
usePreparedStatements Connection
pqConnection OidCache
oidCache StatementCache
statementCache
        let newConnectionState :: ConnectionState
newConnectionState =
              ConnectionState
connectionState
                { ConnectionState.oidCache = newOidCache,
                  ConnectionState.statementCache = newStatementCache
                }

        (Either SessionError result, ConnectionState)
-> IO (Either SessionError result, ConnectionState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SessionError result
result, ConnectionState
newConnectionState)

-- |
-- Execute an operation on the raw libpq connection possibly producing an error and updating the connection.
-- This is a low-level escape hatch for custom integrations.
--
-- You can supply a new connection in the result to replace it in the running Hasql connection.
-- The responsibility to close the old libpq connection is on you.
-- Otherwise, just return the same connection you've received.
--
-- Producing a 'Left' value will cause the session to fail with the given error.
-- Regardless of success or failure, the connection will be replaced with the one you return.
--
-- Throwing exceptions is okay. It will lead to the connection getting reset.
onLibpqConnection ::
  (Pq.Connection -> IO (Either Errors.SessionError a, Pq.Connection)) ->
  Session a
onLibpqConnection :: forall a.
(Connection -> IO (Either SessionError a, Connection)) -> Session a
onLibpqConnection Connection -> IO (Either SessionError a, Connection)
f = (ConnectionState -> IO (Either SessionError a, ConnectionState))
-> Session a
forall a.
(ConnectionState -> IO (Either SessionError a, ConnectionState))
-> Session a
Session \ConnectionState
connectionState -> do
  let pqConnection :: Connection
pqConnection = ConnectionState -> Connection
ConnectionState.connection ConnectionState
connectionState
  (Either SessionError a
result, Connection
newConnection) <- Connection -> IO (Either SessionError a, Connection)
f Connection
pqConnection
  let newState :: ConnectionState
newState = Connection -> ConnectionState -> ConnectionState
ConnectionState.setConnection Connection
newConnection ConnectionState
connectionState
  (Either SessionError a, ConnectionState)
-> IO (Either SessionError a, ConnectionState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SessionError a
result, ConnectionState
newState)