{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}

module Database.PostgreSQL.Pure.Internal.Query
  ( -- * Extended Query
    parse
  , Bind (..)
  , Execute (..)
  , flush
  , sync
  , Message (..)
  , Close (..)
    -- * Transaction
  , begin
  , commit
  , rollback
  ) where

import qualified Database.PostgreSQL.Pure.Internal.Builder   as Builder
import           Database.PostgreSQL.Pure.Internal.Data      (BackendParameters,
                                                              BindParameterFormatCodes (BindParameterFormatCodesAll),
                                                              BindResultFormatCodes (BindResultFormatCodesEach),
                                                              CloseProcedure (CloseProcedure),
                                                              ColumnInfo (ColumnInfo, formatCode),
                                                              CommandComplete (CommandComplete),
                                                              Connection (Connection, config, receptionBuffer, sendingBuffer, socket),
                                                              DataRow (DataRow), ErrorFields,
                                                              ExecuteResult (ExecuteComplete, ExecuteEmptyQuery, ExecuteSuspended),
                                                              Executed (Executed),
                                                              ExecutedProcedure (ExecutedProcedure),
                                                              FormatCode (BinaryFormat), FromRecord, MessageResult,
                                                              Notice (Notice), Oid,
                                                              ParameterDescription (ParameterDescription),
                                                              Portal (Portal), PortalName,
                                                              PortalProcedure (PortalProcedure),
                                                              PreparedStatement (PreparedStatement),
                                                              PreparedStatementName,
                                                              PreparedStatementProcedure (PreparedStatementProcedure),
                                                              Query, ReadyForQuery (ReadyForQuery),
                                                              RowDescription (RowDescription), StringDecoder,
                                                              StringEncoder, ToRecord (toRecord), TransactionState,
                                                              TypeLength (FixedLength))
import qualified Database.PostgreSQL.Pure.Internal.Data      as Data
import qualified Database.PostgreSQL.Pure.Internal.Exception as Exception
import qualified Database.PostgreSQL.Pure.Internal.Parser    as Parser
import           Database.PostgreSQL.Pure.Internal.SocketIO  (buildAndSend, receive, runSocketIO, send)

import           Control.Applicative                         ((<|>))
import           Control.Exception.Safe                      (throw, try)
import           Control.Monad                               (void, when)
import           Control.Monad.State.Strict                  (put)
import qualified Data.Attoparsec.ByteString                  as AP
import qualified Data.Attoparsec.Combinator                  as AP
import qualified Data.ByteString.Builder                     as BSB
import qualified Data.ByteString.Char8                       as BSC
import           Data.Functor                                (($>))
import           Data.List                                   (genericLength)
import           GHC.Records                                 (HasField (getField))

#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail                          (MonadFail)
#endif

-- | To get the procedure to build the message of parsing SQL query and to parse its response.
parse
  :: PreparedStatementName -- ^ A new name of prepared statement.
  -> Query -- ^ SQL whose placeholder style is dollar style.
  -> Either (Word, Word) ([Oid], [Oid]) -- ^ A pair of the number of columns of the parameter and the result,
                                        -- or a pair of the list of OIDs of the parameter and the result.
                                        -- On 'Left' an additional pair of a request and a response is necessary.
  -> PreparedStatementProcedure
parse :: PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
parse PreparedStatementName
name Query
query (Left (Word
parameterLength, Word
resultLength)) = PreparedStatementName
-> Query
-> Word
-> Word
-> Maybe ([Oid], [Oid])
-> PreparedStatementProcedure
parse' PreparedStatementName
name Query
query Word
parameterLength Word
resultLength Maybe ([Oid], [Oid])
forall a. Maybe a
Nothing
parse PreparedStatementName
name Query
query (Right oids :: ([Oid], [Oid])
oids@([Oid]
parameterOids, [Oid]
resultOids)) = PreparedStatementName
-> Query
-> Word
-> Word
-> Maybe ([Oid], [Oid])
-> PreparedStatementProcedure
parse' PreparedStatementName
name Query
query ([Oid] -> Word
forall i a. Num i => [a] -> i
genericLength [Oid]
parameterOids) ([Oid] -> Word
forall i a. Num i => [a] -> i
genericLength [Oid]
resultOids) (([Oid], [Oid]) -> Maybe ([Oid], [Oid])
forall a. a -> Maybe a
Just ([Oid], [Oid])
oids)

parse' :: PreparedStatementName -> Query -> Word -> Word -> Maybe ([Oid], [Oid]) -> PreparedStatementProcedure
parse' :: PreparedStatementName
-> Query
-> Word
-> Word
-> Maybe ([Oid], [Oid])
-> PreparedStatementProcedure
parse' PreparedStatementName
name Query
query Word
parameterLength Word
resultLength Maybe ([Oid], [Oid])
oids =
  let
    inaneColumnInfo :: Oid -> ColumnInfo
inaneColumnInfo Oid
oid = ByteString
-> Oid
-> AttributeNumber
-> Oid
-> TypeLength
-> TypeModifier
-> FormatCode
-> ColumnInfo
ColumnInfo ByteString
"" Oid
0 AttributeNumber
0 Oid
oid (AttributeNumber -> TypeLength
FixedLength AttributeNumber
0) TypeModifier
0 FormatCode
BinaryFormat
    parameterOids :: Maybe [Oid]
parameterOids = ([Oid], [Oid]) -> [Oid]
forall a b. (a, b) -> a
fst (([Oid], [Oid]) -> [Oid]) -> Maybe ([Oid], [Oid]) -> Maybe [Oid]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Oid], [Oid])
oids
    builder :: Builder
