module Hpgsql.InternalTypes
  ( -- * Simple types
    ConnectionString (..),
    ConnectOpts (..),
    PostgresError (..),
    IrrecoverableHpgsqlError (..),
    ErrorDetail (..),
    NotificationResponse (..),
    ResetConnectionOpts (..),
    TransactionStatus (..),
    EncodingContext (..), -- re-exported from Hpgsql.TypeInfo
    throwIrrecoverableError,

    -- * Query types (moved from Hpgsql.Query)
    SingleQueryFragment (..),
    Query (..),
    SingleQuery (..),
    queryToByteString,
    breakQueryIntoStatements,
    renumberParamsFrom,

    -- * Msgs types (moved to avoid cycles)
    ParseComplete (..),
    BindComplete (..),
    NoData (..),
    RowDescription (..),
    CopyInResponse (..),
    ErrorResponse (..),
    CommandComplete (..),
    DataRow (..),
    ReadyForQuery (..),

    -- * Internal connection state types (moved to avoid cycles)
    InternalConnectionState (..),
    WeakThreadId (..),
    QueryState (..),
    QueryId (..),
    QueryProtocol (..),
    CopyQueryState (..),
    ResponseMsgsReceived (..),
    ResponseMsg (..),
    Either3 (..),

    -- * Connection and Pipeline types
    HPgConnection (..),
    Mutex (..),
    Pipeline (..),
    mkMutex,
  )
where

import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar (MVar)
import Control.Concurrent.STM (STM, TQueue, TVar)
import Control.Exception.Safe (Exception (..), MonadThrow, SomeException, throw)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Int (Int32, Int64)
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
#if MIN_VERSION_base(4,19,0)
import Data.Word (Word16, Word64)
#else
import Data.Word (Word16)

#endif
import qualified Control.Concurrent.STM as STM
import Data.Hashable (hash)
import Data.Set (Set)
import Hpgsql.Base (lastTwoAndInit, maximumOnOrDef, minimumOnOrDef)
import Hpgsql.Builder (BinaryField)
import Hpgsql.ParsingInternal (BlockOrNotBlock (..), ParsingOpts (..), parseSql)
import Hpgsql.TransactionStatusInternal (TransactionStatus (..))
import Hpgsql.TypeInfo (EncodingContext (..), Oid (..))
import Network.Socket (AddrInfo, Socket)
import System.Mem.Weak (Weak)

-- | A fragment of a single SQL statement, which is either static SQL or
-- a placeholder for a query argument.
data SingleQueryFragment
  = FragmentOfStaticSql !ByteString
  | FragmentWithSemiColon
  | FragmentOfCommentsOrWhitespace !ByteString
  | -- | The number/index of the query argument, starting from 1 in a single statement
    QueryArgumentPlaceHolder !Int
  deriving stock (SingleQueryFragment -> SingleQueryFragment -> Bool
(SingleQueryFragment -> SingleQueryFragment -> Bool)
-> (SingleQueryFragment -> SingleQueryFragment -> Bool)
-> Eq SingleQueryFragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SingleQueryFragment -> SingleQueryFragment -> Bool
== :: SingleQueryFragment -> SingleQueryFragment -> Bool
$c/= :: SingleQueryFragment -> SingleQueryFragment -> Bool
/= :: SingleQueryFragment -> SingleQueryFragment -> Bool
Eq, Int -> SingleQueryFragment -> ShowS
[SingleQueryFragment] -> ShowS
SingleQueryFragment -> [Char]
(Int -> SingleQueryFragment -> ShowS)
-> (SingleQueryFragment -> [Char])
-> ([SingleQueryFragment] -> ShowS)
-> Show SingleQueryFragment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SingleQueryFragment -> ShowS
showsPrec :: Int -> SingleQueryFragment -> ShowS
$cshow :: SingleQueryFragment -> [Char]
show :: SingleQueryFragment -> [Char]
$cshowList :: [SingleQueryFragment] -> ShowS
showList :: [SingleQueryFragment] -> ShowS
Show)