builder =
      case Maybe ([Oid], [Oid])
oids of
        Just ([Oid]
parameterOids, [Oid]
_) -> PreparedStatementName -> Query -> [Oid] -> Builder
Builder.parse PreparedStatementName
name Query
query [Oid]
parameterOids
        Maybe ([Oid], [Oid])
_                       -> PreparedStatementName -> Query -> [Oid] -> Builder
Builder.parse PreparedStatementName
name Query
query [] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PreparedStatementName -> Builder
Builder.describePreparedStatement PreparedStatementName
name
    parser :: Parser ByteString PreparedStatement
parser = do
      Parser ()
Parser.parseComplete
      ([Oid]
parameterOids, [ColumnInfo]
resultInfos) <-
        case Maybe ([Oid], [Oid])
oids of
          Just ([Oid]
parameterOids, [Oid]
resultOids) -> ([Oid], [ColumnInfo]) -> Parser ByteString ([Oid], [ColumnInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Oid]
parameterOids, Oid -> ColumnInfo
inaneColumnInfo (Oid -> ColumnInfo) -> [Oid] -> [ColumnInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Oid]
resultOids)
          Maybe ([Oid], [Oid])
_ -> do
            ParameterDescription [Oid]
parameterOids <- Parser ParameterDescription
Parser.parameterDescription
            [ColumnInfo]
resultInfos <-
              [Parser ByteString [ColumnInfo]] -> Parser ByteString [ColumnInfo]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AP.choice
                [ do
                    RowDescription [ColumnInfo]
infos <- Parser RowDescription
Parser.rowDescription
                    [ColumnInfo] -> Parser ByteString [ColumnInfo]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ColumnInfo]
infos
                , Parser ()
Parser.noData Parser () -> [ColumnInfo] -> Parser ByteString [ColumnInfo]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []
                ]
            ([Oid], [ColumnInfo]) -> Parser ByteString ([Oid], [ColumnInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Oid]
parameterOids, [ColumnInfo]
resultInfos)
      PreparedStatement -> Parser ByteString PreparedStatement
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreparedStatement -> Parser ByteString PreparedStatement)
-> PreparedStatement -> Parser ByteString PreparedStatement
forall a b. (a -> b) -> a -> b
$ PreparedStatementName -> [Oid] -> [ColumnInfo] -> PreparedStatement
PreparedStatement PreparedStatementName
name [Oid]
parameterOids [ColumnInfo]
resultInfos
  in PreparedStatementName
-> Word
-> Word
-> Maybe [Oid]
-> Builder
-> Parser (MessageResult PreparedStatementProcedure)
-> PreparedStatementProcedure
PreparedStatementProcedure PreparedStatementName
name Word
parameterLength Word
resultLength Maybe [Oid]
parameterOids Builder
builder Parser ByteString PreparedStatement
Parser (MessageResult PreparedStatementProcedure)
parser

-- | This means that @ps@ is a objective of 'bind'.
class Bind ps where
  -- | To get the procedure to build the message of binding the parameter and to parse its response.
  bind
    :: (ToRecord param, MonadFail m)
    => PortalName -- ^ A new name of portal.
    -> FormatCode -- ^ Binary format or text format for the parameter.
    -> FormatCode -- ^ Binary format or text format for the results.
    -> BackendParameters -- ^ The set of the server parameters.
    -> StringEncoder -- ^ How to encode strings.
    -> param -- ^ Parameter for this query.
    -> ps -- ^ Prepared statement.
    -> m PortalProcedure

instance Bind PreparedStatement where
  bind :: PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> PreparedStatement
-> m PortalProcedure
bind PortalName
name FormatCode
parameterFormat FormatCode
resultFormat BackendParameters
backendParams StringEncoder
encode param
parameters ps :: PreparedStatement
ps@(PreparedStatement PreparedStatementName
psName [Oid]
psParameterOids [ColumnInfo]
psResultInfos) = do
    [Maybe ByteString]
record <- BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> param
-> m [Maybe ByteString]
forall a (m :: * -> *).
(ToRecord a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> a
-> m [Maybe ByteString]
toRecord BackendParameters
backendParams StringEncoder
encode ([Oid] -> Maybe [Oid]
forall a. a -> Maybe a
Just [Oid]
psParameterOids) (Int -> FormatCode -> [FormatCode]
forall a. Int -> a -> [a]
replicate ([Oid] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Oid]
psParameterOids) FormatCode
parameterFormat) param
parameters
    let
      builder :: Builder
builder = PortalName
-> PreparedStatementName
-> BindParameterFormatCodes
-> [Maybe ByteString]
-> BindResultFormatCodes
-> Builder
Builder.bind PortalName
name PreparedStatementName
psName (FormatCode -> BindParameterFormatCodes
BindParameterFormatCodesAll FormatCode
parameterFormat) [Maybe ByteString]
record ([FormatCode] -> BindResultFormatCodes
BindResultFormatCodesEach ([FormatCode] -> BindResultFormatCodes)
-> [FormatCode] -> BindResultFormatCodes
forall a b. (a -> b) -> a -> b
$ Int -> FormatCode -> [FormatCode]
forall a. Int -> a -> [a]
replicate ([ColumnInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColumnInfo]
psResultInfos) FormatCode
resultFormat)
      parser :: Parser ByteString (PreparedStatement, Portal)
parser = do
        Parser ()