-- | `Query` is some SQL with values of query arguments inside and also whether it's a prepared statement.
-- It can be concatenated to other `Query` objects freely, and concatenating chains of Queries with
-- at least one prepared statement among them makes the final `Query` object a prepared statement, too.
-- You can build this with the `sql` and `sqlPrep` quasiquoters, the former for unprepared statements,
-- and you can use `preparedStatement` and `nonPreparedStatement` to convert between them.
data Query = Query
  { --  The query parameters and query fragments continue to go up in number across different
    -- statements, e.g. "SELECT $1; SELECT $2; SELECT $3; ...".
    Query -> [SingleQueryFragment]
queryString :: ![SingleQueryFragment],
    Query -> [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams :: ![EncodingContext -> (Maybe Oid, BinaryField)],
    Query -> Bool
isPrepared :: !Bool
  }

instance Show Query where
  show :: Query -> [Char]
show = [SingleQuery] -> [Char]
forall a. Show a => a -> [Char]
show ([SingleQuery] -> [Char])
-> (Query -> [SingleQuery]) -> Query -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty SingleQuery -> [SingleQuery]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty SingleQuery -> [SingleQuery])
-> (Query -> NonEmpty SingleQuery) -> Query -> [SingleQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> NonEmpty SingleQuery
breakQueryIntoStatements

queryToByteString :: Query -> ByteString
queryToByteString :: Query -> ByteString
queryToByteString = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> (Query -> [ByteString]) -> Query -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SingleQuery -> ByteString) -> [SingleQuery] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\SingleQuery {ByteString
queryString :: ByteString
queryString :: SingleQuery -> ByteString
queryString} -> ByteString
queryString) ([SingleQuery] -> [ByteString])
-> (Query -> [SingleQuery]) -> Query -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty SingleQuery -> [SingleQuery]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty SingleQuery -> [SingleQuery])
-> (Query -> NonEmpty SingleQuery) -> Query -> [SingleQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> NonEmpty SingleQuery
breakQueryIntoStatements

instance Semigroup Query where
  Query
q1 <> :: Query -> Query -> Query
<> Query
q2 =
    let maxArgQ1 :: Int
maxArgQ1 =
          Int
-> [SingleQueryFragment]
-> (SingleQueryFragment -> Maybe Int)
-> Int
forall b a. Ord b => b -> [a] -> (a -> Maybe b) -> b
maximumOnOrDef
            Int
0
            Query
q1.queryString
            ( \case
                QueryArgumentPlaceHolder Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
                SingleQueryFragment
_ -> Maybe Int
forall a. Maybe a
Nothing
            )
        (Int
_, [SingleQueryFragment]
remappedQ2) =
          [SingleQueryFragment] -> Int -> (Int, [SingleQueryFragment])
renumberParamsFrom
            Query
q2.queryString
            (Int
maxArgQ1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
     in -- Semigroup concatenation must be associative, and for isPrepared
        -- both || and && are associative, but what would the user expect?
        -- For typical query concatenation, I *think* of some examples:
        -- - [sqlPrep|SELECT ^{columnsQry} FROM some_table ^{whereConditions}|]
        -- - [sqlPrep|INSERT INTO x ^{vALUES rows}|]
        -- In both cases above, we want `isPrepared = True` to be "infectious", so
        -- we want to use ||
        -- Are there counter examples? Yes, if users build "smaller" embeddable Queries
        -- with `sqlPrep`, e.g. if `columnsQry` or `whereConditions` were built with `sqlPrep`.
        -- That feels unlikely.. so we go with ||
        Query {queryString :: [SingleQueryFragment]
queryString = Query
q1.queryString [SingleQueryFragment]
-> [SingleQueryFragment] -> [SingleQueryFragment]
forall a. Semigroup a => a -> a -> a
<> [SingleQueryFragment]
remappedQ2, queryParams :: [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams = Query
q1.queryParams [EncodingContext -> (Maybe Oid, BinaryField)]
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> [EncodingContext -> (Maybe Oid, BinaryField)]
forall a. Semigroup a => a -> a -> a
<> Query
q2.queryParams, isPrepared :: Bool
isPrepared = Query
q1.isPrepared Bool -> Bool -> Bool
|| Query
q2.isPrepared}

-- | A single statement, not multiple, with dollar-numbered query arguments
-- starting from $1.
data SingleQuery = SingleQuery {SingleQuery -> ByteString
queryString :: !ByteString, SingleQuery -> [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams :: ![EncodingContext -> (Maybe Oid, BinaryField)], SingleQuery -> Maybe [Char]
preparedStmtHash :: !(Maybe String)}

mkSingleQuery :: ByteString -> [EncodingContext -> (Maybe Oid, BinaryField)] -> Bool -> SingleQuery
mkSingleQuery :: ByteString
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> Bool
-> SingleQuery
mkSingleQuery ByteString
queryString [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams Bool
isPrepared = SingleQuery {ByteString
queryString :: ByteString
queryString :: ByteString
queryString, [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams :: [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams :: [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams, preparedStmtHash :: Maybe [Char]
preparedStmtHash = if Bool
isPrepared then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall a. Hashable a => a -> Int
hash ByteString
queryString) else Maybe [Char]
forall a. Maybe a
Nothing}

instance Show SingleQuery where
  -- Careful not exposing query arguments
  show :: SingleQuery -> [Char]
show (SingleQuery {ByteString
queryString :: SingleQuery -> ByteString
queryString :: ByteString
queryString}) = ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
queryString

instance IsString Query where
  fromString :: [Char] -> Query
fromString [Char]
s =
    let blocks :: [BlockOrNotBlock]
blocks = ParsingOpts -> Text -> [BlockOrNotBlock]
parseSql ParsingOpts
AcceptOnlyDollarNumberedArgs ([Char] -> Text
Text.pack [Char]
s)
        queryFrags :: [SingleQueryFragment]
queryFrags =
          (BlockOrNotBlock -> SingleQueryFragment)
-> [BlockOrNotBlock] -> [SingleQueryFragment]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \case
                StaticSql Text
t -> ByteString -> SingleQueryFragment
FragmentOfStaticSql (ByteString -> SingleQueryFragment)
-> ByteString -> SingleQueryFragment
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
                BlockOrNotBlock
SemiColon -> SingleQueryFragment
FragmentWithSemiColon
                CommentsOrWhitespace Text
t -> ByteString -> SingleQueryFragment
FragmentOfCommentsOrWhitespace (ByteString -> SingleQueryFragment)
-> ByteString -> SingleQueryFragment
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
                DollarNumberedArg Int
_ ->
                  [Char] -> SingleQueryFragment
forall a. HasCallStack => [Char] -> a
error [Char]
"Dollar-numbered query arguments are not supported in string literals. Use the sql quasiquoter or mkQuery instead."
                BlockOrNotBlock
QuestionMarkArg ->
                  [Char] -> SingleQueryFragment
forall a. HasCallStack => [Char] -> a
error [Char]
"Question mark query arguments are not supported in string literals. Use the sql quasiquoter or mkQuery instead."
                QuasiQuoterExpression QQExprKind
_ Text
_ ->
                  [Char] -> SingleQueryFragment
forall a. HasCallStack => [Char] -> a
error [Char]
"Bug in Hpgsql: parseSql AcceptOnlyDollarNumberedArgs returned quasiquoter expression."
            )
            [BlockOrNotBlock]
blocks
     in Query {queryString :: [SingleQueryFragment]
queryString = [SingleQueryFragment]
queryFrags, queryParams :: [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams = [], isPrepared :: Bool
isPrepared = Bool
False}

-- | For internal usage only. Takes a `Query` and breaks it up into
-- individual SQL statements that can be sent to a postgres backend.
breakQueryIntoStatements :: Query -> NonEmpty SingleQuery
breakQueryIntoStatements :: Query -> NonEmpty SingleQuery
breakQueryIntoStatements qry :: Query
qry@Query {queryString :: Query -> [SingleQueryFragment]
queryString = [SingleQueryFragment]
fullQueryString, queryParams :: Query -> [EncodingContext -> (Maybe Oid, BinaryField)]
queryParams = [EncodingContext -> (Maybe Oid, BinaryField)]
allQueryParams, Bool
isPrepared :: Query -> Bool
isPrepared :: Bool
isPrepared} =
  -- If a user insists in trying to run an empty query, or if
  -- they mistakenly concatenate empty statements, we let them
  [SingleQuery] -> NonEmpty SingleQuery
toEmptyQueryIfNecessary ([SingleQuery] -> NonEmpty SingleQuery)
-> [SingleQuery] -> NonEmpty SingleQuery
forall a b. (a -> b) -> a -> b
$
    (([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])
 -> SingleQuery)
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [SingleQuery]
forall a b. (a -> b) -> [a] -> [b]
map ([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
-> SingleQuery
toSingleQuery ([([SingleQueryFragment],
   [EncodingContext -> (Maybe Oid, BinaryField)])]
 -> [SingleQuery])
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [SingleQuery]
forall a b. (a -> b) -> a -> b
$
      -- If a query string is "SELECT 1; -- comments and empty space", we put
      -- all comments and whitespace together with that last "real" SQL statement
      [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
fixLastEmptyStatement ([([SingleQueryFragment],
   [EncodingContext -> (Maybe Oid, BinaryField)])]
 -> [([SingleQueryFragment],
      [EncodingContext -> (Maybe Oid, BinaryField)])])
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
forall a b. (a -> b) -> a -> b
$
        [SingleQueryFragment]
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
go [SingleQueryFragment]
fullQueryString [EncodingContext -> (Maybe Oid, BinaryField)]
allQueryParams
  where
    toEmptyQueryIfNecessary :: [SingleQuery] -> NonEmpty SingleQuery
toEmptyQueryIfNecessary [] = SingleQuery -> NonEmpty SingleQuery
forall a. a -> NonEmpty a
NE.singleton (SingleQuery -> NonEmpty SingleQuery)
-> SingleQuery -> NonEmpty SingleQuery
forall a b. (a -> b) -> a -> b
$ ByteString
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> Bool
-> SingleQuery
mkSingleQuery ByteString
"" [EncodingContext -> (Maybe Oid, BinaryField)]
allQueryParams Bool
isPrepared
    toEmptyQueryIfNecessary (SingleQuery
x : [SingleQuery]
xs) = SingleQuery
x SingleQuery -> [SingleQuery] -> NonEmpty SingleQuery
forall a. a -> [a] -> NonEmpty a
:| [SingleQuery]
xs
    toSingleQuery :: ([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
-> SingleQuery
toSingleQuery ([SingleQueryFragment]
blks, [EncodingContext -> (Maybe Oid, BinaryField)]
prms) = let queryString :: ByteString
queryString = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (SingleQueryFragment -> ByteString)
-> [SingleQueryFragment] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map SingleQueryFragment -> ByteString
fragToBytestring [SingleQueryFragment]
blks in ByteString
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> Bool
-> SingleQuery
mkSingleQuery ByteString
queryString [EncodingContext -> (Maybe Oid, BinaryField)]
prms Bool
isPrepared
    allWhitespaceOrComments :: [SingleQueryFragment] -> Bool
allWhitespaceOrComments =
      (SingleQueryFragment -> Bool) -> [SingleQueryFragment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
        ( \case
            FragmentOfCommentsOrWhitespace ByteString
_ -> Bool
True
            SingleQueryFragment
_ -> Bool
False
        )
    fixLastEmptyStatement :: [([SingleQueryFragment], [EncodingContext -> (Maybe Oid, BinaryField)])] -> [([SingleQueryFragment], [EncodingContext -> (Maybe Oid, BinaryField)])]
    fixLastEmptyStatement :: [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
fixLastEmptyStatement [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
indivStmts = case [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
-> ([([SingleQueryFragment],
      [EncodingContext -> (Maybe Oid, BinaryField)])],
    Maybe
      (([SingleQueryFragment],
        [EncodingContext -> (Maybe Oid, BinaryField)]),
       ([SingleQueryFragment],
        [EncodingContext -> (Maybe Oid, BinaryField)])))
forall a. [a] -> ([a], Maybe (a, a))
lastTwoAndInit [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
indivStmts of
      ([([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
_, Maybe
  (([SingleQueryFragment],
    [EncodingContext -> (Maybe Oid, BinaryField)]),
   ([SingleQueryFragment],
    [EncodingContext -> (Maybe Oid, BinaryField)]))
Nothing) -> [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
indivStmts -- Only 0 or 1 statements found
      ([([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
firstStmts, Just (([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
secLst, ([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
lst))
        | [SingleQueryFragment] -> Bool
allWhitespaceOrComments (([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
-> [SingleQueryFragment]
forall a b. (a, b) -> a
fst ([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
lst) -> [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
firstStmts [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
forall a. [a] -> [a] -> [a]
++ [([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
secLst ([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
-> ([SingleQueryFragment],
    [EncodingContext -> (Maybe Oid, BinaryField)])
-> ([SingleQueryFragment],
    [EncodingContext -> (Maybe Oid, BinaryField)])
forall a. Semigroup a => a -> a -> a
<> ([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
lst]
        | Bool
otherwise -> [([SingleQueryFragment],
  [EncodingContext -> (Maybe Oid, BinaryField)])]
indivStmts
    isLastFragmentOfAStatement :: SingleQueryFragment -> Bool
isLastFragmentOfAStatement = \case
      SingleQueryFragment
FragmentWithSemiColon -> Bool
True
      SingleQueryFragment
_ -> Bool
False
    fragToBytestring :: SingleQueryFragment -> ByteString
fragToBytestring = \case
      QueryArgumentPlaceHolder Int
n -> ByteString
"$" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
intToBs Int
n
      FragmentOfStaticSql ByteString
t -> ByteString
t
      SingleQueryFragment
FragmentWithSemiColon -> ByteString
";"
      FragmentOfCommentsOrWhitespace ByteString
t -> ByteString
t
    go :: [SingleQueryFragment] -> [EncodingContext -> (Maybe Oid, BinaryField)] -> [([SingleQueryFragment], [EncodingContext -> (Maybe Oid, BinaryField)])]
    go :: [SingleQueryFragment]
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
go [] [] = []
    go [] [EncodingContext -> (Maybe Oid, BinaryField)]
_ = [Char]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> [([SingleQueryFragment],
      [EncodingContext -> (Maybe Oid, BinaryField)])])
-> [Char]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
forall a b. (a -> b) -> a -> b
$ [Char]
"Hpgsql error: empty query fragment list but outstanding query params. Number of query arguments is " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([EncodingContext -> (Maybe Oid, BinaryField)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EncodingContext -> (Maybe Oid, BinaryField)]
allQueryParams) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" and query is " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Query -> [Char]
forall a. Show a => a -> [Char]
show Query
qry
    go [SingleQueryFragment]
frags [EncodingContext -> (Maybe Oid, BinaryField)]
params =
      let ([SingleQueryFragment]
stmtFrags, [SingleQueryFragment]
nextFrags) = case (SingleQueryFragment -> Bool)
-> [SingleQueryFragment]
-> ([SingleQueryFragment], [SingleQueryFragment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break SingleQueryFragment -> Bool
isLastFragmentOfAStatement [SingleQueryFragment]
frags of
            ([SingleQueryFragment]
firstStmts, []) -> ([SingleQueryFragment]
firstStmts, [])
            ([SingleQueryFragment]
firstStmts, SingleQueryFragment
semiColon : [SingleQueryFragment]
next) -> ([SingleQueryFragment]
firstStmts [SingleQueryFragment]
-> [SingleQueryFragment] -> [SingleQueryFragment]
forall a. [a] -> [a] -> [a]
++ [SingleQueryFragment
semiColon], [SingleQueryFragment]
next)
          (Int
maxArgNum, [SingleQueryFragment]
thisQueryFrags) = [SingleQueryFragment] -> Int -> (Int, [SingleQueryFragment])
renumberParamsFrom [SingleQueryFragment]
stmtFrags Int
1
          ([EncodingContext -> (Maybe Oid, BinaryField)]
thisQueryParams, [EncodingContext -> (Maybe Oid, BinaryField)]
nextParams) = Int
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> ([EncodingContext -> (Maybe Oid, BinaryField)],
    [EncodingContext -> (Maybe Oid, BinaryField)])
forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
maxArgNum [EncodingContext -> (Maybe Oid, BinaryField)]
params
       in ([SingleQueryFragment]
thisQueryFrags, [EncodingContext -> (Maybe Oid, BinaryField)]
thisQueryParams) ([SingleQueryFragment],
 [EncodingContext -> (Maybe Oid, BinaryField)])
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
forall a. a -> [a] -> [a]
: [SingleQueryFragment]
-> [EncodingContext -> (Maybe Oid, BinaryField)]
-> [([SingleQueryFragment],
     [EncodingContext -> (Maybe Oid, BinaryField)])]
go [SingleQueryFragment]
nextFrags [EncodingContext -> (Maybe Oid, BinaryField)]
nextParams

intToBs :: Int -> ByteString
intToBs :: Int -> ByteString
intToBs = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Int -> Text) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show

-- | Returns new fragments remapped with `renumberFrom` as the smallest query argument number,
-- and also returns the maximum (new) query argument number, or 0 if there were no query arguments.
renumberParamsFrom :: [SingleQueryFragment] -> Int -> (Int, [SingleQueryFragment])
renumberParamsFrom :: [SingleQueryFragment] -> Int -> (Int, [SingleQueryFragment])
renumberParamsFrom [SingleQueryFragment]
frags Int
renumberFrom =
  (Int -> SingleQueryFragment -> (Int, SingleQueryFragment))
-> Int -> [SingleQueryFragment] -> (Int, [SingleQueryFragment])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumR
    ( \(!Int
maxSoFar) -> \case
        QueryArgumentPlaceHolder Int
n -> let newNum :: Int
newNum = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
smallestArgNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
renumberFrom in (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
newNum Int
maxSoFar, Int -> SingleQueryFragment
QueryArgumentPlaceHolder Int
newNum)
        SingleQueryFragment
x -> (Int
maxSoFar, SingleQueryFragment
x)
    )
    Int
0
    [SingleQueryFragment]
frags
  where
    smallestArgNum :: Int
smallestArgNum =
      Int
-> [SingleQueryFragment]
-> (SingleQueryFragment -> Maybe Int)
-> Int
forall b a. Ord b => b -> [a] -> (a -> Maybe b) -> b
minimumOnOrDef
        Int
1
        [SingleQueryFragment]
frags
        ( \case
            QueryArgumentPlaceHolder Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
            SingleQueryFragment
_ -> Maybe Int
forall a. Maybe a
Nothing
        )

data ConnectionString = ConnectionString
  { ConnectionString -> Text
hostname :: Text,
    ConnectionString -> Word16
port :: Word16,
    ConnectionString -> Text
user :: Text,
    ConnectionString -> Text
password :: Text,
    ConnectionString -> Text
database :: Text,
    ConnectionString -> Text
options :: Text
  }
  deriving stock (ConnectionString -> ConnectionString -> Bool
(ConnectionString -> ConnectionString -> Bool)
-> (ConnectionString -> ConnectionString -> Bool)
-> Eq ConnectionString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionString -> ConnectionString -> Bool
== :: ConnectionString -> ConnectionString -> Bool
$c/= :: ConnectionString -> ConnectionString -> Bool
/= :: ConnectionString -> ConnectionString -> Bool
Eq)

instance Show ConnectionString where
  show :: ConnectionString -> [Char]
show ConnectionString
_ = [Char]
"ConnectionString"

data ConnectOpts = ConnectOpts
  { -- | How long in ms Hpgsql will sleep before re-checking if active queries have been orphaned
    -- from their issuing threads having died. The default is 500ms, and this is only relevant
    -- if you plan on concurrently issuing queries on a single connection, and even then only
    -- if you expect your threads to be killed by asynchronous exceptions frequently enough,
    -- and you want resume using the connection and cannot wait ~500ms until Hpgsql realizes
    -- it's fine to do so.
    -- You probably don't need to worry about this or tune it.
    ConnectOpts -> Int
killedThreadPollIntervalMs :: Int,
    -- | How long in ms Hpgsql will wait before re-sending a cancellation request
    -- while draining orphaned queries (queries from dead threads). The default is 500ms,
    -- and this is only relevant if you plan on interrupting your queries with
    -- asynchronous exceptions, either by use of concurrency primitives or functions like
    -- `timeout`, and continue using the connection for new queries after that.
    -- It is not recommend setting this below 100ms, because orphaned query draining
    -- alternates with resending cancellation requests, so if this is too low it is possible
    -- that draining never finishes, leading to a form of livelock.
    ConnectOpts -> Int
cancellationRequestResendIntervalMs :: Int,
    -- | Immediately after connecting, run a query to fetch all types
    -- from the `pg_type` table. This makes them available in FromPgField
    -- instances.
    -- The default is True. You should only set it to False if you really
    -- know what you're doing, because class instances of custom types
    -- can stop working.
    ConnectOpts -> Bool
fillTypeInfoCache :: Bool
  }

data ErrorDetail
  = ErrorSeverity
  | ErrorCode
  | ErrorHumanReadableMsg
  | ErrorDetail
  | ErrorHint
  | ErrorPosition
  | ErrorInternalPosition
  | ErrorInternalCommand
  | ErrorContext
  | ErrorSchema
  | ErrorTable
  | ErrorColumn
  | ErrorType
  | ErrorConstraint
  | ErrorSourceFile
  | ErrorSourceLine
  | ErrorSourceRoutine
  deriving stock (ErrorDetail -> ErrorDetail -> Bool
(ErrorDetail -> ErrorDetail -> Bool)
-> (ErrorDetail -> ErrorDetail -> Bool) -> Eq ErrorDetail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorDetail -> ErrorDetail -> Bool
== :: ErrorDetail -> ErrorDetail -> Bool
$c/= :: ErrorDetail -> ErrorDetail -> Bool
/= :: ErrorDetail -> ErrorDetail -> Bool
Eq, Eq ErrorDetail
Eq ErrorDetail =>
(ErrorDetail -> ErrorDetail -> Ordering)
-> (ErrorDetail -> ErrorDetail -> Bool)
-> (ErrorDetail -> ErrorDetail -> Bool)
-> (ErrorDetail -> ErrorDetail -> Bool)
-> (ErrorDetail -> ErrorDetail -> Bool)
-> (ErrorDetail -> ErrorDetail -> ErrorDetail)
-> (ErrorDetail -> ErrorDetail -> ErrorDetail)
-> Ord ErrorDetail
ErrorDetail -> ErrorDetail -> Bool
ErrorDetail -> ErrorDetail -> Ordering
ErrorDetail -> ErrorDetail -> ErrorDetail
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ErrorDetail -> ErrorDetail -> Ordering
compare :: ErrorDetail -> ErrorDetail -> Ordering
$c< :: ErrorDetail -> ErrorDetail -> Bool
< :: ErrorDetail -> ErrorDetail -> Bool
$c<= :: ErrorDetail -> ErrorDetail -> Bool
<= :: ErrorDetail -> ErrorDetail -> Bool
$c> :: ErrorDetail -> ErrorDetail -> Bool
> :: ErrorDetail -> ErrorDetail -> Bool
$c>= :: ErrorDetail -> ErrorDetail -> Bool
>= :: ErrorDetail -> ErrorDetail -> Bool
$cmax :: ErrorDetail -> ErrorDetail -> ErrorDetail
max :: ErrorDetail -> ErrorDetail -> ErrorDetail
$cmin :: ErrorDetail -> ErrorDetail -> ErrorDetail
min :: ErrorDetail -> ErrorDetail -> ErrorDetail
Ord, Int -> ErrorDetail -> ShowS
[ErrorDetail] -> ShowS
ErrorDetail -> [Char]
(Int -> ErrorDetail -> ShowS)
-> (ErrorDetail -> [Char])
-> ([ErrorDetail] -> ShowS)
-> Show ErrorDetail
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorDetail -> ShowS
showsPrec :: Int -> ErrorDetail -> ShowS
$cshow :: ErrorDetail -> [Char]
show :: ErrorDetail -> [Char]
$cshowList :: [ErrorDetail] -> ShowS
showList :: [ErrorDetail] -> ShowS
Show)

data NotificationResponse = NotificationResponse {NotificationResponse -> Int32
notifierPid :: !Int32, NotificationResponse -> Text
channelName :: !Text, NotificationResponse -> Text
notifPayload :: !Text}
  deriving stock (NotificationResponse -> NotificationResponse -> Bool
(NotificationResponse -> NotificationResponse -> Bool)
-> (NotificationResponse -> NotificationResponse -> Bool)
-> Eq NotificationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationResponse -> NotificationResponse -> Bool
== :: NotificationResponse -> NotificationResponse -> Bool
$c/= :: NotificationResponse -> NotificationResponse -> Bool
/= :: NotificationResponse -> NotificationResponse -> Bool
Eq, Int -> NotificationResponse -> ShowS
[NotificationResponse] -> ShowS
NotificationResponse -> [Char]
(Int -> NotificationResponse -> ShowS)
-> (NotificationResponse -> [Char])
-> ([NotificationResponse] -> ShowS)
-> Show NotificationResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationResponse -> ShowS
showsPrec :: Int -> NotificationResponse -> ShowS
$cshow :: NotificationResponse -> [Char]
show :: NotificationResponse -> [Char]
$cshowList :: [NotificationResponse] -> ShowS
showList :: [NotificationResponse] -> ShowS
Show)

data ResetConnectionOpts = ResetConnectionOpts
  { -- | Runs `RESET ALL` and `RESET ROLE` on the connection. Defaults to True.
    ResetConnectionOpts -> Bool
resetAll :: Bool,
    -- | Runs `UNLISTEN *` on the connection and clears the internal queue of notifications. Defaults to True.
    ResetConnectionOpts -> Bool
unlistenAll :: Bool,
    -- | Throws an exception if there is an open transaction or if there's a transaction in error state. Defaults to True.
    ResetConnectionOpts -> Bool
checkTransactionState :: Bool
    -- TODO: Check for any temporary tables and throw?
  }

-- | An error coming from PostgreSQL. You can safely handle this and continue using the connection.
data PostgresError = PostgresError {PostgresError -> Map ErrorDetail ByteString
pgErrorDetails :: Map ErrorDetail LBS.ByteString, PostgresError -> ByteString
failedStatement :: !ByteString}
  deriving stock (Int -> PostgresError -> ShowS
[PostgresError] -> ShowS
PostgresError -> [Char]
(Int -> PostgresError -> ShowS)
-> (PostgresError -> [Char])
-> ([PostgresError] -> ShowS)
-> Show PostgresError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostgresError -> ShowS
showsPrec :: Int -> PostgresError -> ShowS
$cshow :: PostgresError -> [Char]
show :: PostgresError -> [Char]
$cshowList :: [PostgresError] -> ShowS
showList :: [PostgresError] -> ShowS
Show)

instance Exception PostgresError

-- | If you receive this exception, don't run any further SQL statements or use it for anything. Just close the connection with `closeForcefully` and discard it.
data IrrecoverableHpgsqlError = IrrecoverableHpgsqlError {IrrecoverableHpgsqlError -> Text
hpgsqlDetails :: Text, IrrecoverableHpgsqlError -> Maybe SomeException
innerException :: Maybe SomeException, IrrecoverableHpgsqlError -> Maybe ByteString
relatedStatement :: !(Maybe ByteString)}
  deriving stock (Int -> IrrecoverableHpgsqlError -> ShowS
[IrrecoverableHpgsqlError] -> ShowS
IrrecoverableHpgsqlError -> [Char]
(Int -> IrrecoverableHpgsqlError -> ShowS)
-> (IrrecoverableHpgsqlError -> [Char])
-> ([IrrecoverableHpgsqlError] -> ShowS)
-> Show IrrecoverableHpgsqlError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IrrecoverableHpgsqlError -> ShowS
showsPrec :: Int -> IrrecoverableHpgsqlError -> ShowS
$cshow :: IrrecoverableHpgsqlError -> [Char]
show :: IrrecoverableHpgsqlError -> [Char]
$cshowList :: [IrrecoverableHpgsqlError] -> ShowS
showList :: [IrrecoverableHpgsqlError] -> ShowS
Show)

instance Exception IrrecoverableHpgsqlError

throwIrrecoverableError :: (MonadThrow m) => Text -> m a
throwIrrecoverableError :: forall (m :: * -> *) a. MonadThrow m => Text -> m a
throwIrrecoverableError Text
errMsg = IrrecoverableHpgsqlError -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw (IrrecoverableHpgsqlError -> m a)
-> IrrecoverableHpgsqlError -> m a
forall a b. (a -> b) -> a -> b
$ IrrecoverableHpgsqlError {hpgsqlDetails :: Text
hpgsqlDetails = Text
errMsg, innerException :: Maybe SomeException
innerException = Maybe SomeException
forall a. Maybe a
Nothing, relatedStatement :: Maybe ByteString
relatedStatement = Maybe ByteString
forall a. Maybe a
Nothing}

-- ------------------------------------------------------------------
-- Msgs types (moved from Hpgsql.Msgs to avoid cycles)
-- ------------------------------------------------------------------

data ParseComplete = ParseComplete
  deriving stock (Int -> ParseComplete -> ShowS
[ParseComplete] -> ShowS
ParseComplete -> [Char]
(Int -> ParseComplete -> ShowS)
-> (ParseComplete -> [Char])
-> ([ParseComplete] -> ShowS)
-> Show ParseComplete
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseComplete -> ShowS
showsPrec :: Int -> ParseComplete -> ShowS
$cshow :: ParseComplete -> [Char]
show :: ParseComplete -> [Char]
$cshowList :: [ParseComplete] -> ShowS
showList :: [ParseComplete] -> ShowS
Show)

data BindComplete = BindComplete
  deriving stock (Int -> BindComplete -> ShowS
[BindComplete] -> ShowS
BindComplete -> [Char]
(Int -> BindComplete -> ShowS)
-> (BindComplete -> [Char])
-> ([BindComplete] -> ShowS)
-> Show BindComplete
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BindComplete -> ShowS
showsPrec :: Int -> BindComplete -> ShowS
$cshow :: BindComplete -> [Char]
show :: BindComplete -> [Char]
$cshowList :: [BindComplete] -> ShowS
showList :: [BindComplete] -> ShowS
Show)

data NoData = NoData
  deriving stock (Int -> NoData -> ShowS
[NoData] -> ShowS
NoData -> [Char]
(Int -> NoData -> ShowS)
-> (NoData -> [Char]) -> ([NoData] -> ShowS) -> Show NoData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoData -> ShowS
showsPrec :: Int -> NoData -> ShowS
$cshow :: NoData -> [Char]
show :: NoData -> [Char]
$cshowList :: [NoData] -> ShowS
showList :: [NoData] -> ShowS
Show)

-- | Column names and type OIDs.
newtype RowDescription = RowDescription {RowDescription -> [(Text, Oid)]
resultColumnTypes :: [(Text, Oid)]}
  deriving stock (Int -> RowDescription -> ShowS
[RowDescription] -> ShowS
RowDescription -> [Char]
(Int -> RowDescription -> ShowS)
-> (RowDescription -> [Char])
-> ([RowDescription] -> ShowS)
-> Show RowDescription
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowDescription -> ShowS
showsPrec :: Int -> RowDescription -> ShowS
$cshow :: RowDescription -> [Char]
show :: RowDescription -> [Char]
$cshowList :: [RowDescription] -> ShowS
showList :: [RowDescription] -> ShowS
Show)

data CopyInResponse = CopyInResponse
  deriving stock (Int -> CopyInResponse -> ShowS
[CopyInResponse] -> ShowS
CopyInResponse -> [Char]
(Int -> CopyInResponse -> ShowS)
-> (CopyInResponse -> [Char])
-> ([CopyInResponse] -> ShowS)
-> Show CopyInResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyInResponse -> ShowS
showsPrec :: Int -> CopyInResponse -> ShowS
$cshow :: CopyInResponse -> [Char]
show :: CopyInResponse -> [Char]
$cshowList :: [CopyInResponse] -> ShowS
showList :: [CopyInResponse] -> ShowS
Show)

newtype ErrorResponse = ErrorResponse (Map ErrorDetail LBS.ByteString)
  deriving stock (Int -> ErrorResponse -> ShowS
[ErrorResponse] -> ShowS
ErrorResponse -> [Char]
(Int -> ErrorResponse -> ShowS)
-> (ErrorResponse -> [Char])
-> ([ErrorResponse] -> ShowS)
-> Show ErrorResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorResponse -> ShowS
showsPrec :: Int -> ErrorResponse -> ShowS
$cshow :: ErrorResponse -> [Char]
show :: ErrorResponse -> [Char]
$cshowList :: [ErrorResponse] -> ShowS
showList :: [ErrorResponse] -> ShowS
Show)

newtype CommandComplete = CommandComplete {CommandComplete -> Int64
numRows :: Int64}
  deriving stock (Int -> CommandComplete -> ShowS
[CommandComplete] -> ShowS
CommandComplete -> [Char]
(Int -> CommandComplete -> ShowS)
-> (CommandComplete -> [Char])
-> ([CommandComplete] -> ShowS)
-> Show CommandComplete
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandComplete -> ShowS
showsPrec :: Int -> CommandComplete -> ShowS
$cshow :: CommandComplete -> [Char]
show :: CommandComplete -> [Char]
$cshowList :: [CommandComplete] -> ShowS
showList :: [CommandComplete] -> ShowS
Show)

newtype DataRow = DataRow {DataRow -> ByteString
rowColumnData :: ByteString}

instance Show DataRow where
  show :: DataRow -> [Char]
show DataRow
_ = [Char]
"DataRow"

newtype ReadyForQuery
  = ReadyForQuery TransactionStatus
  deriving stock (Int -> ReadyForQuery -> ShowS
[ReadyForQuery] -> ShowS
ReadyForQuery -> [Char]
(Int -> ReadyForQuery -> ShowS)
-> (ReadyForQuery -> [Char])
-> ([ReadyForQuery] -> ShowS)
-> Show ReadyForQuery
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadyForQuery -> ShowS
showsPrec :: Int -> ReadyForQuery -> ShowS
$cshow :: ReadyForQuery -> [Char]
show :: ReadyForQuery -> [Char]
$cshowList :: [ReadyForQuery] -> ShowS
showList :: [ReadyForQuery] -> ShowS
Show)

-- ------------------------------------------------------------------
-- Internal connection state types (moved from Hpgsql)
-- ------------------------------------------------------------------

data Either3 a b c = Left3 !a | Middle3 !b | Right3 !c
  deriving stock (Int -> Either3 a b c -> ShowS
[Either3 a b c] -> ShowS
Either3 a b c -> [Char]
(Int -> Either3 a b c -> ShowS)
-> (Either3 a b c -> [Char])
-> ([Either3 a b c] -> ShowS)
-> Show (Either3 a b c)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall a b c.
(Show a, Show b, Show c) =>
Int -> Either3 a b c -> ShowS
forall a b c. (Show a, Show b, Show c) => [Either3 a b c] -> ShowS
forall a b c. (Show a, Show b, Show c) => Either3 a b c -> [Char]
$cshowsPrec :: forall a b c.
(Show a, Show b, Show c) =>
Int -> Either3 a b c -> ShowS
showsPrec :: Int -> Either3 a b c -> ShowS
$cshow :: forall a b c. (Show a, Show b, Show c) => Either3 a b c -> [Char]
show :: Either3 a b c -> [Char]
$cshowList :: forall a b c. (Show a, Show b, Show c) => [Either3 a b c] -> ShowS
showList :: [Either3 a b c] -> ShowS
Show)

-- | An Integer avoids any headaches from wrap-around when comparing query ids.
-- An Int64 should be fine, but the cost of this is negligible.
newtype QueryId = QueryId Integer
  deriving newtype (Int -> QueryId
QueryId -> Int
QueryId -> [QueryId]
QueryId -> QueryId
QueryId -> QueryId -> [QueryId]
QueryId -> QueryId -> QueryId -> [QueryId]
(QueryId -> QueryId)
-> (QueryId -> QueryId)
-> (Int -> QueryId)
-> (QueryId -> Int)
-> (QueryId -> [QueryId])
-> (QueryId -> QueryId -> [QueryId])
-> (QueryId -> QueryId -> [QueryId])
-> (QueryId -> QueryId -> QueryId -> [QueryId])
-> Enum QueryId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: QueryId -> QueryId
succ :: QueryId -> QueryId
$cpred :: QueryId -> QueryId
pred :: QueryId -> QueryId
$ctoEnum :: Int -> QueryId
toEnum :: Int -> QueryId
$cfromEnum :: QueryId -> Int
fromEnum :: QueryId -> Int
$cenumFrom :: QueryId -> [QueryId]
enumFrom :: QueryId -> [QueryId]
$cenumFromThen :: QueryId -> QueryId -> [QueryId]
enumFromThen :: QueryId -> QueryId -> [QueryId]
$cenumFromTo :: QueryId -> QueryId -> [QueryId]
enumFromTo :: QueryId -> QueryId -> [QueryId]
$cenumFromThenTo :: QueryId -> QueryId -> QueryId -> [QueryId]
enumFromThenTo :: QueryId -> QueryId -> QueryId -> [QueryId]
Enum, QueryId -> QueryId -> Bool
(QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool) -> Eq QueryId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryId -> QueryId -> Bool
== :: QueryId -> QueryId -> Bool
$c/= :: QueryId -> QueryId -> Bool
/= :: QueryId -> QueryId -> Bool
Eq, Integer -> QueryId
QueryId -> QueryId
QueryId -> QueryId -> QueryId
(QueryId -> QueryId -> QueryId)
-> (QueryId -> QueryId -> QueryId)
-> (QueryId -> QueryId -> QueryId)
-> (QueryId -> QueryId)
-> (QueryId -> QueryId)
-> (QueryId -> QueryId)
-> (Integer -> QueryId)
-> Num QueryId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: QueryId -> QueryId -> QueryId
+ :: QueryId -> QueryId -> QueryId
$c- :: QueryId -> QueryId -> QueryId
- :: QueryId -> QueryId -> QueryId
$c* :: QueryId -> QueryId -> QueryId
* :: QueryId -> QueryId -> QueryId
$cnegate :: QueryId -> QueryId
negate :: QueryId -> QueryId
$cabs :: QueryId -> QueryId
abs :: QueryId -> QueryId
$csignum :: QueryId -> QueryId
signum :: QueryId -> QueryId
$cfromInteger :: Integer -> QueryId
fromInteger :: Integer -> QueryId
Num, Eq QueryId
Eq QueryId =>
(QueryId -> QueryId -> Ordering)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> QueryId)
-> (QueryId -> QueryId -> QueryId)
-> Ord QueryId
QueryId -> QueryId -> Bool
QueryId -> QueryId -> Ordering
QueryId -> QueryId -> QueryId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QueryId -> QueryId -> Ordering
compare :: QueryId -> QueryId -> Ordering
$c< :: QueryId -> QueryId -> Bool
< :: QueryId -> QueryId -> Bool
$c<= :: QueryId -> QueryId -> Bool
<= :: QueryId -> QueryId -> Bool
$c> :: QueryId -> QueryId -> Bool
> :: QueryId -> QueryId -> Bool
$c>= :: QueryId -> QueryId -> Bool
>= :: QueryId -> QueryId -> Bool
$cmax :: QueryId -> QueryId -> QueryId
max :: QueryId -> QueryId -> QueryId
$cmin :: QueryId -> QueryId -> QueryId
min :: QueryId -> QueryId -> QueryId
Ord, Int -> QueryId -> ShowS
[QueryId] -> ShowS
QueryId -> [Char]
(Int -> QueryId -> ShowS)
-> (QueryId -> [Char]) -> ([QueryId] -> ShowS) -> Show QueryId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryId -> ShowS
showsPrec :: Int -> QueryId -> ShowS
$cshow :: QueryId -> [Char]
show :: QueryId -> [Char]
$cshowList :: [QueryId] -> ShowS
showList :: [QueryId] -> ShowS
Show)

data CopyQueryState = StillCopying | CopyDoneAndSyncSent | CopyFailAndSyncSent
  deriving stock (CopyQueryState -> CopyQueryState -> Bool
(CopyQueryState -> CopyQueryState -> Bool)
-> (CopyQueryState -> CopyQueryState -> Bool) -> Eq CopyQueryState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CopyQueryState -> CopyQueryState -> Bool
== :: CopyQueryState -> CopyQueryState -> Bool
$c/= :: CopyQueryState -> CopyQueryState -> Bool
/= :: CopyQueryState -> CopyQueryState -> Bool
Eq, Int -> CopyQueryState -> ShowS
[CopyQueryState] -> ShowS
CopyQueryState -> [Char]
(Int -> CopyQueryState -> ShowS)
-> (CopyQueryState -> [Char])
-> ([CopyQueryState] -> ShowS)
-> Show CopyQueryState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyQueryState -> ShowS
showsPrec :: Int -> CopyQueryState -> ShowS
$cshow :: CopyQueryState -> [Char]
show :: CopyQueryState -> [Char]
$cshowList :: [CopyQueryState] -> ShowS
showList :: [CopyQueryState] -> ShowS
Show)

data QueryProtocol
  = CopyQuery CopyQueryState
  | ExtendedQuery
  deriving stock (QueryProtocol -> QueryProtocol -> Bool
(QueryProtocol -> QueryProtocol -> Bool)
-> (QueryProtocol -> QueryProtocol -> Bool) -> Eq QueryProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryProtocol -> QueryProtocol -> Bool
== :: QueryProtocol -> QueryProtocol -> Bool
$c/= :: QueryProtocol -> QueryProtocol -> Bool
/= :: QueryProtocol -> QueryProtocol -> Bool
Eq, Int -> QueryProtocol -> ShowS
[QueryProtocol] -> ShowS
QueryProtocol -> [Char]
(Int -> QueryProtocol -> ShowS)
-> (QueryProtocol -> [Char])
-> ([QueryProtocol] -> ShowS)
-> Show QueryProtocol
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryProtocol -> ShowS
showsPrec :: Int -> QueryProtocol -> ShowS
$cshow :: QueryProtocol -> [Char]
show :: QueryProtocol -> [Char]
$cshowList :: [QueryProtocol] -> ShowS
showList :: [QueryProtocol] -> ShowS
Show)

-- | From the docs, "in GHC, if you have a ThreadId, you essentially have a pointer to the thread itself. This means the thread itself can't be garbage collected until you drop the ThreadId. This misfeature will hopefully be corrected at a later date.".
-- And as per https://hackage-content.haskell.org/package/base-4.22.0.0/docs/Control-Concurrent.html#v:mkWeakThreadId even BlockedIndefinitely exceptions aren't delivered if we held a ThreadId directly, so we only keep a WeakThreadId.
#if MIN_VERSION_base(4,19,0)
data WeakThreadId = WeakThreadId !(Weak ThreadId) !Word64
#else
-- fromThreadId is not available in GHC 9.6 and below, so
-- we rely on the String obtained from showThreadId instead
data WeakThreadId = WeakThreadId !(Weak ThreadId) !String
#endif

instance Eq WeakThreadId where
  WeakThreadId Weak ThreadId
_ Word64
t1 == :: WeakThreadId -> WeakThreadId -> Bool
== WeakThreadId Weak ThreadId
_ Word64
t2 = Word64
t1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
t2

#if MIN_VERSION_base(4,19,0)
instance Show WeakThreadId where
  show :: WeakThreadId -> [Char]
show (WeakThreadId Weak ThreadId
_ Word64
threadIdentifier) = [Char]
"WeakThreadId " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
threadIdentifier
#else
instance Show WeakThreadId where
  show (WeakThreadId _ threadIdentifier) = "WeakThreadId " ++ threadIdentifier
#endif

data ResponseMsgsReceived = NoMsgsReceived | ParseCompleteReceived ParseComplete | BindCompleteReceived BindComplete | RowDescriptionOrNoDataOrCopyInResponseReceived (Either3 NoData RowDescription CopyInResponse) | ErrorResponseReceived (Maybe (Either3 NoData RowDescription CopyInResponse)) ErrorResponse | CommandCompleteReceived (Either3 NoData RowDescription CopyInResponse) CommandComplete | ReadyForQueryReceived (Either ErrorResponse CommandComplete) ReadyForQuery
  deriving stock (Int -> ResponseMsgsReceived -> ShowS
[ResponseMsgsReceived] -> ShowS
ResponseMsgsReceived -> [Char]
(Int -> ResponseMsgsReceived -> ShowS)
-> (ResponseMsgsReceived -> [Char])
-> ([ResponseMsgsReceived] -> ShowS)
-> Show ResponseMsgsReceived
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseMsgsReceived -> ShowS
showsPrec :: Int -> ResponseMsgsReceived -> ShowS
$cshow :: ResponseMsgsReceived -> [Char]
show :: ResponseMsgsReceived -> [Char]
$cshowList :: [ResponseMsgsReceived] -> ShowS
showList :: [ResponseMsgsReceived] -> ShowS
Show)

data ResponseMsg = RespParseComplete ParseComplete | RespBindComplete BindComplete | RespNoData NoData | RespRowDescription RowDescription | RespCopyInResponse CopyInResponse | RespErrorResponse ErrorResponse | RespCommandComplete CommandComplete | RespDataRow DataRow | RespReadyForQuery ReadyForQuery
  deriving stock (Int -> ResponseMsg -> ShowS
[ResponseMsg] -> ShowS
ResponseMsg -> [Char]
(Int -> ResponseMsg -> ShowS)
-> (ResponseMsg -> [Char])
-> ([ResponseMsg] -> ShowS)
-> Show ResponseMsg
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseMsg -> ShowS
showsPrec :: Int -> ResponseMsg -> ShowS
$cshow :: ResponseMsg -> [Char]
show :: ResponseMsg -> [Char]
$cshowList :: [ResponseMsg] -> ShowS
showList :: [ResponseMsg] -> ShowS
Show)

data QueryState = QueryState
  { QueryState -> QueryId
queryIdentifier :: !QueryId,
    QueryState -> ByteString
queryText :: !ByteString,
    QueryState -> QueryProtocol
queryProtocol :: !QueryProtocol,
    QueryState -> Maybe [Char]
queryPrepStmtName :: !(Maybe String),
    QueryState -> WeakThreadId
queryOwner :: !WeakThreadId,
    -- | Storing every single "control" (i.e. not `DataRow`) message received for each query
    -- means we can continue to drain its results from another thread at anytime, which is
    -- necessary to continue using the connection in the presence of asynchronous exceptions.
    QueryState -> ResponseMsgsReceived
responseMsgsState :: ResponseMsgsReceived
  }
  deriving stock (Int -> QueryState -> ShowS
[QueryState] -> ShowS
QueryState -> [Char]
(Int -> QueryState -> ShowS)
-> (QueryState -> [Char])
-> ([QueryState] -> ShowS)
-> Show QueryState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryState -> ShowS
showsPrec :: Int -> QueryState -> ShowS
$cshow :: QueryState -> [Char]
show :: QueryState -> [Char]
$cshowList :: [QueryState] -> ShowS
showList :: [QueryState] -> ShowS
Show)

data InternalConnectionState = InternalConnectionState
  { InternalConnectionState -> Integer
totalQueriesSent :: !Integer,
    -- | We support only one pipeline sent to the backend at a time.
    InternalConnectionState -> [QueryState]
currentPipeline :: ![QueryState],
    -- | In cases like when an asynchronous exception interrupts a `withTransaction`
    -- section, we want a "ROLLBACK" to run _before_ any next commands, to preserve
    -- the invariant that `withTransaction` ensures the started transaction is no more
    -- regardless of what happens.
    -- When such a thing happens, this field is True.
    InternalConnectionState -> Bool
mustIssueRollbackBeforeNextCommand :: Bool,
    -- | How did we end up with a TQueue inside an object that
    -- is already a TVar? This is unnecessary and could live out of
    -- InternalConnectionState.
    InternalConnectionState -> TQueue NotificationResponse
notificationsReceived :: !(TQueue NotificationResponse),
    InternalConnectionState -> Set [Char]
preparedStatementNames :: Set String,
    InternalConnectionState -> TransactionStatus
transactionStatusBeforeCurrentPipeline :: !TransactionStatus
  }

-- ------------------------------------------------------------------
-- Connection and Pipeline types
-- ------------------------------------------------------------------

data HPgConnection = HPgConnection
  { HPgConnection -> Socket
socket :: !Socket,
    HPgConnection -> MVar Bool
socketClosed :: !(MVar Bool),
    HPgConnection -> MVar ByteString
recvBuffer :: !(MVar LBS.ByteString),
    HPgConnection -> MVar [(ByteString, STM ())]
sendBuffer :: !(MVar [(LBS.ByteString, STM ())]),
    HPgConnection -> Mutex
socketMutex :: !Mutex,
    HPgConnection -> ConnectionString
originalConnStr :: !ConnectionString,
    HPgConnection -> AddrInfo
connectedTo :: !AddrInfo,
    HPgConnection -> MVar EncodingContext
encodingContext :: !(MVar EncodingContext),
    HPgConnection -> MVar (Map Text Text)
parameterStatusMap :: !(MVar (Map Text Text)),
    HPgConnection -> TVar InternalConnectionState
internalConnectionState :: !(TVar InternalConnectionState),
    HPgConnection -> Int32
connPid :: !Int32,
    HPgConnection -> Int32
cancelSecretKey :: !Int32,
    HPgConnection -> ConnectOpts
connOpts :: !ConnectOpts
  }

instance Eq HPgConnection where
  HPgConnection
conn1 == :: HPgConnection -> HPgConnection -> Bool
== HPgConnection
conn2 = HPgConnection -> Socket
socket HPgConnection
conn1 Socket -> Socket -> Bool
forall a. Eq a => a -> a -> Bool
== HPgConnection -> Socket
socket HPgConnection
conn2

-- | A reentrant mutex, i.e. one that can be re-acquired by the same
-- thread without deadlocking.
newtype Mutex = Mutex (TVar (Maybe (WeakThreadId, Int)))

mkMutex :: IO Mutex
mkMutex :: IO Mutex
mkMutex = TVar (Maybe (WeakThreadId, Int)) -> Mutex
Mutex (TVar (Maybe (WeakThreadId, Int)) -> Mutex)
-> IO (TVar (Maybe (WeakThreadId, Int))) -> IO Mutex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WeakThreadId, Int) -> IO (TVar (Maybe (WeakThreadId, Int)))
forall a. a -> IO (TVar a)
STM.newTVarIO Maybe (WeakThreadId, Int)
forall a. Maybe a
Nothing

data Pipeline a = Pipeline [(SingleQuery, Maybe Int)] (HPgConnection -> [QueryId] -> a)
  deriving stock ((forall a b. (a -> b) -> Pipeline a -> Pipeline b)
-> (forall a b. a -> Pipeline b -> Pipeline a) -> Functor Pipeline
forall a b. a -> Pipeline b -> Pipeline a
forall a b. (a -> b) -> Pipeline a -> Pipeline 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) -> Pipeline a -> Pipeline b
fmap :: forall a b. (a -> b) -> Pipeline a -> Pipeline b
$c<$ :: forall a b. a -> Pipeline b -> Pipeline a
<$ :: forall a b. a -> Pipeline b -> Pipeline a
Functor)

instance Applicative Pipeline where
  pure :: forall a. a -> Pipeline a
pure a
x = [(SingleQuery, Maybe Int)]
-> (HPgConnection -> [QueryId] -> a) -> Pipeline a
forall a.
[(SingleQuery, Maybe Int)]
-> (HPgConnection -> [QueryId] -> a) -> Pipeline a
Pipeline [] (\HPgConnection
_ [QueryId]
_ -> a
x)
  Pipeline [(SingleQuery, Maybe Int)]
queries HPgConnection -> [QueryId] -> a -> b
runFunc <*> :: forall a b. Pipeline (a -> b) -> Pipeline a -> Pipeline b
<*> Pipeline [(SingleQuery, Maybe Int)]
moreQueries HPgConnection -> [QueryId] -> a
run2 = [(SingleQuery, Maybe Int)]
-> (HPgConnection -> [QueryId] -> b) -> Pipeline b
forall a.
[(SingleQuery, Maybe Int)]
-> (HPgConnection -> [QueryId] -> a) -> Pipeline a
Pipeline ([(SingleQuery, Maybe Int)]
queries [(SingleQuery, Maybe Int)]
-> [(SingleQuery, Maybe Int)] -> [(SingleQuery, Maybe Int)]
forall a. [a] -> [a] -> [a]
++ [(SingleQuery, Maybe Int)]
moreQueries) ((HPgConnection -> [QueryId] -> b) -> Pipeline b)
-> (HPgConnection -> [QueryId] -> b) -> Pipeline b
forall a b. (a -> b) -> a -> b
$ \HPgConnection
conn [QueryId]
qryIds ->
    let ([QueryId]
firstQueries, [QueryId]
lastQueries) = Int -> [QueryId] -> ([QueryId], [QueryId])
forall a. Int -> [a] -> ([a], [a])
List.splitAt ([(SingleQuery, Maybe Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(SingleQuery, Maybe Int)]
queries) [QueryId]
qryIds
        f :: a -> b
f = HPgConnection -> [QueryId] -> a -> b
runFunc HPgConnection
conn [QueryId]
firstQueries
        g :: a
g = HPgConnection -> [QueryId] -> a
run2 HPgConnection
conn [QueryId]
lastQueries
     in a -> b
f a
g