Parser.bindComplete
        (PreparedStatement, Portal)
-> Parser ByteString (PreparedStatement, Portal)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreparedStatement
ps, PortalName -> [ColumnInfo] -> PreparedStatement -> Portal
Portal PortalName
name ((\ColumnInfo
i -> ColumnInfo
i { $sel:formatCode:ColumnInfo :: FormatCode
formatCode = FormatCode
resultFormat }) (ColumnInfo -> ColumnInfo) -> [ColumnInfo] -> [ColumnInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnInfo]
psResultInfos) PreparedStatement
ps)
    PortalProcedure -> m PortalProcedure
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PortalProcedure -> m PortalProcedure)
-> PortalProcedure -> m PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> Builder
-> Parser (MessageResult PortalProcedure)
-> PortalProcedure
PortalProcedure PortalName
name FormatCode
resultFormat Builder
builder Parser ByteString (PreparedStatement, Portal)
Parser (MessageResult PortalProcedure)
parser

instance Bind PreparedStatementProcedure where
  bind :: PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> PreparedStatementProcedure
-> m PortalProcedure
bind PortalName
name FormatCode
parameterFormat FormatCode
resultFormat BackendParameters
backendParams StringEncoder
encode param
parameters (PreparedStatementProcedure PreparedStatementName
psName Word
psParameterLength Word
psResultLength Maybe [Oid]
psParameterOids Builder
psBuilder Parser (MessageResult PreparedStatementProcedure)
psParser) = do
    [Maybe ByteString]
record <- BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> param
-> m [Maybe ByteString]
forall a (m :: * -> *).
(ToRecord a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> a
-> m [Maybe ByteString]
toRecord BackendParameters
backendParams StringEncoder
encode Maybe [Oid]
psParameterOids (Int -> FormatCode -> [FormatCode]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
psParameterLength) FormatCode
parameterFormat) param
parameters
    let
      builder :: Builder
builder =
        Builder
psBuilder
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PortalName
-> PreparedStatementName
-> BindParameterFormatCodes
-> [Maybe ByteString]
-> BindResultFormatCodes
-> Builder
Builder.bind PortalName
name PreparedStatementName
psName (FormatCode -> BindParameterFormatCodes
BindParameterFormatCodesAll FormatCode
parameterFormat) [Maybe ByteString]
record ([FormatCode] -> BindResultFormatCodes
BindResultFormatCodesEach ([FormatCode] -> BindResultFormatCodes)
-> [FormatCode] -> BindResultFormatCodes
forall a b. (a -> b) -> a -> b
$ Int -> FormatCode -> [FormatCode]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
psResultLength) FormatCode
resultFormat)
      parser :: Parser ByteString (PreparedStatement, Portal)
parser = do
        ps :: PreparedStatement
ps@PreparedStatement { [ColumnInfo]
$sel:resultInfos:PreparedStatement :: PreparedStatement -> [ColumnInfo]
resultInfos :: [ColumnInfo]
resultInfos } <- Parser ByteString PreparedStatement
Parser (MessageResult PreparedStatementProcedure)
psParser
        Parser ()
Parser.bindComplete
        (PreparedStatement, Portal)
-> Parser ByteString (PreparedStatement, Portal)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreparedStatement
ps, PortalName -> [ColumnInfo] -> PreparedStatement -> Portal
Portal PortalName
name ((\ColumnInfo
i -> ColumnInfo
i { $sel:formatCode:ColumnInfo :: FormatCode
formatCode = FormatCode
resultFormat }) (ColumnInfo -> ColumnInfo) -> [ColumnInfo] -> [ColumnInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnInfo]
resultInfos) PreparedStatement
ps)
    PortalProcedure -> m PortalProcedure
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PortalProcedure -> m PortalProcedure)
-> PortalProcedure -> m PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> Builder
-> Parser (MessageResult PortalProcedure)
-> PortalProcedure
PortalProcedure PortalName
name FormatCode
resultFormat Builder
builder Parser ByteString (PreparedStatement, Portal)
Parser (MessageResult PortalProcedure)
parser

-- | This means that @p@ is a objective of 'execute'.
class Execute p where
  -- | To get the procedure to build the message of execution and to parse its response.
  execute
    :: FromRecord result
    => Word -- ^ How many records to get. “0” means unlimited.
    -> StringDecoder -- ^ How to decode strings.
    -> p -- ^ Portal.
    -> ExecutedProcedure result

instance Execute Portal where
  execute :: Word -> StringDecoder -> Portal -> ExecutedProcedure result
execute Word
rowLimit StringDecoder
decode p :: Portal
p@(Portal PortalName
pName [ColumnInfo]
pInfos ps :: PreparedStatement
ps@PreparedStatement {}) =
    let
      builder :: Builder
builder = PortalName -> Int -> Builder
Builder.execute PortalName
pName (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
rowLimit
      parser :: Parser
  (PreparedStatement, Portal, Executed result, Maybe ErrorFields)
parser = PreparedStatement
-> Portal
-> [ColumnInfo]
-> StringDecoder
-> Parser
     (PreparedStatement, Portal, Executed result, Maybe ErrorFields)
forall r.
FromRecord r =>
PreparedStatement
-> Portal
-> [ColumnInfo]
-> StringDecoder
-> Parser
     (PreparedStatement, Portal, Executed r, Maybe ErrorFields)
executeParser PreparedStatement
ps Portal
p [ColumnInfo]
pInfos StringDecoder
decode
    in Builder
-> Parser (MessageResult (ExecutedProcedure result))
-> ExecutedProcedure result
forall r.
Builder
-> Parser (MessageResult (ExecutedProcedure r))
-> ExecutedProcedure r
ExecutedProcedure Builder
builder Parser
  (PreparedStatement, Portal, Executed result, Maybe ErrorFields)
Parser (MessageResult (ExecutedProcedure result))
parser

instance Execute PortalProcedure where
  execute :: Word
-> StringDecoder -> PortalProcedure -> ExecutedProcedure result
execute Word
rowLimit StringDecoder
decode (PortalProcedure PortalName
pName FormatCode
pFormat Builder
pBuilder Parser (MessageResult PortalProcedure)
pParser) =
    let
      builder :: Builder
builder = Builder
pBuilder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PortalName -> Int -> Builder
Builder.execute PortalName
pName (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
rowLimit)
      parser :: Parser
  ByteString
  (PreparedStatement, Portal, Executed result, Maybe ErrorFields)
parser = do
        (ps :: PreparedStatement
ps@(PreparedStatement PreparedStatementName
_ [Oid]
_ [ColumnInfo]
psInfos), Portal
p) <- Parser ByteString (PreparedStatement, Portal)
Parser (MessageResult PortalProcedure)
pParser
        PreparedStatement
-> Portal
-> [ColumnInfo]
-> StringDecoder
-> Parser
     ByteString
     (PreparedStatement, Portal, Executed result, Maybe ErrorFields)
forall r.
FromRecord r =>
PreparedStatement
-> Portal
-> [ColumnInfo]
-> StringDecoder
-> Parser
     (PreparedStatement, Portal, Executed r, Maybe ErrorFields)
executeParser PreparedStatement
ps Portal
p ((\ColumnInfo
i -> ColumnInfo
i { $sel:formatCode:ColumnInfo :: FormatCode
formatCode = FormatCode
pFormat }) (ColumnInfo -> ColumnInfo) -> [ColumnInfo] -> [ColumnInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnInfo]
psInfos) StringDecoder
decode
    in Builder
-> Parser (MessageResult (ExecutedProcedure result))
-> ExecutedProcedure result
forall r.
Builder
-> Parser (MessageResult (ExecutedProcedure r))
-> ExecutedProcedure r
ExecutedProcedure Builder
builder Parser
  ByteString
  (PreparedStatement, Portal, Executed result, Maybe ErrorFields)
Parser (MessageResult (ExecutedProcedure result))
parser

executeParser :: forall r. FromRecord r => PreparedStatement -> Portal -> [ColumnInfo] -> StringDecoder -> AP.Parser (PreparedStatement, Portal, Executed r, Maybe ErrorFields)
executeParser :: PreparedStatement
-> Portal
-> [ColumnInfo]
-> StringDecoder
-> Parser
     (PreparedStatement, Portal, Executed r, Maybe ErrorFields)
executeParser PreparedStatement
ps Portal
p [ColumnInfo]
infos StringDecoder
decode = do
  [r]
records <- ((\(DataRow r
d) -> r
d) (DataRow r -> r) -> [DataRow r] -> [r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([DataRow r] -> [r])
-> Parser ByteString [DataRow r] -> Parser ByteString [r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (DataRow r) -> Parser ByteString [DataRow r]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
AP.many' (StringDecoder -> [ColumnInfo] -> Parser ByteString (DataRow r)
forall r.
FromRecord r =>
StringDecoder -> [ColumnInfo] -> Parser (DataRow r)
Parser.dataRow StringDecoder
decode [ColumnInfo]
infos)
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([r] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [r]
records) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
    -- detect whether no "data row" responses or value parsing failure
    Bool
r <- Bool -> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AP.option Bool
False (Parser ByteString Bool -> Parser ByteString Bool)
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b. (a -> b) -> a -> b
$ Parser ByteString DataRowRaw -> Parser ByteString DataRowRaw
forall i a. Parser i a -> Parser i a
AP.lookAhead Parser ByteString DataRowRaw
Parser.dataRowRaw Parser ByteString DataRowRaw
-> Parser ByteString Bool -> Parser ByteString Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
r (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
      -- get detailed error
      Parser ByteString (DataRow r) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StringDecoder -> [ColumnInfo] -> Parser ByteString (DataRow r)
forall r.
FromRecord r =>
StringDecoder -> [ColumnInfo] -> Parser (DataRow r)
Parser.dataRow StringDecoder
decode [ColumnInfo]
infos :: AP.Parser (DataRow r))
      String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"can't reach here"
  Maybe ErrorFields
err <- Maybe ErrorFields
-> Parser ByteString (Maybe ErrorFields)
-> Parser ByteString (Maybe ErrorFields)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AP.option Maybe ErrorFields
forall a. Maybe a
Nothing (Parser ByteString (Maybe ErrorFields)
 -> Parser ByteString (Maybe ErrorFields))
-> Parser ByteString (Maybe ErrorFields)
-> Parser ByteString (Maybe ErrorFields)
forall a b. (a -> b) -> a -> b
$ (\(Notice ErrorFields
err) -> ErrorFields -> Maybe ErrorFields
forall a. a -> Maybe a
Just ErrorFields
err) (Notice -> Maybe ErrorFields)
-> Parser ByteString Notice
-> Parser ByteString (Maybe ErrorFields)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Notice
Parser.notice
  ExecuteResult
result <-
    ((\(CommandComplete CommandTag
tag) -> CommandTag -> ExecuteResult
ExecuteComplete CommandTag
tag) (CommandComplete -> ExecuteResult)
-> Parser ByteString CommandComplete
-> Parser ByteString ExecuteResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString CommandComplete
Parser.commandComplete)
    Parser ByteString ExecuteResult
-> Parser ByteString ExecuteResult
-> Parser ByteString ExecuteResult
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
Parser.emptyQuery Parser ()
-> Parser ByteString ExecuteResult
-> Parser ByteString ExecuteResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExecuteResult -> Parser ByteString ExecuteResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExecuteResult
ExecuteEmptyQuery)
    Parser ByteString ExecuteResult
-> Parser ByteString ExecuteResult
-> Parser ByteString ExecuteResult
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
Parser.portalSuspended Parser ()
-> Parser ByteString ExecuteResult
-> Parser ByteString ExecuteResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExecuteResult -> Parser ByteString ExecuteResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExecuteResult
ExecuteSuspended)
  (PreparedStatement, Portal, Executed r, Maybe ErrorFields)
-> Parser
     (PreparedStatement, Portal, Executed r, Maybe ErrorFields)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreparedStatement
ps, Portal
p, ExecuteResult -> [r] -> Portal -> Executed r
forall r. ExecuteResult -> [r] -> Portal -> Executed r
Executed ExecuteResult
result [r]
records Portal
p, Maybe ErrorFields
err)

-- | This means that @p@ is a objective of 'close'.
class Close p where
  -- | To build and send the “Close” message and to receive and parse its response.
  close :: p -> CloseProcedure

instance Close PreparedStatement where
  close :: PreparedStatement -> CloseProcedure
close PreparedStatement
p = Builder -> Parser (MessageResult CloseProcedure) -> CloseProcedure
CloseProcedure (PreparedStatementName -> Builder
Builder.closePreparedStatement (PreparedStatementName -> Builder)
-> PreparedStatementName -> Builder
forall a b. (a -> b) -> a -> b
$ PreparedStatement -> PreparedStatementName
forall k (x :: k) r a. HasField x r a => r -> a
getField @"name" PreparedStatement
p) Parser ()
Parser (MessageResult CloseProcedure)
Parser.closeComplete

instance Close Portal where
  close :: Portal -> CloseProcedure
close Portal
p = Builder -> Parser (MessageResult CloseProcedure) -> CloseProcedure
CloseProcedure (PortalName -> Builder
Builder.closePortal (PortalName -> Builder) -> PortalName -> Builder
forall a b. (a -> b) -> a -> b
$ Portal -> PortalName
forall k (x :: k) r a. HasField x r a => r -> a
getField @"name" Portal
p) Parser ()
Parser (MessageResult CloseProcedure)
Parser.closeComplete

-- | This means that @r@ is a objective of 'flush' and 'sync'.
class Message m where
  builder :: m -> BSB.Builder
  default builder :: HasField "builder" m BSB.Builder => m -> BSB.Builder
  builder = forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "builder" r a => r -> a
getField @"builder"

  parser :: m -> AP.Parser (MessageResult m)
  default parser :: HasField "parser" m (AP.Parser (MessageResult m)) => m -> AP.Parser (MessageResult m)
  parser = forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "parser" r a => r -> a
getField @"parser"

instance Message PreparedStatementProcedure

instance Message PortalProcedure

instance Message (ExecutedProcedure r)

instance Message CloseProcedure

instance Message () where
  builder :: () -> Builder
builder ()
_ = Builder
forall a. Monoid a => a
mempty
  parser :: () -> Parser (MessageResult ())
parser ()
_ = () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

type instance MessageResult () = ()

instance (Message m0, Message m1) => Message (m0, m1) where
  builder :: (m0, m1) -> Builder
builder (m0
m0, m1
m1) = m0 -> Builder
forall m. Message m => m -> Builder
builder m0
m0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> m1 -> Builder
forall m. Message m => m -> Builder
builder m1
m1
  parser :: (m0, m1) -> Parser (MessageResult (m0, m1))
parser (m0
m0, m1
m1) = (,) (MessageResult m0
 -> MessageResult m1 -> (MessageResult m0, MessageResult m1))
-> Parser ByteString (MessageResult m0)
-> Parser
     ByteString
     (MessageResult m1 -> (MessageResult m0, MessageResult m1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m0 -> Parser ByteString (MessageResult m0)
forall m. Message m => m -> Parser (MessageResult m)
parser m0
m0 Parser
  ByteString
  (MessageResult m1 -> (MessageResult m0, MessageResult m1))
-> Parser ByteString (MessageResult m1)
-> Parser ByteString (MessageResult m0, MessageResult m1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m1 -> Parser ByteString (MessageResult m1)
forall m. Message m => m -> Parser (MessageResult m)
parser m1
m1

type instance MessageResult (m0, m1) = (MessageResult m0, MessageResult m1)

instance (Message m0, Message m1, Message m2) => Message (m0, m1, m2) where
  builder :: (m0, m1, m2) -> Builder
builder (m0
m0, m1
m1, m2
m2) = m0 -> Builder
forall m. Message m => m -> Builder
builder m0
m0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> m1 -> Builder
forall m. Message m => m -> Builder
builder m1
m1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> m2 -> Builder
forall m. Message m => m -> Builder
builder m2
m2
  parser :: (m0, m1, m2) -> Parser (MessageResult (m0, m1, m2))
parser (m0
m0, m1
m1, m2
m2) = (,,) (MessageResult m0
 -> MessageResult m1
 -> MessageResult m2
 -> (MessageResult m0, MessageResult m1, MessageResult m2))
-> Parser ByteString (MessageResult m0)
-> Parser
     ByteString
     (MessageResult m1
      -> MessageResult m2
      -> (MessageResult m0, MessageResult m1, MessageResult m2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m0 -> Parser ByteString (MessageResult m0)
forall m. Message m => m -> Parser (MessageResult m)
parser m0
m0 Parser
  ByteString
  (MessageResult m1
   -> MessageResult m2
   -> (MessageResult m0, MessageResult m1, MessageResult m2))
-> Parser ByteString (MessageResult m1)
-> Parser
     ByteString
     (MessageResult m2
      -> (MessageResult m0, MessageResult m1, MessageResult m2))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m1 -> Parser ByteString (MessageResult m1)
forall m. Message m => m -> Parser (MessageResult m)
parser m1
m1 Parser
  ByteString
  (MessageResult m2
   -> (MessageResult m0, MessageResult m1, MessageResult m2))
-> Parser ByteString (MessageResult m2)
-> Parser
     ByteString (MessageResult m0, MessageResult m1, MessageResult m2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m2 -> Parser ByteString (MessageResult m2)
forall m. Message m => m -> Parser (MessageResult m)
parser m2
m2

type instance MessageResult (m0, m1, m2) = (MessageResult m0, MessageResult m1, MessageResult m2)

instance (Message m0, Message m1, Message m2, Message m3) => Message (m0, m1, m2, m3) where
  builder :: (m0, m1, m2, m3) -> Builder
builder (m0
m0, m1
m1, m2
m2, m3
m3) = m0 -> Builder
forall m. Message m => m -> Builder
builder m0
m0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> m1 -> Builder
forall m. Message m => m -> Builder
builder m1
m1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> m2 -> Builder
forall m. Message m => m -> Builder
builder m2
m2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> m3 -> Builder
forall m. Message m => m -> Builder
builder m3
m3
  parser :: (m0, m1, m2, m3) -> Parser (MessageResult (m0, m1, m2, m3))
parser (m0
m0, m1
m1, m2
m2, m3
m3) = (,,,) (MessageResult m0
 -> MessageResult m1
 -> MessageResult m2
 -> MessageResult m3
 -> (MessageResult m0, MessageResult m1, MessageResult m2,
     MessageResult m3))
-> Parser ByteString (MessageResult m0)
-> Parser
     ByteString
     (MessageResult m1
      -> MessageResult m2
      -> MessageResult m3
      -> (MessageResult m0, MessageResult m1, MessageResult m2,
          MessageResult m3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m0 -> Parser ByteString (MessageResult m0)
forall m. Message m => m -> Parser (MessageResult m)
parser m0
m0 Parser
  ByteString
  (MessageResult m1
   -> MessageResult m2
   -> MessageResult m3
   -> (MessageResult m0, MessageResult m1, MessageResult m2,
       MessageResult m3))
-> Parser ByteString (MessageResult m1)
-> Parser
     ByteString
     (MessageResult m2
      -> MessageResult m3
      -> (MessageResult m0, MessageResult m1, MessageResult m2,
          MessageResult m3))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m1 -> Parser ByteString (MessageResult m1)
forall m. Message m => m -> Parser (MessageResult m)
parser m1
m1 Parser
  ByteString
  (MessageResult m2
   -> MessageResult m3
   -> (MessageResult m0, MessageResult m1, MessageResult m2,
       MessageResult m3))
-> Parser ByteString (MessageResult m2)
-> Parser
     ByteString
     (MessageResult m3
      -> (MessageResult m0, MessageResult m1, MessageResult m2,
          MessageResult m3))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m2 -> Parser ByteString (MessageResult m2)
forall m. Message m => m -> Parser (MessageResult m)
parser m2
m2 Parser
  ByteString
  (MessageResult m3
   -> (MessageResult m0, MessageResult m1, MessageResult m2,
       MessageResult m3))
-> Parser ByteString (MessageResult m3)
-> Parser
     ByteString
     (MessageResult m0, MessageResult m1, MessageResult m2,
      MessageResult m3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m3 -> Parser ByteString (MessageResult m3)
forall m. Message m => m -> Parser (MessageResult m)
parser m3
m3

type instance MessageResult (m0, m1, m2, m3) = (MessageResult m0, MessageResult m1, MessageResult m2, MessageResult m3)

instance Message m => Message [m] where
  builder :: [m] -> Builder
builder = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([m] -> [Builder]) -> [m] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m -> Builder
forall m. Message m => m -> Builder
builder (m -> Builder) -> [m] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  parser :: [m] -> Parser (MessageResult [m])
parser = [Parser ByteString (MessageResult m)]
-> Parser ByteString [MessageResult m]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Parser ByteString (MessageResult m)]
 -> Parser ByteString [MessageResult m])
-> ([m] -> [Parser ByteString (MessageResult m)])
-> [m]
-> Parser ByteString [MessageResult m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m -> Parser ByteString (MessageResult m)
forall m. Message m => m -> Parser (MessageResult m)
parser (m -> Parser ByteString (MessageResult m))
-> [m] -> [Parser ByteString (MessageResult m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

type instance MessageResult [m] = [MessageResult m]

-- | To build and send the given message and a “Flush” message and to receive and parse those responses.
flush :: Message m => Connection -> m -> IO (MessageResult m)
flush :: Connection -> m -> IO (MessageResult m)
flush Connection { Socket
socket :: Socket
$sel:socket:Connection :: Connection -> Socket
socket, Buffer
sendingBuffer :: Buffer
$sel:sendingBuffer:Connection :: Connection -> Buffer
sendingBuffer, Buffer
receptionBuffer :: Buffer
$sel:receptionBuffer:Connection :: Connection -> Buffer
receptionBuffer, Config
config :: Config
$sel:config:Connection :: Connection -> Config
config } m
m =
  IO (MessageResult m) -> IO (MessageResult m)
forall a. IO a -> IO a
Exception.convert (IO (MessageResult m) -> IO (MessageResult m))
-> IO (MessageResult m) -> IO (MessageResult m)
forall a b. (a -> b) -> a -> b
$
    Socket
-> Buffer
-> Buffer
-> Config
-> SocketIO (MessageResult m)
-> IO (MessageResult m)
forall a.
Socket -> Buffer -> Buffer -> Config -> SocketIO a -> IO a
runSocketIO Socket
socket Buffer
sendingBuffer Buffer
receptionBuffer Config
config (SocketIO (MessageResult m) -> IO (MessageResult m))
-> SocketIO (MessageResult m) -> IO (MessageResult m)
forall a b. (a -> b) -> a -> b
$ do
      Either InternalException (MessageResult m)
r <- SocketIO (MessageResult m)
-> StateT
     ByteString
     (ReaderT (Socket, Buffer, Buffer, Config) IO)
     (Either InternalException (MessageResult m))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (SocketIO (MessageResult m)
 -> StateT
      ByteString
      (ReaderT (Socket, Buffer, Buffer, Config) IO)
      (Either InternalException (MessageResult m)))
-> SocketIO (MessageResult m)
-> StateT
     ByteString
     (ReaderT (Socket, Buffer, Buffer, Config) IO)
     (Either InternalException (MessageResult m))
forall a b. (a -> b) -> a -> b
$ do
        Builder -> SocketIO ()
buildAndSend (Builder -> SocketIO ()) -> Builder -> SocketIO ()
forall a b. (a -> b) -> a -> b
$ m -> Builder
forall m. Message m => m -> Builder
builder m
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
Builder.flush
        Parser (MessageResult m) -> SocketIO (MessageResult m)
forall response. Parser response -> SocketIO response
receive (Parser (MessageResult m) -> SocketIO (MessageResult m))
-> Parser (MessageResult m) -> SocketIO (MessageResult m)
forall a b. (a -> b) -> a -> b
$ m -> Parser (MessageResult m)
forall m. Message m => m -> Parser (MessageResult m)
parser m
m
      case Either InternalException (MessageResult m)
r of
        Right MessageResult m
r -> MessageResult m -> SocketIO (MessageResult m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MessageResult m
r
        Left (Exception.InternalErrorResponse ErrorFields
fields Maybe TransactionState
_ ByteString
_) -> do
          ReadyForQuery TransactionState
ts <- do
            ByteString -> SocketIO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ByteString
forall a. Monoid a => a
mempty
            ByteString -> SocketIO ()
send ByteString
Builder.sync
            Parser ReadyForQuery
-> StateT
     ByteString
     (ReaderT (Socket, Buffer, Buffer, Config) IO)
     ReadyForQuery
forall response. Parser response -> SocketIO response
receive Parser ReadyForQuery
Parser.readyForQuery
          InternalException -> SocketIO (MessageResult m)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (InternalException -> SocketIO (MessageResult m))
-> InternalException -> SocketIO (MessageResult m)
forall a b. (a -> b) -> a -> b
$ ErrorFields
-> Maybe TransactionState -> ByteString -> InternalException
Exception.InternalErrorResponse ErrorFields
fields (TransactionState -> Maybe TransactionState
forall a. a -> Maybe a
Just TransactionState
ts) ByteString
forall a. Monoid a => a
mempty
        Left InternalException
e -> InternalException -> SocketIO (MessageResult m)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw InternalException
e

-- | To build and send the given message and a “Sync” message and to receive and parse those responses.
sync :: Message m => Connection -> m -> IO (MessageResult m, TransactionState)
sync :: Connection -> m -> IO (MessageResult m, TransactionState)
sync Connection { Socket
socket :: Socket
$sel:socket:Connection :: Connection -> Socket
socket, Buffer
sendingBuffer :: Buffer
$sel:sendingBuffer:Connection :: Connection -> Buffer
sendingBuffer, Buffer
receptionBuffer :: Buffer
$sel:receptionBuffer:Connection :: Connection -> Buffer
receptionBuffer, Config
config :: Config
$sel:config:Connection :: Connection -> Config
config } m
m =
  IO (MessageResult m, TransactionState)
-> IO (MessageResult m, TransactionState)
forall a. IO a -> IO a
Exception.convert (IO (MessageResult m, TransactionState)
 -> IO (MessageResult m, TransactionState))
-> IO (MessageResult m, TransactionState)
-> IO (MessageResult m, TransactionState)
forall a b. (a -> b) -> a -> b
$
    Socket
-> Buffer
-> Buffer
-> Config
-> SocketIO (MessageResult m, TransactionState)
-> IO (MessageResult m, TransactionState)
forall a.
Socket -> Buffer -> Buffer -> Config -> SocketIO a -> IO a
runSocketIO Socket
socket Buffer
sendingBuffer Buffer
receptionBuffer Config
config (SocketIO (MessageResult m, TransactionState)
 -> IO (MessageResult m, TransactionState))
-> SocketIO (MessageResult m, TransactionState)
-> IO (MessageResult m, TransactionState)
forall a b. (a -> b) -> a -> b
$ do
      Either InternalException (MessageResult m, TransactionState)
r <-
        SocketIO (MessageResult m, TransactionState)
-> StateT
     ByteString
     (ReaderT (Socket, Buffer, Buffer, Config) IO)
     (Either InternalException (MessageResult m, TransactionState))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (SocketIO (MessageResult m, TransactionState)
 -> StateT
      ByteString
      (ReaderT (Socket, Buffer, Buffer, Config) IO)
      (Either InternalException (MessageResult m, TransactionState)))
-> SocketIO (MessageResult m, TransactionState)
-> StateT
     ByteString
     (ReaderT (Socket, Buffer, Buffer, Config) IO)
     (Either InternalException (MessageResult m, TransactionState))
forall a b. (a -> b) -> a -> b
$ do
          Builder -> SocketIO ()
buildAndSend (Builder -> SocketIO ()) -> Builder -> SocketIO ()
forall a b. (a -> b) -> a -> b
$ m -> Builder
forall m. Message m => m -> Builder
builder m
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
Builder.sync
          (MessageResult m
r, ReadyForQuery TransactionState
ts) <- Parser (MessageResult m, ReadyForQuery)
-> SocketIO (MessageResult m, ReadyForQuery)
forall response. Parser response -> SocketIO response
receive (Parser (MessageResult m, ReadyForQuery)
 -> SocketIO (MessageResult m, ReadyForQuery))
-> Parser (MessageResult m, ReadyForQuery)
-> SocketIO (MessageResult m, ReadyForQuery)
forall a b. (a -> b) -> a -> b
$ (,) (MessageResult m
 -> ReadyForQuery -> (MessageResult m, ReadyForQuery))
-> Parser ByteString (MessageResult m)
-> Parser
     ByteString (ReadyForQuery -> (MessageResult m, ReadyForQuery))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m -> Parser ByteString (MessageResult m)
forall m. Message m => m -> Parser (MessageResult m)
parser m
m Parser
  ByteString (ReadyForQuery -> (MessageResult m, ReadyForQuery))
-> Parser ReadyForQuery -> Parser (MessageResult m, ReadyForQuery)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ReadyForQuery
Parser.readyForQuery
          (MessageResult m, TransactionState)
-> SocketIO (MessageResult m, TransactionState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessageResult m
r, TransactionState
ts)
      case Either InternalException (MessageResult m, TransactionState)
r of
        Right (MessageResult m, TransactionState)
r -> (MessageResult m, TransactionState)
-> SocketIO (MessageResult m, TransactionState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessageResult m, TransactionState)
r
        Left (Exception.InternalErrorResponse ErrorFields
fields Maybe TransactionState
_ ByteString
rest) -> do
          ByteString -> SocketIO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ByteString
rest
          ReadyForQuery TransactionState
ts <- Parser ReadyForQuery
-> StateT
     ByteString
     (ReaderT (Socket, Buffer, Buffer, Config) IO)
     ReadyForQuery
forall response. Parser response -> SocketIO response
receive Parser ReadyForQuery
Parser.readyForQuery
          InternalException -> SocketIO (MessageResult m, TransactionState)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (InternalException -> SocketIO (MessageResult m, TransactionState))
-> InternalException
-> SocketIO (MessageResult m, TransactionState)
forall a b. (a -> b) -> a -> b
$ ErrorFields
-> Maybe TransactionState -> ByteString -> InternalException
Exception.InternalErrorResponse ErrorFields
fields (TransactionState -> Maybe TransactionState
forall a. a -> Maybe a
Just TransactionState
ts) ByteString
forall a. Monoid a => a
mempty
        Left InternalException
e -> InternalException -> SocketIO (MessageResult m, TransactionState)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw InternalException
e

-- | To send @BEGIN@ SQL statement.
begin :: ExecutedProcedure ()
begin :: ExecutedProcedure ()
begin = Query -> ExecutedProcedure ()
transact Query
"BEGIN"

-- | To send @COMMIT@ SQL statement.
commit :: ExecutedProcedure ()
commit :: ExecutedProcedure ()
commit = Query -> ExecutedProcedure ()
transact Query
"COMMIT"

-- | To send @ROLLBACK@ SQL statement.
rollback :: ExecutedProcedure ()
rollback :: ExecutedProcedure ()
rollback = Query -> ExecutedProcedure ()
transact Query
"ROLLBACK"

transact :: Query -> ExecutedProcedure ()
transact :: Query -> ExecutedProcedure ()
transact Query
q =
  let
    psProc :: PreparedStatementProcedure
psProc = PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
parse PreparedStatementName
"" Query
q (([Oid], [Oid]) -> Either (Word, Word) ([Oid], [Oid])
forall a b. b -> Either a b
Right ([], []))
  in
    case PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> ()
-> PreparedStatementProcedure
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
bind PortalName
"" FormatCode
BinaryFormat FormatCode
BinaryFormat BackendParameters
forall a. Monoid a => a
mempty (ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> (String -> ByteString) -> StringEncoder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack) () PreparedStatementProcedure
psProc of -- mempty (backend parameters) and BSC.pack (string encoder) are not used.
      Right PortalProcedure
pProc -> Word -> StringDecoder -> PortalProcedure -> ExecutedProcedure ()
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
execute Word
1 (String -> Either String String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String String)
-> (ByteString -> String) -> StringDecoder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack) PortalProcedure
pProc
      Left String
err    -> String -> ExecutedProcedure ()
forall a. HasCallStack => String -> a
error String
err