packages feed

hpgsql (empty) → 0.1.0.0

raw patch · 26 files changed

+8668/−0 lines, 26 filesdep +Onlydep +aesondep +attoparsec

Dependencies added: Only, aeson, attoparsec, base, bytestring, case-insensitive, cereal, containers, cryptohash-md5, hashable, haskell-src-meta, network, network-uri, safe-exceptions, scientific, stm, streaming, template-haskell, text, time, transformers, uuid-types, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Marcelo Zabani (c) 2026++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Marcelo Zabani nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ hpgsql.cabal view
@@ -0,0 +1,117 @@+cabal-version: 2.0++name:           hpgsql+version:        0.1.0.0+synopsis:       Pure Haskell PostgreSQL driver (no libpq)+description:    hpgsql is a pure Haskell implementation of a PostgreSQL driver+category:       Database+homepage:       https://github.com/mzabani/hpgsql#readme+bug-reports:    https://github.com/mzabani/hpgsql/issues+author:         Marcelo Zabani+maintainer:     mzabani@gmail.com+copyright:      2026 Marcelo Zabani+license:        BSD3+license-file:   LICENSE+build-type:     Simple+tested-with:+  GHC ==9.6.7+   || ==9.8.4+   || ==9.10.3++source-repository head+  type: git+  location: https://github.com/mzabani/hpgsql++library+  exposed-modules:+      Hpgsql+      Hpgsql.Builder+      Hpgsql.Cancellation+      Hpgsql.Connection+      Hpgsql.Copy+      Hpgsql.Encoding+      Hpgsql.Encoding.RowDecoderMonadic+      Hpgsql.InternalTypes+      Hpgsql.Notification+      Hpgsql.ParsingInternal+      Hpgsql.Pipeline+      Hpgsql.Query+      Hpgsql.Time+      Hpgsql.Transaction+      Hpgsql.TypeInfo+      Hpgsql.Types+  other-modules:+      Hpgsql.Base+      Hpgsql.Internal+      Hpgsql.Locking+      Hpgsql.Msgs+      Hpgsql.Networking+      Hpgsql.QueryInternal+      Hpgsql.SimpleParser+      Hpgsql.TransactionStatusInternal+      Paths_hpgsql+  autogen-modules:+      Paths_hpgsql+  hs-source-dirs:+      src+  default-extensions:+      CPP+      BangPatterns+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveFunctor+      DeriveGeneric+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      LambdaCase+      FlexibleContexts+      FlexibleInstances+      GADTs+      GeneralizedNewtypeDeriving+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      NumericUnderscores+      OverloadedRecordDot+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      StandaloneDeriving+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      QuasiQuotes+      TemplateHaskell+      ViewPatterns+  -- -optP-Wno-nonportable-include-path fixes macOS builds: https://github.com/haskell/cabal/issues/4739#issuecomment-359209133+  ghc-options: -Wall -Wincomplete-uni-patterns -Wunused-packages -Wpartial-fields -optP-Wno-nonportable-include-path+  build-depends:+    Only >= 0.1 && < 0.2,+    aeson >= 2.2 && < 2.3,+    attoparsec >= 0.14 && < 0.15,+    base >= 4.18 && < 4.21,+    bytestring >= 0.11 && < 0.13,+    case-insensitive >= 1.2 && < 1.3,+    cereal >= 0.5 && < 0.6,+    containers >= 0.6 && < 0.8,+    cryptohash-md5 >= 0.11.7.1 && < 0.12,+    hashable >= 1.5 && < 1.6,+    haskell-src-meta >= 0.8 && < 0.9,+    network >= 3.2 && < 3.3,+    network-uri >= 2.6 && < 2.7,+    safe-exceptions >= 0.1 && < 0.2,+    scientific >= 0.3 && < 0.4,+    stm >= 2.5 && < 2.6,+    streaming >= 0.2 && < 0.3,+    template-haskell >= 2.20 && < 2.23,+    text >= 2.0 && < 2.2,+    time >= 1.12 && < 1.13,+    transformers >= 0.6 && < 0.7,+    uuid-types >= 1.0 && < 1.1,+    vector >= 0.13 && < 0.14+  default-language: Haskell2010
+ src/Hpgsql.hs view
@@ -0,0 +1,115 @@+-- |+-- Module      : Hpgsql+-- Description : A pure Haskell PostgreSQL driver (no libpq) with pipelines, prepared statements, streaming, thread safety and interruption safety.+--+-- Hpgsql is a PostgreSQL driver written entirely in Haskell, with no bindings to @libpq@.+-- It communicates with the database using the PostgreSQL wire protocol directly.+--+-- = Quick start+--+-- Connect to the database and run a simple query:+--+-- > {-# LANGUAGE QuasiQuotes #-}+-- > import Hpgsql+-- > import Hpgsql.Connection (withConnection, ConnectionString(..))+-- > import Hpgsql.Query (sql)+-- >+-- > main :: IO ()+-- > main = do+-- >   let connstr = ConnectionString+-- >         { hostname = "localhost"+-- >         , port     = 5432+-- >         , user     = "postgres"+-- >         , password = ""+-- >         , database = "mydb"+-- >         , options  = ""+-- >         }+-- >   -- Connect with a 10-second timeout+-- >   withConnection connstr 10 $ \conn -> do+-- >     rows <- query conn [sql|SELECT 1 + 1|]+-- >     print (rows :: [Only Int])+-- >     -- [Only {fromOnly = 2}]+--+-- = Building queries+--+-- Use the @[sql|...|]@ quasiquoter from "Hpgsql.Query" to build queries. Interpolate Haskell+-- values with @#{}@:+--+-- > let name = "Alice" :: Text+-- > rows <- query conn [sql|SELECT id, email FROM users WHERE name = #{name}|]+-- > print (rows :: [(Int, Text)])+--+-- Values interpolated with @#{}@ are sent as query parameters, so they are safe from SQL injection.+--+-- To embed a 'Query' fragment (e.g. an identifier or a sub-query), use @^{}@:+--+-- > let tableName = escapeIdentifier "users"+-- > rows <- query conn [sql|SELECT * FROM ^{tableName}|]+--+-- You can also use 'Hpgsql.Query.mkQuery' with dollar-numbered query arguments:+--+-- > query conn (mkQuery "SELECT * FROM users WHERE age BETWEEN $1 AND $2" (18 :: Int, 60 :: Int))+--+-- And finally, you can use the @[sqlPrep|...|]@ quasiquoter to build prepared statements.+--+-- = Fetching results+--+-- * 'query' returns all rows as a list.+-- * 'queryS' returns all rows as a Stream, streaming directly from the socket (without cursors).+-- * 'query1' returns exactly one row, throwing if zero or more than one row is returned.+-- * 'queryMay' returns zero or one row, throwing if more than one is returned.+-- * 'execute' runs a statement and returns the count of affected rows.+-- * 'execute_' runs a statement and discards the result.+--+-- All these methods have equivalents in "Hpgsql.Pipeline" that can be composed together+-- to reduce the number of round-trips.+--+-- = Encoders and decoders+--+-- To define your own encoder and decoder instances, take a look at "Hpgsql.Encoding".+--+-- = Handling errors+--+-- - Hpgsql is interruption-safe (with one exception for COPY inside transactions; see "Hpgsql.Copy"), so a query can be interrupted by asynchronous exceptions and you should still be able to run new queries on the same connection without any other side-effects. Naturally, it is up to you to determine which queries ran or not to completion, since they might have side-effects.+-- - Hpgsql will throw either `PostgresError` or `IrrecoverableHpgsqlError`, and:+--    - If you receive a `IrrecoverableHpgsqlError`, Hpgsql makes no promises about which statements ran to completion and what connection state is, and you should `closeForcefully` the connection without running any other queries. These errors should only be thrown for "obvious" developer mistakes from which usually there would be no way to proceed, anyway.+--    - If you receive a `PostgresError` exception, postgres and Hpgsql's states are synced and you can issue new queries afterwards.+--+-- = What's in this module+--+-- This module re-exports some of the essentials: querying and the core types.+-- We recommend importing from this module instead of others whenever possible.+-- For more functionality, see:+--+-- * "Hpgsql.Connection" for connecting and connection state resetting.+-- * "Hpgsql.Copy" for @COPY@ protocol support.+-- * "Hpgsql.Pipeline" for building pipelines of queries.+-- * "Hpgsql.Query" for the @sql@ and @sqlPrep@ quasiquoters, and query-building helpers.+-- * "Hpgsql.Transaction" for transaction management.+-- * "Hpgsql.Types" for extra types that might be useful.+-- * "Hpgsql.Cancellation" for cancelling active queries.+module Hpgsql+  ( -- * Query+    query,+    queryWith,+    queryMWith,+    queryS,+    querySWith,+    querySMWith,+    query1,+    query1With,+    queryMay,+    queryMayWith,+    execute,+    execute_,++    -- * Useful re-exports+    HPgConnection, -- Do not export constructor+    PostgresError (..),+    IrrecoverableHpgsqlError (..),+    ErrorDetail (..),+  )+where++import Hpgsql.Internal+import Hpgsql.InternalTypes (ErrorDetail (..), HPgConnection, IrrecoverableHpgsqlError (..), PostgresError (..))
+ src/Hpgsql/Base.hs view
@@ -0,0 +1,72 @@+module Hpgsql.Base where++import Control.Monad (void)+import Data.Bifunctor (second)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe (mapMaybe)++headMaybe :: [a] -> Maybe a+headMaybe [] = Nothing+headMaybe (x : _) = Just x++lastMaybe :: [a] -> Maybe a+lastMaybe [] = Nothing+lastMaybe [x] = Just x+lastMaybe (_ : xs) = lastMaybe xs++lastAndInit :: [a] -> ([a], Maybe a)+lastAndInit xs = case NE.nonEmpty xs of+  Nothing -> ([], Nothing)+  Just nxs -> second Just $ lastAndInitNE nxs++lastAndInitNE :: NonEmpty a -> ([a], a)+lastAndInitNE (x :| xs) =+  case NE.nonEmpty xs of+    Nothing -> ([], x)+    Just neXs ->+      let (others, l) = lastAndInitNE neXs+       in (x : others, l)++-- | Only returns a Just for list with 2 or more elements,+-- and no element from the input is missing in the returned+-- value, and no element is repeated.+lastTwoAndInit :: [a] -> ([a], Maybe (a, a))+lastTwoAndInit xs = case lastAndInit xs of+  (l, Nothing) -> (l, Nothing)+  (l, Just lst) -> case lastAndInit l of+    (_, Nothing) -> (l ++ [lst], Nothing)+    (l', Just secLst) -> (l', Just (secLst, lst))++whenNonEmpty :: [a] -> (NonEmpty a -> IO b) -> IO ()+whenNonEmpty [] _ = pure ()+whenNonEmpty (x : xs) f = void $ f (x :| xs)++ifM :: IO Bool -> IO a -> IO a -> IO a+ifM cond fTrue fFalse = do+  v <- cond+  if v then fTrue else fFalse++-- | Takes the minimum of the Just values only, or the default if there are none.+minimumOnOrDef :: (Ord b) => b -> [a] -> (a -> Maybe b) -> b+minimumOnOrDef def xs f =+  case mapMaybe f xs of+    [] -> def+    ls -> minimum ls++-- | Takes the maximum of the Just values only, or the default if there are none.+maximumOnOrDef :: (Ord b) => b -> [a] -> (a -> Maybe b) -> b+maximumOnOrDef def xs f =+  case mapMaybe f xs of+    [] -> def+    ls -> maximum ls++whenJust :: (Applicative m) => Maybe a -> (a -> m ()) -> m ()+whenJust m f = case m of+  Nothing -> pure ()+  Just v -> f v++-- whenM :: IO Bool -> IO a -> IO ()+-- whenM cond f = do+--   v <- cond+--   when v $ void f
+ src/Hpgsql/Builder.hs view
@@ -0,0 +1,72 @@+module Hpgsql.Builder where++-- \| This module replicates parts of the API of Data.ByteString.Builder but its own+-- builder is length-aware, which makes other parts of the code a little bit nicer.+-- In COPY benchmarks, this module was introduced in a commit (together with other+-- changes, like replacing `Maybe` with `BinaryField` in `ToPgField`) that barely+-- changed memory usage and runtime.+-- The benefits are exclusively for code readability, then.+-- \|++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Builder.Extra as Builder+import qualified Data.ByteString.Lazy as LBS+import Data.Int (Int16, Int32, Int64)+import Data.Word (Word8)++data BinaryField = SqlNull | NotNull !ByteString+  deriving stock (Eq)++instance Show BinaryField where+  show SqlNull = "NULL"+  show (NotNull bs) = show bs++data LengthAwareBuilder = LengthAwareBuilder !Int32 !Builder.Builder++type Builder = LengthAwareBuilder++instance Semigroup LengthAwareBuilder where+  LengthAwareBuilder l1 b1 <> LengthAwareBuilder l2 b2 = LengthAwareBuilder (l1 + l2) (b1 <> b2)++instance Monoid LengthAwareBuilder where+  mempty = LengthAwareBuilder 0 mempty++builderLength :: LengthAwareBuilder -> Int32+builderLength (LengthAwareBuilder n _) = n++binaryField :: BinaryField -> LengthAwareBuilder+binaryField = \case+  SqlNull -> LengthAwareBuilder 4 (Builder.int32BE (-1))+  NotNull val -> let valLen = fromIntegral (BS.length val) in LengthAwareBuilder (4 + valLen) (Builder.int32BE valLen <> Builder.byteString val)++toLazyByteString :: LengthAwareBuilder -> LBS.ByteString+toLazyByteString (LengthAwareBuilder (fromIntegral -> totalLen) builder) = Builder.toLazyByteStringWith (Builder.untrimmedStrategy totalLen 0) mempty builder++toStrictByteString :: LengthAwareBuilder -> ByteString+toStrictByteString = LBS.toStrict . toLazyByteString++char7 :: Char -> LengthAwareBuilder+char7 c = LengthAwareBuilder 1 (Builder.char7 c)++string7 :: String -> LengthAwareBuilder+string7 s = LengthAwareBuilder (fromIntegral $ length s) (Builder.string7 s)++word8 :: Word8 -> LengthAwareBuilder+word8 s = LengthAwareBuilder 1 (Builder.word8 s)++int16BE :: Int16 -> LengthAwareBuilder+int16BE n = LengthAwareBuilder 2 (Builder.int16BE n)++int32BE :: Int32 -> LengthAwareBuilder+int32BE n = LengthAwareBuilder 4 (Builder.int32BE n)++int64BE :: Int64 -> LengthAwareBuilder+int64BE n = LengthAwareBuilder 8 (Builder.int64BE n)++byteString :: ByteString -> LengthAwareBuilder+byteString bs = LengthAwareBuilder (fromIntegral $ BS.length bs) (Builder.byteString bs)++lazyByteString :: LBS.ByteString -> LengthAwareBuilder+lazyByteString bs = LengthAwareBuilder (fromIntegral $ LBS.length bs) (Builder.lazyByteString bs)
+ src/Hpgsql/Cancellation.hs view
@@ -0,0 +1,6 @@+module Hpgsql.Cancellation+  ( cancelActiveStatement,+  )+where++import Hpgsql.Internal (cancelActiveStatement)
+ src/Hpgsql/Connection.hs view
@@ -0,0 +1,259 @@+module Hpgsql.Connection+  ( connect,+    connectOpts,+    defaultConnectOpts,+    withConnection,+    withConnectionOpts,+    closeGracefully,+    closeForcefully,+    ConnectionString (..),+    parseLibpqConnectionString,+    ResetConnectionOpts (..),+    resetConnectionState,+    renderLibpqConnectionString,+    refreshTypeInfoCache,+    resetTypeInfoCache,+    getParameterStatus,+    getBackendPid,+  )+where++import Control.Applicative+  ( (<|>),+  )+import Control.Monad+  ( unless,+    void,+    when,+  )+import Control.Monad.Trans.Except (runExceptT, throwE)+import Data.Attoparsec.Text+  ( Parser,+    char,+    endOfInput,+    parseOnly,+    peekChar,+    skipWhile,+    takeWhile1,+  )+import qualified Data.Attoparsec.Text as Parsec+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.Char as Char+import Data.Functor.Identity (Identity (..))+import Data.List+  ( sortOn,+  )+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (encodeUtf8)+import Hpgsql.Internal (closeForcefully, closeGracefully, connect, connectOpts, defaultConnectOpts, getBackendPid, getParameterStatus, refreshTypeInfoCache, resetConnectionState, resetTypeInfoCache, withConnection, withConnectionOpts)+import Hpgsql.InternalTypes (ConnectionString (..), ResetConnectionOpts (..))+import Network.URI+  ( URI (..),+    URIAuth (..),+    parseURI,+    unEscapeString,+  )+import Prelude hiding (takeWhile)++-- | Parses a libpq compatible connection string.+parseLibpqConnectionString :: Text -> Either String ConnectionString+parseLibpqConnectionString =+  parseOnly (connStringParser <* endOfInput)++-- | Renders a libpq compatible connection string.+renderLibpqConnectionString :: ConnectionString -> ByteString+renderLibpqConnectionString ConnectionString {..} =+  ByteString.intercalate " " $+    map (\(kw, v) -> kw <> "=" <> v) mixedKwvps+  where+    mixedKwvps =+      catMaybes+        [ Just ("user", quote user),+          Just+            ("host", quote hostname),+          Just+            ("dbname", quote database),+          Just ("password", quote password),+          Just ("port", quote (Text.pack $ show port)),+          if Text.null options then Nothing else Just ("options", quote options)+        ]+    quote un =+      encodeUtf8 $+        "'"+          <> Text.replace "'" "\\'" (Text.replace "\\" "\\\\" un)+          <> "'"++-- | Parser that consumes any kind of Unicode space character, including \t, \n, \r, \f, \v.+skipAllWhiteSpace :: Parser ()+skipAllWhiteSpace = skipWhile Char.isSpace++-- | Parses a value using backslash as an escape char for any char that matches+-- the supplied predicate. Stops at and does not consume the first predicate-passing+-- char, and does not include escape chars in the returned value,+-- as one would expect.+parseWithEscapeCharProper :: (Char -> Bool) -> Parser Text+parseWithEscapeCharProper untilc = do+  cs <- Parsec.takeWhile (\c -> c /= '\\' && not (untilc c))+  nextChar <- peekChar+  case nextChar of+    Nothing -> pure cs+    Just '\\' -> do+      void $ char '\\'+      c <- Parsec.take 1+      rest <- parseWithEscapeCharProper untilc+      pure $ cs <> c <> rest+    Just _ -> pure cs++eitherToMay :: Either a b -> Maybe b+eitherToMay (Left _) = Nothing+eitherToMay (Right v) = Just v++-- | Parses a URI with scheme 'postgres' or 'postgresql', as per https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING.+-- The difference here is that URIs with a query string or with a fragment are not allowed.+uriConnParser :: Text -> Either String ConnectionString+uriConnParser line = runIdentity $ runExceptT @String @_ @ConnectionString $ do+  case parseURI (Text.unpack line) of+    Nothing -> throwE "Connection string is not a URI"+    Just URI {..} -> do+      unless+        (Text.toLower (Text.pack uriScheme) `elem` ["postgres:", "postgresql:"])+        $ throwE+          "Connection string's URI scheme must be 'postgres' or 'postgresql'"+      case uriAuthority of+        Nothing ->+          throwE+            "Connection string must contain at least user and host"+        Just URIAuth {..} -> do+          let database =+                Text.pack $ unEscapeString $ trimFirst '/' uriPath+              hasQueryString = not $ null uriQuery+              hasFragment = not $ null uriFragment+          when (Text.null database) $+            throwE+              "Connection string must contain a database name"+          when (hasQueryString || hasFragment) $+            throwE+              "Custom parameters are not supported in connection strings. Make sure your connection URI does not have a query string or query fragment"++          -- Ports are not mandatory and are defaulted to 5432 when not present+          let port = if null uriPort then Just 5432 else Nothing+          case port+            <|> eitherToMay+              ( parseOnly+                  (Parsec.decimal <* endOfInput)+                  (Text.pack $ trimFirst ':' uriPort)+              ) of+            Nothing ->+              throwE "Invalid port in connection string"+            Just parsedPort -> do+              let (Text.pack . unEscapeString . trimLast '@' -> user, Text.pack . unEscapeString . trimLast '@' . trimFirst ':' -> password) =+                    break (== ':') uriUserInfo+              pure+                ConnectionString+                  { hostname =+                      Text.pack $+                        unEscapeString $+                          unescapeIPv6 uriRegName,+                    port = parsedPort,+                    user,+                    password,+                    database,+                    options = ""+                  }+  where+    unescapeIPv6 :: String -> String+    unescapeIPv6 = trimFirst '[' . trimLast ']'++    trimFirst :: Char -> String -> String+    trimFirst c s@(c1 : cs) = if c == c1 then cs else s+    trimFirst _ s = s++    trimLast :: Char -> String -> String+    trimLast c s = case Text.unsnoc $ Text.pack s of+      Nothing -> s+      Just (t, lastChar) -> if lastChar == c then Text.unpack t else s++keywordValueConnParser :: Text -> Either String ConnectionString+keywordValueConnParser line = runIdentity $ runExceptT $ do+  kvs <-+    sortOn fst+      <$> parseOrFail+        (singleKeyVal `Parsec.sepBy` takeWhile1 Char.isSpace)+        (Text.strip line)+        "Invalid connection string"+  ConnectionString+    <$> getVal "host" Nothing txtToString kvs+    <*> getVal "port" (Just 5432) Parsec.decimal kvs+    <*> getVal "user" Nothing txtToString kvs+    <*> getVal "password" (Just "") txtToString kvs+    <*> getVal "dbname" Nothing txtToString kvs+    <*> getVal "options" (Just "") txtToString kvs+  where+    getVal key def parser pairs =+      case (map snd $ filter ((== key) . fst) pairs, def) of+        ([], Nothing) ->+          throwE $+            "Connection string must contain a value for '"+              <> Text.unpack key+              <> "'"+        ([], Just v) -> pure v+        ([vt], _) ->+          parseOrFail parser vt $+            "Connection string key '"+              <> Text.unpack key+              <> "' is in an unrecognizable format"+        _ ->+          throwE $+            "Duplicate key '"+              <> Text.unpack key+              <> "' found in connection string."++    txtToString = Parsec.takeText+    parseOrFail parser txt errorMsg =+      case parseOnly (parser <* endOfInput) txt of+        Left _ -> throwE errorMsg+        Right v -> pure v++    singleKeyVal = do+      key <- takeWhile1 (\c -> not (Char.isSpace c) && c /= '=')+      skipAllWhiteSpace+      void $ char '='+      skipAllWhiteSpace+      value <-+        takeQuotedString+          <|> parseWithEscapeCharProper+            (\c -> Char.isSpace c || c == '\'' || c == '\\')+          <|> pure ""+      pure (key, value)++    takeQuotedString = do+      void $ char '\''+      s <- parseWithEscapeCharProper (== '\'')+      void $ char '\''+      pure s++-- | Parses a string in one of libpq allowed formats. See https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING.+-- The difference here is that only a subset of all connection parameters are allowed.+-- I wish this function existed in postgresql-simple or some form of it in postgresql-libpq, but if it does I couldn't find it.+connStringParser :: Parser ConnectionString+connStringParser = do+  connStr <-+    Parsec.takeWhile1 (const True)+      <|> fail "Empty connection string"+  -- Very poor connection string type handling here+  let connStrParser =+        if ("postgres://" `Text.isPrefixOf` Text.toLower connStr)+          || ("postgresql://" `Text.isPrefixOf` Text.toLower connStr)+          then+            uriConnParser+          else+            keywordValueConnParser+  case connStrParser connStr of+    Left err ->+      fail $+        "Connection string is not a valid libpq connection string. A valid libpq connection string is either in the format 'postgres://username[:password]@host:port/database_name', with URI-encoded (percent-encoded) components except for the host and bracket-surround IPv6 addresses, or in the keyword value pairs format, e.g. 'dbname=database_name host=localhost user=postgres' with escaping for spaces, quotes or empty values. More info at https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING. Specific error: "+          <> err+    Right c -> pure c
+ src/Hpgsql/Copy.hs view
@@ -0,0 +1,13 @@+module Hpgsql.Copy+  ( copyStart,+    copyEnd,+    putCopyData,+    putCopyError,+    withCopy,+    withCopy_,+    copyFrom,+    copyFromS,+  )+where++import Hpgsql.Internal (copyEnd, copyFrom, copyFromS, copyStart, putCopyData, putCopyError, withCopy, withCopy_)
+ src/Hpgsql/Encoding.hs view
@@ -0,0 +1,1380 @@+{-# LANGUAGE UndecidableInstances #-}++-- |+--+-- = Encoding and decoding fields and rows+--+-- This module contains a collection of functions, classes, and instances that can+-- help you build encoders and decoders for your Haskell types.+--+-- Here's an example:+--+-- > data Person = Person { name :: Text, born :: Day, heightMeters :: Double }+-- >   deriving stock Generic+-- >   deriving anyclass FromPgRow+-- >+-- > persons :: [Person] <- query conn "SELECT * FROM persons"+--+-- Note that Hpgsql's `RowDecoder` does not have a `Monad` instance because that allows it to+-- type check query results and field counts even when queries return zero rows. If you need+-- to write a row decoder that is monadic (because decoding can change depending on the values+-- of fields), check "Hpgsql.Encoding.RowDecoderMonadic".+module Hpgsql.Encoding+  ( -- * Decoding+    FromPgField (..),+    FieldDecoder (..), -- TODO: Can we export ctor?+    FieldInfo (..),+    FromPgRow (..),+    RowDecoder (..), -- TODO: Can we export ctor?+    singleField,+    nullableField,+    genericFromPgRow,++    -- * Encoding++    -- | Keep in mind that Haskell's `Int` is an `Int64` on most+    -- hardware, which is a mismatch for the commonly used 32-bit+    -- `integer` PostgreSQL type.+    -- This is not a problem when decoding because Hpgsql can decode+    -- `integer` into Haskell's `Int`, but when encoding PostgreSQL+    -- will understandably not accept a larger type.+    ToPgField (..),+    FieldEncoder (..),+    ToPgRow (..),+    RowEncoder (..),+    EncodingContext (..),+    genericToPgRow,++    -- * PostgreSQL enums+    LowerCasedPgEnum (..),+    genericEnumFieldDecoder,+    genericEnumFieldEncoder,++    -- * PostgreSQL composite types+    compositeTypeDecoder,+    compositeTypeEncoder,++    -- * Driving PostgreSQL type inference+    typeFieldDecoder,+    typeFieldEncoder,+    typeOidWithName,+    typeMustBeNamed,++    -- * Others+    rawBytesFieldDecoder,+    untypedFieldEncoder,+    toPgVectorField,+    arrayField,+  )+where++import Control.Monad (replicateM, unless, when)+import qualified Data.Aeson as Aeson+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as LBS+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import Data.Fixed (divMod')+import Data.Functor.Contravariant (Contravariant (..))+import Data.Int (Int16, Int32, Int64)+import qualified Data.List as List+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe)+import Data.Monoid (Sum (..))+import Data.Proxy (Proxy (..))+import Data.Ratio (Ratio)+import Data.Scientific (Scientific (..), floatingOrInteger, scientific)+import qualified Data.Serialize as Cereal+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT+import Data.Time (CalendarDiffDays (..), CalendarDiffTime (..), Day, LocalTime (..), NominalDiffTime, TimeOfDay, UTCTime (..), ZonedTime, diffDays, diffTimeToPicoseconds, fromGregorian, picosecondsToDiffTime, secondsToNominalDiffTime, timeOfDayToTime, timeToTimeOfDay, utc, utcToZonedTime, zonedTimeToUTC)+import Data.Time.Calendar.Julian (addJulianDurationClip, fromJulian)+import Data.Tuple.Only (Only (..))+import Data.UUID.Types (UUID)+import qualified Data.UUID.Types as UUID+import Data.Vector (Vector)+import qualified Data.Vector as Vector+import Data.Word (Word32, Word64)+import GHC.Float (castDoubleToWord64, castFloatToWord32, castWord32ToFloat, castWord64ToDouble, expt, float2Double)+import GHC.Generics (C, D, Generic (..), K1 (..), M1 (..), Meta (MetaCons), U1 (..), (:*:) (..), (:+:) (..))+import GHC.TypeLits (KnownSymbol, TypeError, symbolVal)+import qualified GHC.TypeLits as TypeLits+import Hpgsql.Builder (BinaryField (..))+import qualified Hpgsql.Builder as Builder+import qualified Hpgsql.SimpleParser as Parser+import Hpgsql.Time (Unbounded (..))+import Hpgsql.TypeInfo (EncodingContext (..), Oid (..), TypeDetails (..), TypeInfo (..), boolOid, byteaOid, charOid, dateOid, float4Oid, float8Oid, int2Oid, int4Oid, int8Oid, intervalOid, jsonOid, jsonbOid, lookupTypeByName, lookupTypeByOid, nameOid, numericOid, oidOid, textOid, timeOid, timestampOid, timestamptzOid, uuidOid, varcharOid, voidOid)++data FieldInfo = FieldInfo+  { fieldTypeOid :: !Oid,+    -- | The column name from the query's result, if available.+    fieldName :: !(Maybe Text),+    -- | The EncodingContext as of the moment the query ran.+    encodingContext :: !EncodingContext+  }++-- | A decoder for a single field/column.+data FieldDecoder a = FieldDecoder+  { fieldValueDecoder :: FieldInfo -> Maybe ByteString -> Either String a,+    allowedPgTypes :: FieldInfo -> Bool+  }+  deriving stock (Functor)++-- | `f1 <> f2` produces a `FieldDecoder` that tries `f1` first, and if that fails it tries `f2`.+instance Semigroup (FieldDecoder a) where+  dec1 <> dec2 =+    FieldDecoder+      { fieldValueDecoder = \cInfo ->+          let f1 = dec1.fieldValueDecoder cInfo+              f2 = dec2.fieldValueDecoder cInfo+           in \mbs ->+                let cand1 = if dec1.allowedPgTypes cInfo then f1 mbs else Left "Not first parser"+                    cand2 = if dec2.allowedPgTypes cInfo then f2 mbs else Left "Not second parser"+                 in cand1 <> cand2,+        allowedPgTypes = \cInfo -> dec1.allowedPgTypes cInfo || dec2.allowedPgTypes cInfo+      }++data RowDecoder a = RowDecoder+  { fullRowDecoder :: [FieldInfo] -> Parser.Parser a,+    -- | Returns the same colInfos with a boolean indicating if+    -- the expected types match for each colInfo.+    rowColumnsTypeCheck :: [FieldInfo] -> [(FieldInfo, Bool)],+    numExpectedColumns :: !Int+  }+  deriving stock (Functor, Generic)++instance Applicative RowDecoder where+  pure v = RowDecoder (const $ pure v) (map (,True)) 0+  RowDecoder p1 tc1 nc1 <*> RowDecoder p2 tc2 nc2 = RowDecoder (\colTypes -> let (cols1, cols2) = List.splitAt nc1 colTypes in p1 cols1 <*> p2 cols2) (\colTypes -> let (cols1, cols2) = List.splitAt nc1 colTypes in tc1 cols1 ++ tc2 cols2) (nc1 + nc2)++instance (TypeError (TypeLits.Text "RowDecoder does not have a Monad instance in Hpgsql because Hpgsql type-checks the result types of queries before having access to even the first data row. Use the Applicative class to write your instances or use the Monadic decoding variants.")) => Monad RowDecoder where+  (>>=) = error "inaccessible bind in Monad RowDecoder instance"++singleField :: FieldDecoder a -> RowDecoder a+singleField (FieldDecoder {..}) =+  RowDecoder+    { fullRowDecoder = \case+        [singleColInfo] ->+          let decode = fieldValueDecoder singleColInfo+           in do+                lenNextCol <- fromIntegral <$> int32Parser+                nextColBs <-+                  if lenNextCol >= 0+                    then+                      Just <$> Parser.take lenNextCol+                    else pure Nothing+                case decode nextColBs of+                  Right v -> pure v+                  Left err -> fail err+        _ -> error "singleField expected a single column OID but got 0 or >1",+      rowColumnsTypeCheck = \case+        [singleColInfo] -> [(singleColInfo, allowedPgTypes singleColInfo)]+        _ -> error "singleField's rowColumnsTypeCheck expected a single column OID but got 0 or >1",+      numExpectedColumns = 1+    }++int32Parser :: Parser.Parser Int32+int32Parser = either fail pure . Cereal.decode @Int32 =<< Parser.take 4++class FromPgField a where+  fieldDecoder :: FieldDecoder a++class FromPgRow a where+  rowDecoder :: RowDecoder a+  default rowDecoder :: (Generic a, ProductTypeDecoder (Rep a)) => RowDecoder a+  rowDecoder = genericFromPgRow++-- | Allows you to create a @FieldDecoder@ for composite types.+-- For a type such as:+--+-- > CREATE TYPE int_and_bool AS (numfield INT, boolfield BOOL);+--+-- You can define a Haskell type as such:+--+-- > data IntAndBool = IntAndBool Int Bool+-- >+-- > instance FromPgField IntAndBool where+-- >   fieldDecoder = compositeTypeDecoder rowDecoder <&> \(i, b) -> IntAndBool i b+compositeTypeDecoder :: forall a. RowDecoder a -> FieldDecoder a+compositeTypeDecoder (RowDecoder {..}) =+  FieldDecoder+    { fieldValueDecoder = \compositeTypeOid -> \case+        Nothing -> Left "Got NULL in composite type but it was not allowed"+        Just bs -> case Parser.parseOnly (parserForRecord compositeTypeOid.encodingContext <* Parser.endOfInput) bs of+          Parser.ParseOk v -> Right v+          Parser.ParseFail err -> Left err,+      allowedPgTypes = const True -- There's no way to enforce a custom type's OID. We only check if it's structurally the same in the parser (same subtypes in same order)+    }+  where+    parserForRecord :: EncodingContext -> Parser.Parser a+    parserForRecord encodingContext = do+      -- From https://github.com/postgres/postgres/blob/50ba65e73325cf55fedb3e1f14673d816726923b/src/backend/utils/adt/rowtypes.c#L687+      -- we can see a composite type's binary representation consists of: number of columns (Int32) + for_each_column { OID (Int32) + size_or_minus_1 (Int32) + Bytes }+      numCols <- fromIntegral <$> int32Parser+      unless (numCols == numExpectedColumns) $ fail $ "Composite type has " ++ show numCols ++ " attributes but parser expected " ++ show numExpectedColumns+      let mkColInfo oid = FieldInfo oid Nothing encodingContext+      cols <- replicateM numCols $ do+        !oid <- Oid . fromIntegral <$> int32Parser+        (sizeBs, !size) <- Parser.match $ fromIntegral <$> int32Parser+        !bs <- Parser.take (max 0 size)+        pure (oid, sizeBs <> bs)+      let typecheckedCols = rowColumnsTypeCheck (map (mkColInfo . fst) cols)+      unless (all snd typecheckedCols) $ fail $ "Parser for composite found type OIDs " ++ show (map fst cols) ++ " but expected different"+      case Parser.parseOnly (fullRowDecoder (map (mkColInfo . fst) cols) <* Parser.endOfInput) (mconcat $ map snd cols) of+        Parser.ParseOk v -> pure v+        Parser.ParseFail err -> error $ "Error decoding composite type: " ++ show err++-- | Allows you to create a @FieldEncoder@ for composite types.+-- For a type such as:+--+-- > CREATE TYPE int_and_bool AS (numfield INT, boolfield BOOL);+--+-- You can define a Haskell type as such:+--+-- > data IntAndBool = IntAndBool Int Bool+-- >+-- > instance ToPgField IntAndBool where+-- >   fieldEncoder = typeFieldEncoder (typeOidWithName "int_and_bool")+-- >     $ compositeTypeEncoder $ contramap (\(IntAndBool i b) -> (fromIntegral i :: Int32, b)) rowEncoder+compositeTypeEncoder :: forall a. RowEncoder a -> FieldEncoder a+compositeTypeEncoder rowEnc =+  FieldEncoder+    { toTypeOid = \_ -> Nothing,+      toPgField = \encCtx -> \a ->+        let fields = map (\f -> f encCtx) (rowEnc.toPgParams a)+            numCols = Builder.int32BE (fromIntegral $ length fields)+            encodeField (mOid, bf) =+              let Oid oid = fromMaybe (Oid 0) mOid+               in Builder.int32BE oid <> Builder.binaryField bf+         in NotNull (Builder.toStrictByteString (numCols <> foldMap encodeField fields))+    }++instance (FromPgField a) => FromPgRow (Only a) where+  rowDecoder = Only <$> singleField fieldDecoder++instance (FromPgField a, FromPgField b) => FromPgRow (a, b) where+  rowDecoder = (,) <$> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c) => FromPgRow (a, b, c) where+  rowDecoder = (,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d) => FromPgRow (a, b, c, d) where+  rowDecoder = (,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e) => FromPgRow (a, b, c, d, e) where+  rowDecoder = (,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f) => FromPgRow (a, b, c, d, e, f) where+  rowDecoder = (,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f, FromPgField g) => FromPgRow (a, b, c, d, e, f, g) where+  rowDecoder = (,,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f, FromPgField g, FromPgField h) => FromPgRow (a, b, c, d, e, f, g, h) where+  rowDecoder = (,,,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f, FromPgField g, FromPgField h, FromPgField i) => FromPgRow (a, b, c, d, e, f, g, h, i) where+  rowDecoder = (,,,,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f, FromPgField g, FromPgField h, FromPgField i, FromPgField j) => FromPgRow (a, b, c, d, e, f, g, h, i, j) where+  rowDecoder = (,,,,,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f, FromPgField g, FromPgField h, FromPgField i, FromPgField j, FromPgField k) => FromPgRow (a, b, c, d, e, f, g, h, i, j, k) where+  rowDecoder = (,,,,,,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f, FromPgField g, FromPgField h, FromPgField i, FromPgField j, FromPgField k, FromPgField l) => FromPgRow (a, b, c, d, e, f, g, h, i, j, k, l) where+  rowDecoder = (,,,,,,,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++instance (FromPgField a, FromPgField b, FromPgField c, FromPgField d, FromPgField e, FromPgField f, FromPgField g, FromPgField h, FromPgField i, FromPgField j, FromPgField k, FromPgField l, FromPgField m) => FromPgRow (a, b, c, d, e, f, g, h, i, j, k, l, m) where+  rowDecoder = (,,,,,,,,,,,,) <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder++data FieldEncoder a = FieldEncoder+  { toTypeOid :: !(EncodingContext -> Maybe Oid),+    toPgField :: !(EncodingContext -> a -> BinaryField)+  }++instance Contravariant FieldEncoder where+  contramap f fEnc = FieldEncoder {toTypeOid = fEnc.toTypeOid, toPgField = \encCtx -> let toF = fEnc.toPgField encCtx in \v -> toF (f v)}++class ToPgField a where+  fieldEncoder :: FieldEncoder a++-- | Allows you to specify a type for a FieldEncoder. This can be useful to avoid+-- letting postgres infer types itself, which can cause errors. For example:+--+-- > data MyEnum = Val1 | Val2 | Val3+-- > myEnumFieldDecoderWithTypeInfoCheck :: FieldEncoder MyEnum+-- > myEnumFieldDecoderWithTypeInfoCheck =+-- >   let convert = \case+-- >         Val1 -> "val1" :: Text+-- >         Val2 -> "val2"+-- >         Val3 -> "val3"+-- >    in typeFieldEncoder+-- >         (typeOidWithName "my_enum")+-- >         $ contramap convert fieldEncoder+--+-- This will work unless you use non-default flags in your connection options.+typeFieldEncoder :: (EncodingContext -> Maybe Oid) -> FieldEncoder a -> FieldEncoder a+typeFieldEncoder ttoid enc = enc {toTypeOid = ttoid}++typeOidWithName :: Text -> (EncodingContext -> Maybe Oid)+typeOidWithName typName = \encCtx -> typeOid <$> lookupTypeByName typName encCtx.typeInfoCache++instance ToPgField Int where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just haskellIntOid,+        toPgField = \_ -> binaryIntEncoder+      }++instance ToPgField Int16 where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just int2Oid,+        toPgField = \_ -> \n -> NotNull $ Cereal.encode n+      }++instance ToPgField Int32 where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just int4Oid,+        toPgField = \_ -> \n -> NotNull $ Cereal.encode n+      }++instance ToPgField Int64 where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just int8Oid,+        toPgField = \_ -> \n -> NotNull $ Cereal.encode n+      }++instance ToPgField Integer where+  fieldEncoder =+    let fe = fieldEncoder @Scientific+     in FieldEncoder+          { toTypeOid = \_ -> Just numericOid,+            toPgField = \encCtx -> \n -> fe.toPgField encCtx (fromIntegral n)+          }++instance ToPgField (Ratio Integer) where+  fieldEncoder =+    let fe = fieldEncoder @Scientific+     in FieldEncoder+          { toTypeOid = \_ -> Just numericOid,+            toPgField = \encCtx -> \r -> fe.toPgField encCtx (fromRational r)+          }++instance ToPgField Oid where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just oidOid,+        toPgField = \_ -> \n -> NotNull $ Cereal.encode @Int32 $ fromIntegral n+      }++instance ToPgField Scientific where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just numericOid,+        toPgField = \_ -> \n ->+          let sign = Cereal.encode @Int16 $ if n >= 0 then 0 else 0x4000+              -- The number is coeff * 10^exp, but we want it in base-10000 so we convert it to+              -- new_coeff * 10^new_exp with new_exp a multiple of 4+              base10000Expon = 4 * (base10Exponent n `div` 4)+              base10000Coeff = coefficient n * expt 10 (base10Exponent n - base10000Expon)+              ndigits, weight :: Int16+              digits :: ByteString+              (ndigits, weight, digits) = calculateDigits 0 0 (abs base10000Coeff) ""+              dscale = Cereal.encode @Int16 (abs $ fromIntegral base10000Expon) -- More than necessary, but safe?+           in NotNull $ Cereal.encode ndigits <> Cereal.encode (weight - 1 + fromIntegral (base10000Expon `div` 4)) <> sign <> dscale <> digits+      }+    where+      calculateDigits :: Int16 -> Int16 -> Integer -> BS.ByteString -> (Int16, Int16, BS.ByteString)+      calculateDigits !ndigitsSoFar !weightSoFar 0 !encodedDigits = (ndigitsSoFar, weightSoFar, encodedDigits)+      calculateDigits !ndigitsSoFar !weightSoFar !val !encodedDigits =+        let (quotient, fromIntegral -> rest :: Int16) = val `divMod` 10000+         in calculateDigits+              (ndigitsSoFar + 1)+              (weightSoFar + 1)+              quotient+              (Cereal.encode @Int16 rest <> encodedDigits)++instance ToPgField Float where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just float4Oid,+        toPgField = \_ -> \n -> NotNull $ Cereal.encode @Word32 $ castFloatToWord32 n+      }++instance ToPgField Double where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just float8Oid,+        toPgField = \_ -> \n -> NotNull $ Cereal.encode @Word64 $ castDoubleToWord64 n+      }++instance ToPgField Bool where+  -- TODO: Cereal.encode seems to work, but reference the documentation that shows how bools are encoded+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just boolOid,+        toPgField = \_ n -> NotNull $ Cereal.encode @Bool $ n+      }++instance ToPgField Day where+  -- PG Dates are Int32 number of days relative to 2000-01-01+  -- https://github.com/postgres/postgres/blob/master/src/include/datatype/timestamp.h#L235+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just dateOid,+        -- TODO: Catch integer overflow and do what?+        toPgField = \_ d -> NotNull $ Cereal.encode @Int32 $ fromIntegral $ diffDays d (fromGregorian 2000 1 1)+      }++instance ToPgField (Unbounded Day) where+  fieldEncoder =+    let fe = fieldEncoder @Day+     in FieldEncoder+          { toTypeOid = fe.toTypeOid,+            toPgField = \encCtx -> \case+              NegInfinity -> NotNull $ Cereal.encode @Int32 minBound+              Finite v -> fe.toPgField encCtx v+              PosInfinity -> NotNull $ Cereal.encode @Int32 maxBound+          }++instance ToPgField CalendarDiffTime where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just intervalOid,+        toPgField = \_ CalendarDiffTime {..} ->+          let (days :: Int32, timeUnderOneDay) = ctTime `divMod'` 86_400+           in NotNull $ Cereal.encode @(Int64, Int32, Int32) (round $ timeUnderOneDay * 1_000_000, days, fromIntegral ctMonths)+      }++instance ToPgField NominalDiffTime where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just intervalOid,+        toPgField = \_ ndt ->+          NotNull $ Cereal.encode @(Int64, Int32, Int32) (round $ ndt * 1_000_000, 0, 0)+      }++instance ToPgField UTCTime where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just timestamptzOid,+        -- TODO: Catch integer overflow and do what?+        toPgField = \_ (UTCTime parsedDate timeinday) ->+          let day :: Int64 = fromInteger $ parsedDate `diffDays` fromJulian 1999 12 19+              totalusecs :: Int64 = 86_400_000_000 * day + fromInteger (diffTimeToPicoseconds timeinday `div` 1_000_000)+           in NotNull $ Cereal.encode @Int64 totalusecs+      }++instance ToPgField (Unbounded UTCTime) where+  fieldEncoder =+    let fe = fieldEncoder @UTCTime+     in FieldEncoder+          { toTypeOid = fe.toTypeOid,+            toPgField = \encCtx -> \case+              NegInfinity -> NotNull $ Cereal.encode @Int64 minBound+              Finite v -> fe.toPgField encCtx v+              PosInfinity -> NotNull $ Cereal.encode @Int64 maxBound+          }++instance ToPgField ZonedTime where+  fieldEncoder =+    let fe = fieldEncoder @UTCTime+     in FieldEncoder+          { toTypeOid = \_ -> Just timestamptzOid,+            toPgField = \encCtx -> fe.toPgField encCtx . zonedTimeToUTC+          }++instance ToPgField (Unbounded ZonedTime) where+  fieldEncoder =+    let fe = fieldEncoder @ZonedTime+     in FieldEncoder+          { toTypeOid = fe.toTypeOid,+            toPgField = \encCtx -> \case+              NegInfinity -> NotNull $ Cereal.encode @Int64 minBound+              Finite v -> fe.toPgField encCtx v+              PosInfinity -> NotNull $ Cereal.encode @Int64 maxBound+          }++instance ToPgField LocalTime where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just timestampOid,+        toPgField = \_ (LocalTime localDay localTimeOfDay) ->+          let day :: Int64 = fromInteger $ localDay `diffDays` fromJulian 1999 12 19+              totalusecs :: Int64 = 86_400_000_000 * day + fromInteger (diffTimeToPicoseconds (timeOfDayToTime localTimeOfDay) `div` 1_000_000)+           in NotNull $ Cereal.encode @Int64 totalusecs+      }++instance ToPgField TimeOfDay where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just timeOid,+        toPgField = \_ tod ->+          let usecs :: Int64 = fromInteger $ diffTimeToPicoseconds (timeOfDayToTime tod) `div` 1_000_000+           in NotNull $ Cereal.encode @Int64 usecs+      }++instance ToPgField Char where+  fieldEncoder =+    let fe = fieldEncoder @Text+     in FieldEncoder+          { toTypeOid = \_ -> Just textOid,+            toPgField = \encCtx -> let !toTextField = fe.toPgField encCtx in \t -> toTextField $ Text.singleton t+          }++instance ToPgField ByteString where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just byteaOid,+        toPgField = \_ -> \bs -> NotNull bs+      }++instance ToPgField LBS.ByteString where+  fieldEncoder =+    let fe = fieldEncoder @ByteString+     in FieldEncoder+          { toTypeOid = \_ -> Just byteaOid,+            toPgField = \encCtx -> fe.toPgField encCtx . LBS.toStrict+          }++instance ToPgField Text where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just textOid,+        toPgField = \_ -> \t ->+          let bs = encodeUtf8 t+           in NotNull bs+      }++instance ToPgField LT.Text where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just textOid,+        toPgField = \_ -> \t ->+          let bs = LBS.toStrict $ LT.encodeUtf8 t+           in NotNull bs+      }++instance ToPgField String where+  fieldEncoder =+    let fe = fieldEncoder @Text+     in FieldEncoder+          { toTypeOid = \_ -> Just textOid,+            toPgField = \encCtx -> fe.toPgField encCtx . Text.pack+          }++-- From https://hackage.haskell.org/package/case-insensitive-1.2.1.0/docs/Data-CaseInsensitive.html,+-- "Note that the FoldCase instance for ByteStrings is only guaranteed to be correct for ISO-8859-1 encoded strings!".+-- So we don't have those instances.++-- | This instance does not work if you have fillTypeInfoCache disabled (that would be a non-default+-- connection option).+instance ToPgField (CI Text) where+  fieldEncoder = typeFieldEncoder (typeOidWithName "citext") $ contramap CI.original fieldEncoder++-- | This instance does not work if you have fillTypeInfoCache disabled (that would be a non-default+-- connection option).+instance ToPgField (CI LT.Text) where+  fieldEncoder = typeFieldEncoder (typeOidWithName "citext") $ contramap CI.original fieldEncoder++-- | This instance does not work if you have fillTypeInfoCache disabled (that would be a non-default+-- connection option).+instance ToPgField (CI String) where+  fieldEncoder = typeFieldEncoder (typeOidWithName "citext") $ contramap CI.original fieldEncoder++instance ToPgField UUID where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just uuidOid,+        toPgField = \_ -> NotNull . LBS.toStrict . UUID.toByteString+      }++instance ToPgField Aeson.Value where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just jsonbOid,+        toPgField = \_ -> \v ->+          let bs = BS.cons 1 (LBS.toStrict $ Aeson.encode v)+           in NotNull bs+      }++instance (ToPgField a) => ToPgField (Maybe a) where+  fieldEncoder =+    let fe = fieldEncoder @a+     in FieldEncoder+          { toTypeOid = fe.toTypeOid,+            toPgField = \encCtx -> \case+              Nothing -> SqlNull+              Just n -> fe.toPgField encCtx n+          }++instance (ToPgField a) => ToPgField (Vector a) where+  fieldEncoder =+    let fe = fieldEncoder @a+     in FieldEncoder+          { toTypeOid = \encodingContext -> do+              -- Maybe monad+              elOid <- fe.toTypeOid encodingContext+              arrayTypInfo <- lookupTypeByOid elOid encodingContext.typeInfoCache+              arrayTypInfo.oidOfArrayType,+            toPgField = toPgVectorField+          }++data RowEncoder a = RowEncoder+  { toPgParams :: !(a -> [EncodingContext -> (Maybe Oid, BinaryField)]),+    toTypeOids :: !(Proxy a -> [EncodingContext -> Maybe Oid]),+    -- | This produces bytes for Binary COPY FROM STDIN rows, which can increase performance+    -- and reduce memory usage comparing to deriving these bytes from `toPgParams`.+    -- The produced bytes should not contain the total number of fields in the+    -- beginning.+    toBinaryCopyBytes :: !(EncodingContext -> a -> Builder.Builder)+  }++instance Contravariant RowEncoder where+  contramap f rec = RowEncoder (\v -> rec.toPgParams (f v)) (\_ -> rec.toTypeOids Proxy) (\encCtx -> let !toBytes = rec.toBinaryCopyBytes encCtx in \v -> toBytes (f v))++-- | These are from `Divisible`, but we don't currently pull in the extra dependency that has that.+divide :: (a -> (b, c)) -> RowEncoder b -> RowEncoder c -> RowEncoder a+divide d re1 re2 =+  RowEncoder+    { toPgParams = \a -> let (b, c) = d a in re1.toPgParams b ++ re2.toPgParams c,+      toTypeOids = \_ -> re1.toTypeOids Proxy ++ re2.toTypeOids Proxy,+      toBinaryCopyBytes = \encCtx ->+        let !toBytes1 = re1.toBinaryCopyBytes encCtx+            !toBytes2 = re2.toBinaryCopyBytes encCtx+         in \a -> let (b, c) = d a in toBytes1 b <> toBytes2 c+    }++class ToPgRow a where+  rowEncoder :: RowEncoder a+  default rowEncoder :: (Generic a, ProductTypeEncoder (Rep a)) => RowEncoder a+  rowEncoder = genericToPgRow++instance ToPgRow () where+  rowEncoder = RowEncoder (\_ -> []) (\_ -> []) (\_ -> \_ -> mempty)++singleFieldRowEncoder :: forall a. (ToPgField a) => RowEncoder a+singleFieldRowEncoder =+  let fe = fieldEncoder @a+   in RowEncoder+        { toPgParams = \a -> [\encodingContext -> (fe.toTypeOid encodingContext, fe.toPgField encodingContext a)],+          toTypeOids = \_ -> [fe.toTypeOid],+          toBinaryCopyBytes = \encCtx -> let !enc = fe.toPgField encCtx in \a -> Builder.binaryField $ enc a+        }++instance (ToPgField a) => ToPgRow (Only a) where+  rowEncoder = contramap fromOnly singleFieldRowEncoder++instance (ToPgField a, ToPgField b) => ToPgRow (a, b) where+  rowEncoder = divide id singleFieldRowEncoder singleFieldRowEncoder++instance (ToPgField a, ToPgField b, ToPgField c) => ToPgRow (a, b, c) where+  rowEncoder = divide (\(a, b, c) -> ((a, b), c)) rowEncoder singleFieldRowEncoder++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d) => ToPgRow (a, b, c, d) where+  rowEncoder = divide (\(a, b, c, d) -> ((a, b), (c, d))) rowEncoder rowEncoder++-- This instance implements toBinaryCopyBytes as well because we did this+-- to test if this method can help improve performance of COPY in our+-- benchmarks. We found that it can, but we didn't bother yet implementing+-- this for other types.+-- toBinaryCopyBytes encCtx = \(a, b, c, d) -> Builder.int16BE 4 <> toPgFieldWithSize a <> toPgFieldWithSize b <> toPgFieldWithSize c <> toPgFieldWithSize d+--   where+--     toPgFieldWithSize :: (ToPgField x) => x -> Builder.Builder+--     toPgFieldWithSize v = Builder.binaryField $ toPgField encCtx v++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d, ToPgField e) => ToPgRow (a, b, c, d, e) where+  rowEncoder = divide (\(a, b, c, d, e) -> ((a, b, c), (d, e))) rowEncoder rowEncoder++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d, ToPgField e, ToPgField f) => ToPgRow (a, b, c, d, e, f) where+  rowEncoder = divide (\(a, b, c, d, e, f) -> ((a, b, c), (d, e, f))) rowEncoder rowEncoder++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d, ToPgField e, ToPgField f, ToPgField g) => ToPgRow (a, b, c, d, e, f, g) where+  rowEncoder = divide (\(a, b, c, d, e, f, g) -> ((a, b, c), (d, e, f, g))) rowEncoder rowEncoder++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d, ToPgField e, ToPgField f, ToPgField g, ToPgField h) => ToPgRow (a, b, c, d, e, f, g, h) where+  rowEncoder = divide (\(a, b, c, d, e, f, g, h) -> ((a, b, c, d), (e, f, g, h))) rowEncoder rowEncoder++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d, ToPgField e, ToPgField f, ToPgField g, ToPgField h, ToPgField i) => ToPgRow (a, b, c, d, e, f, g, h, i) where+  rowEncoder = divide (\(a, b, c, d, e, f, g, h, i) -> ((a, b, c, d), (e, f, g, h, i))) rowEncoder rowEncoder++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d, ToPgField e, ToPgField f, ToPgField g, ToPgField h, ToPgField i, ToPgField j) => ToPgRow (a, b, c, d, e, f, g, h, i, j) where+  rowEncoder = divide (\(a, b, c, d, e, f, g, h, i, j) -> ((a, b, c, d, e), (f, g, h, i, j))) rowEncoder rowEncoder++instance (ToPgField a, ToPgField b, ToPgField c, ToPgField d, ToPgField e, ToPgField f, ToPgField g, ToPgField h, ToPgField i, ToPgField j, ToPgField k) => ToPgRow (a, b, c, d, e, f, g, h, i, j, k) where+  rowEncoder = divide (\(a, b, c, d, e, f, g, h, i, j, k) -> ((a, b, c, d, e, f), (g, h, i, j, k))) rowEncoder rowEncoder++-- instance (ToPgField a) => ToPgRow [a] where+--   rowEncoder = RowEncoder {+--     toPgParams = \xs -> concatMap toPgParams xs+--     , toTypeOids = \_ -> concatMap (\)+--   } $ \cols -> map (\v encodingContext -> let typOid = toTypeOid (Proxy @a) encodingContext in (typOid, toPgField encodingContext v)) cols++-- | The OID for `Data.Int`, which is machine dependent.+haskellIntOid :: Oid++-- | All pg type OIDs that fit into Haskell's `Data.Int`, whose size is machine dependent.+haskellIntOids :: [Oid]+(haskellIntOid, haskellIntOids)+  | (fromIntegral (maxBound @Int) :: Integer) > fromIntegral (maxBound @Int32) = (int8Oid, [int2Oid, int4Oid, int8Oid])+  | (fromIntegral (maxBound @Int) :: Integer) > fromIntegral (maxBound @Int16) = (int4Oid, [int2Oid, int4Oid])+  | otherwise = (int2Oid, [int2Oid])++-- | Big-Endian binary encoder for Haskell's `Data.Int`, which is machine-dependent.+binaryIntEncoder :: Int -> BinaryField+binaryIntEncoder+  | haskellIntOid == int8Oid = NotNull . Cereal.encode @Int64 . fromIntegral+  | haskellIntOid == int4Oid = NotNull . Cereal.encode @Int32 . fromIntegral+  | otherwise = NotNull . Cereal.encode @Int16 . fromIntegral++-- | Big-Endian binary decoder for Haskell's various IntXX types.+binaryIntDecoder :: forall a. (Integral a, Bounded a) => Oid -> ByteString -> Either String a+binaryIntDecoder typOid = \bs ->+  if doesFit+    then intDecoder bs+    else Left $ "Chosen integral type does not fit every value for PG type with OID " ++ show typOid+  where+    maxBoundPgType :: Integer+    intDecoder :: ByteString -> Either String a+    (maxBoundPgType, intDecoder)+      | typOid == int8Oid = (fromIntegral $ maxBound @Int64, fmap fromIntegral . Cereal.decode @Int64)+      | typOid == int4Oid = (fromIntegral $ maxBound @Int32, fmap fromIntegral . Cereal.decode @Int32)+      | typOid == int2Oid = (fromIntegral $ maxBound @Int16, fmap fromIntegral . Cereal.decode @Int16)+      | otherwise = error "Bug in Hpgsql. Decoding binary integral type not an int2, int4 or int8"+    doesFit = maxBoundPgType <= fromIntegral (maxBound @a)++binaryFloat4Decoder :: ByteString -> Float+binaryFloat4Decoder = castWord32ToFloat . either error id . Cereal.decode @Word32++binaryFloat8Decoder :: ByteString -> Double+binaryFloat8Decoder = castWord64ToDouble . either error id . Cereal.decode @Word64++parsePgType :: [Oid] -> (Maybe ByteString -> Either String a) -> FieldDecoder a+parsePgType !requiredTypeOids !fieldValueDecoder =+  FieldDecoder+    { fieldValueDecoder = \_oid -> fieldValueDecoder,+      allowedPgTypes = (`elem` requiredTypeOids) . fieldTypeOid+    }++instance FromPgField () where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \_oid -> \case+          Just "" -> Right ()+          Just bs -> Left $ "Invalid value '" ++ show bs ++ "' for postgres void type"+          Nothing -> Left "Cannot decode SQL null as the Haskell () type. Use a `Maybe ()`",+        allowedPgTypes = (== voidOid) . fieldTypeOid+      }++instance FromPgField Int where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \FieldInfo {fieldTypeOid = oid} ->+          let !decode = binaryIntDecoder oid+           in \case+                Just bs -> decode bs+                Nothing -> Left "Cannot decode SQL null as the Haskell Int type. Use a `Maybe Int`",+        allowedPgTypes = (`elem` haskellIntOids) . fieldTypeOid+      }++instance FromPgField Int16 where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \FieldInfo {fieldTypeOid = oid} ->+          let !decode = binaryIntDecoder oid+           in \case+                Just bs -> decode bs+                Nothing -> Left "Cannot decode SQL null as the Haskell Int16 type. Use a `Maybe Int16`",+        allowedPgTypes = (== int2Oid) . fieldTypeOid+      }++instance FromPgField Int32 where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \FieldInfo {fieldTypeOid = oid} ->+          let !decode = binaryIntDecoder oid+           in \case+                Just bs -> decode bs+                Nothing -> Left "Cannot decode SQL null as the Haskell Int32 type. Use a `Maybe Int32`",+        allowedPgTypes = (`elem` [int2Oid, int4Oid]) . fieldTypeOid+      }++instance FromPgField Int64 where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \FieldInfo {fieldTypeOid = oid} ->+          let !decode = binaryIntDecoder oid+           in \case+                Just bs -> decode bs+                Nothing -> Left "Cannot decode SQL null as the Haskell Int64 type. Use a `Maybe Int64`",+        allowedPgTypes = (`elem` [int2Oid, int4Oid, int8Oid]) . fieldTypeOid+      }++instance FromPgField Integer where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \FieldInfo {fieldTypeOid = oid} ->+          let !decodeInt = binaryIntDecoder @Int64 oid+           in \case+                Just bs+                  | oid /= numericOid -> fromIntegral <$> decodeInt bs+                  | otherwise -> case Parser.parseOnly (scientificDecoder True <* Parser.endOfInput) bs of+                      Parser.ParseOk sci -> case floatingOrInteger @Double @Integer sci of+                        Right i -> Right i+                        Left _ -> Left "Internal error in Hpgsql. Scientific to Integer conversion failed"+                      Parser.ParseFail err -> Left err+                Nothing -> Left "Cannot decode SQL null as the Haskell Integer type. Use a `Maybe Integer`",+        allowedPgTypes = (`elem` [int8Oid, numericOid, int4Oid, int2Oid]) . fieldTypeOid+      }++instance FromPgField Oid where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \_ -> \case+          -- Oids are just int4+          Just bs -> Oid <$> binaryIntDecoder int4Oid bs+          Nothing -> Left "Cannot decode SQL null as the Haskell Oid type. Use a `Maybe Oid`",+        allowedPgTypes = (== oidOid) . fieldTypeOid+      }++instance FromPgField Float where+  fieldDecoder = parsePgType [float4Oid] $ \case+    Just bs -> Right $ binaryFloat4Decoder bs+    Nothing -> Left "Cannot decode SQL null as the Haskell Float type. Use a `Maybe Float`"++instance FromPgField Double where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \FieldInfo {fieldTypeOid = oid} ->+          let !decoder+                | oid == float8Oid = binaryFloat8Decoder+                | otherwise = float2Double . binaryFloat4Decoder+           in \case+                Just bs -> Right $ decoder bs+                Nothing -> Left "Cannot decode SQL null as the Haskell Double type. Use a `Maybe Double`",+        allowedPgTypes = (`elem` [float8Oid, float4Oid]) . fieldTypeOid+      }++-- | Allows you to specify a type (and other checks, possibly) for a `FieldDecoder`.+-- This can be useful to ensure you're not accidentally decoding a different type.+--+-- > data MyEnum = Val1 | Val2 | Val3+-- > myEnumFieldDecoderWithTypeInfoCheck :: FieldDecoder MyEnum+-- > myEnumFieldDecoderWithTypeInfoCheck =+-- >   let convert = \case+-- >         "val1" -> Val1+-- >         "val2" -> Val2+-- >         "val3" -> Val3+-- >         _ -> error "Invalid value for MyEnum"+-- >    in typeFieldDecoder+-- >         (typeMustBeNamed "my_enum")+-- >         $ convert <$> rawBytesFieldDecoder+--+-- This will work unless you use non-default flags in your connection options.+typeFieldDecoder :: (FieldInfo -> Bool) -> FieldDecoder a -> FieldDecoder a+typeFieldDecoder fieldCheck dec = dec {allowedPgTypes = fieldCheck}++typeMustBeNamed :: Text -> (FieldInfo -> Bool)+typeMustBeNamed typName = \fieldInfo ->+  (typeName <$> lookupTypeByOid fieldInfo.fieldTypeOid fieldInfo.encodingContext.typeInfoCache) == Just typName++scientificDecoder :: Bool -> Parser.Parser Scientific+scientificDecoder mustBeInteger = do+  ndigits <- int16Parser+  weight <- int16Parser+  sign <- int16Parser -- 0x0000 is positive, 0x4000 is negative, 0xC000 is NAN, 0xD000 is Positive Infinity, 0xF000 is Negative Infinity+  unless (sign == 0x0000 || sign == 0x4000) $ fail "NaN, positive or negative infinities cannot be decoded into Integer or Scientific"+  !dscale <- int16Parser+  when (mustBeInteger && dscale /= 0) $ fail "Decoding into `Integer` requires explicit casting with `numeric(X,0)` to force integral values"+  valueAbs <- parseAndMult ndigits (fromIntegral weight * 4) 0+  pure $ (if sign == 0x0000 then 1 else (-1)) * valueAbs+  where+    parseAndMult :: Int16 -> Int -> Scientific -> Parser.Parser Scientific+    parseAndMult 0 _ !val = pure val+    parseAndMult !ndigitsLeft !currexpon !val = do+      !digit <- fromIntegral <$> int16Parser+      parseAndMult (ndigitsLeft - 1) (currexpon - 4) (val + scientific digit currexpon)++instance FromPgField Scientific where+  -- See https://github.com/postgres/postgres/blob/799959dc7cf0e2462601bea8d07b6edec3fa0c4f/src/backend/utils/adt/numeric.c#L1163+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \FieldInfo {fieldTypeOid = oid} ->+          let !decodeInt = binaryIntDecoder @Int64 oid+           in \case+                Just bs ->+                  -- TODO: There is loss converting from Float/Double to Scientific, but it might be quite small, so should we accept+                  -- float4Oid and float8Oid here?+                  if oid == numericOid+                    then case Parser.parseOnly (scientificDecoder False <* Parser.endOfInput) bs of+                      Parser.ParseOk sci -> Right sci+                      Parser.ParseFail err -> Left err+                    else flip scientific 0 . fromIntegral <$> decodeInt bs+                Nothing -> Left "Cannot decode SQL null as the Haskell Scientific type. Use a `Maybe Scientific`",+        allowedPgTypes = (`elem` [numericOid, int2Oid, int4Oid, int8Oid]) . fieldTypeOid+      }++instance FromPgField (Ratio Integer) where+  fieldDecoder = toRational <$> fieldDecoder @Scientific++binaryTrue :: ByteString+binaryTrue = Cereal.encode True++instance FromPgField Bool where+  fieldDecoder = parsePgType [boolOid] $ \case+    Just bs -> Right $ bs == binaryTrue+    Nothing -> Left "Cannot decode SQL null as the Haskell Bool type. Use a `Maybe Bool`"++instance FromPgField Char where+  fieldDecoder =+    let textParser = fieldValueDecoder (fieldDecoder @Text)+     in FieldDecoder+          { fieldValueDecoder = \colInfo@FieldInfo {fieldTypeOid = oid} ->+              let !decodeText = textParser colInfo+               in \mbs -> case mbs of+                    Just bs ->+                      if oid == charOid+                        -- TODO: Postgres has values of type "char" in the pg_type.typcategory table.+                        -- We should test this instance works with those, and we haven't yet.+                        then Right $ BSC.head bs+                        else case decodeText mbs of+                          Left err -> Left err+                          Right t -> if Text.length t > 1 then Left "Cannot parse text with more than one character into a Haskell Char type." else Right (Text.head t)+                    Nothing -> Left "Cannot decode SQL null as the Haskell Char type. Use a `Maybe Char`",+            -- TODO: All the varchar types?+            allowedPgTypes = (`elem` [charOid, textOid]) . fieldTypeOid+          }++instance FromPgField ByteString where+  fieldDecoder = parsePgType [byteaOid] $ \case+    Just bs -> Right bs+    Nothing -> Left "Cannot decode SQL null as the Haskell ByteString type. Use a `Maybe ByteString`"++instance FromPgField LBS.ByteString where+  fieldDecoder = parsePgType [byteaOid] $ \case+    Just bs -> Right $ LBS.fromStrict bs+    Nothing -> Left "Cannot decode SQL null as the Haskell ByteString type. Use a `Maybe ByteString`"++instance FromPgField Text where+  fieldDecoder = parsePgType [textOid, varcharOid, nameOid] $ \case+    Just bs -> Right $ decodeUtf8 bs+    -- TODO: Use some faster unsafeDecodeUtf8 function?+    Nothing -> Left "Cannot decode SQL null as the Haskell Text type. Use a `Maybe Text`"++instance FromPgField LT.Text where+  fieldDecoder = parsePgType [textOid, varcharOid, nameOid] $ \case+    Just bs -> Right $ LT.fromStrict $ decodeUtf8 bs+    -- TODO: Use some faster unsafeDecodeUtf8 function?+    Nothing -> Left "Cannot decode SQL null as the Haskell Text type. Use a `Maybe Text`"++instance FromPgField String where+  fieldDecoder = parsePgType [textOid, varcharOid, nameOid] $ \case+    -- connection option).+    Just bs -> Right $ Text.unpack $ decodeUtf8 bs+    -- TODO: Use some faster unsafeDecodeUtf8 function?+    Nothing -> Left "Cannot decode SQL null as the Haskell String type. Use a `Maybe String`"++-- | This instance does not work if you have fillTypeInfoCache disabled (that would be a non-default+-- connection option).+instance FromPgField (CI Text) where+  fieldDecoder = typeFieldDecoder (typeMustBeNamed "citext") $ CI.mk <$> fieldDecoder++-- | This instance does not work if you have fillTypeInfoCache disabled (that would be a non-default+-- connection option).+instance FromPgField (CI LT.Text) where+  fieldDecoder = typeFieldDecoder (typeMustBeNamed "citext") $ CI.mk <$> fieldDecoder++-- | This instance does not work if you have fillTypeInfoCache disabled (that would be a non-default+-- connection option).+instance FromPgField (CI String) where+  fieldDecoder = typeFieldDecoder (typeMustBeNamed "citext") $ CI.mk <$> fieldDecoder++instance FromPgField UTCTime where+  fieldDecoder = parsePgType [timestamptzOid] $ \case+    Just bs -> do+      -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909+      totalusecs <- Cereal.decode @Int64 bs+      let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day+          parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19+      Right $ UTCTime parsedDate (picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)+    Nothing -> Left "Cannot decode SQL null as the Haskell UTCTime type. Use a `Maybe UTCTime`"++instance FromPgField (Unbounded UTCTime) where+  fieldDecoder = parsePgType [timestamptzOid] $ \case+    Just bs -> do+      -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909+      totalusecs <- Cereal.decode @Int64 bs+      Right $+        if totalusecs == minBound+          then NegInfinity+          else+            if totalusecs == maxBound+              then PosInfinity+              else+                let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day+                    parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19+                 in Finite $ UTCTime parsedDate (picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)+    Nothing -> Left "Cannot decode SQL null as the Haskell (Unbounded UTCTime) type. Use a `Maybe (Unbounded UTCTime)`"++instance FromPgField ZonedTime where+  fieldDecoder = parsePgType [timestamptzOid] $ \case+    Just bs -> do+      -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909+      totalusecs <- Cereal.decode @Int64 bs+      let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day+          parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19+      Right $ utcToZonedTime utc $ UTCTime parsedDate (picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)+    Nothing -> Left "Cannot decode SQL null as the Haskell ZonedTime type. Use a `Maybe ZonedTime`"++instance FromPgField (Unbounded ZonedTime) where+  fieldDecoder = parsePgType [timestamptzOid] $ \case+    Just bs -> do+      -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909+      totalusecs <- Cereal.decode @Int64 bs+      Right $+        if totalusecs == minBound+          then NegInfinity+          else+            if totalusecs == maxBound+              then PosInfinity+              else+                let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day+                    parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19+                 in Finite $ utcToZonedTime utc $ UTCTime parsedDate (picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)+    Nothing -> Left "Cannot decode SQL null as the Haskell ZonedTime type. Use a `Maybe ZonedTime`"++instance FromPgField LocalTime where+  fieldDecoder = parsePgType [timestampOid] $ \case+    Just bs -> do+      totalusecs <- Cereal.decode @Int64 bs+      let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day+          parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19+      Right $ LocalTime parsedDate (timeToTimeOfDay $ picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)+    Nothing -> Left "Cannot decode SQL null as the Haskell LocalTime type. Use a `Maybe LocalTime`"++instance FromPgField TimeOfDay where+  fieldDecoder = parsePgType [timeOid] $ \case+    Just bs -> do+      usecs <- Cereal.decode @Int64 bs+      Right $ timeToTimeOfDay $ picosecondsToDiffTime $ fromIntegral usecs * 1_000_000+    Nothing -> Left "Cannot decode SQL null as the Haskell TimeOfDay type. Use a `Maybe TimeOfDay`"++instance FromPgField Day where+  fieldDecoder = parsePgType [dateOid] $ \case+    Just bs -> do+      -- There is a very specific conversion function for these, which I poorly translated to Haskell+      -- https://github.com/postgres/postgres/blob/799959dc7cf0e2462601bea8d07b6edec3fa0c4f/src/backend/utils/adt/datetime.c#L321+      -- But I found a simpler way to do this. Let's see if it works in our property based tests+      jd <- Cereal.decode @Int32 bs+      Right $ addJulianDurationClip (CalendarDiffDays 0 (fromIntegral jd - 13)) $ fromJulian 2000 01 01+    Nothing -> Left "Cannot decode SQL null as the Haskell Day type. Use a `Maybe Day`"++instance FromPgField (Unbounded Day) where+  fieldDecoder = parsePgType [dateOid] $ \case+    Just bs -> do+      -- There is a very specific conversion function for these, which I poorly translated to Haskell+      -- https://github.com/postgres/postgres/blob/799959dc7cf0e2462601bea8d07b6edec3fa0c4f/src/backend/utils/adt/datetime.c#L321+      -- But I found a simpler way to do this. Let's see if it works in our property based tests+      jd <- Cereal.decode @Int32 bs+      Right $+        if jd == minBound+          then NegInfinity+          else+            if jd == maxBound+              then PosInfinity+              else+                Finite $ addJulianDurationClip (CalendarDiffDays 0 (fromIntegral jd - 13)) $ fromJulian 2000 01 01+    Nothing -> Left "Cannot decode SQL null as the Haskell (Unbounded Day) type. Use a `Maybe (Unbounded Day)`"++instance FromPgField CalendarDiffTime where+  fieldDecoder = parsePgType [intervalOid] $ \case+    Just bs -> do+      (nMicrosecs :: Int64, nDays :: Int32, nMonths :: Int32) <- Cereal.decode bs+      Right $ CalendarDiffTime {ctMonths = fromIntegral nMonths, ctTime = secondsToNominalDiffTime (fromIntegral nDays * 86400) + realToFrac (picosecondsToDiffTime (fromIntegral nMicrosecs * 1_000_000))}+    Nothing -> Left "Cannot decode SQL null as the Haskell CalendarDiffTime type. Use a `Maybe CalendarDiffTime`"++instance FromPgField UUID where+  fieldDecoder = parsePgType [uuidOid] $ \case+    Just bs -> case UUID.fromByteString (LBS.fromStrict bs) of+      Just uuid -> Right uuid+      Nothing -> Left "Bug in Hpgsql: UUID field could not be decoded"+    Nothing -> Left "Cannot decode SQL null as the Haskell UUID type. Use a `Maybe UUID`"++instance FromPgField Aeson.Value where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder =+          \FieldInfo {fieldTypeOid} ->+            let+              -- jsonb has a byte prepended to the contents and json does not+              !fixJsonb = if fieldTypeOid == jsonbOid then BS.drop 1 else Prelude.id+             in+              \case+                Just bs -> case Aeson.decodeStrict $ fixJsonb bs of+                  Just d -> Right d+                  Nothing -> Left "Bug in Hpgsql. Postgres produced a json or jsonb value that Aeson does not consider valid."+                Nothing -> Left "Cannot decode SQL null as the Haskell Aeson.Value type. Use a `Maybe Aeson.Value` if you want SQL nulls",+        allowedPgTypes = (`elem` [jsonOid, jsonbOid]) . fieldTypeOid+      }++-- | A FieldDecoder that accepts and decodes SQL NULLs into `Nothing` values+-- for a given decoder.+nullableField :: FieldDecoder a -> FieldDecoder (Maybe a)+nullableField FieldDecoder {..} =+  FieldDecoder+    { fieldValueDecoder = \oid ->+        let !origFieldValueParser = fieldValueDecoder oid+         in \case+              Nothing -> Right Nothing+              justBs -> Just <$> origFieldValueParser justBs,+      allowedPgTypes+    }++instance (FromPgField a) => FromPgField (Maybe a) where+  fieldDecoder = nullableField fieldDecoder++allowOnlyArrayTypes :: FieldInfo -> Bool+allowOnlyArrayTypes fieldInfo =+  -- TODO: We could check the elemTypeOid too, but maybe later+  case lookupTypeByOid fieldInfo.fieldTypeOid fieldInfo.encodingContext.typeInfoCache of+    Just (TypeInfo {typeDetails = ArrayType _}) -> True+    Nothing -> True -- Assume user knows what they're doing+    Just _ -> False -- Definitely not an array++instance forall a. (FromPgField a) => FromPgField (Vector a) where+  fieldDecoder = arrayField Vector.replicateM fieldDecoder++instance {-# OVERLAPPING #-} forall a. (FromPgField a) => FromPgField (Vector (Vector a)) where+  -- From https://github.com/postgres/postgres/blob/5941946d0934b9eccb0d5bfebd40b155249a0130/src/backend/utils/adt/arrayfuncs.c#L1548+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder = \colInfo ->+          let !arrayFieldDecoder = arrayParser colInfo.encodingContext <* Parser.endOfInput+           in \case+                Nothing -> Left "Cannot decode SQL null as the Haskell Vector type. Use a `Maybe (Vector (Vector a))`"+                Just bs -> case Parser.parseOnly arrayFieldDecoder bs of+                  Parser.ParseOk v -> Right v+                  Parser.ParseFail err -> Left err,+        allowedPgTypes = allowOnlyArrayTypes+      }+    where+      !elementParser = fieldDecoder @a+      arrayParser :: EncodingContext -> Parser.Parser (Vector (Vector a))+      arrayParser encodingContext = do+        !ndim <- int32Parser+        !_hasNull <- int32Parser+        !elementTypeOid :: Oid <- Oid . fromIntegral <$> int32Parser+        let !elementColInfo = FieldInfo elementTypeOid Nothing encodingContext+        when (ndim /= 2) $ fail $ "TODO: No support for " ++ show ndim ++ "-dimensional arrays in Hpgsql. Got array with ndim=" ++ show ndim+        unless (elementParser.allowedPgTypes elementColInfo) $ fail $ "Array contains elements of type OID " ++ show elementTypeOid ++ " but decoder does not handle that type"+        numRows <- do+          !dim_i :: Int <- fromIntegral <$> int32Parser+          !_lb_i <- int32Parser+          pure dim_i+        lengthEachRow <- do+          !dim_i :: Int <- fromIntegral <$> int32Parser+          !_lb_i <- int32Parser+          pure dim_i++        Vector.replicateM numRows $ do+          Vector.replicateM lengthEachRow $+            do+              size :: Int <- fromIntegral <$> int32Parser+              elementBs <- if size == (-1) then pure Nothing else Just <$> Parser.take size+              case elementParser.fieldValueDecoder elementColInfo elementBs of+                Left err -> fail $ "Error parsing array element: " ++ show err+                Right el -> pure el++int16Parser :: Parser.Parser Int16+int16Parser = either fail pure . Cereal.decode @Int16 =<< Parser.take 2++-- | Derives `FromPgRow` generically.+genericFromPgRow :: forall a. (Generic a, ProductTypeDecoder (Rep a)) => RowDecoder a+genericFromPgRow = to <$> genRowDecoder @(Rep a)++class ProductTypeDecoder f where+  genRowDecoder :: RowDecoder (f a)++instance (ProductTypeDecoder a, ProductTypeDecoder b) => ProductTypeDecoder (a :*: b) where+  genRowDecoder = (:*:) <$> genRowDecoder <*> genRowDecoder++instance (ProductTypeDecoder f) => ProductTypeDecoder (M1 a c f) where+  genRowDecoder = M1 <$> genRowDecoder++instance (FromPgField a) => ProductTypeDecoder (K1 r a) where+  genRowDecoder = fmap K1 $ singleField $ fieldDecoder @a++genericToPgRow :: forall a. (Generic a, ProductTypeEncoder (Rep a)) => RowEncoder a+genericToPgRow = contramap from genRowEncoder++class ProductTypeEncoder f where+  genRowEncoder :: RowEncoder (f a)++instance (ProductTypeEncoder a, ProductTypeEncoder b) => ProductTypeEncoder (a :*: b) where+  genRowEncoder = divide (\(a :*: b) -> (a, b)) genRowEncoder genRowEncoder++instance (ProductTypeEncoder f) => ProductTypeEncoder (M1 i c f) where+  genRowEncoder = contramap unM1 genRowEncoder++instance (ToPgField a) => ProductTypeEncoder (K1 r a) where+  genRowEncoder = contramap unK1 singleFieldRowEncoder++-- | For the very common case of a Haskell enum matching a custom postgres enum type+-- that has its values all as lower case strings, this newtype can help you derive+-- instances as such:+--+-- > data Mood = Sad | Ok | Happy+-- >   deriving stock (Generic)+-- >   deriving (FromPgField, ToPgField) via (LowerCasedPgEnum Mood)+--+-- And this would match the Postgres equivalent:+--+-- > CREATE TYPE mood AS ENUM ('sad', 'ok', 'happy');+--+-- If you run into PostgreSQL type inference problems with this, you can+-- write instances manually with 'genericEnumFieldDecoder', 'genericEnumFieldEncoder',+-- 'typeFieldEncoder', and 'typeFieldDecoder'.+newtype LowerCasedPgEnum a = LowerCasedPgEnum a++instance (Generic a, EnumDecoder (Rep a)) => FromPgField (LowerCasedPgEnum a) where+  fieldDecoder = LowerCasedPgEnum <$> genericEnumFieldDecoder LT.toLower++instance (Generic a, EnumEncoder (Rep a)) => ToPgField (LowerCasedPgEnum a) where+  fieldEncoder = untypedFieldEncoder $ \_encCtx -> \(LowerCasedPgEnum v) -> NotNull $ genericEnumFieldEncoder Text.toLower v++-- | One of the functions behind 'LowerCasedPgEnum', but you can decide+-- how to map your type's constructor names arbitrarily, which can be+-- useful if you're not using lowercase values in your postgres enums.+genericEnumFieldDecoder ::+  forall a.+  (Generic a, EnumDecoder (Rep a)) =>+  -- | A function that takes in the Haskell constructor name and returns the textual representation of the enum in postgres+  (LT.Text -> LT.Text) ->+  FieldDecoder a+genericEnumFieldDecoder nameTransform = fromMaybe (error $ "Invalid enum value. Not one of " ++ show (Map.keys allValuesMap)) . flip Map.lookup allValuesMap <$> rawBytesFieldDecoder+  where+    -- TODO: Vector of pointers to ByteStrings for a bit more memory locality? Does it make a perf difference?+    allValuesMap = Map.mapKeys (LBS.toStrict . LT.encodeUtf8 . nameTransform) $ fmap to genEnumDecoder++class EnumDecoder f where+  -- | Returns the textual representation and constructed object for every possible+  -- value of the enum.+  genEnumDecoder :: Map LT.Text (f a)++instance (EnumDecoder a, EnumDecoder b) => EnumDecoder (a :+: b) where+  genEnumDecoder = (L1 <$> genEnumDecoder) `Map.union` (R1 <$> genEnumDecoder)++instance (EnumDecoder f) => EnumDecoder (M1 D c f) where+  genEnumDecoder = M1 <$> genEnumDecoder++-- U1 is "Unit"-type, that is: no value in the constructor, AKA "pure enum".+instance (KnownSymbol ctorName) => EnumDecoder (M1 C ('MetaCons ctorName ctorFixity 'False) U1) where+  genEnumDecoder = Map.singleton (LT.pack $ symbolVal (Proxy @ctorName)) (M1 U1)++-- | One of the functions behind 'LowerCasedPgEnum', but you can decide+-- how to map your type's constructor names arbitrarily, which can be+-- useful if you're not using lowercase values in your postgres enums.+genericEnumFieldEncoder ::+  forall a.+  (Generic a, EnumEncoder (Rep a)) =>+  -- | A function that takes in the Haskell constructor name and returns the textual representation of the enum in postgres+  (Text -> Text) ->+  a ->+  ByteString+genericEnumFieldEncoder nameTransform = encodeUtf8 . nameTransform . genEnumEncoder . from++class EnumEncoder f where+  -- | Returns the textual representation of an enum value's constructor.+  genEnumEncoder :: f a -> Text++instance (EnumEncoder a, EnumEncoder b) => EnumEncoder (a :+: b) where+  genEnumEncoder (L1 x) = genEnumEncoder x+  genEnumEncoder (R1 x) = genEnumEncoder x++instance (EnumEncoder f) => EnumEncoder (M1 D c f) where+  genEnumEncoder (M1 x) = genEnumEncoder x++-- U1 is "Unit"-type, that is: no value in the constructor, AKA "pure enum".+instance (KnownSymbol ctorName) => EnumEncoder (M1 C ('MetaCons ctorName ctorFixity 'False) U1) where+  genEnumEncoder _ = Text.pack $ symbolVal (Proxy @ctorName)++-- | Returns a `FieldEncoder` that is sent without a type OID in queries.+-- This means postgres will try to infer the type of these arguments.+-- Check `typedFieldEncoder` if you're interested in encoding your custom types,+-- you probably don't need this.+untypedFieldEncoder :: (EncodingContext -> a -> BinaryField) -> FieldEncoder a+untypedFieldEncoder enc = FieldEncoder {toTypeOid = \_ -> Nothing, toPgField = enc}++-- | A decoder that accepts any PG type and returns the object's+-- postgres' binary representation as a ByteString.+rawBytesFieldDecoder :: FieldDecoder ByteString+rawBytesFieldDecoder =+  FieldDecoder+    { fieldValueDecoder = \_oid -> \case+        Nothing -> Left "Cannot decode SQL null as the `rawBytesFieldDecoder`."+        Just bs -> Right bs,+      allowedPgTypes = const True+    }++-- | Returns a field-encoding function for a vector-like Foldable (e.g. Lists and Vector itself).+toPgVectorField :: forall f a. (Foldable f, ToPgField a) => EncodingContext -> f a -> BinaryField+toPgVectorField encCtx =+  let fe = fieldEncoder @a+      encodeElement el = Builder.binaryField $ fe.toPgField encCtx el+      Oid elemOid = fromMaybe (Oid 0) (fe.toTypeOid encCtx)+   in \vec ->+        let ndim = Builder.byteString $ Cereal.encode @Int32 1+            -- Postgres seems to build the "has_nulls" flag itself in the ReadArrayBinary function at https://github.com/postgres/postgres/blob/aa7f9493a02f5981c09b924323f0e7a58a32f2ed/src/backend/utils/adt/arrayfuncs.c#L1429, so we can just set it to 0+            hasNull = Builder.byteString $ Cereal.encode @Int32 0+            -- hasNull = Builder.byteString $ Cereal.encode @Int32 (if Vector.any (\e -> toPgField e == Nothing) vec then 1 else 0)+            elemOidBs = Builder.byteString $ Cereal.encode @Int32 elemOid+            lb1 = Builder.byteString $ Cereal.encode @Int32 1+            (Sum len, encodedElements) = foldMap (\el -> (Sum 1, encodeElement el)) vec+            dim1 = Builder.byteString $ Cereal.encode @Int32 len+            fullBs = ndim <> hasNull <> elemOidBs <> dim1 <> lb1 <> encodedElements+         in NotNull (Builder.toStrictByteString fullBs)++-- | A FieldDecoder that accepts and decodes Postgres arrays.+arrayField :: forall a f. (Monoid (f a)) => (forall m. (Monad m) => Int -> m a -> m (f a)) -> FieldDecoder a -> FieldDecoder (f a)+arrayField !replicateFunction !elementParser =+  -- From https://github.com/postgres/postgres/blob/5941946d0934b9eccb0d5bfebd40b155249a0130/src/backend/utils/adt/arrayfuncs.c#L1548+  FieldDecoder+    { fieldValueDecoder = \colInfo ->+        let !arrayFieldDecoder = arrayParser colInfo.encodingContext <* Parser.endOfInput+         in \case+              Nothing -> Left "Cannot decode SQL null as the Haskell Vector type. Use a `Maybe (Vector a)`"+              Just bs -> case Parser.parseOnly arrayFieldDecoder bs of+                Parser.ParseOk v -> Right v+                Parser.ParseFail err -> Left err,+      allowedPgTypes = allowOnlyArrayTypes+    }+  where+    arrayParser :: EncodingContext -> Parser.Parser (f a)+    arrayParser encodingContext = do+      !ndim <- int32Parser+      !_hasNull <- int32Parser+      !elementTypeOid :: Oid <- Oid . fromIntegral <$> int32Parser+      let !elementColInfo = FieldInfo elementTypeOid Nothing encodingContext+      when (ndim > 1) $ fail $ "TODO: No support for multi-dimensional arrays in Hpgsql. Got array with ndim=" ++ show ndim+      if ndim == 0+        then pure mempty+        else do+          !dim_i :: Int <- fromIntegral <$> int32Parser+          !_lb_i <- int32Parser+          unless (elementParser.allowedPgTypes elementColInfo) $ fail $ "Array contains elements of type OID " ++ show elementTypeOid ++ " but decoder does not handle that type"+          replicateFunction dim_i $ do+            size :: Int <- fromIntegral <$> int32Parser+            elementBs <- if size == (-1) then pure Nothing else Just <$> Parser.take size+            case elementParser.fieldValueDecoder elementColInfo elementBs of+              Left err -> fail $ "Error parsing array element: " ++ show err+              Right el -> pure el
+ src/Hpgsql/Encoding/RowDecoderMonadic.hs view
@@ -0,0 +1,55 @@+module Hpgsql.Encoding.RowDecoderMonadic+  ( RowDecoderMonadic (..), -- TODO: Can we export ctor?+    ConversionState (..),+    toMonadicRowDecoder,+  )+where++import Data.Bifunctor (first)+import qualified Data.List as List+import Hpgsql.Encoding (FieldInfo, RowDecoder (..))+import qualified Hpgsql.SimpleParser as Parser++-- | Unlike @Hpgsql.Encoding.RowDecoder@, this has a @Monad@ instance.+-- You should prefer to use @Hpgsql.Encoding.RowDecoder@ (through @FromPgRow@ instances)+-- instead of this, and use this only if your row decoder is complex enough that+-- decoded fields can change the behaviour of other decoded fields.+-- The regular @RowDecoder@ can even type-check queries that return no results, while+-- this can't.+-- Look for the 'query' and 'pipeline' functions with an 'M' in them for ways to query+-- with this kind of row decoder.+newtype RowDecoderMonadic a = RowDecoderMonadic+  { -- | Returns the parsed row and the number of columns parsed+    fullRowDecoder :: ConversionState -> Parser.Parser (a, Int)+  }++newtype ConversionState = ConversionState+  { colsLeftToParse :: [FieldInfo]+  }++instance Functor RowDecoderMonadic where+  fmap f (RowDecoderMonadic {fullRowDecoder}) = RowDecoderMonadic $ \cs -> fmap (first f) (fullRowDecoder cs)++instance Applicative RowDecoderMonadic where+  pure v = RowDecoderMonadic $ \_cs -> pure (v, 0)+  RowDecoderMonadic {fullRowDecoder = rpF} <*> RowDecoderMonadic {fullRowDecoder = rpV} = RowDecoderMonadic $ \cs -> do+    (rowF, n1) <- rpF cs+    (rowV, n2) <- rpV cs {colsLeftToParse = List.drop n1 cs.colsLeftToParse}+    pure (rowF rowV, n1 + n2)++instance Monad RowDecoderMonadic where+  RowDecoderMonadic {fullRowDecoder} >>= f = RowDecoderMonadic $ \cs0 -> do+    (row, numColsParsed) <- fullRowDecoder cs0+    let RowDecoderMonadic {fullRowDecoder = parserOfRemainder} = f row+    parserOfRemainder cs0 {colsLeftToParse = List.drop numColsParsed cs0.colsLeftToParse}++-- | Takes an Applicative row parser (which can type-check result rows before even fetching+-- any rows from the response) and transforms it into a Monadic row parser, which has no such+-- type-checking.+toMonadicRowDecoder :: RowDecoder a -> RowDecoderMonadic a+toMonadicRowDecoder RowDecoder {fullRowDecoder, numExpectedColumns} = RowDecoderMonadic $ \cs -> do+  let numActualCols = length cs.colsLeftToParse+  case compare numActualCols numExpectedColumns of+    EQ -> (,numExpectedColumns) <$> fullRowDecoder cs.colsLeftToParse+    GT -> (,numExpectedColumns) <$> fullRowDecoder (List.take numExpectedColumns cs.colsLeftToParse)+    LT -> fail $ "More number of columns expected by the row parser than found in query results. Expected " ++ show numExpectedColumns ++ " but got " ++ show numActualCols
+ src/Hpgsql/Internal.hs view
@@ -0,0 +1,1696 @@+module Hpgsql.Internal+  ( -- * Connection+    connect,+    connectOpts,+    defaultConnectOpts,+    withConnection,+    withConnectionOpts,+    closeGracefully,+    closeForcefully,++    -- * Query+    query,+    queryWith,+    queryMWith,+    queryS,+    querySWith,+    querySMWith,+    query1,+    query1With,+    queryMay,+    queryMayWith,+    execute,+    execute_,++    -- * Pipeline+    Pipeline,+    runPipeline,+    pipelineS,+    pipelineSWith,+    pipelineSMWith,+    pipeline,+    pipelineWith,+    pipelineExec,+    pipelineExec_,+    pipeline1,+    pipeline1With,+    pipelineMay,+    pipelineMayWith,++    -- * Copy+    copyStart,+    copyEnd,+    putCopyData,+    withCopy,+    withCopy_,+    copyFrom,+    copyFromS,++    -- * Pool+    resetConnectionState,++    -- * Transaction+    transactionStatus,++    -- * Notifications+    getNotification,+    getNotificationNonBlocking,++    -- * Type info+    refreshTypeInfoCache,+    resetTypeInfoCache,+    getParameterStatus,+    getBackendPid,++    -- * Misc+    cancelActiveStatement,++    -- * Infrastructure (not re-exported publicly)+    connectionReadyForNewPipeline,+    fullTransactionStatus,+    receiveNextMsgWithMaskedContinuation,+    receiveNextMsgWithMaskedContinuationButDontThrowOnParsingFailure,+    sendCancellationRequest,+    isLastInPipeline,+    updateConnStateTxn,+    withControlMsgsLock,+    receiveOutstandingResponseMsgsAtomically,+    consumeResults,+    consumeResultsIgnoreRows,+    consumeStreamingResults,+    WhichRowDecoder (..),+    mkPostgresError,+    throwPostgresError,+    throwIrrecoverableErrorWithStatement,+    lookupQueryText,+    sendPipeline,+    waitUntilPipelineIsReadyForNewQuery,+    acquireOwnershipOfOrphanedQueries,+    nonAtomicSendMsg,+    rethrowAsIrrecoverable,+    atomicallySendControlMsgs,+    atomicallySendControlMsgs_,+    SomeMessage (..),+    runPipelineInternal,+    InternalConnectOrCancelRequest (..),+    internalConnectOrCancel,+    debugPrint,+    _globalDebugLock,+    timeDebugNonBlockingOperation,+    whenNotClosed,+    chunkBuildersBySize,+    pipelineExecInternal,+    pipelineM,+    withCopyInternal,+    copyEndInternal,+    putCopyError,+  )+where++import Control.Applicative (Alternative (..))+import Control.Concurrent (modifyMVar, modifyMVar_, readMVar)+import Control.Concurrent.MVar (MVar, newMVar)+import Control.Concurrent.STM (STM, TVar)+import qualified Control.Concurrent.STM as STM+import Control.Exception.Safe (MonadThrow, SomeException, bracket, bracketOnError, finally, handle, mask, mask_, onException, throw, toException, tryJust)+import Control.Monad (forM, forM_, join, unless, void, when)+import Data.ByteString (ByteString)+import Data.ByteString.Internal (w2c)+import qualified Data.ByteString.Lazy as LBS+import Data.Data (Proxy (..))+import Data.Either (isLeft, isRight)+import Data.Int (Int32, Int64)+import qualified Data.List as List+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe, isNothing, mapMaybe)+import qualified Data.Serialize as Cereal+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8)+import qualified Data.Text.IO as Text+import Data.Time (DiffTime, diffTimeToPicoseconds, secondsToDiffTime)+import GHC.Conc (ThreadStatus (..), threadStatus)+import Hpgsql.Base+import qualified Hpgsql.Builder as Builder+import Hpgsql.Encoding (FieldInfo (..), FromPgRow (..), RowDecoder (..), RowEncoder (..), ToPgRow (..))+import Hpgsql.Encoding.RowDecoderMonadic (ConversionState (..), RowDecoderMonadic (..))+import Hpgsql.InternalTypes (BindComplete (..), CommandComplete (..), ConnectOpts (..), ConnectionString (..), CopyInResponse (..), CopyQueryState (..), DataRow (..), Either3 (..), EncodingContext (..), ErrorDetail (..), ErrorResponse (..), HPgConnection (..), InternalConnectionState (..), IrrecoverableHpgsqlError (..), NoData (..), NotificationResponse (..), ParseComplete (..), Pipeline (..), PostgresError (..), Query (..), QueryId (..), QueryProtocol (..), QueryState (..), ReadyForQuery (..), ResetConnectionOpts (..), ResponseMsg (..), ResponseMsgsReceived (..), RowDescription (..), SingleQuery (..), TransactionStatus (..), WeakThreadId (..), mkMutex, queryToByteString, throwIrrecoverableError)+import Hpgsql.Locking (getMyWeakThreadId, withMutex)+import Hpgsql.Msgs (AuthenticationMethod (..), AuthenticationResponse (..), BackendKeyData (..), Bind (..), CancelRequest (..), CopyData (..), CopyDone (..), Describe (..), Execute (..), FromPgMessage (..), NoticeResponse (..), ParameterStatus (..), Parse (..), PasswordMessage (..), PgMsgParser (..), StartupMessage (..), Sync (..), Terminate (..), ToPgMessage (..), parsePgMessage)+import qualified Hpgsql.Msgs as Msgs+import Hpgsql.Networking (recvNonBlocking, sendNonBlocking, socketWaitRead, socketWaitWrite)+import Hpgsql.Query (breakQueryIntoStatements)+import qualified Hpgsql.SimpleParser as Parser+import Hpgsql.TypeInfo (ArrayTypeDetails (..), TypeDetails (..), TypeInfo (..), buildTypeInfoCache, builtinPgTypesMap)+import Network.Socket (AddrInfo (..))+import qualified Network.Socket as Socket+import qualified Network.Socket.ByteString as SocketBS+import qualified Network.Socket.ByteString.Lazy as SocketLBS+import Streaming (Of (..), Stream)+import qualified Streaming as S+import qualified Streaming.Internal as SInternal+import qualified Streaming.Prelude as S+import System.IO (stderr)+import System.IO.Error (isResourceVanishedError)+import System.IO.Unsafe (unsafePerformIO)+import System.Mem.Weak (deRefWeak)+import System.Timeout (timeout)++-- | Returns a Left with the current pipeline if connection is not ready for a new pipeline, a Right+-- with the current transaction status otherwise.+connectionReadyForNewPipeline :: InternalConnectionState -> Either (NonEmpty QueryState) TransactionStatus+connectionReadyForNewPipeline (currentPipeline -> pip) =+  -- You can tell there are two ways to represent no active pipeline, aka being ready+  -- to send a new query: and empty pipeline and a pipeline with a ReadyForQuery received.+  -- This might seem silly, but it really helps resuming interrupted execution from a point+  -- when ReadyForQuery was already received, because we can still associate a ReadyForQuery+  -- with a QueryId.+  -- The empty list should only exist immediately after connecting and before the very first+  -- query is sent. After that it's never empty again as new pipelines replace old ones.+  case pip of+    [] -> Right TransIdle+    (q1 : qs) -> case headMaybe $+      mapMaybe+        ( \qstate -> case responseMsgsState qstate of+            ReadyForQueryReceived _ (ReadyForQuery s) -> Just s+            _ -> Nothing+        )+        pip of+      Nothing -> Left (q1 :| qs)+      Just st -> Right st++-- | Returns the transaction's status _before_ the current pipeline was sent+-- and the current transaction status.+-- The former can be used to determine if the pipeline was initiated inside+-- an explicit or implicit transaction.+fullTransactionStatus :: TVar InternalConnectionState -> STM (TransactionStatus, TransactionStatus)+fullTransactionStatus sttv = do+  st <- STM.readTVar sttv+  (st.transactionStatusBeforeCurrentPipeline,) <$> case connectionReadyForNewPipeline st of+    Right s -> pure s+    Left pip ->+      pure $+        if any+          ( ( \case+                ErrorResponseReceived _ _ -> True+                _ -> False+            )+              . responseMsgsState+          )+          pip+          then+            TransInError+          else TransActive++-- | The current transaction status.+-- Note that if `withTransaction` is interruped by an asynchronous exception,+-- this may still report `TransActive` until you run your next command.+-- See `withTransaction` for details.+transactionStatus :: HPgConnection -> IO TransactionStatus+transactionStatus conn = snd <$> STM.atomically (fullTransactionStatus conn.internalConnectionState)++connect :: ConnectionString -> DiffTime -> IO HPgConnection+connect =+  connectOpts defaultConnectOpts++connectOpts :: ConnectOpts -> ConnectionString -> DiffTime -> IO HPgConnection+connectOpts =+  internalConnectOrCancel+    Connect++defaultConnectOpts :: ConnectOpts+defaultConnectOpts =+  ConnectOpts+    { killedThreadPollIntervalMs = 500,+      cancellationRequestResendIntervalMs = 500,+      fillTypeInfoCache = True+    }++data InternalConnectOrCancelRequest a where+  Connect :: InternalConnectOrCancelRequest HPgConnection+  CancelNotConnect :: CancelRequest -> AddrInfo -> InternalConnectOrCancelRequest ()++internalConnectOrCancel :: InternalConnectOrCancelRequest a -> ConnectOpts -> ConnectionString -> DiffTime -> IO a+internalConnectOrCancel connectOrCancel connOpts originalConnStr@ConnectionString {..} conntimeout = do+  sockOrTimeout <- timeout (fromInteger $ diffTimeToPicoseconds conntimeout `div` 1_000_000) getConnectedSocket+  case sockOrTimeout of+    Nothing -> throwIrrecoverableError "Could not connect in the supplied timeout"+    -- TODO: It's still possible for an asynchronous exception to interrupt this before the `onException` handler is installed+    Just (sock, addrInfo) -> flip onException (Socket.close sock) $ do+      Socket.withFdSocket sock Socket.getNonBlock >>= \case+        False -> throwIrrecoverableError "Socket is not marked as non-blocking, which is not supported by hpgsql. You might be running on an unsupported platform"+        True -> pure ()+      socketIsClosed <- newMVar False+      recvBuffer <- newMVar mempty+      sendBuffer <- newMVar mempty+      socketMutex <- mkMutex+      encodingContext <- newMVar (EncodingContext builtinPgTypesMap)+      connParams <- newMVar mempty+      notifQueue <- STM.newTQueueIO+      currentConnectionState <-+        STM.newTVarIO $+          InternalConnectionState+            { totalQueriesSent = 0,+              currentPipeline = [],+              notificationsReceived = notifQueue,+              mustIssueRollbackBeforeNextCommand = False,+              preparedStatementNames = mempty,+              transactionStatusBeforeCurrentPipeline = TransIdle+            }+      let hpgConnPartialDoNotReturn = HPgConnection sock socketIsClosed recvBuffer sendBuffer socketMutex originalConnStr addrInfo encodingContext connParams currentConnectionState 0 0 connOpts+      case connectOrCancel of+        CancelNotConnect cancelRequest _ -> do+          nonAtomicSendMsg hpgConnPartialDoNotReturn cancelRequest+          -- We _must_ wait until the socket is closed _by the other end_ (PostgreSQL-the-server),+          -- because otherwise this cancellation request might be processed while the client sends+          -- another query. See https://www.postgresql.org/message-id/flat/27126.1126649920%40sss.pgh.pa.us#75364d0966758fccad56cd6c71547771+          void $ tryJust (\err -> if isResourceVanishedError err then Just () else Nothing) $ socketWaitRead (socket hpgConnPartialDoNotReturn)+          Socket.close sock+        Connect -> do+          debugPrint "Sending startup message"+          -- We set the client_encoding to UTF8 at connection time+          nonAtomicSendMsg hpgConnPartialDoNotReturn $ StartupMessage {user = Text.unpack user, database = Text.unpack database, options = "-c client_encoding=UTF8 " <> Text.unpack options}+          AuthenticationResponse authMethod <- receiveNextMsgWithMaskedContinuationButDontThrowOnParsingFailure hpgConnPartialDoNotReturn (msgParser @Msgs.AuthenticationResponse) $ \case+            Right knownAuthMsg -> pure knownAuthMsg+            Left unknownAuthMsg -> throwIrrecoverableError $ "Received unknown authentication message from PostgreSQL. This is probably an authentication method unsupported by hpgsql. More details about the message: " <> Text.pack (show unknownAuthMsg)+          case authMethod of+            AuthOk -> pure ()+            AuthCleartextPassword -> do+              nonAtomicSendMsg hpgConnPartialDoNotReturn $ PasswordMessage authMethod (Text.unpack user) (Text.unpack password)+              receiveAuthOkOrThrow hpgConnPartialDoNotReturn+            AuthMD5Password _ -> do+              nonAtomicSendMsg hpgConnPartialDoNotReturn $ PasswordMessage authMethod (Text.unpack user) (Text.unpack password)+              receiveAuthOkOrThrow hpgConnPartialDoNotReturn+            _ -> throwIrrecoverableError $ "Hpgsql does not yet support authenticating with method " <> Text.pack (show authMethod)+          errorOrBackendKeyData <- receiveNextMsgUnsafe hpgConnPartialDoNotReturn $ Right <$> msgParser @BackendKeyData <|> Left <$> msgParser @ErrorResponse+          case errorOrBackendKeyData of+            Left errResp -> throw $ IrrecoverableHpgsqlError {hpgsqlDetails = "Socket connected but postgresql threw an error during connection startup handshake", innerException = Just $ toException $ mkPostgresError "" errResp, relatedStatement = Nothing}+            Right backendKeyData -> do+              readyForQueryOrError <- receiveNextMsgUnsafe hpgConnPartialDoNotReturn $ Right <$> msgParser @ReadyForQuery <|> Left <$> msgParser @ErrorResponse+              case readyForQueryOrError of+                Left errResp -> throw $ IrrecoverableHpgsqlError {hpgsqlDetails = "A postgresql error happened while connecting", innerException = Just $ toException $ mkPostgresError "" errResp, relatedStatement = Nothing}+                Right ReadyForQuery {} -> pure ()+              debugPrint $ "Connected with backend PID " ++ show (backendPid backendKeyData)+              let finalConn = hpgConnPartialDoNotReturn {connPid = backendPid backendKeyData, cancelSecretKey = backendSecretKey backendKeyData}+              when (fillTypeInfoCache connOpts) $ join $ runPipeline finalConn $ refreshTypeInfoCache finalConn+              pure finalConn+  where+    -- \| Unsafe version of `withSafeReceiveNextMsg`.+    receiveNextMsgUnsafe :: (Show a) => HPgConnection -> PgMsgParser a -> IO a+    receiveNextMsgUnsafe conn parser = receiveNextMsgWithMaskedContinuation conn parser pure++    receiveAuthOkOrThrow :: HPgConnection -> IO ()+    receiveAuthOkOrThrow conn = do+      authMsg <- receiveNextMsgUnsafe conn (Right <$> msgParser @AuthenticationResponse <|> Left <$> msgParser @ErrorResponse)+      case authMsg of+        Left errResp -> throw $ IrrecoverableHpgsqlError {hpgsqlDetails = "A postgresql error happened while connecting", innerException = Just $ toException $ mkPostgresError "" errResp, relatedStatement = Nothing}+        Right (AuthenticationResponse authMethod) ->+          case authMethod of+            AuthOk -> pure ()+            _ -> throwIrrecoverableError "Failed to authenticate user."++    getConnectedSocket = do+      addrInfo <- case connectOrCancel of+        CancelNotConnect _ addrInfo -> pure addrInfo+        Connect ->+          if "/" `Text.isInfixOf` hostname+            then+              pure+                AddrInfo+                  { addrFlags = [],+                    addrFamily = Socket.AF_UNIX,+                    addrSocketType = Socket.Stream,+                    addrProtocol = Socket.defaultProtocol,+                    addrAddress = Socket.SockAddrUnix $ Text.unpack (Text.dropWhileEnd (== '/') hostname) ++ "/.s.PGSQL." ++ show port,+                    addrCanonName = Nothing+                  }+            else do+              addrInfos <- Socket.getAddrInfo (Just Socket.defaultHints) (Just $ Text.unpack hostname) (Just $ show port)+              case addrInfos of+                [] -> throwIrrecoverableError "Could not resolve address"+                addrInfo : _ -> pure addrInfo+      -- TODO: It's still possible for an asynchronous exception to interrupt this before the `onException` handler is installed+      sock <- Socket.openSocket addrInfo+      flip onException (Socket.close sock) $ do+        Socket.connect sock (Socket.addrAddress addrInfo)+        pure (sock, addrInfo)++-- | Fetches custom types from postgres and refreshes this connection's+-- internal typeInfo cache with them.+-- Note that builtin postgres types are always available in the typeInfo cache;+-- this just refreshes any other custom types, including removing those that+-- no longer exist and adding new ones.+-- Hpgsql runs this automatically for new connections unless you disable it.+-- This is a Pipeline so you can batch it with other commands for reduced latency.+-- See `ConnectOpts` and `resetTypeInfoCache` for more.+refreshTypeInfoCache :: HPgConnection -> Pipeline (IO ())+refreshTypeInfoCache conn =+  -- https://www.postgresql.org/docs/current/system-catalog-initial-data.html#SYSTEM-CATALOG-OID-ASSIGNMENT+  -- says "OIDs assigned during normal database operation are constrained to be 16384 or higher. This ensures that the range 10000—16383 is free for OIDs assigned automatically by genbki.pl or during initdb. These automatically-assigned OIDs are not considered stable, and may change from one installation to another."+  let fetchPipeline = pipeline "select oid, typname, typarray, typelem, typcategory, typtype from pg_catalog.pg_type WHERE oid >= 16384"+   in fillTypeInfoCache <$> fetchPipeline+  where+    fillTypeInfoCache queryResultsIO = do+      queryResults <- queryResultsIO+      let customTypes = buildTypeInfoCache $ map (\(oid, typname, typarray, typelem, typcategory, typtype) -> TypeInfo oid typname (if typarray == 0 then Nothing else Just typarray) (toTypeDetails typelem typcategory typtype)) queryResults+      modifyMVar_ conn.encodingContext $ \_ -> pure $ EncodingContext $ customTypes <> builtinPgTypesMap+    toTypeDetails typelem typcategory typtype = case (typcategory, typtype) of+      ('A', _) -> ArrayType (ArrayTypeDetails typelem)+      (_, 'c') -> CompositeType+      (_, 'd') -> DomainType+      (_, 'e') -> EnumType+      (_, 'p') -> PseudoType+      (_, 'r') -> RangeType+      (_, 'm') -> MultiRangeType+      _ -> BasicType++-- | Useful to reset the connection's internal typeInfo cache+-- to the builtin postgres types.+resetTypeInfoCache :: HPgConnection -> IO ()+resetTypeInfoCache conn = modifyMVar_ conn.encodingContext $ \_ -> pure $ EncodingContext builtinPgTypesMap++getParameterStatus :: HPgConnection -> Text -> IO (Maybe Text)+getParameterStatus HPgConnection {parameterStatusMap} paramName = Map.lookup paramName <$> readMVar parameterStatusMap++getBackendPid :: HPgConnection -> Int32+getBackendPid HPgConnection {connPid} = connPid++-- | Resets many forms of connection state in an attempt to make it+-- as similar as possible to a newly opened connection. It can be useful to+-- run this before e.g. putting a connection back into a connection pool.+-- Check `ResetConnectionOpts` for more details.+resetConnectionState ::+  HPgConnection ->+  -- | Pass `Nothing` to use defaults.+  Maybe ResetConnectionOpts ->+  IO ()+resetConnectionState conn@HPgConnection {internalConnectionState} mCleanOpts = do+  STM.atomically $ do+    st <- STM.readTVar internalConnectionState+    when (isLeft $ connectionReadyForNewPipeline st) $ throwIrrecoverableError "There are still active queries in progress. Make sure to close this connection with `closeForcefully` or consume all existing queries' results"+  when (checkTransactionState cleanOpts) $ do+    txnStatus <- transactionStatus conn+    unless (txnStatus == TransIdle) $ throwIrrecoverableError $ "The connection's transaction was left in an invalid state: " <> Text.pack (show txnStatus) <> ". Make sure to close this connection with `closeForcefully`"+  -- What if there are notifications in the socket buffer? It seems reasonable to assume that when+  -- running "UNLISTEN *" those would be received, so this might be fine as long as we+  -- clear the internal queue _after_ "UNLISTEN *".+  do+    let qs = (if unlistenAll cleanOpts then ["UNLISTEN *"] else []) ++ (if resetAll cleanOpts then ["RESET ALL", "RESET ROLE"] else [])+    runPipeline conn (traverse pipelineExec_ qs) >>= sequence_+  when (unlistenAll cleanOpts) clearInternalNotificationQueue+  where+    cleanOpts = fromMaybe ResetConnectionOpts {resetAll = True, unlistenAll = True, checkTransactionState = True} mCleanOpts+    clearInternalNotificationQueue = STM.atomically $ do+      st <- STM.readTVar internalConnectionState+      emptyQueue <- STM.newTQueue+      STM.writeTVar internalConnectionState $ st {notificationsReceived = emptyQueue}++-- | Closes the connection with postgres. Do not use this in exception handlers; use `closeForcefully`+-- instead.+closeGracefully :: HPgConnection -> IO ()+closeGracefully conn@(HPgConnection {socket}) = whenNotClosed conn $ flip finally (Socket.close socket >> modifyMVar_ conn.socketClosed (const $ pure True)) $ do+  withControlMsgsLock+    conn+    (const $ pure ())+    (const $ pure ())+    $ \() -> do+      nonAtomicSendMsg conn Terminate++-- | Closes the connection with postgres as quickly as possible without+-- the proper postgres protocol handshake procedures. This is equivalent to+-- closing the connection's socket in the kernel without making postgres+-- aware of it.+-- Use this if you need to close the connection in exception handlers or+-- if you received an irrecoverable Hpgsql exception.+closeForcefully :: HPgConnection -> IO ()+closeForcefully conn@(HPgConnection {socket}) = whenNotClosed conn $ do+  Socket.close socket+  modifyMVar_ conn.socketClosed $ const $ pure True++whenNotClosed :: HPgConnection -> IO () -> IO ()+whenNotClosed conn f = do+  isClosed <- readMVar conn.socketClosed+  unless isClosed f++withConnection :: ConnectionString -> DiffTime -> (HPgConnection -> IO a) -> IO a+withConnection connstr conntimeout f = bracketOnError (connect connstr conntimeout) closeForcefully $ \conn -> do+  res <- f conn+  closeGracefully conn+  pure res++withConnectionOpts :: ConnectOpts -> ConnectionString -> DiffTime -> (HPgConnection -> IO a) -> IO a+withConnectionOpts connOpts connstr conntimeout f = bracketOnError (connectOpts connOpts connstr conntimeout) closeForcefully $ \conn -> do+  res <- f conn+  closeGracefully conn+  pure res++-- | Just like `receiveNextMsgWithMaskedContinuation` but passes a `Maybe a` to+-- the continuation instead of throwing an exception on parser failure. On parsing+-- failure, this makes sure the message buffer remains unaltered.+receiveNextMsgWithMaskedContinuation :: (Show a) => HPgConnection -> PgMsgParser a -> (a -> IO b) -> IO b+receiveNextMsgWithMaskedContinuation conn parser f =+  receiveNextMsgWithMaskedContinuationButDontThrowOnParsingFailure conn parser $ \case+    Right p -> f p+    Left (msgIdentChar, mPgError) -> throw IrrecoverableHpgsqlError {hpgsqlDetails = "Could not parse postgres message with ident char " <> Text.pack (show msgIdentChar) <> ". This is an internal error in Hpgsql. Please report it.", innerException = toException <$> mPgError, relatedStatement = Nothing}++-- | Masks asynchronous exceptions in between the moment the message is extracted from+-- the internal buffer and the supplied function runs to completion.+-- This is important for control messages (i.e. not `DataRow`) because if you extract a+-- message from the buffer, you must be able to update the connection's internal state,+-- lest it will be left in a very broken place.+-- CAREFUL: avoid doing networking or too much work in your supplied function. It must+-- be really cheap!+receiveNextMsgWithMaskedContinuationButDontThrowOnParsingFailure :: (Show a) => HPgConnection -> PgMsgParser a -> (Either (Char, Maybe PostgresError) a -> IO b) -> IO b+receiveNextMsgWithMaskedContinuationButDontThrowOnParsingFailure conn@HPgConnection {socket, recvBuffer} parser f = do+  -- We need to preserve the invariant that the internal buffer's first byte is+  -- always the first byte of a valid Message while keeping this function+  -- interruptible.+  -- This means we can't extract a message partially from the internal buffer,+  -- due to the presence of asynchronous exceptions.+  -- So we append to the buffer up until it has been fully fetched,+  -- and then extract it from the buffer in one piece.+  currentBuf <- receiveUntilBufferHasAtLeast 5+  let bufLen = LBS.length currentBuf+  let charAndLength = LBS.take 5 currentBuf+  let (w2c -> msgIdentChar, lenbs) = fromMaybe (error "impossible") $ LBS.uncons charAndLength+      lenLeftToFetch :: Int64 = fromIntegral $ either error id (Cereal.decodeLazy @Int32 lenbs) - 4+      fullMessageLen = 5 + lenLeftToFetch+  restOfMsg <- LBS.drop 5 . LBS.take fullMessageLen <$> if bufLen >= fullMessageLen then pure currentBuf else receiveUntilBufferHasAtLeast fullMessageLen+  receivedNoticeOrParameterSoTryAgain <- go msgIdentChar restOfMsg fullMessageLen+  case receivedNoticeOrParameterSoTryAgain of+    Nothing -> receiveNextMsgWithMaskedContinuationButDontThrowOnParsingFailure conn parser f+    Just res -> pure res+  where+    -- We mask_ because if the supplied IO action runs with a message extracted from+    -- the recvBuffer, then we _must_ remove that message from recvBuffer.+    -- TODO: These IO actions are always STM transactions (some times just a `pure` call),+    -- so maybe we should reflect that in the type to avoid the impression that+    -- anything can happen.+    go msgIdentChar restOfMsg fullMessageLen = mask_ $ modifyMVar recvBuffer $ \lbs -> do+      let !bufferWithoutMsg =+            if LBS.length lbs >= fullMessageLen+              then LBS.drop fullMessageLen lbs+              else+                error "Bug in Hpgsql. Internal buffer's bytes weren't filled enough"++      case parsePgMessage msgIdentChar restOfMsg parser of+        Just msg -> do+          debugPrint $ "Received " ++ show msg+          fmap (bufferWithoutMsg,) $ Just <$> f (Right msg)+        Nothing -> do+          -- This could be a Notification, NOTICE or a ParameterStatus message, since these+          -- can be received _at any time_ according to the docs.+          case parsePgMessage msgIdentChar restOfMsg (Left3 <$> msgParser @NotificationResponse <|> Middle3 <$> msgParser @NoticeResponse <|> Right3 <$> msgParser @ParameterStatus) of+            Just (Left3 notifResponse) -> do+              debugPrint "Received notification. Will add it to internal queue."+              STM.atomically $ do+                sttv <- STM.readTVar $ internalConnectionState conn+                STM.writeTQueue (notificationsReceived sttv) notifResponse+              pure (bufferWithoutMsg, Nothing)+            Just (Middle3 (NoticeResponse details)) -> do+              let severity =+                    fromMaybe+                      "Notice of unknown severity"+                      (Map.lookup ErrorSeverity details)+                  humanmsg = fromMaybe "no message" (Map.lookup ErrorHumanReadableMsg details)+              Text.hPutStrLn stderr $ decodeUtf8 $ LBS.toStrict $ severity <> ": " <> humanmsg+              pure (bufferWithoutMsg, Nothing)+            Just (Right3 (ParameterStatus {..})) -> do+              when (parameterName == "client_encoding" && parameterValue /= "UTF8") $ throwIrrecoverableError $ "Postgres sent us a change of client_encoding to not UTF8, and Hpgsql only supports UTF8. The encoding postgres sent us is " <> parameterValue+              modifyMVar_ (parameterStatusMap conn) $ \(!paramMap) -> pure (Map.insert parameterName parameterValue paramMap)+              pure (bufferWithoutMsg, Nothing)+            Nothing ->+              -- Just in case this is a postgres error, it might include useful information,+              -- so we spit that out+              let mPgError = mkPostgresError "" <$> parsePgMessage msgIdentChar restOfMsg (msgParser @ErrorResponse)+               in fmap (lbs,) $ Just <$> f (Left (msgIdentChar, mPgError))++    -- \| Appends into the internal buffer by reading from the socket+    -- until the buffer has at least N bytes.+    -- Returns the current buffer.+    receiveUntilBufferHasAtLeast :: Int64 -> IO LBS.ByteString+    receiveUntilBufferHasAtLeast minBytesNecessary = do+      currentBuffer <- readMVar recvBuffer+      let nBytesInBuffer = LBS.length currentBuffer+      if nBytesInBuffer >= minBytesNecessary+        then pure currentBuffer+        else do+          -- This takes from the kernel's recv buffer and appends to our buffer atomically,+          -- or an exception is thrown when receiving.+          mask $ \restore -> rethrowAsIrrecoverable $ modifyMVar_ recvBuffer $ \lbs -> do+            restore $ socketWaitRead socket+            someBytes <- timeDebugNonBlockingOperation "recv" $ recvNonBlocking socket (max 16000 $ fromIntegral $ minBytesNecessary - nBytesInBuffer)+            pure (lbs <> LBS.fromStrict someBytes)+          receiveUntilBufferHasAtLeast minBytesNecessary++sendCancellationRequest :: HPgConnection -> IO ()+sendCancellationRequest conn = do+  copyState <-+    STM.atomically $+      STM.readTVar (internalConnectionState conn) >>= \st -> pure $ case currentPipeline st of+        [QueryState {queryProtocol = CopyQuery copyState}] -> Just copyState+        _ -> Nothing+  let markCopyFailSent = do+        let sttv = internalConnectionState conn+        st <- STM.readTVar sttv+        case currentPipeline st of+          [qs@QueryState {queryProtocol = CopyQuery StillCopying}] -> STM.writeTVar (internalConnectionState conn) $ st {currentPipeline = [qs {queryProtocol = CopyQuery CopyFailAndSyncSent}]}+          _ -> throwIrrecoverableError "Impossible: when marking CopyFail state was invalid"+  case copyState of+    Just StillCopying ->+      atomicallySendControlMsgs_ conn ([SomeMessage $ Msgs.CopyFail "COPY statement cancelled by Hpgsql", SomeMessage Sync], markCopyFailSent)+    Just CopyDoneAndSyncSent ->+      pure+        () -- Already finished, nothing to cancel+    Just CopyFailAndSyncSent ->+      pure+        () -- Already cancelled, no need to send another+    Nothing ->+      internalConnectOrCancel+        (CancelNotConnect (CancelRequest (connPid conn) (cancelSecretKey conn)) (connectedTo conn))+        (connOpts conn)+        (originalConnStr conn)+        (secondsToDiffTime 30)++isLastInPipeline :: HPgConnection -> QueryId -> IO Bool+isLastInPipeline conn qryId = STM.atomically $ updateConnStateTxn conn $ \sttv -> do+  InternalConnectionState {currentPipeline = queries} <- STM.readTVar sttv+  pure $ case lastMaybe queries of+    Nothing -> False+    Just q -> queryIdentifier q == qryId++updateConnStateTxn :: HPgConnection -> (TVar InternalConnectionState -> STM a) -> STM a+updateConnStateTxn conn f = f (internalConnectionState conn)++-- | Run an acquire STM transaction, then the supplied function, then a release+-- STM transaction (bracket style), while holding a connection-level lock.+-- This is necessary for "control" messages, i.e. messages that affect the+-- connection's internal state.+withControlMsgsLock ::+  HPgConnection ->+  (TVar InternalConnectionState -> STM a) ->+  (TVar InternalConnectionState -> STM b) ->+  (a -> IO c) ->+  IO c+withControlMsgsLock conn@HPgConnection {socket, socketMutex} acqStm relStm f = do+  withMutex socketMutex $ do+    -- The lock is acquired, so now we run flushSendBuffer+    -- so the caller will only see internal state after previous+    -- messages were sent+    flushSendBuffer+    bracket+      (STM.atomically $ updateConnStateTxn conn acqStm)+      (const $ void $ STM.atomically $ updateConnStateTxn conn relStm)+      ( \acq -> do+          res <- f acq+          -- Flush the send buffer that `f` may have populated and+          -- apply all internal connection state changes before we+          -- let the release STM transaction look at it.+          flushSendBuffer+          pure res+      )+  where+    flushSendBuffer :: IO ()+    flushSendBuffer =+      -- An exception here could be a socket error or something+      -- that forces us to discard the connection+      rethrowAsIrrecoverable $+        mask $+          \restore -> do+            let go = do+                  others <- modifyMVar conn.sendBuffer $ \case+                    [] -> pure ([], [])+                    ((!msgs, afterSentTxn) : xs) ->+                      if LBS.null msgs+                        then do+                          -- debugPrint "Finished sending msgs"+                          STM.atomically afterSentTxn+                          pure (xs, xs)+                        else do+                          restore $ socketWaitWrite socket+                          n <- timeDebugNonBlockingOperation "sendNonBlocking" $ sendNonBlocking socket msgs+                          -- debugPrint $ "Sent " ++ show n ++ ". Left: " ++ show (LBS.length (LBS.drop n msgs))+                          let !remaining = LBS.drop n msgs+                              fin = (remaining, afterSentTxn) : xs+                          pure (fin, fin)++                  -- debugPrint $ show $ stop || null others+                  unless (null others) go+            go++-- | Receives the next response message for the given QueryId atomically, updates+-- internal connection state to reflect it, and returns the updated state alongside the+-- received message.+-- This also receives ReadyForQuery if the query is already in ErrorResponse or if it's the+-- last in the pipeline and has received CommandComplete.+-- If a pipeline has already received ReadyForQuery, this will return that ReadyForQuery+-- without receiving any new messages. This is helpful if a thread is interrupted+-- You don't want to use this for receiving DataRows in large scale, because the costs of+-- STM transactions apply here.+receiveOutstandingResponseMsgsAtomically :: WeakThreadId -> HPgConnection -> QueryId -> IO (Maybe ResponseMsg, ResponseMsgsReceived)+receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId = do+  -- debugPrint $ "Internal state: [Waiting] until ok to receive response control messages for QueryId " ++ show qryId+  withControlMsgsLock+    conn+    -- Check last received message and take lock before receiving next message+    (const getQueryStateIfFirstOrThrow)+    (const $ pure ())+    $ \qryState -> do+      case responseMsgsState qryState of+        NoMsgsReceived -> receiveParseOrBindCompleteAtomically+        ParseCompleteReceived _ -> receiveBindCompleteAtomically+        BindCompleteReceived _ -> receiveNoDataOrRowDescriptionOrCopyInResponseAtomically+        RowDescriptionOrNoDataOrCopyInResponseReceived _ -> receiveDataRowOrCommandCompleteAtomically+        ErrorResponseReceived _ _ -> receiveReadyForQueryAtomically+        state@(CommandCompleteReceived _ _) -> ifM (isLastInPipeline conn qryId) receiveReadyForQueryAtomically (pure (Nothing, state)) -- Nothing more to receive after CommandComplete unless it's the last query in the pipeline+        state@(ReadyForQueryReceived _ _) -> pure (Nothing, state) -- Definitely nothing to receive if we're here+  where+    -- \| We don't send a `Parse` msg for already-prepared statements, and so for those+    -- we don't even get a `ParseComplete`.+    -- We do have an assertion in `updateQueryStateIfFirstOrThrow` to ensure we aren't+    -- dismissive of messages arriving in unexpected order.+    receiveParseOrBindCompleteAtomically = receiveNextMsgWithMaskedContinuation conn (Right3 <$> msgParser @ParseComplete <|> Left3 <$> msgParser @ErrorResponse <|> Middle3 <$> msgParser @BindComplete) $ \msgE -> do+      STM.atomically $ updateQueryStateIfFirstOrThrow $ case msgE of+        Right3 msg -> RespParseComplete msg+        Middle3 msg -> RespBindComplete msg+        Left3 err -> RespErrorResponse err+    receiveBindCompleteAtomically = receiveNextMsgWithMaskedContinuation conn (Right <$> msgParser @BindComplete <|> Left <$> msgParser @ErrorResponse) $ \msgE -> do+      STM.atomically $ updateQueryStateIfFirstOrThrow $ case msgE of+        Right msg -> RespBindComplete msg+        Left err -> RespErrorResponse err+    receiveNoDataOrRowDescriptionOrCopyInResponseAtomically = receiveNextMsgWithMaskedContinuation conn (Right <$> (Right3 <$> msgParser @RowDescription <|> Left3 <$> msgParser @NoData <|> Middle3 <$> msgParser @CopyInResponse) <|> Left <$> msgParser @ErrorResponse) $ \msgE -> do+      STM.atomically $ updateQueryStateIfFirstOrThrow $ case msgE of+        Right (Left3 msg) -> RespNoData msg+        Right (Middle3 msg) -> RespCopyInResponse msg+        Right (Right3 msg) -> RespRowDescription msg+        Left err -> RespErrorResponse err+    receiveDataRowOrCommandCompleteAtomically = receiveNextMsgWithMaskedContinuation conn (Right3 <$> msgParser @DataRow <|> Middle3 <$> msgParser @CommandComplete <|> Left3 <$> msgParser @ErrorResponse) $ \msgE -> do+      STM.atomically $ updateQueryStateIfFirstOrThrow $ case msgE of+        Right3 msg -> RespDataRow msg+        Middle3 msg -> RespCommandComplete msg+        Left3 msg -> RespErrorResponse msg+    receiveReadyForQueryAtomically = receiveNextMsgWithMaskedContinuation conn (msgParser @ReadyForQuery) $ \rq -> STM.atomically $ updateQueryStateIfFirstOrThrow $ RespReadyForQuery rq+    getQueryStateIfFirstOrThrow :: STM QueryState+    getQueryStateIfFirstOrThrow = updateConnStateTxn conn $ \sttv -> do+      st <- STM.readTVar sttv+      case currentPipeline st of+        [] -> throwIrrecoverableError $ "QueryId " <> Text.pack (show qryId) <> " does not exist because the pipeline is empty. This is most likely a bug in Hpgsql, but just in case, are you trying to consume a pipeline that no longer exists?"+        queries+          | all ((> qryId) . queryIdentifier) queries -> throwIrrecoverableError $ "Bug in Hpgsql: trying to receive outstanding messages for a pipeline that has already been fully consumed. Information about this pipeline no longer available in internal state.: " <> Text.pack (show (qryId, queries))+          | any ((/= thisThreadId) . queryOwner) queries -> throwIrrecoverableError "Hpgsql does not support consuming different SQL statements' results of the same pipeline from different threads. Behaviour is undefined if you try that."+        (splitQueries -> (earlierQueries, thisQuery))+          | any queryInError earlierQueries -> throwIrrecoverableError "Another query in the same pipeline threw an error"+          | not (all queryComplete earlierQueries) -> throwIrrecoverableError "Are you trying to consume a statement's results before consuming the results of previous statements of the same pipeline? Hpgsql does not support that. It is also possible a previous statement in the pipeline threw an irrecoverable error, and you still tried to consume another statement's results, which is also not supported."+          | otherwise -> pure thisQuery++    splitQueries :: [QueryState] -> ([QueryState], QueryState)+    splitQueries qs = case List.span ((< qryId) . queryIdentifier) qs of+      (_, []) -> error $ "Could not find query with right Id: " ++ show (qs, qryId)+      (as, firstQuery : _others)+        | queryIdentifier firstQuery == qryId -> (as, firstQuery)+        | otherwise -> error $ "Could not find query right Id (part 2): " ++ show (qs, qryId)++    queryComplete :: QueryState -> Bool+    queryComplete QueryState {responseMsgsState} = case responseMsgsState of+      CommandCompleteReceived _ _ -> True+      _ -> False++    queryInError :: QueryState -> Bool+    queryInError QueryState {responseMsgsState} = case responseMsgsState of+      ErrorResponseReceived _ _ -> True+      ReadyForQueryReceived (Left ErrorResponse {}) _ -> True+      _ -> False++    updateQueryStateIfFirstOrThrow :: ResponseMsg -> STM (Maybe ResponseMsg, ResponseMsgsReceived)+    updateQueryStateIfFirstOrThrow respMsg = updateConnStateTxn conn $ \sttv -> do+      -- IMPORTANT: No `STM.retry` here as this is called unmasked and must terminate promptly!+      st <- STM.readTVar sttv+      firstPendingQry <- getQueryStateIfFirstOrThrow+      (newState, newPrepStmtNames) <- case (respMsg, firstPendingQry.responseMsgsState) of+        (RespParseComplete msg, NoMsgsReceived) ->+          -- Add the parsed statement name to internal state if there is one+          pure (ParseCompleteReceived msg, maybe st.preparedStatementNames (`Set.insert` st.preparedStatementNames) firstPendingQry.queryPrepStmtName)+        (RespBindComplete msg, ParseCompleteReceived _) -> pure (BindCompleteReceived msg, st.preparedStatementNames)+        (RespBindComplete msg, NoMsgsReceived) -> do+          -- This transition should only happen for already-prepared statements.+          when (isNothing firstPendingQry.queryPrepStmtName) $ throwIrrecoverableErrorWithStatement firstPendingQry.queryText "Bug in Hpgsql. Received a BindComplete without a ParseComplete but SQL statement wasn't prepared"+          pure (BindCompleteReceived msg, st.preparedStatementNames)+        (RespNoData msg, BindCompleteReceived _) -> pure (RowDescriptionOrNoDataOrCopyInResponseReceived $ Left3 msg, st.preparedStatementNames)+        (RespRowDescription msg, BindCompleteReceived _) -> pure (RowDescriptionOrNoDataOrCopyInResponseReceived $ Middle3 msg, st.preparedStatementNames)+        (RespCopyInResponse msg, BindCompleteReceived _) -> pure (RowDescriptionOrNoDataOrCopyInResponseReceived $ Right3 msg, st.preparedStatementNames)+        (RespDataRow _, RowDescriptionOrNoDataOrCopyInResponseReceived prev) -> pure (RowDescriptionOrNoDataOrCopyInResponseReceived prev, st.preparedStatementNames) -- When draining a query that was already fetching rows, this can happen+        (RespErrorResponse msg, _) -> pure (ErrorResponseReceived Nothing msg, st.preparedStatementNames)+        (RespCommandComplete msg, RowDescriptionOrNoDataOrCopyInResponseReceived noDataRowDesc) -> pure (CommandCompleteReceived noDataRowDesc msg, st.preparedStatementNames)+        (RespReadyForQuery rq, ErrorResponseReceived _ err) -> pure (ReadyForQueryReceived (Left err) rq, st.preparedStatementNames)+        (RespReadyForQuery rq, CommandCompleteReceived _ cmd) -> pure (ReadyForQueryReceived (Right cmd) rq, st.preparedStatementNames)+        (_, before) -> throwIrrecoverableErrorWithStatement firstPendingQry.queryText $ "Bug in Hpgsql. Response messages in invalid order. Had " <> Text.pack (show before) <> " and received " <> Text.pack (show respMsg)+      let allQueries = currentPipeline st+      STM.writeTVar sttv $+        st+          { currentPipeline =+              -- We could set the pipeline to an empty list when receiving a ReadyForQuery,+              -- and that would be one fewer state to handle, but it disassociates a QueryId+              -- from ReadyForQuery and makes it impossible to resume interruption of `consumeResults`+              -- for a query that has finished executing, leading to bugs if query result+              -- consumption is interrupted in just the right place.+              map+                ( \qs ->+                    if queryIdentifier qs == qryId+                      then+                        qs+                          { responseMsgsState = newState+                          }+                      else qs+                )+                allQueries,+            preparedStatementNames = newPrepStmtNames+          }+      pure (Just respMsg, newState)++-- | After sending one or more queries to the backend, run this function for each query to fetch that query's results.+-- You must call the returned IO function and consume the returned Stream completely until you get to the+-- `Either ErrorResponse CommandComplete` object.+-- For non-row returning statements like INSERT, DELETE, and UPDATE, the returned Stream will be empty but the execution status+-- will still be available in the Stream's result.+-- This function can also "consume results" of a `COPY FROM STDIN` statement, which essentially means it can receive the+-- control messages of that starting from any possible state.+-- By following these rules you will always keep the internal connection's state healthy, even in the presence of concurrency+-- and asynchronous exceptions.+consumeResults ::+  HPgConnection ->+  QueryId ->+  IO (Maybe (Either3 NoData RowDescription CopyInResponse), Stream (Of DataRow) IO (Either ErrorResponse CommandComplete))+consumeResults conn qryId = do+  -- debugPrint "++++ Inside consumeResults"+  -- We assume it's possible to receive a DataRow here even in the first call because `consumeResults`+  -- can be used to drain results or orphaned queries/pipelines that had been partially consumed.+  -- We could have two different functions - one for draining and another for consuming results -, but+  -- that's more code paths to test, with draining very rarely exercised.+  thisThreadId <- getMyWeakThreadId+  let receiveUntilTimeToReceiveRows :: IO (Maybe (Either3 NoData RowDescription CopyInResponse), Either3 ErrorResponse (Maybe DataRow) CommandComplete)+      receiveUntilTimeToReceiveRows = do+        nextMsg <- receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId+        case nextMsg of+          (Just (RespDataRow dr), RowDescriptionOrNoDataOrCopyInResponseReceived noDataOrRowDesc) -> pure (Just noDataOrRowDesc, Middle3 $ Just dr)+          (Just (RespDataRow _), _) -> throwIrrecoverableError "Impossible: Got DataRow but did not have RowDescOrNoData before?"+          (_, ErrorResponseReceived mNoDataOrRowDesc err) -> pure (mNoDataOrRowDesc, Left3 err)+          (_, CommandCompleteReceived noDataOrRowDesc cmd) -> pure (Just noDataOrRowDesc, Right3 cmd)+          (_, RowDescriptionOrNoDataOrCopyInResponseReceived noDataOrRowDesc) -> pure (Just noDataOrRowDesc, Middle3 Nothing)+          (_, ParseCompleteReceived _) -> receiveUntilTimeToReceiveRows+          (_, BindCompleteReceived _) -> receiveUntilTimeToReceiveRows+          (_, ReadyForQueryReceived errOrCmd _) -> pure (Nothing, either Left3 Right3 errOrCmd)+          (_, NoMsgsReceived) -> receiveUntilTimeToReceiveRows -- TODO: This should be unreachable+  firstMsg <- receiveUntilTimeToReceiveRows+  case firstMsg of+    (mERowDesc, Left3 err) -> do+      receiveReadyForQueryIfNecessary thisThreadId+      pure (mERowDesc, pure $ Left err)+    (mERowDesc, Right3 cmd) -> do+      receiveReadyForQueryIfNecessary thisThreadId+      pure (mERowDesc, pure $ Right cmd)+    (mERowDesc, Middle3 mDataRow) -> do+      let allOtherRows =+            S.unfold+              ( \() -> do+                  -- This is a bit ugly, but we try very carefully not to bear the cost of STM+                  -- transactions at all when receiving DataRows, since they can come in very large+                  -- amounts, but we need to make sure the _other_ important messages, like ErrorResponse+                  -- and CommandComplete, do update internal state.+                  mRow <- receiveNextMsgWithMaskedContinuationButDontThrowOnParsingFailure conn (msgParser @DataRow) pure+                  case mRow of+                    Right row -> pure $ Right (row :> ())+                    Left _ -> do+                      stateAfterNextMsg <- snd <$> receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId+                      case stateAfterNextMsg of+                        ErrorResponseReceived _ err -> do+                          receiveReadyForQueryIfNecessary thisThreadId+                          pure $ Left $ Left err+                        CommandCompleteReceived _ cmd -> do+                          receiveReadyForQueryIfNecessary thisThreadId+                          pure $ Left $ Right cmd+                        ReadyForQueryReceived errOrCmd _ -> pure $ Left errOrCmd+                        _ -> throwIrrecoverableError "Internal error in Hpgsql. After a DataRow we should get either an ErrorResponse or a CommandComplete message"+              )+              ()+          finalStream = case mDataRow of+            Nothing -> allOtherRows+            Just dr ->+              SInternal.Step $+                dr :> allOtherRows+      pure (mERowDesc, finalStream)+  where+    receiveReadyForQueryIfNecessary :: WeakThreadId -> IO ()+    receiveReadyForQueryIfNecessary thisThreadId = void $ receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId++mkPostgresError :: ByteString -> ErrorResponse -> PostgresError+mkPostgresError stmtText (ErrorResponse errDetailMap) = PostgresError {pgErrorDetails = errDetailMap, failedStatement = stmtText}++throwPostgresError :: ByteString -> ErrorResponse -> IO a+throwPostgresError stmtText errResp = throw $ mkPostgresError stmtText errResp++throwIrrecoverableErrorWithStatement :: (MonadThrow m) => ByteString -> Text -> m a+throwIrrecoverableErrorWithStatement stmtText errMsg = throw $ IrrecoverableHpgsqlError {hpgsqlDetails = errMsg, innerException = Nothing, relatedStatement = Just stmtText}++lookupQueryText :: HPgConnection -> QueryId -> IO ByteString+lookupQueryText conn qryId = STM.atomically $ do+  st <- STM.readTVar (internalConnectionState conn)+  pure $ maybe "" queryText $ List.find ((== qryId) . queryIdentifier) (currentPipeline st)++-- | Executes a SQL statement (that may or may not be row-returning) and+-- returns the count of affected rows of the given query.+execute :: HPgConnection -> Query -> IO Int64+execute conn qry = join $ runPipeline conn (pipelineExec qry)++-- | Executes a SQL statement that may or may not be row-returning.+execute_ :: HPgConnection -> Query -> IO ()+execute_ conn qry = void $ execute conn qry++consumeResultsIgnoreRows :: HPgConnection -> QueryId -> IO Int64+consumeResultsIgnoreRows conn qryId = do+  qText <- lookupQueryText conn qryId+  (_mRowDesc, resultsStream) <- consumeResults conn qryId+  results <- S.effects resultsStream+  case results of+    Left err -> throwPostgresError qText err+    Right (CommandComplete n) -> pure n++-- | Runs a query and streams results directly from the connection's socket, i.e. without using cursors.+--+-- Note on thread safety: it is important to note the same thread that runs this must+-- be the thread that consumes the returned Stream, and the returned Stream must be+-- consumed completely (up to the last row or a postgres error) before you are able+-- to run other queries.+queryS :: (FromPgRow a) => HPgConnection -> Query -> IO (Stream (Of a) IO ())+queryS = querySWith rowDecoder++-- | Runs a query and streams results directly from the connection's socket, i.e. without using cursors.+--+-- Note on thread safety: it is important to note the same thread that runs this must+-- be the thread that consumes the returned Stream, and the returned Stream must be+-- consumed completely (up to the last row or a postgres error) before you are able+-- to run other queries.+querySWith :: RowDecoder a -> HPgConnection -> Query -> IO (Stream (Of a) IO ())+querySWith rparser conn qry = join $ runPipeline conn $ pipelineSWith rparser qry++-- | Runs a query and streams results directly from the connection's socket, i.e. without using cursors.+--+-- Prefer to use 'queryS' and 'querySWith', because 'RowDecoder' can typecheck PostgreSQL results+-- even when no rows are returned by queries, and 'RowDecoderMonadic' cannot.+--+-- Note on thread safety: it is important to note the same thread that runs this must+-- be the thread that consumes the returned Stream, and the returned Stream must be+-- consumed completely (up to the last row or a postgres error) before you are able+-- to run other queries.+querySMWith :: RowDecoderMonadic a -> HPgConnection -> Query -> IO (Stream (Of a) IO ())+querySMWith rparser conn qry = join $ runPipeline conn $ pipelineSMWith rparser qry++-- | Sends any number of queries to the backend atomically, or throws an irrecoverable exception+-- if it can't do that. Then runs the continuation.+-- DO NOT CALL THIS FUNCTION WHILE HOLDING THE CONTROL-MSGS-LOCK, because it needs to wait/block+-- until the pipeline is ready, which won't happen if we're holding the control-msgs-lock.+sendPipeline :: HPgConnection -> NonEmpty (ByteString, QueryProtocol, Maybe String) -> (InternalConnectionState -> EncodingContext -> [SomeMessage]) -> STM () -> (NonEmpty QueryId -> IO a) -> IO a+sendPipeline conn queriesBeingSent allMsgs onMsgsSentTxn continuation = do+  thisWeakThreadId <- getMyWeakThreadId+  qryIds <- waitUntilPipelineIsReadyForNewQuery conn (getUniqueQueryStatesForNewPipeline queriesBeingSent) $ \(nextId, lastId) -> do+    -- If this thread is interrupted now, it is ok: only `totalQueriesSent` was bumped, but `currentPipeline`+    -- is still empty (it will be modified once we send all control messages to postgres).+    -- This is Note [Only modify totalQueriesSent]+    let newPipelineList = zipWith (\queryIdentifier (queryText, queryProtocol, queryPrepStmtName) -> QueryState {queryIdentifier, queryText, queryOwner = thisWeakThreadId, queryProtocol, queryPrepStmtName, responseMsgsState = NoMsgsReceived}) [nextId .. lastId] (NE.toList queriesBeingSent)+    case NE.nonEmpty newPipelineList of+      Nothing -> throwIrrecoverableError "Bug in Hpgsql: empty newPipeline to be sent"+      Just newPipeline -> do+        -- The encodingContext could live within internalConnectionState or be a TVar. It gets read+        -- from and update very infrequently, so no big reason for it to be its own MVar.+        -- Although, in the end, it probably doesn't matter much+        sttv <- STM.atomically $ STM.readTVar conn.internalConnectionState+        encCtx <- readMVar conn.encodingContext+        atomicallySendControlMsgs_+          conn+          ( allMsgs sttv encCtx,+            do+              st <- STM.readTVar (internalConnectionState conn)+              (_, txnStatusRightBeforeSendingPipeline) <- fullTransactionStatus (internalConnectionState conn)+              STM.writeTVar (internalConnectionState conn) $ st {currentPipeline = NE.toList newPipeline, transactionStatusBeforeCurrentPipeline = txnStatusRightBeforeSendingPipeline}+              onMsgsSentTxn -- Caller-supplied+          )+        debugPrint $ "+++ Sent QueryIds " ++ show [nextId .. lastId]+        pure $ fmap queryIdentifier newPipeline+  continuation qryIds+  where+    getUniqueQueryStatesForNewPipeline :: NonEmpty (ByteString, QueryProtocol, Maybe String) -> STM (QueryId, QueryId)+    getUniqueQueryStatesForNewPipeline (fmap (\(_, proto, _) -> proto) -> qryprotos) = do+      let sttv = internalConnectionState conn+      st <- STM.readTVar sttv+      when (isLeft $ connectionReadyForNewPipeline st) $ throwIrrecoverableError "Bug in Hpgsql: the connection should be ready for a new pipeline due to loopUntilNoPipeline"+      -- Reserve N ids+      let nextId = QueryId $ totalQueriesSent st+          lastId = nextId + fromIntegral (length qryprotos) - 1+      -- We only modify `totalQueriesSent` in our internal state in this STM transaction.+      -- Check why in Note [Only modify totalQueriesSent]+      STM.writeTVar sttv (st {totalQueriesSent = totalQueriesSent st + fromIntegral (length qryprotos)})+      pure (nextId, lastId)++-- | Checks there is no active pipeline and runs the supplied function with the control-msg lock when there+-- isn't one. If there is an active pipeline, waits until it's done executing (and cancels-drains it if it+-- has been orphaned) until it can run the supplied function.+-- The supplied STM transaction runs while the control-msg lock is held.+-- DO NOT CALL THIS FUNCTION WHILE HOLDING THE CONTROL-MSGS-LOCK, because it needs to wait/block+-- until the pipeline is ready, which won't happen if we're holding the control-msgs-lock.+waitUntilPipelineIsReadyForNewQuery :: forall a b. HPgConnection -> STM a -> (a -> IO b) -> IO b+waitUntilPipelineIsReadyForNewQuery conn lockAcquireStm f = do+  thisWeakThreadId <- getMyWeakThreadId+  queriesToDrain <- acquireOwnershipOfOrphanedQueries conn+  withControlMsgsLock+    conn+    ( \sttv -> do+        st <- STM.readTVar sttv+        (txnStatusBeforePipeline, _) <- fullTransactionStatus sttv+        pure+          ( txnStatusBeforePipeline,+            st.mustIssueRollbackBeforeNextCommand,+            case st.currentPipeline of+              [QueryState {queryProtocol = CopyQuery _, queryText}] -> Just queryText+              _ -> Nothing+          )+    )+    (const $ pure ())+    $ \(txnStatusBeforePipeline, mustIssueRollback, isCopyCommand) -> do+      whenJust isCopyCommand $ \copyCmd ->+        when (not (null queriesToDrain) && txnStatusBeforePipeline == TransInTrans) $ throwIrrecoverableErrorWithStatement copyCmd "Hpgsql cannot resume execution from an interrupted COPY statement inside a transaction, because cancelling COPY would leave the transaction in an error state and completing it could partially complete it. There is no semantics preserving action possible."+      -- We don't want to send cancellation requests if we're in an explicit transaction+      -- because that would put the transaction in TransInError, which is not semantics-preserving+      -- (so in that case we let statements complete and just drain them).+      -- Unless of course the transaction was interrupted by an asynchronous exception, in+      -- which case it's fine to cancel because we're about to ROLLBACK anyway.+      let onlyDrainNotCancel = txnStatusBeforePipeline == TransInTrans && not mustIssueRollback+      cancelActiveStatement conn onlyDrainNotCancel+      -- After draining, we ROLLBACK if we must. A failed command still leaves+      -- the need for "ROLLBACK", after all.+      when (mustIssueRollback && not (null queriesToDrain)) $ do+        debugPrint "Executing ROLLBACK now that the pipeline is clear."+        -- The command below would go into an infinite loop if not for the+        -- `not (null queriesToDrain)` check a few lines up, but that's a big hack:+        -- We couple updating internal connection state to sending the "ROLLBACK"+        -- to the backend, but if "ROLLBACK" is interrupted here, it's still not+        -- super clear what might happen. Some thoughts:+        -- - If interruption happens before ROLLBACK is sent, the state will still have+        --   mustIssueRollbackBeforeNextCommand=True. But without queries to drain,+        --   this code will never run => Problem! TODO how do we fix this?+        -- - If ROLLBACK gets sent, internal state will be updated with+        --   mustIssueRollbackBeforeNextCommand=False. The next query will try to+        --   drain it.+        --    - The next query won't try to cancel it because of txnStatusBeforePipeline,+        --      being TransInStrans, so it will only drain the ROLLBACK, which is great.+        join $ runPipelineInternal conn (pipelineExec_ "ROLLBACK") $ do+          st <- STM.readTVar conn.internalConnectionState+          STM.writeTVar conn.internalConnectionState st {mustIssueRollbackBeforeNextCommand = False}++  -- Different threads might be racing to send their pipelines,+  -- so we choose the winner with a mutex+  retOrRepeat <- withControlMsgsLock+    conn+    ( \sttv -> do+        st <- STM.readTVar sttv+        case connectionReadyForNewPipeline st of+          Left p -> pure $ Left p+          Right _ -> Right <$> lockAcquireStm+    )+    (const $ pure ())+    $ \case+      Left (QueryState {queryOwner} :| _) -> pure $ Left queryOwner+      Right acq -> do+        debugPrint "+++ No active pipeline found"+        Right <$> f acq+  case retOrRepeat of+    Left existingPipelineOwnerThread -> do+      -- If there is a pipeline, we must wait while _not_ holding+      -- the control-msgs lock so the other pipeline can reach+      -- completion. Also, we resume immediately if the pipeline+      -- state changes, as it's important to resume quickly to avoid introducing+      -- N * intervalMs delays for a concurrent workload with N+      -- threads blocked waiting on each other.+      let intervalMs = killedThreadPollIntervalMs $ connOpts conn+      debugPrint $ "There is a pipeline owned by a different thread (" ++ show existingPipelineOwnerThread ++ ") so we (" ++ show thisWeakThreadId ++ ") will try again in " ++ show intervalMs ++ "ms. Pipeline contains: "+      void $ timeout (1000 * intervalMs) $ STM.atomically $ do+        st <- STM.readTVar (internalConnectionState conn)+        when (isLeft $ connectionReadyForNewPipeline st) STM.retry+      waitUntilPipelineIsReadyForNewQuery conn lockAcquireStm f+    Right ret -> pure ret++-- | Cancels any running statements in the current connection, including COPY, or returns if there+-- is no active query to cancel.+-- Make sure you do not try to consume results of queries you have already sent if you run this, or+-- behaviour is undefined. That means if you had a Stream result and you run this function, you should+-- not further inspect the Stream, and if you had sent a pipeline with multiple queries and you run this+-- function, you should not try to consume the results of any query in that pipeline.+-- Also, PostgreSQL's protocol specifies cancellation requests require opening a new connection to the+-- server, which means parallelism can introduce non-determinism, as such:+--+--     forkIO $ query conn "SELECT ..."+--     sendCancellationRequest conn+--+-- That the cancellation request _can_ arrive before the query even arrives, so it won't be cancelled,+-- and this _can_ happen even if all the messages of the "SELECT ..." query are sent first.+-- The cancellation request can also arrive after the active query finishes.+--+-- Modulo the race condition mentioned above, the database connection should be in a healthy+-- and usable state after this function returns, although keep in mind that cancelling a+-- query inside a transaction is equivalent to that query throwing an error, so this+-- can put transactions in an error state.+cancelActiveStatement ::+  HPgConnection ->+  -- | If True, this won't send cancellation requests to postgres and will just drain orphaned/interrupted queries until they complete, if any.+  Bool ->+  IO ()+cancelActiveStatement conn@HPgConnection {connOpts} onlyDrainNotCancel = do+  -- Drain results of orphaned queries if necessary+  queriesToDrain <- acquireOwnershipOfOrphanedQueries conn+  -- Acquire control-msg lock when draining to avoid a race condition where+  -- soon after draining the last query a different thread runs a new query.+  -- We want the supplied `f` function to run on a clean state/pipeline.+  unless (null queriesToDrain) $ do+    debugPrint $ "Going to take control-msg lock to drain " ++ show queriesToDrain+    withControlMsgsLock conn (const $ pure ()) (const $ pure ()) $ \() -> do+      -- It is possible not just in theory for the cancellation request to+      -- arrive/be processed by postgres _before_ the current pipeline has+      -- reached postgres, since cancellation requests go through a different+      -- connection, so there's no guarantee of ordered delivery.+      -- Even if the cancellation request arrives later at the server,+      -- the kernel can still deliver them in different order, and postgres+      -- itself can process them in different order, at least due to the+      -- kernel's scheduler not giving guarantees.+      -- We've seen it happen in our tests (i.e. "Exercise interruption safety"),+      -- so this is not merely hypothetical.+      -- What we do here is fire a cancellation request every few seconds to cover+      -- for that.+      debugPrint "Cancelling active pipeline to drain."+      unless onlyDrainNotCancel $ sendCancellationRequest conn+      -- debugPrint $ "Draining " ++ show queriesToDrain+      let drainUntilError [] = pure ()+          drainUntilError (q : qs) = do+            (_, res) <- consumeResults conn q+            eErrorOrCmdComplete <- S.effects res+            -- If we get an error, we cannot continue to consume the results+            -- of other queries as the whole pipeline is trashed+            case eErrorOrCmdComplete of+              Right _cmdComplete -> drainUntilError qs+              Left _err -> pure ()+          alternateDrainingWithCancelReqs qs = do+            -- If the cancellationRequestResendIntervalMs is too short, draining+            -- will never complete...+            -- We could with `withAsync` to run these in parallel, but it feels overkill.+            -- So we recommend in the docs that people don't set this too low.+            drained <- timeout (1000 * cancellationRequestResendIntervalMs connOpts) $ drainUntilError qs+            case drained of+              Just () -> pure ()+              Nothing -> do+                debugPrint $ "Sending another cancellation request as orphaned pipeline still not completely drained: " ++ show queriesToDrain+                unless onlyDrainNotCancel $ sendCancellationRequest conn+                leftToDrain <- acquireOwnershipOfOrphanedQueries conn+                alternateDrainingWithCancelReqs leftToDrain+      alternateDrainingWithCancelReqs queriesToDrain++-- | Returns queries that have been taken possession of by this thread for cancellation and draining+-- or an empty list if there's no need for that.+acquireOwnershipOfOrphanedQueries :: HPgConnection -> IO [QueryId]+acquireOwnershipOfOrphanedQueries conn = do+  thisThreadId <- getMyWeakThreadId+  debugPrint $ "+++ I am " ++ show thisThreadId ++ " and will look for orphaned queries to drain"+  withControlMsgsLock+    conn+    STM.readTVar+    (const $ pure ())+    $ \st -> do+      if isRight (connectionReadyForNewPipeline st)+        then pure []+        else do+          -- TODO: We should either move the WeakThreadId owner into the full pipeline,+          -- or change this to a `takeWhile` because the internal model allows different+          -- queries to have different owners, even if in practice that shouldn't happen.+          let activeQueries = currentPipeline st+          mustTakeOwnership <- fmap (List.foldl' (||) False) $ forM activeQueries $ \QueryState {queryOwner} ->+            -- See Note [`timeout` uses the same ThreadId] for why having the same ThreadId _still_ means+            -- we need to cancel and drain those queries+            if queryOwner == thisThreadId then pure True else threadDoesNotExist queryOwner+          if mustTakeOwnership+            then do+              STM.atomically $ STM.writeTVar (internalConnectionState conn) $ st {currentPipeline = map (\qs -> qs {queryOwner = thisThreadId}) $ currentPipeline st}+              let owner = map queryOwner activeQueries+              debugPrint $ "We (" ++ show thisThreadId ++ ") took ownership of the pipeline orphaned by " ++ show owner+              pure $ map queryIdentifier activeQueries+            else pure []+  where+    threadDoesNotExist :: WeakThreadId -> IO Bool+    threadDoesNotExist (WeakThreadId wtid _) =+      deRefWeak wtid >>= \case+        Nothing -> pure True+        Just tid -> (`elem` [ThreadDied, ThreadFinished]) <$> threadStatus tid++-- | Fetches any number of rows by streaming them directly from the socket.+pipelineS :: (FromPgRow a) => Query -> Pipeline (IO (Stream (Of a) IO ()))+pipelineS = pipelineSWith rowDecoder++-- | Fetches any number of rows by streaming them directly from the socket, with a custom row decoder.+pipelineSWith :: RowDecoder a -> Query -> Pipeline (IO (Stream (Of a) IO ()))+pipelineSWith rowparser@(RowDecoder _ _ expectedColFmts) (lastAndInitNE . breakQueryIntoStatements -> (firstQueriesToSend, lastQueryToSend)) =+  Pipeline+    (map (,Nothing) firstQueriesToSend ++ [(lastQueryToSend, Just expectedColFmts)])+    ( \conn qryIds -> do+        case lastAndInit qryIds of+          (firstQueries, mLastQry) -> do+            forM_ firstQueries $ consumeResultsIgnoreRows conn+            pure $ consumeStreamingResults (ApplicativeRowDecoder rowparser) conn (fromMaybe (error "pipelineS internal bug: no mLastQry") mLastQry)+    )++-- | Prefer to use 'pipelineS' and 'pipelineSWith', because 'RowDecoder' can typecheck PostgreSQL results+-- even when no rows are returned by queries, and 'RowDecoderMonadic' cannot.+pipelineSMWith :: RowDecoderMonadic a -> Query -> Pipeline (IO (Stream (Of a) IO ()))+pipelineSMWith rowparser (lastAndInitNE . breakQueryIntoStatements -> (firstQueriesToSend, lastQueryToSend)) =+  Pipeline+    (map (,Nothing) firstQueriesToSend ++ [(lastQueryToSend, Nothing)])+    ( \conn qryIds -> do+        case lastAndInit qryIds of+          (firstQueries, mLastQry) -> do+            forM_ firstQueries $ consumeResultsIgnoreRows conn+            pure $ consumeStreamingResults (MonadicRowDecoder rowparser) conn (fromMaybe (error "pipelineSMWith internal bug: no mLastQry") mLastQry)+    )++-- | Fetches any number of rows from a query.+pipeline :: (FromPgRow a) => Query -> Pipeline (IO [a])+pipeline = pipelineWith rowDecoder++-- | Fetches any number of rows from a query with a custom row decoder.+pipelineWith :: RowDecoder a -> Query -> Pipeline (IO [a])+pipelineWith rowparser q = (S.toList_ =<<) <$> pipelineSWith rowparser q++-- | Prefer to use 'pipeline' and 'pipelineWith', because 'RowDecoder' can typecheck PostgreSQL results+-- even when no rows are returned by queries, and 'RowDecoderMonadic' cannot.+pipelineM :: RowDecoderMonadic a -> Query -> Pipeline (IO [a])+pipelineM rowparser q = (S.toList_ =<<) <$> pipelineSMWith rowparser q++-- | Fetch exactly one row (not zero, not more than one) or throw+-- an exception otherwise.+pipeline1 :: (FromPgRow a) => Query -> Pipeline (IO a)+pipeline1 = pipeline1With rowDecoder++-- | Fetch exactly one row (not zero, not more than one) or throw+-- an exception otherwise.+pipeline1With :: RowDecoder a -> Query -> Pipeline (IO a)+pipeline1With rowparser q = (toSingleRow =<<) <$> pipelineWith rowparser q+  where+    toSingleRow res = do+      let queryBs = queryToByteString q+      case res of+        [] -> throwIrrecoverableErrorWithStatement queryBs "Expected exactly one row in query/pipeline1 call, but got none."+        [singleRow] -> pure singleRow+        _ -> throwIrrecoverableErrorWithStatement queryBs "Expected exactly one row in query/pipeline1 call, but got more than one."++-- | Fetch one or zero rows (not more than one) or throw an exception otherwise.+pipelineMay :: (FromPgRow a) => Query -> Pipeline (IO (Maybe a))+pipelineMay = pipelineMayWith rowDecoder++-- | Fetch one or zero rows (not more than one) or throw an exception otherwise.+pipelineMayWith :: RowDecoder a -> Query -> Pipeline (IO (Maybe a))+pipelineMayWith rowparser q = (toMaybeRow =<<) <$> pipelineWith rowparser q+  where+    toMaybeRow res = do+      let queryBs = queryToByteString q+      case res of+        [] -> pure Nothing+        [singleRow] -> pure $ Just singleRow+        _ -> throwIrrecoverableErrorWithStatement queryBs "Expected zero or one row in query/pipelineMay call, but got more than one."++-- | Returns the count of affected rows of the given query.+pipelineExec :: Query -> Pipeline (IO Int64)+pipelineExec = pipelineExecInternal . breakQueryIntoStatements++pipelineExec_ :: Query -> Pipeline (IO ())+pipelineExec_ = fmap void . pipelineExecInternal . breakQueryIntoStatements++pipelineExecInternal :: NonEmpty SingleQuery -> Pipeline (IO Int64)+pipelineExecInternal qs =+  Pipeline+    (map (,Nothing) (NE.toList qs))+    ( \conn qryIds -> do+        case lastAndInit qryIds of+          (firstQueries, mLastQry) -> do+            forM_ firstQueries $ consumeResultsIgnoreRows conn+            consumeResultsIgnoreRows conn (fromMaybe (error "pipelineExec internal bug: no mLastQry") mLastQry)+    )++-- | Runs a pipeline of statements, that is, sends multiple SQL statements in a single round-trip+-- to the server.+--+-- Note on thread safety: the thread that runs this must be the thread that consumes the+-- results of every query in the supplied pipeline _in order_, until all+-- query results are consumed or an error occurs.+-- Anything else is not officially supported by Hpgsql and may result in deadlocks or undefined behaviour.+runPipeline :: HPgConnection -> Pipeline a -> IO a+runPipeline conn pip = runPipelineInternal conn pip (pure ())++-- | Sends a Pipeline coupled with an STM transaction that runs when+-- the messages cross the userspace/kernel frontier (aka "are sent").+runPipelineInternal :: HPgConnection -> Pipeline a -> STM () -> IO a+runPipelineInternal conn (Pipeline (NE.nonEmpty -> mQueries) run) onMsgsSentTxn =+  case mQueries of+    Nothing -> pure $ run conn []+    Just queries -> do+      sendPipeline+        conn+        (fmap (\(SingleQuery {queryString, preparedStmtHash}, _) -> (queryString, ExtendedQuery, preparedStmtHash)) queries)+        ( \st encCtx ->+            let toMessages alreadyParsed (SingleQuery qryString qryParams preparedStmtHash, mExpectedResultColFmts) =+                  let paramOidsAndValues = map ($ encCtx) qryParams+                   in ( if not alreadyParsed+                          then+                            [SomeMessage $ Parse qryString (map fst paramOidsAndValues) preparedStmtHash]+                          else []+                      )+                        ++ [ SomeMessage $+                               Bind+                                 { paramsValuesInOrder = map snd paramOidsAndValues,+                                   resultColumnFmts = fromMaybe 1 mExpectedResultColFmts,+                                   preparedStmtHash+                                 },+                             SomeMessage Describe,+                             SomeMessage Execute+                           ]+                queryMsgs =+                  mconcat $+                    snd $+                      List.mapAccumL+                        ( \pnames qry ->+                            case (fst qry).preparedStmtHash of+                              Nothing -> (pnames, toMessages False qry)+                              Just psh -> (Set.insert psh pnames, toMessages (psh `Set.member` pnames) qry)+                        )+                        st.preparedStatementNames+                        (NE.toList queries)+             in queryMsgs ++ [SomeMessage Sync] -- concatMap toMessages queries ++ [SomeMessage Sync])+        )+        onMsgsSentTxn+        $ \qryIds -> pure $ run conn (NE.toList qryIds)++data WhichRowDecoder a = ApplicativeRowDecoder !(RowDecoder a) | MonadicRowDecoder !(RowDecoderMonadic a)++consumeStreamingResults :: WhichRowDecoder a -> HPgConnection -> QueryId -> Stream (Of a) IO ()+consumeStreamingResults rp conn qryId = S.effect $ do+  qText <- lookupQueryText conn qryId+  (mERowDesc, rowsStream) <- consumeResults conn qryId+  case mERowDesc of+    Nothing -> do+      -- This is likely an error that happened when binding parameters (e.g. more/fewer params necessary than were sent)+      -- or a query that has no parameters and fails very early (e.g. "SELECT 1/0")+      rowCount :> res <- S.length rowsStream+      when (rowCount > 0) $ throwIrrecoverableErrorWithStatement qText "Bug in Hpgsql. We didn't get either NoData or RowDescription, so we assumed there was an error binding the query, but we got more than 0 rows in results"+      case res of+        Left err -> throwPostgresError qText err+        Right _cmd -> throwIrrecoverableErrorWithStatement qText "Bug in Hpgsql. We didn't get either NoData or RowDescription, so we assumed there was an error binding the query, but we then received a CommandComplete."+    Just (Left3 _noData) -> throwIrrecoverableErrorWithStatement qText "You have sent a count-returning query but expected it to be a rows-returning query. This is not supported."+    Just (Right3 _copyInResponse) -> throwIrrecoverableErrorWithStatement qText "You have sent a COPY FROM STDIN query but expected it to be a rows-returning query. This is not supported."+    Just (Middle3 (RowDescription coltypes)) -> do+      encodingContext <- readMVar conn.encodingContext+      let numResultColumns = length coltypes+          mkColInfo (colName, oid) = FieldInfo oid (Just colName) encodingContext+          colInfos = map mkColInfo coltypes+      !rowparser <- case rp of+        ApplicativeRowDecoder (RowDecoder rparser rtypecheck expectedNumCols) -> do+          let typecheckedColInfos = rtypecheck colInfos+          unless (numResultColumns == expectedNumCols) $ throwIrrecoverableErrorWithStatement qText $ "Query result contains " <> Text.pack (show numResultColumns) <> " columns but row parser expected " <> Text.pack (show expectedNumCols)+          unless (all snd typecheckedColInfos) $ throwIrrecoverableErrorWithStatement qText "Query result column types do not match expected column types"+          pure $ rparser colInfos <* Parser.endOfInput+        MonadicRowDecoder (RowDecoderMonadic rparser) -> pure $ fmap fst $ rparser ConversionState {colsLeftToParse = colInfos} <* Parser.endOfInput+      pure $ do+        errOrCmdComplete <-+          S.mapM+            ( \(DataRow rowColumnData) ->+                case Parser.parseOnly rowparser rowColumnData of+                  Parser.ParseOk row -> pure row+                  Parser.ParseFail err -> throwIrrecoverableErrorWithStatement qText $ "Failed parsing a row: " <> Text.pack (show err)+            )+            rowsStream+        S.effect $ case errOrCmdComplete of+          Left err -> throwPostgresError qText err+          Right _cmdComplete -> pure mempty++-- | Fetches any number of rows from a query.+--+-- > query conn "SELECT * FROM table"+query :: forall a. (FromPgRow a) => HPgConnection -> Query -> IO [a]+query = queryWith (rowDecoder @a)++-- | Fetches any number of rows from a query with a custom row decoder.+--+-- > queryWith rowDecoder conn "SELECT * FROM table"+queryWith :: RowDecoder a -> HPgConnection -> Query -> IO [a]+queryWith rparser conn qry = join $ runPipeline conn $ pipelineWith rparser qry++-- | Prefer to use 'query' and 'queryWith', because 'RowDecoder' can typecheck PostgreSQL results+-- even when no rows are returned by queries, and 'RowDecoderMonadic' cannot.+queryMWith :: RowDecoderMonadic a -> HPgConnection -> Query -> IO [a]+queryMWith rparser conn qry = join $ runPipeline conn $ pipelineM rparser qry++-- | Fetch exactly one row (not zero, not more than one) or throw+-- an exception otherwise.+query1 :: forall a. (FromPgRow a) => HPgConnection -> Query -> IO a+query1 = query1With rowDecoder++-- | Fetch exactly one row (not zero, not more than one) or throw+-- an exception otherwise.+query1With :: RowDecoder a -> HPgConnection -> Query -> IO a+query1With rparser conn q = join $ runPipeline conn $ pipeline1With rparser q++-- | Fetch one or zero rows (not more than one) or throw an exception otherwise.+queryMay :: forall a. (FromPgRow a) => HPgConnection -> Query -> IO (Maybe a)+queryMay = queryMayWith rowDecoder++-- | Fetch one or zero rows (not more than one) or throw an exception otherwise.+queryMayWith :: RowDecoder a -> HPgConnection -> Query -> IO (Maybe a)+queryMayWith rparser conn q = join $ runPipeline conn $ pipelineMayWith rparser q++-- | Runs a COPY FROM STDIN statement, giving you the ability to pass a+-- row-inserting function.+--+-- > withCopy_ conn "COPY employee FROM STDIN WITH (FORMAT CSV)" $ do+-- >    putCopyData conn "5,Dracula\n"+-- >    putCopyData conn "6,The Grinch\n"+--+-- You can also use `copyFromS` for binary COPY.+--+-- Note on interruption safety: if this is interrupted by an asynchronous+-- exception while running inside a transaction, hpgsql will throw an exception+-- on the next statement. This happens because hpgsql would change semantics if+-- it aborted the COPY statement - because it would abort the entire transaction -,+-- and it couldn't "complete" the COPY either due to the risk of not all rows+-- having been inserted.+withCopy_ :: HPgConnection -> Query -> IO a -> IO Int64+withCopy_ conn copyQ copyFn = fst <$> withCopy conn copyQ copyFn++-- | Runs a COPY FROM STDIN statement, giving you the ability to pass a+-- row-inserting function.+--+-- > withCopy conn "COPY employee FROM STDIN WITH (FORMAT CSV)" $ do+-- >    putCopyData conn "5,Dracula\n"+-- >    putCopyData conn "6,The Grinch\n"+--+-- You can also use `copyFromS` for binary COPY.+--+-- Note on interruption safety: if this is interrupted by an asynchronous+-- exception while running inside a transaction, hpgsql will throw an exception+-- on the next statement. This happens because hpgsql would change semantics if+-- it aborted the COPY statement - because it would abort the entire transaction -,+-- and it couldn't "complete" the COPY either due to the risk of not all rows+-- having been inserted.+withCopy :: HPgConnection -> Query -> IO a -> IO (Int64, a)+withCopy conn copyQ copyFn = withCopyInternal conn copyQ $ \qryId -> do+  ret <- copyFn+  count <- copyEndInternal conn qryId+  pure (count, ret)++withCopyInternal :: HPgConnection -> Query -> (QueryId -> IO (Int64, a)) -> IO (Int64, a)+withCopyInternal conn (lastAndInitNE . breakQueryIntoStatements -> (firstQueries, SingleQuery {..})) copyFn = do+  -- We error here if the Query is more than just "COPY .." because if we+  -- ran the other statements in a separate pipeline, they would+  -- run in a different implicit transaction, which could be unexpected.+  whenNonEmpty firstQueries $ const $ throwIrrecoverableError "Query for COPY must not have other SQL statements"+  thisThreadId <- getMyWeakThreadId+  sendPipeline+    conn+    ((queryString, CopyQuery StillCopying, Nothing) :| [])+    ( \_st encCtx ->+        let paramOidsAndValues = map ($ encCtx) queryParams+         in [ SomeMessage $ Parse queryString (map fst paramOidsAndValues) Nothing,+              SomeMessage $ Bind {paramsValuesInOrder = map snd paramOidsAndValues, resultColumnFmts = 0, preparedStmtHash = Nothing},+              -- We don't send Msgs.Describe because we expect CopyInResponse in place of NoData+              SomeMessage Execute,+              SomeMessage Msgs.Flush -- This might not be necessary for COPY, but possibly useful if the user calls this with not-a-COPY statement so we get errors earlier?+            ]+    )+    (pure ())+    $ \(qryId :| _) -> do+      void $ receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId+      void $ receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId+      void $ receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId+      copyFn qryId++-- | Copies rows into a table with the binary COPY protocol.+-- This must be a "COPY table FROM STDIN WITH (FORMAT BINARY)"-like statement.+-- Returns the Stream's result and the count of inserted rows.+--+-- > let rows :: Stream (Of Employee) IO ()+-- >     rows = someStreamOfEmployees+-- > copyFromS conn "COPY employee FROM STDIN WITH (FORMAT BINARY)" rows+--+-- Note on interruption safety: if this is interrupted by an asynchronous+-- exception while running inside a transaction, hpgsql will throw an exception+-- on the next statement. This happens because hpgsql would change semantics if+-- it aborted the COPY statement - because it would abort the entire transaction -,+-- and it couldn't "complete" the COPY either due to the risk of not all rows+-- having been inserted.+copyFromS :: forall r b. (ToPgRow r) => HPgConnection -> Query -> Stream (Of r) IO b -> IO (Int64, b)+copyFromS conn copyQ allRows =+  withCopyInternal conn copyQ $ \qryId -> do+    -- Take the controlMsgsLock to flush all buffers+    withControlMsgsLock conn (const $ pure ()) (const $ pure ()) (const $ pure ())+    encCtx <- readMVar conn.encodingContext+    let !toBinaryRow = rowEncoder.toBinaryCopyBytes encCtx+        numColsBs = Builder.int16BE $ fromIntegral $ length $ rowEncoder.toTypeOids (Proxy @r)+    rethrowAsIrrecoverable $ nonAtomicSendMsg conn $ CopyData $ Builder.byteString "PGCOPY\n\xff\r\n\0" <> Builder.int32BE 0 <> Builder.int32BE 0+    eHasRows <- S.inspect allRows+    ret <- case eHasRows of+      Left ret -> pure ret+      Right (firstRow :> otherRows) -> do+        let byteStream :: Stream (Of Builder.Builder) IO b+            byteStream = S.map (\row -> numColsBs <> toBinaryRow row) (S.cons firstRow otherRows)+            chunkedByteStream :: Stream (Of Builder.Builder) IO b+            chunkedByteStream = chunkBuildersBySize 16384 byteStream+        -- Using strict bytestrings reduces allocations a tiny little bit.. not sure why, but maybe+        -- fusion rules?+        S.mapM_+          ( \bs -> do+              rethrowAsIrrecoverable $ SocketBS.sendAll conn.socket $ Builder.toStrictByteString $ toPgMessage $ CopyData bs+          )+          chunkedByteStream+    rethrowAsIrrecoverable $ nonAtomicSendMsg conn $ CopyData $ Builder.int16BE (-1)+    count <- copyEndInternal conn qryId+    pure (count, ret)++-- | Copies rows into a table with the binary COPY protocol.+-- This must be a "COPY table FROM STDIN WITH (FORMAT BINARY)"-like statement.+-- Returns the Stream's result and the count of inserted rows.+--+-- > let rows :: [Employee]+-- >     rows = someListOfEmployees+-- > copyFrom conn "COPY employee FROM STDIN WITH (FORMAT BINARY)" rows+--+-- Note on interruption safety: if this is interrupted by an asynchronous+-- exception while running inside a transaction, hpgsql will throw an exception+-- on the next statement. This happens because hpgsql would change semantics if+-- it aborted the COPY statement - because it would abort the entire transaction -,+-- and it couldn't "complete" the COPY either due to the risk of not all rows+-- having been inserted.+copyFrom :: (ToPgRow r) => HPgConnection -> Query -> [r] -> IO Int64+copyFrom conn copyQ rows = fst <$> copyFromS conn copyQ (S.each rows)++-- | Accumulates builders until their combined length reaches or exceeds the+-- given size in bytes, then yields the accumulated builder and starts over.+chunkBuildersBySize :: (Monad m) => Int32 -> Stream (Of Builder.Builder) m r -> Stream (Of Builder.Builder) m r+chunkBuildersBySize maxSize = go mempty+  where+    go !acc !stream = do+      e <- S.lift $ S.next stream+      case e of+        Left r -> do+          when (Builder.builderLength acc > 0) $+            S.yield acc+          pure r+        Right (b, rest) ->+          let acc' = acc <> b+           in if Builder.builderLength acc' >= maxSize+                then S.yield acc' >> go mempty rest+                else go acc' rest++copyStart :: HPgConnection -> Query -> IO ()+copyStart conn copyQry = snd <$> withCopyInternal conn copyQry (\_qryId -> pure (0, ()))++putCopyData :: HPgConnection -> ByteString -> IO ()+putCopyData conn t = nonAtomicSendMsg conn $ CopyData (Builder.byteString t)++putCopyError :: HPgConnection -> String -> IO ()+putCopyError conn causeForFailure = withControlMsgsLock conn (const $ pure ()) (const $ pure ()) $ const $ do+  mCopyState <-+    STM.atomically $+      STM.readTVar (internalConnectionState conn) >>= \st -> pure $ case currentPipeline st of+        [QueryState {queryProtocol = CopyQuery copyState}] -> Just copyState+        _ -> Nothing+  case mCopyState of+    Just StillCopying -> do+      let markCopyFailSent = do+            let sttv = internalConnectionState conn+            st <- STM.readTVar sttv+            case currentPipeline st of+              [qs@QueryState {queryProtocol = CopyQuery StillCopying}] -> STM.writeTVar (internalConnectionState conn) $ st {currentPipeline = [qs {queryProtocol = CopyQuery CopyFailAndSyncSent}]}+              _ -> throwIrrecoverableError "Impossible: when marking CopyFail state was invalid"+      atomicallySendControlMsgs_ conn ([SomeMessage $ Msgs.CopyFail causeForFailure, SomeMessage Sync], markCopyFailSent)+    Just copyState ->+      throwIrrecoverableError $ "Current COPY command is not in a cancellable state. Its current state is " <> Text.pack (show copyState)+    Nothing ->+      throwIrrecoverableError "There is no active COPY command to cancel"++copyEnd :: HPgConnection -> IO Int64+copyEnd conn = do+  thisThreadId <- getMyWeakThreadId+  qryId <- STM.atomically $ do+    st <- STM.readTVar conn.internalConnectionState+    case st.currentPipeline of+      [] -> throwIrrecoverableErrorWithStatement "Ending a COPY statement" "No active COPY statement when running copyEnd"+      [qs] -> case qs.queryProtocol of+        ExtendedQuery -> throwIrrecoverableErrorWithStatement "Ending a COPY statement" "No active COPY statement when running copyEnd, but rather there was a regular query"+        CopyQuery StillCopying -> if qs.queryOwner == thisThreadId then pure qs.queryIdentifier else throwIrrecoverableErrorWithStatement "Ending a COPY statement" "Active COPY statement was issued by a different thread, and Hpgsql does not support multiple threads running/ending the same COPY statement"+        CopyQuery CopyDoneAndSyncSent -> throwIrrecoverableErrorWithStatement "Ending a COPY statement" "Active COPY statement was already finished"+        CopyQuery CopyFailAndSyncSent -> throwIrrecoverableErrorWithStatement "Ending a COPY statement" "Active COPY statement had previously failed"+      _ -> throwIrrecoverableErrorWithStatement "Ending a COPY statement" "Active pipeline with other statements running when a copyEnd was attempted"++  copyEndInternal conn qryId++copyEndInternal :: HPgConnection -> QueryId -> IO Int64+copyEndInternal conn qryId = do+  atomicallySendControlMsgs_+    conn+    ( [SomeMessage CopyDone, SomeMessage Sync],+      do+        -- When CopyDone+Sync are sent, we must update the connection state+        let sttv = internalConnectionState conn+        st <- STM.readTVar sttv+        case currentPipeline st of+          [q@QueryState {queryProtocol = CopyQuery StillCopying}] -> STM.writeTVar sttv $ st {currentPipeline = [q {queryProtocol = CopyQuery CopyDoneAndSyncSent}]}+          _ -> throwIrrecoverableError "putCopyEnd called but there was no active COPY statement"+    )+  qText <- lookupQueryText conn qryId+  (_, stream) <- consumeResults conn qryId+  res <- S.effects stream+  case res of+    Left err -> throwPostgresError qText err+    Right (CommandComplete n) -> pure n++-- | A simpler version of `atomicallySendControlMsgs`.+atomicallySendControlMsgs_ :: HPgConnection -> ([SomeMessage], STM ()) -> IO ()+atomicallySendControlMsgs_ conn (msgs, stateUpdate) = atomicallySendControlMsgs conn (const $ pure ()) (const $ pure ()) (const ((), msgs, stateUpdate))++data SomeMessage = forall msg. (ToPgMessage msg) => SomeMessage msg++instance ToPgMessage SomeMessage where+  toPgMessage (SomeMessage msg) = toPgMessage msg++-- | Sends messages by running the supplied function in a way that is+-- semantically equivalent to being atomic, and guarantees the success+-- STM transaction will be applied when the messages were sent, even+-- if this thread is killed.+-- This is an essential message-sending primitive that guarantees that+-- if you send a series of messages, that the internal connection+-- state will be updated once they're sent, and other callers calling this+-- will wait for previous messages to be sent, so they see the same state+-- they would under normal/error-free operation.+atomicallySendControlMsgs :: HPgConnection -> (TVar InternalConnectionState -> STM a) -> (TVar InternalConnectionState -> STM ()) -> (a -> (b, [SomeMessage], STM ())) -> IO b+atomicallySendControlMsgs conn acquire release f = do+  withControlMsgsLock+    conn+    acquire+    release+    $ \acqValue ->+      let (!ret, !msgs, !afterSentTxn) = f acqValue+       in modifyMVar (sendBuffer conn) $ \msgsInBuffer ->+            -- Use a DList for appends? Probably not worth it since there are so few control messages.+            pure (msgsInBuffer ++ [(Builder.toLazyByteString (mconcat $ map toPgMessage msgs), afterSentTxn)], ret)++-- | This function is thread-and-interruption-safe, so you+-- can run it with the same connection in parallel to any other functions.+getNotificationNonBlocking :: HPgConnection -> IO (Maybe NotificationResponse)+getNotificationNonBlocking conn = STM.atomically $ updateConnStateTxn conn $ \sttv -> do+  st <- STM.readTVar sttv+  STM.tryReadTQueue (notificationsReceived st)++-- | Blocks until a new Notification arrives. This function is both thread-safe and+-- interruption-safe, so you can run it with the same connection in parallel to any+-- other functions.+getNotification :: HPgConnection -> IO NotificationResponse+getNotification conn =+  -- This implementation blocks concurrency in some cases, but should be optimised+  -- for the most common case of no concurrency, and should be correct.+  getNonBlockingOr $+    waitUntilPipelineIsReadyForNewQuery conn (pure ()) $ \() ->+      -- Another query might have filled our internal notification queue while we were+      -- draining, so check that first.+      getNonBlockingOr $+        receiveNextMsgWithMaskedContinuation conn (msgParser @NotificationResponse) pure+  where+    getNonBlockingOr f = do+      mNotifFromQueue <- getNotificationNonBlocking conn+      case mNotifFromQueue of+        Just notif -> pure notif+        Nothing -> f++-- | Non-atomic because if it's interrupted, it can leave the socket in a state+-- where only part of the message's bytes were pushed across the userspace<->kernel+-- boundary, leaving the connection in a ruined state.+-- TODO: Maybe we should mark the connection as broken on exception?+nonAtomicSendMsg :: (ToPgMessage msg, Show msg) => HPgConnection -> msg -> IO ()+nonAtomicSendMsg HPgConnection {socket} msg = do+  SocketLBS.sendAll socket $ Builder.toLazyByteString $ toPgMessage msg+  debugPrint $ "Sent " ++ show msg++-- | Wraps an IO action to rethrow any exception as a IrrecoverableHpgsqlError.+rethrowAsIrrecoverable :: IO a -> IO a+rethrowAsIrrecoverable = handle (throw . asIrrec)+  where+    asIrrec (ex :: SomeException) = IrrecoverableHpgsqlError {hpgsqlDetails = "An inner exception was thrown", innerException = Just ex, relatedStatement = Nothing}++{-# NOINLINE _globalDebugLock #-}+_globalDebugLock :: MVar Bool+_globalDebugLock = unsafePerformIO $ newMVar True++debugPrint :: String -> IO ()+debugPrint _ = pure ()++-- debugPrint str = modifyMVar_ _globalDebugLock $ \p -> when p (putStrLn str) >> pure p++{-# INLINE timeDebugNonBlockingOperation #-}+timeDebugNonBlockingOperation :: String -> IO a -> IO a+timeDebugNonBlockingOperation _ f = f++-- timeDebugNonBlockingOperation opName f = do+--   t1 <- getMonotonicTime+--   ret <- f+--   t2 <- getMonotonicTime+--   when (t2 - t1 > 0.01) $ putStrLn $ opName ++ " took more than 10ms: " ++ show (t2 - t1)+--   pure ret++-- Note [Polling Weak ThreadId instead of finalizers]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- When a connection is shared across multiple threads, and one such thread+-- is interrupted by an asynchronous exception after sending a query to+-- postgres but before consuming its results, the other thread will still+-- be blocked in sending its query until it can know the first thread has died.+--+-- One way to implement this is by adding finalizers on `ThreadId` that would+-- then STM.writeTVar and set `queryOwner = Nothing`, so good old `STM.retry`+-- would make blocked threads retry promptly when that happens.+--+-- However, it is possible to `addFinalizer`, but not to `removeFinalizer`.+-- And that means every new sent query adds a new finalizer, and these accumulate+-- (leak).+-- There are strategies to only register a finalizer once, but that requires+-- keeping state that grows with the number of threads a connection is picked up by.+--+-- I did implement the strategy with finalizers at some point, but thought+-- it wasn't worth the risk, and then switched to polling `deRefWeak` instead.+--+-- One other interesting thing is that I've seen GHC's runtime take a while to+-- collect ThreadIds, so forcing a garbage collection in between waits helps+-- it realise more promptly.+-- This isn't done for users of the library; we do it only in our tests, because+-- we hope real world applications allocate memory a lot more than our tests, so+-- they trigger collections more often. Or one can hope.
+ src/Hpgsql/InternalTypes.hs view
@@ -0,0 +1,480 @@+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 (Eq, 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; ...".+    queryString :: ![SingleQueryFragment],+    queryParams :: ![EncodingContext -> (Maybe Oid, BinaryField)],+    isPrepared :: !Bool+  }++instance Show Query where+  show = show . NE.toList . breakQueryIntoStatements++queryToByteString :: Query -> ByteString+queryToByteString = mconcat . map (\SingleQuery {queryString} -> queryString) . NE.toList . breakQueryIntoStatements++instance Semigroup Query where+  q1 <> q2 =+    let maxArgQ1 =+          maximumOnOrDef+            0+            q1.queryString+            ( \case+                QueryArgumentPlaceHolder n -> Just n+                _ -> Nothing+            )+        (_, remappedQ2) =+          renumberParamsFrom+            q2.queryString+            (maxArgQ1 + 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 = q1.queryString <> remappedQ2, queryParams = q1.queryParams <> q2.queryParams, isPrepared = q1.isPrepared || q2.isPrepared}++-- | A single statement, not multiple, with dollar-numbered query arguments+-- starting from $1.+data SingleQuery = SingleQuery {queryString :: !ByteString, queryParams :: ![EncodingContext -> (Maybe Oid, BinaryField)], preparedStmtHash :: !(Maybe String)}++mkSingleQuery :: ByteString -> [EncodingContext -> (Maybe Oid, BinaryField)] -> Bool -> SingleQuery+mkSingleQuery queryString queryParams isPrepared = SingleQuery {queryString, queryParams, preparedStmtHash = if isPrepared then Just (show $ hash queryString) else Nothing}++instance Show SingleQuery where+  -- Careful not exposing query arguments+  show (SingleQuery {queryString}) = show queryString++instance IsString Query where+  fromString s =+    let blocks = parseSql AcceptOnlyDollarNumberedArgs (Text.pack s)+        queryFrags =+          map+            ( \case+                StaticSql t -> FragmentOfStaticSql $ encodeUtf8 t+                SemiColon -> FragmentWithSemiColon+                CommentsOrWhitespace t -> FragmentOfCommentsOrWhitespace $ encodeUtf8 t+                DollarNumberedArg _ ->+                  error "Dollar-numbered query arguments are not supported in string literals. Use the sql quasiquoter or mkQuery instead."+                QuestionMarkArg ->+                  error "Question mark query arguments are not supported in string literals. Use the sql quasiquoter or mkQuery instead."+                QuasiQuoterExpression _ _ ->+                  error "Bug in Hpgsql: parseSql AcceptOnlyDollarNumberedArgs returned quasiquoter expression."+            )+            blocks+     in Query {queryString = queryFrags, queryParams = [], isPrepared = 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 qry@Query {queryString = fullQueryString, queryParams = allQueryParams, isPrepared} =+  -- If a user insists in trying to run an empty query, or if+  -- they mistakenly concatenate empty statements, we let them+  toEmptyQueryIfNecessary $+    map toSingleQuery $+      -- If a query string is "SELECT 1; -- comments and empty space", we put+      -- all comments and whitespace together with that last "real" SQL statement+      fixLastEmptyStatement $+        go fullQueryString allQueryParams+  where+    toEmptyQueryIfNecessary [] = NE.singleton $ mkSingleQuery "" allQueryParams isPrepared+    toEmptyQueryIfNecessary (x : xs) = x :| xs+    toSingleQuery (blks, prms) = let queryString = mconcat $ map fragToBytestring blks in mkSingleQuery queryString prms isPrepared+    allWhitespaceOrComments =+      all+        ( \case+            FragmentOfCommentsOrWhitespace _ -> True+            _ -> False+        )+    fixLastEmptyStatement :: [([SingleQueryFragment], [EncodingContext -> (Maybe Oid, BinaryField)])] -> [([SingleQueryFragment], [EncodingContext -> (Maybe Oid, BinaryField)])]+    fixLastEmptyStatement indivStmts = case lastTwoAndInit indivStmts of+      (_, Nothing) -> indivStmts -- Only 0 or 1 statements found+      (firstStmts, Just (secLst, lst))+        | allWhitespaceOrComments (fst lst) -> firstStmts ++ [secLst <> lst]+        | otherwise -> indivStmts+    isLastFragmentOfAStatement = \case+      FragmentWithSemiColon -> True+      _ -> False+    fragToBytestring = \case+      QueryArgumentPlaceHolder n -> "$" <> intToBs n+      FragmentOfStaticSql t -> t+      FragmentWithSemiColon -> ";"+      FragmentOfCommentsOrWhitespace t -> t+    go :: [SingleQueryFragment] -> [EncodingContext -> (Maybe Oid, BinaryField)] -> [([SingleQueryFragment], [EncodingContext -> (Maybe Oid, BinaryField)])]+    go [] [] = []+    go [] _ = error $ "Hpgsql error: empty query fragment list but outstanding query params. Number of query arguments is " ++ show (length allQueryParams) ++ " and query is " ++ show qry+    go frags params =+      let (stmtFrags, nextFrags) = case List.break isLastFragmentOfAStatement frags of+            (firstStmts, []) -> (firstStmts, [])+            (firstStmts, semiColon : next) -> (firstStmts ++ [semiColon], next)+          (maxArgNum, thisQueryFrags) = renumberParamsFrom stmtFrags 1+          (thisQueryParams, nextParams) = List.splitAt maxArgNum params+       in (thisQueryFrags, thisQueryParams) : go nextFrags nextParams++intToBs :: Int -> ByteString+intToBs = encodeUtf8 . Text.pack . 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 frags renumberFrom =+  List.mapAccumR+    ( \(!maxSoFar) -> \case+        QueryArgumentPlaceHolder n -> let newNum = n - smallestArgNum + renumberFrom in (max newNum maxSoFar, QueryArgumentPlaceHolder newNum)+        x -> (maxSoFar, x)+    )+    0+    frags+  where+    smallestArgNum =+      minimumOnOrDef+        1+        frags+        ( \case+            QueryArgumentPlaceHolder n -> Just n+            _ -> Nothing+        )++data ConnectionString = ConnectionString+  { hostname :: Text,+    port :: Word16,+    user :: Text,+    password :: Text,+    database :: Text,+    options :: Text+  }+  deriving stock (Eq)++instance Show ConnectionString where+  show _ = "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.+    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.+    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.+    fillTypeInfoCache :: Bool+  }++data ErrorDetail+  = ErrorSeverity+  | ErrorCode+  | ErrorHumanReadableMsg+  | ErrorDetail+  | ErrorHint+  | ErrorPosition+  | ErrorInternalPosition+  | ErrorInternalCommand+  | ErrorContext+  | ErrorSchema+  | ErrorTable+  | ErrorColumn+  | ErrorType+  | ErrorConstraint+  | ErrorSourceFile+  | ErrorSourceLine+  | ErrorSourceRoutine+  deriving stock (Eq, Ord, Show)++data NotificationResponse = NotificationResponse {notifierPid :: !Int32, channelName :: !Text, notifPayload :: !Text}+  deriving stock (Eq, Show)++data ResetConnectionOpts = ResetConnectionOpts+  { -- | Runs `RESET ALL` and `RESET ROLE` on the connection. Defaults to True.+    resetAll :: Bool,+    -- | Runs `UNLISTEN *` on the connection and clears the internal queue of notifications. Defaults to True.+    unlistenAll :: Bool,+    -- | Throws an exception if there is an open transaction or if there's a transaction in error state. Defaults to True.+    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 {pgErrorDetails :: Map ErrorDetail LBS.ByteString, failedStatement :: !ByteString}+  deriving stock (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 {hpgsqlDetails :: Text, innerException :: Maybe SomeException, relatedStatement :: !(Maybe ByteString)}+  deriving stock (Show)++instance Exception IrrecoverableHpgsqlError++throwIrrecoverableError :: (MonadThrow m) => Text -> m a+throwIrrecoverableError errMsg = throw $ IrrecoverableHpgsqlError {hpgsqlDetails = errMsg, innerException = Nothing, relatedStatement = Nothing}++-- ------------------------------------------------------------------+-- Msgs types (moved from Hpgsql.Msgs to avoid cycles)+-- ------------------------------------------------------------------++data ParseComplete = ParseComplete+  deriving stock (Show)++data BindComplete = BindComplete+  deriving stock (Show)++data NoData = NoData+  deriving stock (Show)++-- | Column names and type OIDs.+newtype RowDescription = RowDescription {resultColumnTypes :: [(Text, Oid)]}+  deriving stock (Show)++data CopyInResponse = CopyInResponse+  deriving stock (Show)++newtype ErrorResponse = ErrorResponse (Map ErrorDetail LBS.ByteString)+  deriving stock (Show)++newtype CommandComplete = CommandComplete {numRows :: Int64}+  deriving stock (Show)++newtype DataRow = DataRow {rowColumnData :: ByteString}++instance Show DataRow where+  show _ = "DataRow"++newtype ReadyForQuery+  = ReadyForQuery TransactionStatus+  deriving stock (Show)++-- ------------------------------------------------------------------+-- Internal connection state types (moved from Hpgsql)+-- ------------------------------------------------------------------++data Either3 a b c = Left3 !a | Middle3 !b | Right3 !c+  deriving stock (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 (Enum, Eq, Num, Ord, Show)++data CopyQueryState = StillCopying | CopyDoneAndSyncSent | CopyFailAndSyncSent+  deriving stock (Eq, Show)++data QueryProtocol+  = CopyQuery CopyQueryState+  | ExtendedQuery+  deriving stock (Eq, 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 _ t1 == WeakThreadId _ t2 = t1 == t2++#if MIN_VERSION_base(4,19,0)+instance Show WeakThreadId where+  show (WeakThreadId _ threadIdentifier) = "WeakThreadId " ++ show 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 (Show)++data ResponseMsg = RespParseComplete ParseComplete | RespBindComplete BindComplete | RespNoData NoData | RespRowDescription RowDescription | RespCopyInResponse CopyInResponse | RespErrorResponse ErrorResponse | RespCommandComplete CommandComplete | RespDataRow DataRow | RespReadyForQuery ReadyForQuery+  deriving stock (Show)++data QueryState = QueryState+  { queryIdentifier :: !QueryId,+    queryText :: !ByteString,+    queryProtocol :: !QueryProtocol,+    queryPrepStmtName :: !(Maybe String),+    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.+    responseMsgsState :: ResponseMsgsReceived+  }+  deriving stock (Show)++data InternalConnectionState = InternalConnectionState+  { totalQueriesSent :: !Integer,+    -- | We support only one pipeline sent to the backend at a time.+    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.+    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.+    notificationsReceived :: !(TQueue NotificationResponse),+    preparedStatementNames :: Set String,+    transactionStatusBeforeCurrentPipeline :: !TransactionStatus+  }++-- ------------------------------------------------------------------+-- Connection and Pipeline types+-- ------------------------------------------------------------------++data HPgConnection = HPgConnection+  { socket :: !Socket,+    socketClosed :: !(MVar Bool),+    recvBuffer :: !(MVar LBS.ByteString),+    sendBuffer :: !(MVar [(LBS.ByteString, STM ())]),+    socketMutex :: !Mutex,+    originalConnStr :: !ConnectionString,+    connectedTo :: !AddrInfo,+    encodingContext :: !(MVar EncodingContext),+    parameterStatusMap :: !(MVar (Map Text Text)),+    internalConnectionState :: !(TVar InternalConnectionState),+    connPid :: !Int32,+    cancelSecretKey :: !Int32,+    connOpts :: !ConnectOpts+  }++instance Eq HPgConnection where+  conn1 == conn2 = socket conn1 == socket 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 = Mutex <$> STM.newTVarIO Nothing++data Pipeline a = Pipeline [(SingleQuery, Maybe Int)] (HPgConnection -> [QueryId] -> a)+  deriving stock (Functor)++instance Applicative Pipeline where+  pure x = Pipeline [] (\_ _ -> x)+  Pipeline queries runFunc <*> Pipeline moreQueries run2 = Pipeline (queries ++ moreQueries) $ \conn qryIds ->+    let (firstQueries, lastQueries) = List.splitAt (length queries) qryIds+        f = runFunc conn firstQueries+        g = run2 conn lastQueries+     in f g
+ src/Hpgsql/Locking.hs view
@@ -0,0 +1,56 @@+module Hpgsql.Locking (getMyWeakThreadId, withMutex, Mutex, WeakThreadId) where++import Control.Concurrent (mkWeakThreadId, myThreadId)+import qualified Control.Concurrent.STM as STM+import Control.Exception.Safe (bracket)+import Control.Monad (void)+import Hpgsql.InternalTypes (Mutex (..), WeakThreadId (..), throwIrrecoverableError)+#if MIN_VERSION_base(4,19,0)+import GHC.Conc.Sync (fromThreadId)+#else+import GHC.Conc.Sync (showThreadId)+#endif++getMyWeakThreadId :: IO WeakThreadId+getMyWeakThreadId = do+  -- We don't keep a reference to `ThreadId` as it can stop threads from getting+  -- runtime exceptions and can prevent dead threads from being garbage-collected.+  -- It's explained somewhere in hackage.+  tid <- myThreadId+  wtid <- mkWeakThreadId tid+#if MIN_VERSION_base(4,19,0)+  pure $ WeakThreadId wtid (fromThreadId tid)+#else+  let tidStr = showThreadId tid+  pure $ WeakThreadId wtid tidStr+#endif++withMutex ::+  Mutex ->+  IO a ->+  IO a+withMutex (Mutex blockedByT) f = do+  thisThreadId <- getMyWeakThreadId+  bracket+    ( STM.atomically $ do+        blockedBy <- STM.readTVar blockedByT+        newSt :: (WeakThreadId, Int) <- case blockedBy of+          Nothing -> pure {- traceShowWith ("Grabbing ",) $ -} (thisThreadId, 1)+          Just (tid, nGrabs) ->+            if tid == thisThreadId+              then pure {- traceShowWith ("Grabbing ",) $ -} (thisThreadId, nGrabs + 1)+              else STM.retry+        STM.writeTVar blockedByT (Just newSt)+    )+    -- Release lock on success or error+    ( const $ void $ STM.atomically $ do+        blockedBy <- STM.readTVar blockedByT+        newSt <- case blockedBy of+          Nothing -> throwIrrecoverableError "Impossible: should have been blocked but was not!"+          Just (tid, nGrabs) ->+            let newLockState = {- traceShowWith ("Releasing ",) $ -} if nGrabs <= 1 then Nothing else Just (thisThreadId, nGrabs - 1)+             in if tid == thisThreadId then pure newLockState else throwIrrecoverableError "Impossible: Lock of a different thread!"+        STM.writeTVar blockedByT newSt+        -- debugPrint "Internal state: [Released control-msg-lock]."+    )+    $ \() -> f
+ src/Hpgsql/Msgs.hs view
@@ -0,0 +1,472 @@+module Hpgsql.Msgs (AuthenticationResponse (..), AuthenticationMethod (..), BackendKeyData (..), Bind (..), BindComplete (..), CancelRequest (..), CommandComplete (..), CopyData (..), CopyDone (..), CopyFail (..), CopyInResponse (..), DataRow (..), Describe (..), ErrorDetail (..), ErrorResponse (..), Execute (..), Flush (..), NoData (..), ParameterStatus (..), Query (..), ReadyForQuery (..), RowDescription (..), StartupMessage (..), ToPgMessage (..), FromPgMessage (..), PgMsgParser (..), Terminate (..), TransactionStatus (..), NoticeResponse (..), NotificationResponse (..), Parse (..), ParseComplete (..), PasswordMessage (..), Sync (..), parsePgMessage, nulTermCString) where++import Control.Applicative (Alternative (..))+import Control.Monad (replicateM)+import qualified Crypto.Hash.MD5 as MD5+import qualified Data.Attoparsec.ByteString as Parsec+import qualified Data.Attoparsec.ByteString.Lazy as LazyParsec+import qualified Data.Attoparsec.Text as TextParsec+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Internal (w2c)+import qualified Data.ByteString.Lazy as LBS+import Data.Functor (void)+import Data.Int (Int16, Int32)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe, mapMaybe)+import qualified Data.Serialize as Cereal+import Data.Text (Text)+import Data.Text.Encoding (decodeASCII, decodeUtf8)+import Data.Word (Word8)+import Hpgsql.Builder (BinaryField, Builder, builderLength)+import qualified Hpgsql.Builder as Builder+import Hpgsql.InternalTypes (BindComplete (..), CommandComplete (..), CopyInResponse (..), DataRow (..), ErrorDetail (..), ErrorResponse (..), NoData (..), NotificationResponse (..), ParseComplete (..), ReadyForQuery (..), RowDescription (..), TransactionStatus (..))+import Hpgsql.TypeInfo (Oid (..))++class ToPgMessage a where+  toPgMessage :: a -> Builder++newtype PgMsgParser a+  = PgMsgParser+      ( Char ->+        -- \| Message contents after the Int32 length attribute+        LBS.ByteString ->+        Maybe a+      )+  deriving stock (Functor)++instance Applicative PgMsgParser where+  pure a = PgMsgParser $ \_ _ -> Just a++  -- TODO: Is this Applicative correct? Double-check laws+  PgMsgParser f <*> PgMsgParser p = PgMsgParser $ \c r -> f c r <*> p c r++instance Alternative PgMsgParser where+  empty = PgMsgParser $ \_ _ -> Nothing+  PgMsgParser p1 <|> PgMsgParser p2 = PgMsgParser $ \c restOfMsg -> p1 c restOfMsg <|> p2 c restOfMsg++class FromPgMessage a where+  msgParser :: PgMsgParser a++parsePgMessage :: Char -> LBS.ByteString -> PgMsgParser a -> Maybe a+parsePgMessage c restOfMsg (PgMsgParser parseFunc) = parseFunc c restOfMsg++colParser :: Parsec.Parser (Text, Oid)+colParser = do+  colName <- nulTerminatedCStringParser -- Column name as C string+  void $ Parsec.take (4 + 2)+  -- TODO: OIDs are unsigned integers! Try `select (-1)::oid` to see. Change to UInt32 somehow+  typOid <- either fail pure . Cereal.decode @Int32 =<< Parsec.take 4+  void $ Parsec.take (2 + 4 + 2)+  pure (colName, Oid (fromIntegral typOid))++nulTerminatedCStringParser :: Parsec.Parser Text+nulTerminatedCStringParser = do+  stringWithoutNul <- Parsec.takeWhile (/= 0)+  Parsec.skip (== 0)+  pure $ decodeUtf8 stringWithoutNul++newtype AuthenticationResponse = AuthenticationResponse AuthenticationMethod+  deriving stock (Show)++data AuthenticationMethod = AuthOk | AuthKerberosV5 | AuthCleartextPassword | AuthMD5Password LBS.ByteString | AuthGSS | AuthGSSContinue | AuthSSPI | AuthSASL | AuthSASLContinue | AuthSASLFinal+  deriving stock (Show)++data PasswordMessage+  = -- | Two last are username and password+    PasswordMessage AuthenticationMethod String String+  deriving stock (Show)++data BackendKeyData = BackendKeyData {backendPid :: Int32, backendSecretKey :: Int32}+  deriving stock (Show)++data Bind = Bind {paramsValuesInOrder :: ![BinaryField], resultColumnFmts :: !Int, preparedStmtHash :: !(Maybe String)}+  deriving stock (Show)++-- | PId first, secret key second+data CancelRequest = CancelRequest Int32 Int32+  deriving stock (Show)++newtype CopyData = CopyData Builder++instance Show CopyData where+  show _ = "CopyData"++data Describe = Describe+  deriving stock (Show)++data Execute = Execute+  deriving stock (Show)++data CopyDone = CopyDone+  deriving stock (Show)++newtype CopyFail = CopyFail {causeForFailure :: String}+  deriving stock (Show)++data Flush = Flush+  deriving stock (Show)++newtype NoticeResponse = NoticeResponse (Map ErrorDetail LBS.ByteString)+  deriving stock (Show)++newtype Query = Query ByteString++instance Show Query where+  show _ = "Query"++data Parse = Parse {queryString :: !ByteString, specifiedParameterTypes :: ![Maybe Oid], preparedStmtHash :: !(Maybe String)}++instance Show Parse where+  show Parse {..} = "Parse (" ++ show (length specifiedParameterTypes) ++ " params specified) - " ++ show queryString++data ParameterStatus = ParameterStatus {parameterName :: !Text, parameterValue :: !Text}+  deriving stock (Show)++data StartupMessage = StartupMessage {user :: String, database :: String, options :: String}+  deriving stock (Show)++data Sync = Sync+  deriving stock (Show)++data Terminate = Terminate+  deriving stock (Show)++instance FromPgMessage AuthenticationResponse where+  msgParser = PgMsgParser $ \c restOfMsg -> case c of+    'R' -> case LBS.length restOfMsg of+      4 ->+        case Cereal.decodeLazy @Int32 restOfMsg of+          Right 0 -> Just $ AuthenticationResponse AuthOk+          Right 2 -> Just $ AuthenticationResponse AuthKerberosV5+          Right 3 -> Just $ AuthenticationResponse AuthCleartextPassword+          Right 7 -> Just $ AuthenticationResponse AuthGSS+          Right 9 -> Just $ AuthenticationResponse AuthSSPI+          _ -> Nothing+      8 -> case first (Cereal.decodeLazy @Int32) $ LBS.splitAt 4 restOfMsg of+        (Right 5, salt) -> Just $ AuthenticationResponse (AuthMD5Password salt)+        _ -> Nothing -- We don't care too much about parsing every possible response yet+      _ -> Nothing -- We don't care too much about parsing every possible response yet+    _ -> Nothing++instance FromPgMessage BackendKeyData where+  msgParser = PgMsgParser $ \c (LBS.splitAt 4 -> (pidBS, secretBS)) -> case c of+    'K' -> case (,) <$> Cereal.decodeLazy @Int32 pidBS <*> Cereal.decodeLazy @Int32 secretBS of+      Right (pid, secret) -> Just $ BackendKeyData {backendPid = pid, backendSecretKey = secret}+      Left _ -> Nothing+    _ -> Nothing++instance FromPgMessage BindComplete where+  msgParser = PgMsgParser $ \c _restOfMsg -> case c of+    '2' -> Just BindComplete+    _ -> Nothing++instance FromPgMessage CommandComplete where+  msgParser = PgMsgParser $ \c restOfMsg -> case c of+    'C' ->+      let astext = decodeASCII $ LBS.toStrict $ LBS.dropEnd 1 restOfMsg+       in case TextParsec.parseOnly ((ins <|> del <|> upd <|> merge <|> sel <|> move <|> fetch <|> copy) <* TextParsec.endOfInput) astext of+            Left _ -> Just $ CommandComplete 0+            Right n -> Just $ CommandComplete n+    _ -> Nothing+    where+      ins = TextParsec.string "INSERT 0 " >> TextParsec.decimal+      del = TextParsec.string "DELETE " >> TextParsec.decimal+      upd = TextParsec.string "UPDATE " >> TextParsec.decimal+      merge = TextParsec.string "MERGE " >> TextParsec.decimal+      sel = TextParsec.string "SELECT " >> TextParsec.decimal+      move = TextParsec.string "MOVE " >> TextParsec.decimal+      fetch = TextParsec.string "FETCH " >> TextParsec.decimal+      copy = TextParsec.string "COPY " >> TextParsec.decimal++instance ToPgMessage CancelRequest where+  toPgMessage (CancelRequest pid secret) =+    Builder.int32BE (4 + 4 + 4 + 4) <> Builder.int32BE 80877102 <> Builder.int32BE pid <> Builder.int32BE secret++instance ToPgMessage CopyData where+  toPgMessage (CopyData bs) =+    let len = Builder.builderLength bs+     in Builder.char7 'd' <> Builder.int32BE (4 + len) <> bs++instance ToPgMessage CopyFail where+  toPgMessage (CopyFail bs) =+    let cstr = nulTermCString bs+     in Builder.char7 'f' <> Builder.int32BE (4 + fromIntegral (length bs) + 1) <> cstr++instance ToPgMessage CopyDone where+  toPgMessage CopyDone =+    Builder.char7 'c' <> Builder.int32BE 4++instance ToPgMessage Describe where+  toPgMessage Describe =+    let unnamedPortal = nulTermCString ""+     in Builder.char7 'D' <> Builder.int32BE (4 + 1 + 1) <> Builder.char7 'P' <> unnamedPortal++instance ToPgMessage Execute where+  toPgMessage _ =+    let unnamedPortal = nulTermCString ""+        infiniteRowsToReturn :: Int32 = 0+        contents = unnamedPortal <> Builder.int32BE infiniteRowsToReturn+        contentsLen = fromIntegral $ LBS.length $ Builder.toLazyByteString contents+     in Builder.char7 'E' <> Builder.int32BE (4 + contentsLen) <> contents++instance ToPgMessage Flush where+  toPgMessage Flush =+    Builder.char7 'H' <> Builder.int32BE 4++instance FromPgMessage CopyInResponse where+  msgParser = PgMsgParser $ \c _ -> case c of+    'G' -> Just CopyInResponse+    _ -> Nothing++instance FromPgMessage DataRow where+  msgParser = PgMsgParser $ \c !restOfMsg -> case c of+    'D' -> Just $ DataRow {rowColumnData = LBS.toStrict $ LBS.drop 2 restOfMsg}+    _ -> Nothing++instance FromPgMessage NoData where+  msgParser = PgMsgParser $ \c _ -> case c of+    'n' -> Just NoData+    _ -> Nothing++instance FromPgMessage ParameterStatus where+  msgParser = PgMsgParser $ \c !restOfMsg -> case c of+    'S' -> case LazyParsec.parseOnly (((,) <$> nulTerminatedCStringParser <*> nulTerminatedCStringParser) <* Parsec.endOfInput) restOfMsg of+      Left _ -> error "Failed parsing ParameterStatus"+      Right (parameterName, parameterValue) -> Just $ ParameterStatus {..}+    _ -> Nothing++instance FromPgMessage ParseComplete where+  msgParser = PgMsgParser $ \c _ -> case c of+    '1' -> Just ParseComplete+    _ -> Nothing++instance ToPgMessage PasswordMessage where+  toPgMessage (PasswordMessage crypt username password) =+    let passwordBs = case crypt of+          AuthCleartextPassword -> nulTermCString password+          AuthMD5Password (LBS.toStrict -> salt) ->+            let passwordBytes = Builder.toStrictByteString (Builder.string7 password)+                usernameBytes = Builder.toStrictByteString (Builder.string7 username)+                innerHex = bytestringToHex (MD5.hash (passwordBytes <> usernameBytes))+                outerHex = bytestringToHex (MD5.hash (innerHex <> salt))+             in Builder.byteString "md5" <> Builder.byteString outerHex <> Builder.word8 0+          _ -> error "PasswordMessage method not implemented"+        msgLen = builderLength passwordBs + 4+     in Builder.char7 'p' <> Builder.int32BE msgLen <> passwordBs++instance ToPgMessage Query where+  toPgMessage (Query bs) =+    -- TODO: Do we check if bytestring's length is too long or just continue ignoring the possibility?+    Builder.char7 'Q' <> Builder.int32BE (5 + fromIntegral (BS.length bs)) <> Builder.byteString bs <> Builder.word8 0++instance ToPgMessage Sync where+  toPgMessage Sync =+    Builder.char7 'S' <> Builder.int32BE 4++instance ToPgMessage Terminate where+  toPgMessage Terminate =+    Builder.char7 'X' <> Builder.int32BE 4++nulTermCString :: String -> Builder+nulTermCString s = Builder.string7 s <> Builder.word8 0++bytestringToHex :: ByteString -> ByteString+bytestringToHex = BS.concatMap (\w -> let (hi, lo) = w `divMod` 16 in BS.pack [hexChar hi, hexChar lo])+  where+    hexChar n+      | n < 10 = n + 48+      | otherwise = n + 87++instance ToPgMessage Bind where+  toPgMessage Bind {..} =+    let unnamedDestPortal = nulTermCString ""+        preparedStmtName = nulTermCString $ fromMaybe "" preparedStmtHash+        numParamFmtCodesAllBinary :: Int16 = 1+        fmtCodesBinary :: Int16 = 1+        numQryParams :: Int16 = fromIntegral $ length paramsValuesInOrder+        paramsLenAndVals =+          Builder.lazyByteString $+            Builder.toLazyByteString $+              mconcat $+                map+                  Builder.binaryField+                  paramsValuesInOrder+        numResultColumnsFmtCodes :: Int16 = fromIntegral resultColumnFmts+        resultColumnsFmtCodes =+          mconcat $+            map+              (const $ Builder.int16BE 1)+              [1 .. resultColumnFmts]+        contents = unnamedDestPortal <> preparedStmtName <> Builder.int16BE numParamFmtCodesAllBinary <> Builder.int16BE fmtCodesBinary <> Builder.int16BE numQryParams <> paramsLenAndVals <> Builder.int16BE numResultColumnsFmtCodes <> resultColumnsFmtCodes+        contentsLen = fromIntegral $ LBS.length $ Builder.toLazyByteString contents+     in Builder.char7 'B' <> Builder.int32BE (4 + contentsLen) <> contents++instance ToPgMessage Parse where+  toPgMessage Parse {..} =+    let preparedStmtName = nulTermCString $ fromMaybe "" preparedStmtHash+        numParamsSpecified :: Int16 = fromIntegral $ length specifiedParameterTypes+        -- A 0 for an OID means "type unspecified", and is what we use when we don't know the type+        paramOids = mconcat $ map (Builder.int32BE . maybe 0 fromIntegral) specifiedParameterTypes+        contents = preparedStmtName <> Builder.byteString queryString <> Builder.word8 0 <> Builder.int16BE numParamsSpecified <> paramOids+        contentsLen = fromIntegral $ LBS.length $ Builder.toLazyByteString contents+     in Builder.char7 'P' <> Builder.int32BE (4 + contentsLen) <> contents++instance ToPgMessage StartupMessage where+  toPgMessage StartupMessage {..} =+    let protocolMajorVersion :: Int16 = 3+        protocolMinorVersion :: Int16 = 0+        userBS = nulTermCString "user" <> nulTermCString user+        databaseBS = nulTermCString "database" <> nulTermCString database+        optionsBS = nulTermCString "options" <> nulTermCString options+        contents = Builder.int16BE protocolMajorVersion <> Builder.int16BE protocolMinorVersion <> userBS <> databaseBS <> optionsBS <> Builder.word8 0+        contentsLen = fromIntegral $ LBS.length $ Builder.toLazyByteString contents+     in -- TODO: What protocol version do we announce? We're following the example from the docs for now+        -- TODO: Can we send things like client_encoding, DateStyle, et. al as options here?++        Builder.int32BE (4 + contentsLen) <> contents++instance FromPgMessage ReadyForQuery where+  msgParser = PgMsgParser $ \c restOfMsg -> case (c, restOfMsg) of+    ('Z', "I") -> Just $ ReadyForQuery TransIdle+    ('Z', "T") -> Just $ ReadyForQuery TransInTrans+    ('Z', "E") -> Just $ ReadyForQuery TransInError+    _ -> Nothing++instance FromPgMessage RowDescription where+  msgParser = PgMsgParser $ \c restOfMsg ->+    if c == 'T'+      then+        let (numColsBS, colContents) = LBS.splitAt 2 restOfMsg+            numCols = either error id $ Cereal.decodeLazy @Int16 numColsBS+            allColOidsParser :: Parsec.Parser [(Text, Oid)]+            allColOidsParser = replicateM (fromIntegral numCols) colParser+         in case LazyParsec.parseOnly (allColOidsParser <* Parsec.endOfInput) colContents of+              Left err -> error $ "Error parsing row's column types' OIDs: " ++ err+              Right v -> Just $ RowDescription v+      else Nothing++instance FromPgMessage ErrorResponse where+  msgParser = PgMsgParser $ \c restOfMsg ->+    if c /= 'E'+      then Nothing+      else+        if LBS.length restOfMsg == 0+          then Just $ ErrorResponse mempty+          else+            let errorFields = LBS.split 0 restOfMsg+                parseSingleErrorField ef = do+                  -- Maybe monad+                  (fieldErrorByte, fieldErrorBs) <- LBS.uncons ef+                  errDetail <- byteToErrorDetail fieldErrorByte+                  pure (errDetail, fieldErrorBs)+             in Just $ ErrorResponse $ Map.fromList $ mapMaybe parseSingleErrorField errorFields++instance FromPgMessage NoticeResponse where+  msgParser = PgMsgParser $ \c restOfMsg ->+    if c /= 'N'+      then Nothing+      else+        -- TODO NOTICEs are exactly like ErrorResponses, so we could use a single parser+        if LBS.length restOfMsg == 0+          then Just $ NoticeResponse mempty+          else+            let errorFields = LBS.split 0 restOfMsg+                parseSingleErrorField ef = do+                  -- Maybe monad+                  (fieldErrorByte, fieldErrorBs) <- LBS.uncons ef+                  errDetail <- byteToErrorDetail fieldErrorByte+                  pure (errDetail, fieldErrorBs)+             in Just $ NoticeResponse $ Map.fromList $ mapMaybe parseSingleErrorField errorFields++instance FromPgMessage NotificationResponse where+  msgParser = PgMsgParser $ \c restOfMsg ->+    if c /= 'A'+      then Nothing+      else+        let (notifierPidBs, channelNameAndPayload) = LBS.splitAt 4 restOfMsg+            notifierPid = either error id $ Cereal.decodeLazy @Int32 notifierPidBs+         in case LazyParsec.parseOnly+              ((NotificationResponse notifierPid <$> nulTerminatedCStringParser <*> nulTerminatedCStringParser) <* Parsec.endOfInput)+              channelNameAndPayload of+              Left _ -> Nothing+              Right notif -> Just notif++byteToErrorDetail :: Word8 -> Maybe ErrorDetail+byteToErrorDetail b = case w2c b of+  -- Taken from https://www.postgresql.org/docs/current/protocol-error-fields.html+  'S' -> Nothing -- This is localized severity which can make code locale-dependent, so we don't want it!+  'V' -> Just ErrorSeverity+  -- S++  --     Severity: the field contents are ERROR, FATAL, or PANIC (in an error message), or WARNING, NOTICE, DEBUG, INFO, or LOG (in a notice message), or a localized translation of one of these. Always present.+  -- V++  --     Severity: the field contents are ERROR, FATAL, or PANIC (in an error message), or WARNING, NOTICE, DEBUG, INFO, or LOG (in a notice message). This is identical to the S field except that the contents are never localized. This is present only in messages generated by PostgreSQL versions 9.6 and later.+  'C' -> Just ErrorCode+  -- C++  --     Code: the SQLSTATE code for the error (see Appendix A). Not localizable. Always present.+  'M' -> Just ErrorHumanReadableMsg+  -- M++  --     Message: the primary human-readable error message. This should be accurate but terse (typically one line). Always present.+  'D' -> Just ErrorDetail+  -- D++  --     Detail: an optional secondary error message carrying more detail about the problem. Might run to multiple lines.+  'H' -> Just ErrorHint+  -- H++  --     Hint: an optional suggestion what to do about the problem. This is intended to differ from Detail in that it offers advice (potentially inappropriate) rather than hard facts. Might run to multiple lines.+  'P' -> Just ErrorPosition+  -- P++  --     Position: the field value is a decimal ASCII integer, indicating an error cursor position as an index into the original query string. The first character has index 1, and positions are measured in characters not bytes.+  'p' -> Just ErrorInternalPosition+  -- p++  --     Internal position: this is defined the same as the P field, but it is used when the cursor position refers to an internally generated command rather than the one submitted by the client. The q field will always appear when this field appears.+  'q' -> Just ErrorInternalCommand+  -- q++  --     Internal query: the text of a failed internally-generated command. This could be, for example, an SQL query issued by a PL/pgSQL function.+  'W' -> Just ErrorContext+  -- W++  --     Where: an indication of the context in which the error occurred. Presently this includes a call stack traceback of active procedural language functions and internally-generated queries. The trace is one entry per line, most recent first.+  's' -> Just ErrorSchema+  -- s++  --     Schema name: if the error was associated with a specific database object, the name of the schema containing that object, if any.+  't' -> Just ErrorTable+  -- t++  --     Table name: if the error was associated with a specific table, the name of the table. (Refer to the schema name field for the name of the table's schema.)+  'c' -> Just ErrorColumn+  -- c++  --     Column name: if the error was associated with a specific table column, the name of the column. (Refer to the schema and table name fields to identify the table.)+  'd' -> Just ErrorType+  -- d++  --     Data type name: if the error was associated with a specific data type, the name of the data type. (Refer to the schema name field for the name of the data type's schema.)+  'n' -> Just ErrorConstraint+  -- n++  --     Constraint name: if the error was associated with a specific constraint, the name of the constraint. Refer to fields listed above for the associated table or domain. (For this purpose, indexes are treated as constraints, even if they weren't created with constraint syntax.)+  'F' -> Just ErrorSourceFile+  -- F++  --     File: the file name of the source-code location where the error was reported.+  'L' -> Just ErrorSourceLine+  -- L++  --     Line: the line number of the source-code location where the error was reported.+  'R' -> Just ErrorSourceRoutine+  -- R++  --     Routine: the name of the source-code routine reporting the error.+  _ -> Nothing
+ src/Hpgsql/Networking.hs view
@@ -0,0 +1,121 @@+-- |+-- This module contains code largely copied from the @network@ library+-- (BSD-3-Clause), with modifications to remove blocking calls+-- (threadWaitWrite, threadWaitRead).+--+-- Original copyright:+--   Copyright (c) 2002-2010, The University Court of the University of Glasgow+--   Copyright (c) 2007-2010, Johan Tibell+--+-- See: https://github.com/haskell/network/blob/master/LICENSE+module Hpgsql.Networking+  ( recvNonBlocking,+    socketWaitRead,+    socketWaitWrite,+    sendNonBlocking,+  )+where++import Control.Concurrent (threadWaitRead, threadWaitWrite)+import Control.Exception.Safe (throw)+import Data.ByteString (ByteString)+import Data.ByteString.Internal (createAndTrim)+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Int (Int64)+import Foreign (Ptr, Storable (..), Word8, allocaArray, castPtr, nullPtr, plusPtr)+import Foreign.C (CChar (..), CInt (..), CSize (..), eAGAIN, eWOULDBLOCK, getErrno)+import Network.Socket (Socket, withFdSocket)+import System.Posix.Types (CSsize (..))++socketWaitRead :: Socket -> IO ()+socketWaitRead socket = withFdSocket socket (threadWaitRead . fromIntegral)++socketWaitWrite :: Socket -> IO ()+socketWaitWrite socket = withFdSocket socket (threadWaitWrite . fromIntegral)++recvNonBlocking :: Socket -> CSize -> IO ByteString+recvNonBlocking s nbytes = withFdSocket s $ \fd -> createAndTrim (fromIntegral nbytes) $ \buffer -> do+  -- Largely copied from https://hackage-content.haskell.org/package/network-3.2.8.0/docs/src/Network.Socket.Buffer.html#recvBufNoWait and other functions from the network library,+  -- but then modified to our needs.+  r <- c_recv fd (castPtr buffer) nbytes 0 {-flags-}+  if r >= 0+    then do+      -- putStrLn $ "Asked for " ++ show nbytes ++ ", got " ++ show r+      pure $ fromIntegral r+    else do+      err <- getErrno+      if err == eAGAIN || err == eWOULDBLOCK+        then do+          -- putStrLn $ "Asked for " ++ show nbytes ++ ", but got eAGAIN"+          pure 0+        else+          throw $ userError "Internal error in hpgsql's recvNonBlocking"++sendNonBlocking :: Socket -> L.ByteString -> IO Int64+sendNonBlocking s lbs = do+  -- Largely copied from https://hackage-content.haskell.org/package/network-3.2.8.0/docs/src/Network.Socket.ByteString.Lazy.Posix.html#send,+  -- but then modified to our needs.+  let cs = take maxNumChunks (L.toChunks lbs)+      len = length cs+  siz <- withFdSocket s $ \fd -> allocaArray len $ \ptr ->+    withPokes cs ptr $ \niovs ->+      -- This part has `throwSocketErrorWaitWrite s "writev"` in the+      -- original codebase, but we don't have that here because that+      -- calls threadWaitWrite, which blocks.+      c_writev fd ptr niovs+  return $ fromIntegral siz+  where+    withPokes ss p f = loop ss p 0 0+      where+        loop (c : cs) q k niovs+          | k < maxNumBytes = unsafeUseAsCStringLen c $ \(ptr, len) -> do+              poke q $ IOVec (castPtr ptr) (fromIntegral len)+              loop+                cs+                (q `plusPtr` sizeOf (IOVec nullPtr 0))+                (k + fromIntegral len)+                (niovs + 1)+          | otherwise = f niovs+        loop _ _ _ niovs = f niovs+    maxNumBytes = 4194304 :: Int -- maximum number of bytes to transmit in one system call+    maxNumChunks = 1024 :: Int -- maximum number of chunks to transmit in one system call++data IOVec = IOVec+  { iovBase :: Ptr Word8,+    iovLen :: CSize+  }++instance Storable IOVec where+  sizeOf ~_ = (16)+  alignment ~_ = alignment (0 :: CInt)++  peek p = do+    base <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p+    len <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p+    return $ IOVec base len++  poke p iov = do+    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (iovBase iov)+    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (iovLen iov)++-- -- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair+-- -- consisting of a pointer to a temporarily allocated array of pointers to+-- -- IOVec made from @cs@ and the number of pointers (@length cs@).+-- -- /Unix only/.+-- withIOVec :: [(Ptr Word8, Int)] -> ((Ptr IOVec, Int) -> IO a) -> IO a+-- withIOVec [] f = f (nullPtr, 0)+-- withIOVec cs f =+--   allocaArray csLen $ \aPtr -> do+--     zipWithM_ pokeIov (ptrs aPtr) cs+--     f (aPtr, csLen)+--   where+--     csLen = length cs+--     ptrs = iterate (`plusPtr` sizeOf (IOVec nullPtr 0))+--     pokeIov ptr (sPtr, sLen) = poke ptr $ IOVec sPtr (fromIntegral sLen)++foreign import ccall unsafe "recv"+  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt++foreign import ccall unsafe "writev"+  c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize
+ src/Hpgsql/Notification.hs view
@@ -0,0 +1,9 @@+module Hpgsql.Notification+  ( getNotification,+    getNotificationNonBlocking,+    NotificationResponse (..),+  )+where++import Hpgsql.Internal (getNotification, getNotificationNonBlocking)+import Hpgsql.InternalTypes (NotificationResponse (..))
+ src/Hpgsql/ParsingInternal.hs view
@@ -0,0 +1,337 @@+-- |+--+-- This module contains parsers that are helpful to separate SQL statements from each other by finding query boundaries: semi-colons, but not when inside a string or a parenthesised expression, for example.+module Hpgsql.ParsingInternal+  ( parseSql,+    BlockOrNotBlock (..),+    ParsingOpts (..),+    QQExprKind (..),+    blockListText,+    blockText,+    flattenBlocks,+  )+where++import Control.Applicative+  ( optional,+    (<|>),+  )+import Control.Monad+  ( void,+  )+import Data.Attoparsec.Text+  ( Parser,+    char,+    endOfInput,+    many',+    many1,+    peekChar,+    string,+    takeWhile,+    takeWhile1,+  )+import qualified Data.Attoparsec.Text as Parsec+import qualified Data.Char as Char+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import qualified Data.Text as Text+import Language.Haskell.Meta.Parse (parseExp)+import Prelude hiding (takeWhile)++data BlockOrNotBlock = StaticSql !Text | DollarNumberedArg !Int | QuestionMarkArg | QuasiQuoterExpression !QQExprKind !Text | SemiColon | CommentsOrWhitespace !Text+  deriving stock (Eq, Show)++data QQExprKind = QQInterpolation | QQEmbeddedQuery+  deriving stock (Eq, Show)++data ParsingOpts = AcceptQuestionMarksAsQueryArgs | AcceptOnlyDollarNumberedArgs | AcceptQuasiQuoterExpressions+  deriving stock (Show)++-- | Parses one or more SQL statements (separated by semi-colons).+parseSql :: ParsingOpts -> Text -> [BlockOrNotBlock]+parseSql _ "" = []+parseSql popts str = case Parsec.parseOnly (many' (sqlStatementParser popts True) <* endOfInput) str of+  Right mStatements -> mconcat mStatements+  Left err -> error $ "Bug in hpgsql when parsing SQL: " ++ err++sqlStatementParser :: ParsingOpts -> Bool -> Parser [BlockOrNotBlock]+sqlStatementParser popts isBeginningOfStmt = do+  t1 <-+    (if isBeginningOfStmt then commentOrSpaceParser else fail "No whitespace parsing in the middle")+      <|> (\t -> [StaticSql t | not (Text.null t)])+        <$> takeWhile+          (\c -> not (isPossibleBlockStartingChar popts c) && c /= ';')+  mc <- peekChar+  case mc of+    Nothing -> if null t1 then fail "Nothing to parse" else pure t1+    Just ';' -> do+      void $ char ';'+      pure $ t1 ++ [SemiColon]+    Just _ -> do+      t2 <- many1 (blockParser popts) <|> (\pt -> [[StaticSql pt]]) <$> Parsec.take 1+      -- After reading blocks or just a char, we still need to find a semi-colon+      -- or EOF to get a statement from start to finish!+      t3 <- sqlStatementParser popts False <|> ([] <$ endOfInput)+      pure $ t1 ++ mconcat t2 <> t3+  where+    -- \| Parses 1 or more consecutive white-space or comments+    commentOrSpaceParser :: Parser [BlockOrNotBlock]+    commentOrSpaceParser =+      many1 (CommentsOrWhitespace <$> takeWhile1 Char.isSpace <|> doubleDashComment <|> cStyleComment)++eol :: Parser Text+eol = string "\n" <|> string "\r\n"++blockText :: BlockOrNotBlock -> Text+blockText = \case+  StaticSql t -> t+  CommentsOrWhitespace t -> t+  QuestionMarkArg -> "?"+  DollarNumberedArg n -> "$" <> Text.pack (show n)+  QuasiQuoterExpression QQInterpolation t -> "#{" <> t <> "}"+  QuasiQuoterExpression QQEmbeddedQuery t -> "^{" <> t <> "}"+  SemiColon -> ";"++blockListText :: [BlockOrNotBlock] -> Text+blockListText = Text.concat . map blockText++-- For now, this assumes standard_conforming_strings is always on.+blockParser :: ParsingOpts -> Parser [BlockOrNotBlock]+blockParser popts =+  -- Unicode escaped strings aren't explicitly implemented, but work with the current parser.+  -- Since single quotes can't be an escape character for them (see https://www.postgresql.org/docs/current/sql-syntax-lexical.html),+  -- backslashes will be treated like a regular character - which works for us -, and if other characters are chosen as the escape character,+  -- our parsers will treat those also as regular characters, which should be fine.+  -- This seems fragile, but our tests will error out if changes make this unsupported.+  (: [])+    <$> ( case popts of+            AcceptQuasiQuoterExpressions -> quasiQuoterExpressionParser+            _ -> fail "No quasiquoter expressions"+        )+    <|> (: []) <$> parseStdConformingString+    <|> parenthesisedExpression popts+    <|> (: []) <$> cStyleComment+    <|> (: [])+      <$> ( case popts of+              AcceptOnlyDollarNumberedArgs -> dollarNumberedQueryArgParser+              _ -> fail "No dollar-numbered query args"+          )+    <|> (: []) <$> dollarStringParser+    <|> (: [])+      <$> ( case popts of+              AcceptQuestionMarksAsQueryArgs -> questionMarkQueryArgParser+              _ -> fail "No question marks as query args"+          )+    <|> (: []) <$> doubleDashComment+    <|> (: []) <$> doubleQuotedIdentifier+    <|> (: []) <$> cStyleEscapedString++-- | A character that may be the first of a block. This needs to match parsers in `blockParser`, and is only useful+-- to optimize our parsers by avoiding backtracking through usage of `takeWhile` and similar.+isPossibleBlockStartingChar :: ParsingOpts -> Char -> Bool+isPossibleBlockStartingChar popts c =+  c+    == '('+    || c+      == '-'+    || c+      == '/'+    || c+      == '"'+    || c+      == '$'+    || c+      == '\''+    || c+      == 'E'+    || c+      == '?'+    || ( case popts of+           AcceptQuasiQuoterExpressions -> c == '#' || c == '^'+           _ -> False+       )++quasiQuoterExpressionParser :: Parser BlockOrNotBlock+quasiQuoterExpressionParser = do+  prefix <- string "#{" <|> string "^{"+  let kind = if prefix == "#{" then QQInterpolation else QQEmbeddedQuery+  expr <- findExpressionEnd ""+  pure $ QuasiQuoterExpression kind expr+  where+    -- Scan for '}' left-to-right, trying parseExp at each one.+    -- The first '}' where parseExp succeeds is the expression boundary.+    findExpressionEnd acc = do+      chunk <- takeWhile (/= '}')+      void $ char '}'+      let candidate = acc <> chunk+      case parseExp (Text.unpack candidate) of+        Right _ -> pure candidate+        Left _ -> findExpressionEnd (candidate <> "}")++dollarNumberedQueryArgParser :: Parser BlockOrNotBlock+dollarNumberedQueryArgParser = do+  void $ char '$'+  DollarNumberedArg <$> Parsec.decimal++questionMarkQueryArgParser :: Parser BlockOrNotBlock+questionMarkQueryArgParser = do+  void $ char '?'+  escapedQuestionMark <- optional $ char '?'+  case escapedQuestionMark of+    Just _ -> pure $ StaticSql "?"+    Nothing -> pure QuestionMarkArg++dollarStringParser :: Parser BlockOrNotBlock+dollarStringParser = fmap StaticSql $ do+  void $ char '$'+  b <- takeWhile (/= '$')+  void $ char '$'+  let dollarSep = "$" <> b <> "$"+  rest <- go dollarSep+  pure $ dollarSep <> rest+  where+    go dollarSep = do+      t <- takeWhile (/= '$')+      ending <- optional $ string dollarSep <|> "" <$ endOfInput+      case ending of+        Nothing -> do+          void $ char '$'+          rest <- go dollarSep+          pure $ t <> "$" <> rest+        Just e -> pure $ t <> e++doubleDashComment :: Parser BlockOrNotBlock+doubleDashComment = fmap CommentsOrWhitespace $ do+  begin <- string "--"+  rest <- Parsec.takeWhile (\c -> c /= '\n' && c /= '\r')+  end <- eol <|> "" <$ endOfInput+  pure $ begin <> rest <> end++cStyleComment :: Parser BlockOrNotBlock+cStyleComment = fmap CommentsOrWhitespace $ do+  openComment <- string "/*"+  rest <-+    Parsec.scan+      (1 :: Int, False, False)+      ( \(openCommentCount, hasPartialOpening, hasPartialClosing) c ->+          nothingWhenDone $ case (hasPartialOpening, hasPartialClosing, c) of+            -- Handle slashes in all possible contexts+            (False, False, '/') -> Just (openCommentCount, True, False)+            (False, True, '/') -> Just (openCommentCount - 1, False, False)+            (True, False, '/') -> Just (openCommentCount, True, False)+            -- Handle asterisks in all possible contexts+            (False, False, '*') -> Just (openCommentCount, False, True)+            (True, False, '*') -> Just (openCommentCount + 1, False, False)+            (False, True, '*') -> Just (openCommentCount, False, True)+            -- Handle other characters+            (True, True, _) ->+              error+                "Report this as a bug in codd: C Style comment parser invalid state"+            _ -> Just (openCommentCount, False, False)+      )+  end <- string "/" <|> "" <$ endOfInput -- We are generous with eof and allow even invalid SQL in many places+  pure $ openComment <> rest <> end+  where+    nothingWhenDone (Just (0, _, _)) = Nothing+    nothingWhenDone x = x++parenthesisedExpression :: ParsingOpts -> Parser [BlockOrNotBlock]+parenthesisedExpression popts = do+  openParen <- string "(" <|> fail "No open paren"+  rest <- insideParenParser+  pure $ StaticSql openParen : rest+  where+    insideParenParser :: Parser [BlockOrNotBlock]+    insideParenParser = do+      more <-+        takeWhile+          (\c -> not (isPossibleBlockStartingChar popts c) && c /= ')')+      nextChar <- peekChar+      case nextChar of+        Nothing -> pure [StaticSql more] -- Be gentle with EOF+        Just ')' -> do+          closeParen <- string ")"+          pure [StaticSql more, StaticSql closeParen]+        Just _ -> do+          blocksOrOtherwise <- blockParser popts <|> (\t -> [StaticSql t]) <$> Parsec.take 1+          rest <- insideParenParser -- We're still inside an openParen after parsing a block or a character+          pure $ StaticSql more : blocksOrOtherwise ++ rest++-- | Parses a value using backslash as an escape char for any char that matches+-- the supplied predicate. Does not consume the ending char and RETURNS any+-- backslash escape chars in the result.+-- Use `parseWithEscapeCharProper` to exclude the escape chars from the result.+-- This function is useful if you want the original parsed contents.+parseWithEscapeCharPreserve :: (Char -> Bool) -> Parser Text+parseWithEscapeCharPreserve untilc = do+  cs <- Parsec.takeWhile (\c -> c /= '\\' && not (untilc c))+  nextChar <- peekChar+  case nextChar of+    Just '\\' -> do+      c <- Parsec.take 2+      rest <- parseWithEscapeCharPreserve untilc+      pure $ cs <> c <> rest+    _ -> pure cs++doubleQuotedIdentifier :: Parser BlockOrNotBlock+doubleQuotedIdentifier = fmap StaticSql $ do+  openingQuote <- string "\""+  rest <- parseWithEscapeCharPreserve (== '"')+  ending <- string "\""+  pure $ openingQuote <> rest <> ending++-- | Parses a single quoted NON standard conforming string, i.e. strings that use backslash as an escape character, and are marked+-- by beginning with an `E`. Consecutive simple quotes are also treated as a single quote, just like in std conforming strings.+-- See https://www.postgresql.org/docs/current/sql-syntax-lexical.html+cStyleEscapedString :: Parser BlockOrNotBlock+cStyleEscapedString = fmap StaticSql $ do+  openingChars <- string "E'"+  rest <-+    Parsec.scan+      (False, False)+      ( \(lastCharWasBackslash, lastCharWasSingleQuote) c ->+          case ((lastCharWasBackslash, lastCharWasSingleQuote), c) of+            ((False, False), '\'') -> Just (False, True)+            ((False, True), '\'') -> Just (False, False) -- Two consecutive single quotes are not end of string+            ((False, True), _) -> Nothing -- A single quote not preceded by \ and followed by not-a-single-quote is end of string+            ((False, False), '\\') -> Just (True, False)+            ((False, False), _) -> Just (False, False) -- "regular" character+            ((True, False), _) -> Just (False, False) -- Any character after a backslash must be included in the string+            ((True, True), _) ->+              error+                "Please submit this as a bug report to codd, saying both backslash and single quote were last char in cStyleEscapedString"+      )+  pure $ openingChars <> rest++-- | Parses a single quoted standard conforming string, i.e. strings that use '' as a representation of a single quote, and+-- takes any other character literally.+parseStdConformingString :: Parser BlockOrNotBlock+parseStdConformingString = fmap StaticSql $ do+  openingQuote <- string "'"+  rest <-+    Parsec.scan+      False+      ( \lastCharWasQuote c -> case (lastCharWasQuote, c) of+          (False, '\'') -> Just True+          (True, '\'') -> Just False -- Two consecutive single quotes represent a single quote, not end of string+          (True, _) -> Nothing -- One single quote followed by any other character means that single quote was end of string+          (False, _) -> Just False+      )+  pure $ openingQuote <> rest++flattenBlocks :: [BlockOrNotBlock] -> [BlockOrNotBlock]+flattenBlocks =+  map+    ( \bs@(firstEl :| _) -> case firstEl of+        StaticSql _ -> StaticSql $ blockListText $ NE.toList bs+        CommentsOrWhitespace _ -> CommentsOrWhitespace $ blockListText $ NE.toList bs+        x -> x+    )+    . NE.groupBy+      ( \a b -> case (a, b) of+          (StaticSql _, StaticSql _) -> True+          (CommentsOrWhitespace _, CommentsOrWhitespace _) -> True+          _ -> False+      )+    . filter (\b -> blockText b /= "")
+ src/Hpgsql/Pipeline.hs view
@@ -0,0 +1,45 @@+-- |+-- Pipelines are a way to build a sequence of SQL statements that get sent in a single round-trip+-- to PostgreSQL. This helps avoid latencies.+--+-- Here's an example:+--+-- > f :: Int -> IO (Stream (Of Aeson.Value) IO ())+-- > f val = do+-- >   (updateTbl :: IO (), aggRes :: IO (Only Int), largeResults) <-+-- >     runPipeline conn $+-- >       (,,)+-- >         <$> pipelineExec_ [sql|UPDATE tbl SET val=#{val}|]+-- >         <*> pipeline1 [sql|SELECT SUM(val) FROM tbl|]+-- >         <*> pipelineSWith+-- >           (rowDecoder @(Vector Int, Vector Text))+-- >           -- We use a prepared statement for the query below+-- >           [sqlPrep|SELECT x, y FROM tbl|]+-- >   updateTbl+-- >   Only total <- aggRes+-- >   Streaming.map Aeson.toJSON <$> largeResults+--+-- All the queries above are sent in a single round-trip and execute in order in the server.+--+-- For all pipeline usage, you must always:+--+-- * Run the returned `IO` values in order.+-- * Run the returned `IO` values in the same thread that called `runPipeline`. This also applies to consuming Streams.+--+-- Or else Hpgsql can deadlock or run into undefined behaviour.+module Hpgsql.Pipeline+  ( Pipeline, -- Don't export constructor+    runPipeline,+    pipelineS,+    pipelineSWith,+    pipelineSMWith,+    pipeline,+    pipelineWith,+    pipelineExec,+    pipelineExec_,+    pipeline1,+    pipeline1With,+  )+where++import Hpgsql.Internal (Pipeline, pipeline, pipeline1, pipeline1With, pipelineExec, pipelineExec_, pipelineS, pipelineSMWith, pipelineSWith, pipelineWith, runPipeline)
+ src/Hpgsql/Query.hs view
@@ -0,0 +1,78 @@+module Hpgsql.Query+  ( Query, -- Do not export constructor+    SingleQuery, -- Do not export constructor+    sql,+    sqlPrep,+    mkQuery,+    escapeIdentifier,+    vALUES,+    preparedStatement,+    nonPreparedStatement,++    -- * Internal+    -- $internal+    breakQueryIntoStatements,+    mkQueryInternal,+    encodeParam,+  )+where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.List as List+import Data.Proxy (Proxy (..))+import Hpgsql.Builder (BinaryField (..))+import Hpgsql.Encoding (RowEncoder (..), ToPgRow (..))+import Hpgsql.InternalTypes (Query (..), SingleQuery (..), SingleQueryFragment (..), breakQueryIntoStatements)+import Hpgsql.QueryInternal (encodeParam, mkQuery, mkQueryInternal, sql, sqlPrep)+import Hpgsql.TypeInfo (EncodingContext, Oid)++-- $internal+-- These functions are internal implementation details and are not intended for public use.+-- They may change or be removed without notice.++-- | Escapes a database object identifier like a table name or a column name,+-- so it can be embedded  inside a @[sql|...|]@ quasiquote using @^{expr}@ syntax:+--+-- > [sql| SELECT ^{escapeIdentifier "çolumñ"} FROM ^{escapeIdentifier "sChEmA"}.some_table |]+escapeIdentifier :: ByteString -> Query+escapeIdentifier v = Query {queryString = [FragmentOfStaticSql "\"", FragmentOfStaticSql (doubleQuotes v), FragmentOfStaticSql "\""], queryParams = [], isPrepared = False}+  where+    doubleQuotes = BS.intercalate "\"\"" . BS.split 0x22 {- '"' -}++-- | Generates a query like @VALUES ($1,$2), ($3,$4)@ from a list of rows.+-- Can be embedded inside a @[sql|...|]@ quasiquote using @^{expr}@ syntax:+--+-- > [sql| INSERT INTO emp(id,name) ^{vALUES rows} ON CONFLICT DO NOTHING |]+vALUES :: forall a. (ToPgRow a) => [a] -> Query+vALUES [] =+  let rowOids = rowEncoder.toTypeOids (Proxy @a)+      nullParams :: [EncodingContext -> (Maybe Oid, BinaryField)]+      nullParams = map (\f -> \encCtx -> (f encCtx, SqlNull)) rowOids+   in [sql|(SELECT * FROM (VALUES ^{commaSeparatedRowTuples [nullParams]}) _subq LIMIT 0)|]+vALUES rows =+  let allParams = map rowEncoder.toPgParams rows+   in "VALUES " <> commaSeparatedRowTuples allParams++commaSeparatedRowTuples :: [[EncodingContext -> (Maybe Oid, BinaryField)]] -> Query+commaSeparatedRowTuples rowTuples =+  let (_, queryFragsPerRow) =+        List.mapAccumR+          ( \(!maxArgSoFar) singleRow ->+              let numParams = length singleRow+                  numberedArgs = map (QueryArgumentPlaceHolder . (+ maxArgSoFar)) [1 .. numParams]+               in (maxArgSoFar + numParams, FragmentOfStaticSql "(" : (List.intersperse (FragmentOfStaticSql ",") numberedArgs ++ [FragmentOfStaticSql ")"]))+          )+          0+          rowTuples+   in Query {queryString = mconcat $ List.intersperse [FragmentOfStaticSql ","] queryFragsPerRow, queryParams = mconcat rowTuples, isPrepared = False}++-- | Turns a `Query` into a prepared `Query`, i.e. every SQL statement+-- in the `Query` will be a prepared statement.+preparedStatement :: Query -> Query+preparedStatement Query {..} = Query {isPrepared = True, ..}++-- | Turns a `Query` into a non-prepared `Query`, i.e. every SQL statement+-- in the `Query` will not be a prepared statement.+nonPreparedStatement :: Query -> Query+nonPreparedStatement Query {..} = Query {isPrepared = False, ..}
+ src/Hpgsql/QueryInternal.hs view
@@ -0,0 +1,261 @@+module Hpgsql.QueryInternal+  ( Query (..),+    SingleQuery (..),+    sql,+    sqlPrep,+    mkQueryInternal,+    breakQueryIntoStatements,+    mkQuery,+    encodeParam,+  )+where++import Data.ByteString (ByteString)+import Data.Either (rights)+import qualified Data.List as List+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Hpgsql.Builder (BinaryField)+import Hpgsql.Encoding (FieldEncoder (..), RowEncoder (..), ToPgField (..), ToPgRow (..))+import Hpgsql.InternalTypes (Query (..), SingleQuery (..), SingleQueryFragment (..), breakQueryIntoStatements, renumberParamsFrom)+import Hpgsql.ParsingInternal (BlockOrNotBlock (..), ParsingOpts (..), QQExprKind (..), blockText, flattenBlocks, parseSql)+import Hpgsql.TypeInfo (EncodingContext, Oid)+import Language.Haskell.Meta.Parse (parseExp)+import Language.Haskell.TH+import Language.Haskell.TH.Quote++-- | A useful representation for our quasiquoter parsing.+data SqlFragment+  = NonInterpolatedSqlFragment !Text+  | InterpolatedHaskellExpr !Text+  | EmbeddedQueryExpr !Text+  | SemiColonFragment+  | WhitespaceOrCommentsFragment !Text+  deriving stock (Eq)++-- | Takes in a query string with query arguments as dollar-numbered arguments and returns a Query you+-- can run.+-- Examples:+-- - "SELECT * FROM table WHERE col1=$1 AND col2=$2"+-- - "SELECT * FROM table WHERE (["a", "b", "c"]'::jsonb ? 'b') = $1"+-- Question marks are interpreted literally, i.e. they have no special meaning.+-- Note that if the number of arguments does not match what's in the query string,+-- this will throw an error.+mkQuery :: (ToPgRow a) => ByteString -> a -> Query+mkQuery qryText p = mkQueryInternalFromSqlStatements (parseSql AcceptOnlyDollarNumberedArgs $ decodeUtf8 qryText) (rowEncoder.toPgParams p)+  where+    mkQueryInternalFromSqlStatements :: [BlockOrNotBlock] -> [EncodingContext -> (Maybe Oid, BinaryField)] -> Query+    mkQueryInternalFromSqlStatements blocks allParams =+      let paramsLen = length allParams+          qryTextForError = show $ mconcat $ map blockText blocks+          queryFrags =+            map+              ( \case+                  StaticSql t -> FragmentOfStaticSql $ encodeUtf8 t+                  SemiColon -> FragmentWithSemiColon+                  CommentsOrWhitespace t -> FragmentOfCommentsOrWhitespace $ encodeUtf8 t+                  DollarNumberedArg n ->+                    if n < 1+                      then+                        error $ "Dollar-numbered query argument placeholders must start from 1. Query: " ++ qryTextForError+                      else+                        if n > paramsLen+                          then+                            error $ "Query contains more dollar-numbered query arguments than actually supplied query arguments. Query: " ++ qryTextForError+                          else QueryArgumentPlaceHolder n+                  QuestionMarkArg ->+                    error $ "Bug in Hpgsql: parseSql AcceptOnlyDollarNumberedArgs returned question mark place holders. Query: " ++ qryTextForError+                  QuasiQuoterExpression _ _ ->+                    error $ "Bug in Hpgsql: parseSql AcceptOnlyDollarNumberedArgs returned quasiquoter expression. Query: " ++ qryTextForError+              )+              blocks+       in Query {queryString = queryFrags, queryParams = allParams, isPrepared = False}++-- | Takes in a query string with query arguments as question marks (NOT dollar-numbered arguments).+-- Example:+-- - "SELECT * FROM table WHERE col1=? AND col2=?"+-- You should really use `mkQuery` instead of this. This is here only for hpgsql-simple-compat.+mkQueryInternal :: ByteString -> [[Either ByteString (EncodingContext -> (Maybe Oid, BinaryField))]] -> Query+mkQueryInternal queryTemplate allParams =+  let statements = parseSql AcceptQuestionMarksAsQueryArgs (decodeUtf8 queryTemplate)+      paramsByIdx = Map.fromList $ zip [(1 :: Int) ..] allParams+      qryTextForError = mconcat $ map blockText statements+      (_, queryFrags) =+        List.mapAccumL+          ( \(!maxArgSoFar, !maxRealArgSoFar) sqlPiece -> case sqlPiece of+              StaticSql t -> ((maxArgSoFar, maxRealArgSoFar), [FragmentOfStaticSql $ encodeUtf8 t])+              SemiColon -> ((maxArgSoFar, maxRealArgSoFar), [FragmentWithSemiColon])+              CommentsOrWhitespace t -> ((maxArgSoFar, maxRealArgSoFar), [FragmentOfCommentsOrWhitespace $ encodeUtf8 t])+              DollarNumberedArg _ ->+                error $ "Bug in Hpgsql: parsed a DollarNumberedArg in mkQueryInternal. Query: " ++ show (queryTemplate, qryTextForError)+              QuasiQuoterExpression _ _ ->+                error $ "Bug in Hpgsql: parsed a QuasiQuoterExpression in mkQueryInternal. Query: " ++ show (queryTemplate, qryTextForError)+              QuestionMarkArg ->+                let thisParamNum = maxArgSoFar + 1+                 in case Map.lookup thisParamNum paramsByIdx of+                      Nothing -> error $ "Could not find query argument of number " <> show thisParamNum <> " for query with " <> show (length allParams) <> " arguments supplied. Did you supply an insufficient amount of query arguments? Query is " ++ show qryTextForError+                      Just args ->+                        let (newMaxRealArg, frags) =+                              List.mapAccumL+                                ( \(!newArgNum) arg -> case arg of+                                    Left fakeArg ->+                                      (newArgNum, FragmentOfStaticSql fakeArg)+                                    Right _properArg ->+                                      (newArgNum + 1, QueryArgumentPlaceHolder $ newArgNum + 1)+                                )+                                maxRealArgSoFar+                                args+                         in ((thisParamNum, newMaxRealArg), frags)+          )+          (0, 0)+          statements+   in Query {queryString = mconcat queryFrags, queryParams = concatMap rights allParams, isPrepared = False}++-- A practical quasiquoter for SQL. Interpolate Haskell values with @#{}@:+--+-- > let name = "Alice" :: Text+-- > rows <- query conn [sql|SELECT id, email FROM users WHERE name = #{name}|]+-- > print (rows :: [(Int, Text)])+--+-- Values interpolated with @#{}@ are sent as query parameters, so they are safe from SQL injection.+--+-- To embed a 'Query' fragment (e.g. a dynamic table name or a sub-query), use @^{}@:+--+-- > let tableName = escapeIdentifier "users"+-- > rows <- query conn [sql|SELECT * FROM ^{tableName}|]+sql :: QuasiQuoter+sql =+  QuasiQuoter+    { quoteExp = liftQuery False . parseSql AcceptQuasiQuoterExpressions . Text.pack,+      quotePat = error "Hpgsql's sql quasiquoter does not implement quotePat",+      quoteType = error "Hpgsql's sql quasiquoter does not implement quoteType",+      quoteDec = error "Hpgsql's sql quasiquoter does not implement quoteDec"+    }++-- | Just like the @sql@ quasiquoter, but every SQL statement inside is+-- a prepared statement.+sqlPrep :: QuasiQuoter+sqlPrep =+  QuasiQuoter+    { quoteExp = liftQuery True . parseSql AcceptQuasiQuoterExpressions . Text.pack,+      quotePat = error "Hpgsql's sql quasiquoter does not implement quotePat",+      quoteType = error "Hpgsql's sql quasiquoter does not implement quoteType",+      quoteDec = error "Hpgsql's sql quasiquoter does not implement quoteDec"+    }++liftQuery :: Bool -> [BlockOrNotBlock] -> Q Exp+liftQuery isPrepared (flattenBlocks -> stmt) = do+  let allFragments = concatMap parseBlockQuasiQuoter stmt+      hasEmbedded = any isEmbedded allFragments+  if hasEmbedded+    then liftQueryDynamic isPrepared allFragments+    else liftQueryStatic isPrepared allFragments+  where+    isEmbedded (EmbeddedQueryExpr _) = True+    isEmbedded _ = False++-- | Static path: no ^{} expressions, SQL string is a compile-time literal.+liftQueryStatic :: Bool -> [SqlFragment] -> Q Exp+liftQueryStatic isPrepared allFragments = do+  let (fragQExps, varNames) = buildQueryFragsAndVars allFragments 1+  fragExps <- sequence fragQExps+  paramExps <- mapM generateParamExp varNames+  [|Query $(pure $ ListE fragExps) $(pure $ ListE paramExps) isPrepared|]++-- | Dynamic path: has ^{} expressions, build query at runtime via buildQueryQQ.+liftQueryDynamic :: Bool -> [SqlFragment] -> Q Exp+liftQueryDynamic isPrepared allFragments = do+  partExps <- mapM fragmentToPartExp allFragments+  [|buildQueryQQ isPrepared $(pure $ ListE partExps)|]++-- | Convert a SqlFragment into a TH expression producing a QueryBuildPart.+fragmentToPartExp :: SqlFragment -> Q Exp+fragmentToPartExp (NonInterpolatedSqlFragment t) =+  [|StaticSqlPart $(litE (stringL (Text.unpack t)))|]+fragmentToPartExp (InterpolatedHaskellExpr haskellExpr) =+  case parseExp (Text.unpack haskellExpr) of+    Left err -> error $ "Could not parse Haskell expression '" ++ Text.unpack haskellExpr ++ "': " ++ err+    Right expr -> [|ParamPart (encodeParam $(pure expr))|]+fragmentToPartExp SemiColonFragment =+  [|SemiColonPart|]+fragmentToPartExp (WhitespaceOrCommentsFragment t) =+  [|WhitespaceOrCommenstPart $(litE (stringL (Text.unpack t)))|]+fragmentToPartExp (EmbeddedQueryExpr haskellExpr) =+  case parseExp (Text.unpack haskellExpr) of+    Left err -> error $ "Could not parse Haskell expression '" ++ Text.unpack haskellExpr ++ "': " ++ err+    Right expr -> [|EmbeddedQueryPart $(pure expr)|]++-- | Walk through fragments in order, building SingleQueryFragment TH expressions+-- and collecting the interpolated Haskell expressions.+buildQueryFragsAndVars :: [SqlFragment] -> Int -> ([Q Exp], [Text])+buildQueryFragsAndVars [] _ = ([], [])+buildQueryFragsAndVars (NonInterpolatedSqlFragment t : rest) n =+  let (restFrags, restVars) = buildQueryFragsAndVars rest n+   in ([|FragmentOfStaticSql (encodeUtf8 $(litE (stringL (Text.unpack t))))|] : restFrags, restVars)+buildQueryFragsAndVars (WhitespaceOrCommentsFragment t : rest) n =+  let (restFrags, restVars) = buildQueryFragsAndVars rest n+   in ([|FragmentOfCommentsOrWhitespace (encodeUtf8 $(litE (stringL (Text.unpack t))))|] : restFrags, restVars)+buildQueryFragsAndVars (InterpolatedHaskellExpr var : rest) n =+  let (restFrags, restVars) = buildQueryFragsAndVars rest (n + 1)+   in ([|QueryArgumentPlaceHolder $(litE (integerL (fromIntegral n)))|] : restFrags, var : restVars)+buildQueryFragsAndVars (SemiColonFragment : rest) n =+  let (restFrags, restVars) = buildQueryFragsAndVars rest n+   in ([|FragmentWithSemiColon|] : restFrags, restVars)+buildQueryFragsAndVars (EmbeddedQueryExpr _ : _) _ =+  error "Bug in Hpgsql: EmbeddedQueryExpr should not appear in static path"++-- | Parts used to build a SingleQuery at runtime when ^{} embedded queries are present.+data QueryBuildPartQQ+  = StaticSqlPart !ByteString+  | ParamPart !(EncodingContext -> (Maybe Oid, BinaryField))+  | EmbeddedQueryPart !Query+  | SemiColonPart+  | WhitespaceOrCommenstPart !ByteString++buildQueryQQ :: Bool -> [QueryBuildPartQQ] -> Query+buildQueryQQ isPrepared parts =+  let (queryFrags, allParams) = go parts 1+   in Query {queryString = queryFrags, queryParams = allParams, isPrepared}+  where+    go [] _ = ([], [])+    go (part : rest) argNum = case part of+      StaticSqlPart bs ->+        let (restFrags, restParams) = go rest argNum+         in (FragmentOfStaticSql bs : restFrags, restParams)+      WhitespaceOrCommenstPart bs ->+        let (restFrags, restParams) = go rest argNum+         in (FragmentOfCommentsOrWhitespace bs : restFrags, restParams)+      ParamPart p ->+        let (restFrags, restParams) = go rest (argNum + 1)+         in (QueryArgumentPlaceHolder argNum : restFrags, p : restParams)+      SemiColonPart ->+        let (restFrags, restParams) = go rest argNum+         in (FragmentWithSemiColon : restFrags, restParams)+      EmbeddedQueryPart q ->+        let (newMaxArgNum, renumberedFrags) = renumberParamsFrom q.queryString argNum+            (restFrags, restParams) = go rest (newMaxArgNum + 1)+         in (renumberedFrags ++ restFrags, q.queryParams ++ restParams)++parseBlockQuasiQuoter :: BlockOrNotBlock -> [SqlFragment]+parseBlockQuasiQuoter (StaticSql text) = [NonInterpolatedSqlFragment text]+parseBlockQuasiQuoter SemiColon = [SemiColonFragment]+parseBlockQuasiQuoter (CommentsOrWhitespace text) = [WhitespaceOrCommentsFragment text]+parseBlockQuasiQuoter (DollarNumberedArg n) = [NonInterpolatedSqlFragment $ "$" <> Text.pack (show n)] -- If someone uses e.g. $2 in a quasiquoter, it should be an error, but let's assume they know what they're doing and treat it as text+parseBlockQuasiQuoter QuestionMarkArg = [NonInterpolatedSqlFragment "?"] -- If someone uses a question mark in a quasiquoter, it should be an error, but let's assume they know what they're doing and treat it as text+parseBlockQuasiQuoter (QuasiQuoterExpression QQInterpolation expr) = [InterpolatedHaskellExpr expr]+parseBlockQuasiQuoter (QuasiQuoterExpression QQEmbeddedQuery expr) = [EmbeddedQueryExpr expr]++-- | Generate a parameter expression for a captured variable+generateParamExp :: Text -> Q Exp+generateParamExp (Text.unpack -> haskellExpr) =+  case parseExp haskellExpr of+    Left err -> error $ "Could not parse Haskell expression '" ++ haskellExpr ++ "': " ++ err+    Right expr ->+      [|encodeParam $(pure expr)|]++encodeParam :: (ToPgField a) => a -> EncodingContext -> (Maybe Oid, BinaryField)+encodeParam v =+  let fe = fieldEncoder+   in \encCtx -> (fe.toTypeOid encCtx, fe.toPgField encCtx v)
+ src/Hpgsql/SimpleParser.hs view
@@ -0,0 +1,106 @@+-- |+-- A minimal attoparsec-like parser that uses CPS to reduce allocations+-- and perform better than attoparsec, at least the way we use it in+-- hpgsql.+--+-- In benchmarks, this can improve performance by 12-15% materializing+-- query results.+module Hpgsql.SimpleParser+  ( Parser (..),+    ParseResult (..),+    parseOnly,+    take,+    endOfInput,+    match,+  )+where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Prelude hiding (take)++data ParseResult a+  = ParseFail !String+  | ParseOk !a+  deriving stock (Show)++-- | A parser that consumes a strict 'ByteString'.+newtype Parser a = Parser+  { unParser ::+      forall r.+      ByteString ->+      (String -> r) ->+      -- \^ failure continuation+      (a -> ByteString -> r) ->+      -- \^ success continuation+      r+  }++instance Functor Parser where+  fmap f (Parser p) = Parser $ \bs kf ks ->+    p bs kf (\a bs' -> ks (f a) bs')+  {-# INLINE fmap #-}++instance Applicative Parser where+  pure a = Parser $ \bs _ ks -> ks a bs+  {-# INLINE pure #-}++  Parser pf <*> Parser pa = Parser $ \bs kf ks ->+    pf bs kf (\f bs' -> pa bs' kf (\a bs'' -> ks (f a) bs''))+  {-# INLINE (<*>) #-}++instance Monad Parser where+  return = pure+  {-# INLINE return #-}++  Parser p >>= k = Parser $ \bs kf ks ->+    p bs kf (\a bs' -> unParser (k a) bs' kf ks)+  {-# INLINE (>>=) #-}++instance MonadFail Parser where+  fail msg = Parser $ \_ kf _ -> kf msg+  {-# INLINE fail #-}++-- | Run a parser and return either an error message or the parsed value,+-- using the strict 'ParseResult' type. Any unconsumed trailing input is+-- discarded.+parseOnly :: Parser a -> ByteString -> ParseResult a+parseOnly (Parser p) bs = p bs ParseFail (\a _ -> ParseOk a)+{-# INLINE parseOnly #-}++-- | Consume exactly @n@ bytes of input, failing if fewer than @n@ bytes+-- remain.+take :: Int -> Parser ByteString+take n = Parser $ \bs kf ks ->+  -- Special-casing n>0 helps reduce memory usage+  -- by ~1.5% in our benchmarks without a measurable+  -- difference in run time+  if n > 0+    then+      if BS.length bs >= n+        then case BS.splitAt n bs of+          (!h, !t) -> ks h t+        else kf ("take: wanted " <> show n <> " bytes but only " <> show (BS.length bs) <> " remain")+    else+      ks mempty bs+{-# INLINE take #-}++-- | Succeeds only when the input has been fully consumed.+endOfInput :: Parser ()+endOfInput = Parser $ \bs kf ks ->+  if BS.null bs then ks () bs else kf "endOfInput: input remaining"+{-# INLINE endOfInput #-}++-- | Run a parser and additionally return the slice of input it consumed.+-- Because the input is a strict 'ByteString', the returned slice is a view+-- over the original buffer and allocates no extra memory.+match :: Parser a -> Parser (ByteString, a)+match (Parser p) = Parser $ \bs kf ks ->+  p+    bs+    kf+    ( \a bs' ->+        let !consumed = BS.take (BS.length bs - BS.length bs') bs+         in ks (consumed, a) bs'+    )+{-# INLINE match #-}
+ src/Hpgsql/Time.hs view
@@ -0,0 +1,18 @@+module Hpgsql.Time+  ( Unbounded (..),+  )+where++-- | Use this type to represent -infinity and +infinity.+data Unbounded a+  = NegInfinity+  | Finite !a+  | PosInfinity+  deriving (Eq, Ord, Functor)++instance (Show a) => Show (Unbounded a) where+  show =+    \case+      NegInfinity -> "-infinity"+      Finite time -> show time+      PosInfinity -> "infinity"
+ src/Hpgsql/Transaction.hs view
@@ -0,0 +1,120 @@+module Hpgsql.Transaction (withTransaction, withTransactionMode, begin, beginMode, commit, rollback, transactionStatus, IsolationLevel (..), ReadWriteMode (..), TransactionStatus (..)) where++import qualified Control.Concurrent.STM as STM+import Control.Exception.Safe (Exception (..), bracketWithError, throw, tryAny)+import Control.Monad (unless)+import Hpgsql.Internal (execute_, fullTransactionStatus, transactionStatus)+import Hpgsql.InternalTypes (HPgConnection (..), InternalConnectionState (..), IrrecoverableHpgsqlError)+import Hpgsql.Query (Query)+import Hpgsql.TransactionStatusInternal (TransactionStatus (..))++-- The types and constructors here have matching names to postgresql-simple where+-- I thought sameness would be convenient. The implementation is of course our+-- own, and I did choose to keep some things different out of my preferences.++data IsolationLevel+  = DefaultIsolationLevel+  | ReadUncommitted+  | ReadCommitted+  | RepeatableRead+  | Serializable+  deriving (Show, Eq, Ord, Enum, Bounded)++data ReadWriteMode+  = DefaultReadWriteMode+  | ReadWrite+  | ReadOnly+  deriving (Show, Eq, Ord, Enum, Bounded)++begin :: HPgConnection -> IO ()+begin conn = beginMode conn DefaultIsolationLevel DefaultReadWriteMode++beginMode :: HPgConnection -> IsolationLevel -> ReadWriteMode -> IO ()+beginMode conn il rw = do+  let readWrite = case rw of+        ReadWrite -> Just "READ WRITE"+        ReadOnly -> Just "READ ONLY"+        DefaultReadWriteMode -> Nothing+      isolLvl = case il of+        DefaultIsolationLevel -> Nothing+        Serializable -> Just "ISOLATION LEVEL SERIALIZABLE"+        RepeatableRead -> Just "ISOLATION LEVEL REPEATABLE READ"+        ReadCommitted -> Just "ISOLATION LEVEL READ COMMITTED"+        ReadUncommitted -> Just "ISOLATION LEVEL READ UNCOMMITTED"+  execute_ conn $ "BEGIN " <> withComma readWrite isolLvl+  where+    withComma :: Maybe Query -> Maybe Query -> Query+    withComma mv1 mv2 = case (mv1, mv2) of+      (Just v1, Just v2) -> v1 <> "," <> v2+      (Just v1, Nothing) -> v1+      (Nothing, Just v2) -> v2+      (Nothing, Nothing) -> ""++commit :: HPgConnection -> IO ()+commit conn = execute_ conn "COMMIT"++rollback :: HPgConnection -> IO ()+rollback conn = execute_ conn "ROLLBACK"++-- | Runs the supplied function inside a transaction with the database's+-- default isolation level and read-write mode, i.e. `BEGIN`s a transaction,+-- runs the supplied function and then `COMMIT`s if there are no exceptions.+-- In case the supplied function throws an exception, this runs `ROLLBACK`.+-- In case an asynchronous exception is thrown, Hpgsql ensures a `ROLLBACK`+-- will be issued before your next query on the same connection.+withTransaction :: HPgConnection -> IO a -> IO a+withTransaction conn = withTransactionMode conn DefaultIsolationLevel DefaultReadWriteMode++-- | Runs the supplied function inside a transaction with the supplied+-- isolation level and read-write mode, i.e. `BEGIN`s a transaction,+-- runs the supplied function and then `COMMIT`s if there are no exceptions.+-- In case the supplied function throws an exception, this runs `ROLLBACK`.+-- In case an asynchronous exception is thrown, Hpgsql ensures a `ROLLBACK`+-- will be issued before your next query on this connection.+withTransactionMode :: HPgConnection -> IsolationLevel -> ReadWriteMode -> IO a -> IO a+withTransactionMode conn il rw f = bracketWithError (beginMode conn il rw) cleanup $ \() -> do+  res <- tryAny f+  case res of+    Left ex -> case fromException ex of+      Just (_ :: IrrecoverableHpgsqlError) -> throw ex -- Rethrow internal errors+      Nothing -> do+        -- In case of a synchronous exception, we rollback synchronously.+        -- If this is interrupted:+        -- - Before ROLLBACK is sent, `cleanup` will enqueue a "ROLLBACK".+        -- - After ROLLBACK is sent but before it finishes, a ROLLBACK will still be enqueued+        --   (check `cleanup`), which means:+        --      - If ROLLBACK has already completed by the time the new ROLLBACK is meant to be sent,+        --        the new ROLLBACK will produce a "WARNING: there is no transaction in progress". This+        --        isn't great, but is mostly harmless.+        --      - If ROLLBACK is cancelled by the future ROLLBACK, all is good as well.+        -- - After ROLLBACK is sent and completed, `cleanup` won't enqueue a new ROLLBACK, and all is well.+        --+        -- We rollback here, not in `cleanup`, because that runs with async exceptions masked+        rollback conn >> throw ex -- Reminder that this can be interrupted before/after "rollback" is sent+    Right v -> do+      -- If this is interrupted:+      -- - Before COMMIT is sent, it's equivalent to failing in the middle of the user-supplied action+      -- - After COMMIT is sent but before it's finished, a ROLLBACK will still be enqueued+      --   (check `cleanup`), which means:+      --      - If COMMIT has already completed by the time ROLLBACK is meant to be sent, ROLLBACK will+      --        produce a "WARNING: there is no transaction in progress". This isn't great, but+      --        is mostly harmless.+      --      - If COMMIT is cancelled by the future ROLLBACK, all is good as well.+      -- - After COMMIT is sent and completed, this is just interruption right after a successful+      --   operation, and `cleanup` won't enqueue a ROLLBACK.+      commit conn+      pure v+  where+    cleanup mEx () = case mEx of+      Nothing -> pure ()+      Just (fromException -> (Just (_ :: IrrecoverableHpgsqlError))) -> pure () -- Do nothing if an internal error was thrown, just let it propagate+      Just _ex -> do+        -- print _ex+        -- Mark ROLLBACK to be sent before next command+        STM.atomically $ do+          (_, txnStatus) <- fullTransactionStatus conn.internalConnectionState+          -- The rollback in case of a synchronous exception may have run, so we+          -- don't need another one in that case.+          unless (txnStatus == TransIdle) $ do+            st <- STM.readTVar conn.internalConnectionState+            STM.writeTVar conn.internalConnectionState st {mustIssueRollbackBeforeNextCommand = True}
+ src/Hpgsql/TransactionStatusInternal.hs view
@@ -0,0 +1,11 @@+module Hpgsql.TransactionStatusInternal (TransactionStatus (..)) where++data TransactionStatus+  = -- | A command is in progress+    TransActive+  | -- | Not inside a transaction+    TransIdle+  | -- | Inside a transaction, but no command running+    TransInTrans+  | TransInError+  deriving stock (Eq, Show)
+ src/Hpgsql/TypeInfo.hs view
@@ -0,0 +1,2610 @@+-- |+-- This file has is very similar to a similarly named file from the great postgresql-simple library, more specifically+-- to https://hackage.haskell.org/package/postgresql-simple-0.7.0.0/docs/src/Database.PostgreSQL.Simple.TypeInfo.Static.html+-- We started with that and later came up with our own from scratch, though.+-- We thank them for their great work.+module Hpgsql.TypeInfo+  ( EncodingContext (..),+    Oid (..),+    TypeInfo (..),+    TypeDetails (..),+    ArrayTypeDetails (..),+    builtinPgTypesMap,+    buildTypeInfoCache,+    lookupTypeByName,+    lookupTypeByOid,+    boolOid,+    byteaOid,+    charOid,+    nameOid,+    int8Oid,+    int2Oid,+    int4Oid,+    regprocOid,+    textOid,+    oidOid,+    tidOid,+    xidOid,+    cidOid,+    xmlOid,+    pointOid,+    lsegOid,+    pathOid,+    boxOid,+    polygonOid,+    lineOid,+    cidrOid,+    float4Oid,+    float8Oid,+    unknownOid,+    circleOid,+    moneyOid,+    macaddrOid,+    inetOid,+    bpcharOid,+    varcharOid,+    dateOid,+    timeOid,+    timestampOid,+    timestamptzOid,+    intervalOid,+    timetzOid,+    bitOid,+    varbitOid,+    numericOid,+    refcursorOid,+    recordOid,+    voidOid,+    regprocedureOid,+    regoperOid,+    regoperatorOid,+    regclassOid,+    regtypeOid,+    uuidOid,+    jsonOid,+    jsonbOid,+    int2vectorOid,+    oidvectorOid,+    int4rangeOid,+    _int4rangeOid,+    numrangeOid,+    _numrangeOid,+    tsrangeOid,+    _tsrangeOid,+    tstzrangeOid,+    _tstzrangeOid,+    daterangeOid,+    _daterangeOid,+    int8rangeOid,+    _int8rangeOid,+    _boolOid,+    _byteaOid,+    _charOid,+    _nameOid,+    _int2Oid,+    _int4Oid,+    _int8Oid,+    _textOid,+    _oidOid,+    _float4Oid,+    _float8Oid,+    _numericOid,+    _dateOid,+    _timestamptzOid,+    _intervalOid,+    _jsonOid,+    _jsonbOid,+    _varcharOid,+  )+where++import Data.Int (Int32)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)++newtype Oid = Oid Int32+  deriving stock (Show)+  deriving newtype (Eq, Real, Num, Ord, Integral, Enum)++data TypeInfo = TypeInfo+  { typeOid :: !Oid,+    typeName :: !Text,+    -- | Only a Nothing if this 'TypeInfo' already represents an array type, otherwise+    -- the Oid of the Array type with elements of this 'TypeInfo'.+    oidOfArrayType :: !(Maybe Oid),+    typeDetails :: !TypeDetails+  }++newtype ArrayTypeDetails = ArrayTypeDetails+  { elemTypeOid :: Oid+  }++data TypeDetails = BasicType | ArrayType !ArrayTypeDetails | CompositeType | DomainType | EnumType | PseudoType | RangeType | MultiRangeType++data TypeInfoCache = TypeInfoCache !(Map Oid TypeInfo) !(Map Text TypeInfo)++instance Semigroup TypeInfoCache where+  TypeInfoCache ma1 ma2 <> TypeInfoCache mb1 mb2 = TypeInfoCache (ma1 <> mb1) (ma2 <> mb2)++lookupTypeByOid :: Oid -> TypeInfoCache -> Maybe TypeInfo+lookupTypeByOid oid (TypeInfoCache m _) = Map.lookup oid m++lookupTypeByName :: Text -> TypeInfoCache -> Maybe TypeInfo+lookupTypeByName n (TypeInfoCache _ m) = Map.lookup n m++buildTypeInfoCache :: [TypeInfo] -> TypeInfoCache+buildTypeInfoCache ts = TypeInfoCache tsByOid tsByName+  where+    tsByOid = Map.fromList $ map (\ti -> (ti.typeOid, ti)) ts+    tsByName = Map.fromList $ map (\ti -> (ti.typeName, ti)) ts++newtype EncodingContext = EncodingContext+  { -- | A map with all builtin PostgreSQL types plus+    -- user-defined types, unless you specify custom connection options.+    typeInfoCache :: TypeInfoCache+  }++-- The query to get all the code you find in this file starting from here is:+-- 1. psql -X -t -d postgres -c "select typname || E'Oid :: Oid\n' || typname || 'Oid = Oid ' || oid from pg_catalog.pg_type order by oid" | sed 's|\+||g'+--    for the many type bindings at the very bottom of the file+-- 2. psql -X -t -d postgres -c "select 'TypeInfo ' || typname || 'Oid ' || '\"' || typname || '\" ' || case WHEN typarray=0 THEN 'Nothing' else '(Just ' || typarray || ')' end || ' ' || case WHEN typcategory='A' THEN '(ArrayType (ArrayTypeDetails ' || typelem || '))' WHEN typtype='c' THEN 'CompositeType' WHEN typtype='d' THEN 'DomainType' WHEN typtype='e' THEN 'EnumType' WHEN typtype='p' THEN 'PseudoType' WHEN typtype='r' THEN 'RangeType' WHEN typtype='m' THEN 'MultiRangeType' else 'BasicType' end || ',' from pg_catalog.pg_type order by oid"+--    for the Map++-- | This contains every type that is builtin to PostgreSQL+-- alongside some info about them.+-- User defined types are not available here, but are accessible+-- in @EncodingContext@ in many places where it might be useful.+builtinPgTypesMap :: TypeInfoCache+builtinPgTypesMap =+  buildTypeInfoCache+    [ TypeInfo boolOid "bool" (Just 1000) BasicType,+      TypeInfo byteaOid "bytea" (Just 1001) BasicType,+      TypeInfo charOid "char" (Just 1002) BasicType,+      TypeInfo nameOid "name" (Just 1003) BasicType,+      TypeInfo int8Oid "int8" (Just 1016) BasicType,+      TypeInfo int2Oid "int2" (Just 1005) BasicType,+      TypeInfo int2vectorOid "int2vector" (Just 1006) (ArrayType (ArrayTypeDetails 21)),+      TypeInfo int4Oid "int4" (Just 1007) BasicType,+      TypeInfo regprocOid "regproc" (Just 1008) BasicType,+      TypeInfo textOid "text" (Just 1009) BasicType,+      TypeInfo oidOid "oid" (Just 1028) BasicType,+      TypeInfo tidOid "tid" (Just 1010) BasicType,+      TypeInfo xidOid "xid" (Just 1011) BasicType,+      TypeInfo cidOid "cid" (Just 1012) BasicType,+      TypeInfo oidvectorOid "oidvector" (Just 1013) (ArrayType (ArrayTypeDetails 26)),+      TypeInfo pg_ddl_commandOid "pg_ddl_command" Nothing PseudoType,+      TypeInfo pg_typeOid "pg_type" (Just 210) CompositeType,+      TypeInfo pg_attributeOid "pg_attribute" (Just 270) CompositeType,+      TypeInfo pg_procOid "pg_proc" (Just 272) CompositeType,+      TypeInfo pg_classOid "pg_class" (Just 273) CompositeType,+      TypeInfo jsonOid "json" (Just 199) BasicType,+      TypeInfo xmlOid "xml" (Just 143) BasicType,+      TypeInfo _xmlOid "_xml" Nothing (ArrayType (ArrayTypeDetails 142)),+      TypeInfo pg_node_treeOid "pg_node_tree" Nothing BasicType,+      TypeInfo _jsonOid "_json" Nothing (ArrayType (ArrayTypeDetails 114)),+      TypeInfo _pg_typeOid "_pg_type" Nothing (ArrayType (ArrayTypeDetails 71)),+      TypeInfo table_am_handlerOid "table_am_handler" Nothing PseudoType,+      TypeInfo _pg_attributeOid "_pg_attribute" Nothing (ArrayType (ArrayTypeDetails 75)),+      TypeInfo _xid8Oid "_xid8" Nothing (ArrayType (ArrayTypeDetails 5069)),+      TypeInfo _pg_procOid "_pg_proc" Nothing (ArrayType (ArrayTypeDetails 81)),+      TypeInfo _pg_classOid "_pg_class" Nothing (ArrayType (ArrayTypeDetails 83)),+      TypeInfo index_am_handlerOid "index_am_handler" Nothing PseudoType,+      TypeInfo pointOid "point" (Just 1017) BasicType,+      TypeInfo lsegOid "lseg" (Just 1018) BasicType,+      TypeInfo pathOid "path" (Just 1019) BasicType,+      TypeInfo boxOid "box" (Just 1020) BasicType,+      TypeInfo polygonOid "polygon" (Just 1027) BasicType,+      TypeInfo lineOid "line" (Just 629) BasicType,+      TypeInfo _lineOid "_line" Nothing (ArrayType (ArrayTypeDetails 628)),+      TypeInfo cidrOid "cidr" (Just 651) BasicType,+      TypeInfo _cidrOid "_cidr" Nothing (ArrayType (ArrayTypeDetails 650)),+      TypeInfo float4Oid "float4" (Just 1021) BasicType,+      TypeInfo float8Oid "float8" (Just 1022) BasicType,+      TypeInfo unknownOid "unknown" Nothing PseudoType,+      TypeInfo circleOid "circle" (Just 719) BasicType,+      TypeInfo _circleOid "_circle" Nothing (ArrayType (ArrayTypeDetails 718)),+      TypeInfo macaddr8Oid "macaddr8" (Just 775) BasicType,+      TypeInfo _macaddr8Oid "_macaddr8" Nothing (ArrayType (ArrayTypeDetails 774)),+      TypeInfo moneyOid "money" (Just 791) BasicType,+      TypeInfo _moneyOid "_money" Nothing (ArrayType (ArrayTypeDetails 790)),+      TypeInfo macaddrOid "macaddr" (Just 1040) BasicType,+      TypeInfo inetOid "inet" (Just 1041) BasicType,+      TypeInfo _boolOid "_bool" Nothing (ArrayType (ArrayTypeDetails 16)),+      TypeInfo _byteaOid "_bytea" Nothing (ArrayType (ArrayTypeDetails 17)),+      TypeInfo _charOid "_char" Nothing (ArrayType (ArrayTypeDetails 18)),+      TypeInfo _nameOid "_name" Nothing (ArrayType (ArrayTypeDetails 19)),+      TypeInfo _int2Oid "_int2" Nothing (ArrayType (ArrayTypeDetails 21)),+      TypeInfo _int2vectorOid "_int2vector" Nothing (ArrayType (ArrayTypeDetails 22)),+      TypeInfo _int4Oid "_int4" Nothing (ArrayType (ArrayTypeDetails 23)),+      TypeInfo _regprocOid "_regproc" Nothing (ArrayType (ArrayTypeDetails 24)),+      TypeInfo _textOid "_text" Nothing (ArrayType (ArrayTypeDetails 25)),+      TypeInfo _tidOid "_tid" Nothing (ArrayType (ArrayTypeDetails 27)),+      TypeInfo _xidOid "_xid" Nothing (ArrayType (ArrayTypeDetails 28)),+      TypeInfo _cidOid "_cid" Nothing (ArrayType (ArrayTypeDetails 29)),+      TypeInfo _oidvectorOid "_oidvector" Nothing (ArrayType (ArrayTypeDetails 30)),+      TypeInfo _bpcharOid "_bpchar" Nothing (ArrayType (ArrayTypeDetails 1042)),+      TypeInfo _varcharOid "_varchar" Nothing (ArrayType (ArrayTypeDetails 1043)),+      TypeInfo _int8Oid "_int8" Nothing (ArrayType (ArrayTypeDetails 20)),+      TypeInfo _pointOid "_point" Nothing (ArrayType (ArrayTypeDetails 600)),+      TypeInfo _lsegOid "_lseg" Nothing (ArrayType (ArrayTypeDetails 601)),+      TypeInfo _pathOid "_path" Nothing (ArrayType (ArrayTypeDetails 602)),+      TypeInfo _boxOid "_box" Nothing (ArrayType (ArrayTypeDetails 603)),+      TypeInfo _float4Oid "_float4" Nothing (ArrayType (ArrayTypeDetails 700)),+      TypeInfo _float8Oid "_float8" Nothing (ArrayType (ArrayTypeDetails 701)),+      TypeInfo _polygonOid "_polygon" Nothing (ArrayType (ArrayTypeDetails 604)),+      TypeInfo _oidOid "_oid" Nothing (ArrayType (ArrayTypeDetails 26)),+      TypeInfo aclitemOid "aclitem" (Just 1034) BasicType,+      TypeInfo _aclitemOid "_aclitem" Nothing (ArrayType (ArrayTypeDetails 1033)),+      TypeInfo _macaddrOid "_macaddr" Nothing (ArrayType (ArrayTypeDetails 829)),+      TypeInfo _inetOid "_inet" Nothing (ArrayType (ArrayTypeDetails 869)),+      TypeInfo bpcharOid "bpchar" (Just 1014) BasicType,+      TypeInfo varcharOid "varchar" (Just 1015) BasicType,+      TypeInfo dateOid "date" (Just 1182) BasicType,+      TypeInfo timeOid "time" (Just 1183) BasicType,+      TypeInfo timestampOid "timestamp" (Just 1115) BasicType,+      TypeInfo _timestampOid "_timestamp" Nothing (ArrayType (ArrayTypeDetails 1114)),+      TypeInfo _dateOid "_date" Nothing (ArrayType (ArrayTypeDetails 1082)),+      TypeInfo _timeOid "_time" Nothing (ArrayType (ArrayTypeDetails 1083)),+      TypeInfo timestamptzOid "timestamptz" (Just 1185) BasicType,+      TypeInfo _timestamptzOid "_timestamptz" Nothing (ArrayType (ArrayTypeDetails 1184)),+      TypeInfo intervalOid "interval" (Just 1187) BasicType,+      TypeInfo _intervalOid "_interval" Nothing (ArrayType (ArrayTypeDetails 1186)),+      TypeInfo _numericOid "_numeric" Nothing (ArrayType (ArrayTypeDetails 1700)),+      TypeInfo pg_databaseOid "pg_database" (Just 10052) CompositeType,+      TypeInfo _cstringOid "_cstring" Nothing (ArrayType (ArrayTypeDetails 2275)),+      TypeInfo timetzOid "timetz" (Just 1270) BasicType,+      TypeInfo _timetzOid "_timetz" Nothing (ArrayType (ArrayTypeDetails 1266)),+      TypeInfo bitOid "bit" (Just 1561) BasicType,+      TypeInfo _bitOid "_bit" Nothing (ArrayType (ArrayTypeDetails 1560)),+      TypeInfo varbitOid "varbit" (Just 1563) BasicType,+      TypeInfo _varbitOid "_varbit" Nothing (ArrayType (ArrayTypeDetails 1562)),+      TypeInfo numericOid "numeric" (Just 1231) BasicType,+      TypeInfo refcursorOid "refcursor" (Just 2201) BasicType,+      TypeInfo _refcursorOid "_refcursor" Nothing (ArrayType (ArrayTypeDetails 1790)),+      TypeInfo regprocedureOid "regprocedure" (Just 2207) BasicType,+      TypeInfo regoperOid "regoper" (Just 2208) BasicType,+      TypeInfo regoperatorOid "regoperator" (Just 2209) BasicType,+      TypeInfo regclassOid "regclass" (Just 2210) BasicType,+      TypeInfo regtypeOid "regtype" (Just 2211) BasicType,+      TypeInfo _regprocedureOid "_regprocedure" Nothing (ArrayType (ArrayTypeDetails 2202)),+      TypeInfo _regoperOid "_regoper" Nothing (ArrayType (ArrayTypeDetails 2203)),+      TypeInfo _regoperatorOid "_regoperator" Nothing (ArrayType (ArrayTypeDetails 2204)),+      TypeInfo _regclassOid "_regclass" Nothing (ArrayType (ArrayTypeDetails 2205)),+      TypeInfo _regtypeOid "_regtype" Nothing (ArrayType (ArrayTypeDetails 2206)),+      TypeInfo recordOid "record" (Just 2287) PseudoType,+      TypeInfo cstringOid "cstring" (Just 1263) PseudoType,+      TypeInfo anyOid "any" Nothing PseudoType,+      TypeInfo anyarrayOid "anyarray" Nothing PseudoType,+      TypeInfo voidOid "void" Nothing PseudoType,+      TypeInfo triggerOid "trigger" Nothing PseudoType,+      TypeInfo language_handlerOid "language_handler" Nothing PseudoType,+      TypeInfo internalOid "internal" Nothing PseudoType,+      TypeInfo anyelementOid "anyelement" Nothing PseudoType,+      TypeInfo _recordOid "_record" Nothing PseudoType,+      TypeInfo anynonarrayOid "anynonarray" Nothing PseudoType,+      TypeInfo pg_authidOid "pg_authid" (Just 10057) CompositeType,+      TypeInfo pg_auth_membersOid "pg_auth_members" (Just 10058) CompositeType,+      TypeInfo _txid_snapshotOid "_txid_snapshot" Nothing (ArrayType (ArrayTypeDetails 2970)),+      TypeInfo uuidOid "uuid" (Just 2951) BasicType,+      TypeInfo _uuidOid "_uuid" Nothing (ArrayType (ArrayTypeDetails 2950)),+      TypeInfo txid_snapshotOid "txid_snapshot" (Just 2949) BasicType,+      TypeInfo fdw_handlerOid "fdw_handler" Nothing PseudoType,+      TypeInfo pg_lsnOid "pg_lsn" (Just 3221) BasicType,+      TypeInfo _pg_lsnOid "_pg_lsn" Nothing (ArrayType (ArrayTypeDetails 3220)),+      TypeInfo tsm_handlerOid "tsm_handler" Nothing PseudoType,+      TypeInfo pg_ndistinctOid "pg_ndistinct" Nothing BasicType,+      TypeInfo pg_dependenciesOid "pg_dependencies" Nothing BasicType,+      TypeInfo anyenumOid "anyenum" Nothing PseudoType,+      TypeInfo tsvectorOid "tsvector" (Just 3643) BasicType,+      TypeInfo tsqueryOid "tsquery" (Just 3645) BasicType,+      TypeInfo gtsvectorOid "gtsvector" (Just 3644) BasicType,+      TypeInfo _tsvectorOid "_tsvector" Nothing (ArrayType (ArrayTypeDetails 3614)),+      TypeInfo _gtsvectorOid "_gtsvector" Nothing (ArrayType (ArrayTypeDetails 3642)),+      TypeInfo _tsqueryOid "_tsquery" Nothing (ArrayType (ArrayTypeDetails 3615)),+      TypeInfo regconfigOid "regconfig" (Just 3735) BasicType,+      TypeInfo _regconfigOid "_regconfig" Nothing (ArrayType (ArrayTypeDetails 3734)),+      TypeInfo regdictionaryOid "regdictionary" (Just 3770) BasicType,+      TypeInfo _regdictionaryOid "_regdictionary" Nothing (ArrayType (ArrayTypeDetails 3769)),+      TypeInfo jsonbOid "jsonb" (Just 3807) BasicType,+      TypeInfo _jsonbOid "_jsonb" Nothing (ArrayType (ArrayTypeDetails 3802)),+      TypeInfo anyrangeOid "anyrange" Nothing PseudoType,+      TypeInfo event_triggerOid "event_trigger" Nothing PseudoType,+      TypeInfo int4rangeOid "int4range" (Just 3905) RangeType,+      TypeInfo _int4rangeOid "_int4range" Nothing (ArrayType (ArrayTypeDetails 3904)),+      TypeInfo numrangeOid "numrange" (Just 3907) RangeType,+      TypeInfo _numrangeOid "_numrange" Nothing (ArrayType (ArrayTypeDetails 3906)),+      TypeInfo tsrangeOid "tsrange" (Just 3909) RangeType,+      TypeInfo _tsrangeOid "_tsrange" Nothing (ArrayType (ArrayTypeDetails 3908)),+      TypeInfo tstzrangeOid "tstzrange" (Just 3911) RangeType,+      TypeInfo _tstzrangeOid "_tstzrange" Nothing (ArrayType (ArrayTypeDetails 3910)),+      TypeInfo daterangeOid "daterange" (Just 3913) RangeType,+      TypeInfo _daterangeOid "_daterange" Nothing (ArrayType (ArrayTypeDetails 3912)),+      TypeInfo int8rangeOid "int8range" (Just 3927) RangeType,+      TypeInfo _int8rangeOid "_int8range" Nothing (ArrayType (ArrayTypeDetails 3926)),+      TypeInfo pg_shseclabelOid "pg_shseclabel" (Just 10093) CompositeType,+      TypeInfo jsonpathOid "jsonpath" (Just 4073) BasicType,+      TypeInfo _jsonpathOid "_jsonpath" Nothing (ArrayType (ArrayTypeDetails 4072)),+      TypeInfo regnamespaceOid "regnamespace" (Just 4090) BasicType,+      TypeInfo _regnamespaceOid "_regnamespace" Nothing (ArrayType (ArrayTypeDetails 4089)),+      TypeInfo regroleOid "regrole" (Just 4097) BasicType,+      TypeInfo _regroleOid "_regrole" Nothing (ArrayType (ArrayTypeDetails 4096)),+      TypeInfo regcollationOid "regcollation" (Just 4192) BasicType,+      TypeInfo _regcollationOid "_regcollation" Nothing (ArrayType (ArrayTypeDetails 4191)),+      TypeInfo int4multirangeOid "int4multirange" (Just 6150) MultiRangeType,+      TypeInfo nummultirangeOid "nummultirange" (Just 6151) MultiRangeType,+      TypeInfo tsmultirangeOid "tsmultirange" (Just 6152) MultiRangeType,+      TypeInfo tstzmultirangeOid "tstzmultirange" (Just 6153) MultiRangeType,+      TypeInfo datemultirangeOid "datemultirange" (Just 6155) MultiRangeType,+      TypeInfo int8multirangeOid "int8multirange" (Just 6157) MultiRangeType,+      TypeInfo anymultirangeOid "anymultirange" Nothing PseudoType,+      TypeInfo anycompatiblemultirangeOid "anycompatiblemultirange" Nothing PseudoType,+      TypeInfo pg_brin_bloom_summaryOid "pg_brin_bloom_summary" Nothing BasicType,+      TypeInfo pg_brin_minmax_multi_summaryOid "pg_brin_minmax_multi_summary" Nothing BasicType,+      TypeInfo pg_mcv_listOid "pg_mcv_list" Nothing BasicType,+      TypeInfo pg_snapshotOid "pg_snapshot" (Just 5039) BasicType,+      TypeInfo _pg_snapshotOid "_pg_snapshot" Nothing (ArrayType (ArrayTypeDetails 5038)),+      TypeInfo xid8Oid "xid8" (Just 271) BasicType,+      TypeInfo anycompatibleOid "anycompatible" Nothing PseudoType,+      TypeInfo anycompatiblearrayOid "anycompatiblearray" Nothing PseudoType,+      TypeInfo anycompatiblenonarrayOid "anycompatiblenonarray" Nothing PseudoType,+      TypeInfo anycompatiblerangeOid "anycompatiblerange" Nothing PseudoType,+      TypeInfo pg_subscriptionOid "pg_subscription" (Just 10112) CompositeType,+      TypeInfo _int4multirangeOid "_int4multirange" Nothing (ArrayType (ArrayTypeDetails 4451)),+      TypeInfo _nummultirangeOid "_nummultirange" Nothing (ArrayType (ArrayTypeDetails 4532)),+      TypeInfo _tsmultirangeOid "_tsmultirange" Nothing (ArrayType (ArrayTypeDetails 4533)),+      TypeInfo _tstzmultirangeOid "_tstzmultirange" Nothing (ArrayType (ArrayTypeDetails 4534)),+      TypeInfo _datemultirangeOid "_datemultirange" Nothing (ArrayType (ArrayTypeDetails 4535)),+      TypeInfo _int8multirangeOid "_int8multirange" Nothing (ArrayType (ArrayTypeDetails 4536)),+      TypeInfo _pg_attrdefOid "_pg_attrdef" Nothing (ArrayType (ArrayTypeDetails 10001)),+      TypeInfo pg_attrdefOid "pg_attrdef" (Just 10000) CompositeType,+      TypeInfo _pg_constraintOid "_pg_constraint" Nothing (ArrayType (ArrayTypeDetails 10003)),+      TypeInfo pg_constraintOid "pg_constraint" (Just 10002) CompositeType,+      TypeInfo _pg_inheritsOid "_pg_inherits" Nothing (ArrayType (ArrayTypeDetails 10005)),+      TypeInfo pg_inheritsOid "pg_inherits" (Just 10004) CompositeType,+      TypeInfo _pg_indexOid "_pg_index" Nothing (ArrayType (ArrayTypeDetails 10007)),+      TypeInfo pg_indexOid "pg_index" (Just 10006) CompositeType,+      TypeInfo _pg_operatorOid "_pg_operator" Nothing (ArrayType (ArrayTypeDetails 10009)),+      TypeInfo pg_operatorOid "pg_operator" (Just 10008) CompositeType,+      TypeInfo _pg_opfamilyOid "_pg_opfamily" Nothing (ArrayType (ArrayTypeDetails 10011)),+      TypeInfo pg_opfamilyOid "pg_opfamily" (Just 10010) CompositeType,+      TypeInfo _pg_opclassOid "_pg_opclass" Nothing (ArrayType (ArrayTypeDetails 10013)),+      TypeInfo pg_opclassOid "pg_opclass" (Just 10012) CompositeType,+      TypeInfo _pg_amOid "_pg_am" Nothing (ArrayType (ArrayTypeDetails 10015)),+      TypeInfo pg_amOid "pg_am" (Just 10014) CompositeType,+      TypeInfo _pg_amopOid "_pg_amop" Nothing (ArrayType (ArrayTypeDetails 10017)),+      TypeInfo pg_amopOid "pg_amop" (Just 10016) CompositeType,+      TypeInfo _pg_amprocOid "_pg_amproc" Nothing (ArrayType (ArrayTypeDetails 10019)),+      TypeInfo pg_amprocOid "pg_amproc" (Just 10018) CompositeType,+      TypeInfo _pg_languageOid "_pg_language" Nothing (ArrayType (ArrayTypeDetails 10021)),+      TypeInfo pg_languageOid "pg_language" (Just 10020) CompositeType,+      TypeInfo _pg_largeobject_metadataOid "_pg_largeobject_metadata" Nothing (ArrayType (ArrayTypeDetails 10023)),+      TypeInfo pg_largeobject_metadataOid "pg_largeobject_metadata" (Just 10022) CompositeType,+      TypeInfo _pg_largeobjectOid "_pg_largeobject" Nothing (ArrayType (ArrayTypeDetails 10025)),+      TypeInfo pg_largeobjectOid "pg_largeobject" (Just 10024) CompositeType,+      TypeInfo _pg_aggregateOid "_pg_aggregate" Nothing (ArrayType (ArrayTypeDetails 10027)),+      TypeInfo pg_aggregateOid "pg_aggregate" (Just 10026) CompositeType,+      TypeInfo _pg_statisticOid "_pg_statistic" Nothing (ArrayType (ArrayTypeDetails 10029)),+      TypeInfo pg_statisticOid "pg_statistic" (Just 10028) CompositeType,+      TypeInfo _pg_statistic_extOid "_pg_statistic_ext" Nothing (ArrayType (ArrayTypeDetails 10031)),+      TypeInfo pg_statistic_extOid "pg_statistic_ext" (Just 10030) CompositeType,+      TypeInfo _pg_statistic_ext_dataOid "_pg_statistic_ext_data" Nothing (ArrayType (ArrayTypeDetails 10033)),+      TypeInfo pg_statistic_ext_dataOid "pg_statistic_ext_data" (Just 10032) CompositeType,+      TypeInfo _pg_rewriteOid "_pg_rewrite" Nothing (ArrayType (ArrayTypeDetails 10035)),+      TypeInfo pg_rewriteOid "pg_rewrite" (Just 10034) CompositeType,+      TypeInfo _pg_triggerOid "_pg_trigger" Nothing (ArrayType (ArrayTypeDetails 10037)),+      TypeInfo pg_triggerOid "pg_trigger" (Just 10036) CompositeType,+      TypeInfo _pg_event_triggerOid "_pg_event_trigger" Nothing (ArrayType (ArrayTypeDetails 10039)),+      TypeInfo pg_event_triggerOid "pg_event_trigger" (Just 10038) CompositeType,+      TypeInfo _pg_descriptionOid "_pg_description" Nothing (ArrayType (ArrayTypeDetails 10041)),+      TypeInfo pg_descriptionOid "pg_description" (Just 10040) CompositeType,+      TypeInfo _pg_castOid "_pg_cast" Nothing (ArrayType (ArrayTypeDetails 10043)),+      TypeInfo pg_castOid "pg_cast" (Just 10042) CompositeType,+      TypeInfo _pg_enumOid "_pg_enum" Nothing (ArrayType (ArrayTypeDetails 10045)),+      TypeInfo pg_enumOid "pg_enum" (Just 10044) CompositeType,+      TypeInfo _pg_namespaceOid "_pg_namespace" Nothing (ArrayType (ArrayTypeDetails 10047)),+      TypeInfo pg_namespaceOid "pg_namespace" (Just 10046) CompositeType,+      TypeInfo _pg_conversionOid "_pg_conversion" Nothing (ArrayType (ArrayTypeDetails 10049)),+      TypeInfo pg_conversionOid "pg_conversion" (Just 10048) CompositeType,+      TypeInfo _pg_dependOid "_pg_depend" Nothing (ArrayType (ArrayTypeDetails 10051)),+      TypeInfo pg_dependOid "pg_depend" (Just 10050) CompositeType,+      TypeInfo _pg_databaseOid "_pg_database" Nothing (ArrayType (ArrayTypeDetails 1248)),+      TypeInfo _pg_db_role_settingOid "_pg_db_role_setting" Nothing (ArrayType (ArrayTypeDetails 10054)),+      TypeInfo pg_db_role_settingOid "pg_db_role_setting" (Just 10053) CompositeType,+      TypeInfo _pg_tablespaceOid "_pg_tablespace" Nothing (ArrayType (ArrayTypeDetails 10056)),+      TypeInfo pg_tablespaceOid "pg_tablespace" (Just 10055) CompositeType,+      TypeInfo _pg_authidOid "_pg_authid" Nothing (ArrayType (ArrayTypeDetails 2842)),+      TypeInfo _pg_auth_membersOid "_pg_auth_members" Nothing (ArrayType (ArrayTypeDetails 2843)),+      TypeInfo _pg_shdependOid "_pg_shdepend" Nothing (ArrayType (ArrayTypeDetails 10060)),+      TypeInfo pg_shdependOid "pg_shdepend" (Just 10059) CompositeType,+      TypeInfo _pg_shdescriptionOid "_pg_shdescription" Nothing (ArrayType (ArrayTypeDetails 10062)),+      TypeInfo pg_shdescriptionOid "pg_shdescription" (Just 10061) CompositeType,+      TypeInfo _pg_ts_configOid "_pg_ts_config" Nothing (ArrayType (ArrayTypeDetails 10064)),+      TypeInfo pg_ts_configOid "pg_ts_config" (Just 10063) CompositeType,+      TypeInfo _pg_ts_config_mapOid "_pg_ts_config_map" Nothing (ArrayType (ArrayTypeDetails 10066)),+      TypeInfo pg_ts_config_mapOid "pg_ts_config_map" (Just 10065) CompositeType,+      TypeInfo _pg_ts_dictOid "_pg_ts_dict" Nothing (ArrayType (ArrayTypeDetails 10068)),+      TypeInfo pg_ts_dictOid "pg_ts_dict" (Just 10067) CompositeType,+      TypeInfo _pg_ts_parserOid "_pg_ts_parser" Nothing (ArrayType (ArrayTypeDetails 10070)),+      TypeInfo pg_ts_parserOid "pg_ts_parser" (Just 10069) CompositeType,+      TypeInfo _pg_ts_templateOid "_pg_ts_template" Nothing (ArrayType (ArrayTypeDetails 10072)),+      TypeInfo pg_ts_templateOid "pg_ts_template" (Just 10071) CompositeType,+      TypeInfo _pg_extensionOid "_pg_extension" Nothing (ArrayType (ArrayTypeDetails 10074)),+      TypeInfo pg_extensionOid "pg_extension" (Just 10073) CompositeType,+      TypeInfo _pg_foreign_data_wrapperOid "_pg_foreign_data_wrapper" Nothing (ArrayType (ArrayTypeDetails 10076)),+      TypeInfo pg_foreign_data_wrapperOid "pg_foreign_data_wrapper" (Just 10075) CompositeType,+      TypeInfo _pg_foreign_serverOid "_pg_foreign_server" Nothing (ArrayType (ArrayTypeDetails 10078)),+      TypeInfo pg_foreign_serverOid "pg_foreign_server" (Just 10077) CompositeType,+      TypeInfo _pg_user_mappingOid "_pg_user_mapping" Nothing (ArrayType (ArrayTypeDetails 10080)),+      TypeInfo pg_user_mappingOid "pg_user_mapping" (Just 10079) CompositeType,+      TypeInfo _pg_foreign_tableOid "_pg_foreign_table" Nothing (ArrayType (ArrayTypeDetails 10082)),+      TypeInfo pg_foreign_tableOid "pg_foreign_table" (Just 10081) CompositeType,+      TypeInfo _pg_policyOid "_pg_policy" Nothing (ArrayType (ArrayTypeDetails 10084)),+      TypeInfo pg_policyOid "pg_policy" (Just 10083) CompositeType,+      TypeInfo _pg_replication_originOid "_pg_replication_origin" Nothing (ArrayType (ArrayTypeDetails 10086)),+      TypeInfo pg_replication_originOid "pg_replication_origin" (Just 10085) CompositeType,+      TypeInfo _pg_default_aclOid "_pg_default_acl" Nothing (ArrayType (ArrayTypeDetails 10088)),+      TypeInfo pg_default_aclOid "pg_default_acl" (Just 10087) CompositeType,+      TypeInfo _pg_init_privsOid "_pg_init_privs" Nothing (ArrayType (ArrayTypeDetails 10090)),+      TypeInfo pg_init_privsOid "pg_init_privs" (Just 10089) CompositeType,+      TypeInfo _pg_seclabelOid "_pg_seclabel" Nothing (ArrayType (ArrayTypeDetails 10092)),+      TypeInfo pg_seclabelOid "pg_seclabel" (Just 10091) CompositeType,+      TypeInfo _pg_shseclabelOid "_pg_shseclabel" Nothing (ArrayType (ArrayTypeDetails 4066)),+      TypeInfo _pg_collationOid "_pg_collation" Nothing (ArrayType (ArrayTypeDetails 10095)),+      TypeInfo pg_collationOid "pg_collation" (Just 10094) CompositeType,+      TypeInfo _pg_parameter_aclOid "_pg_parameter_acl" Nothing (ArrayType (ArrayTypeDetails 10097)),+      TypeInfo pg_parameter_aclOid "pg_parameter_acl" (Just 10096) CompositeType,+      TypeInfo _pg_partitioned_tableOid "_pg_partitioned_table" Nothing (ArrayType (ArrayTypeDetails 10099)),+      TypeInfo pg_partitioned_tableOid "pg_partitioned_table" (Just 10098) CompositeType,+      TypeInfo _pg_rangeOid "_pg_range" Nothing (ArrayType (ArrayTypeDetails 10101)),+      TypeInfo pg_rangeOid "pg_range" (Just 10100) CompositeType,+      TypeInfo _pg_transformOid "_pg_transform" Nothing (ArrayType (ArrayTypeDetails 10103)),+      TypeInfo pg_transformOid "pg_transform" (Just 10102) CompositeType,+      TypeInfo _pg_sequenceOid "_pg_sequence" Nothing (ArrayType (ArrayTypeDetails 10105)),+      TypeInfo pg_sequenceOid "pg_sequence" (Just 10104) CompositeType,+      TypeInfo _pg_publicationOid "_pg_publication" Nothing (ArrayType (ArrayTypeDetails 10107)),+      TypeInfo pg_publicationOid "pg_publication" (Just 10106) CompositeType,+      TypeInfo _pg_publication_namespaceOid "_pg_publication_namespace" Nothing (ArrayType (ArrayTypeDetails 10109)),+      TypeInfo pg_publication_namespaceOid "pg_publication_namespace" (Just 10108) CompositeType,+      TypeInfo _pg_publication_relOid "_pg_publication_rel" Nothing (ArrayType (ArrayTypeDetails 10111)),+      TypeInfo pg_publication_relOid "pg_publication_rel" (Just 10110) CompositeType,+      TypeInfo _pg_subscriptionOid "_pg_subscription" Nothing (ArrayType (ArrayTypeDetails 6101)),+      TypeInfo _pg_subscription_relOid "_pg_subscription_rel" Nothing (ArrayType (ArrayTypeDetails 10114)),+      TypeInfo pg_subscription_relOid "pg_subscription_rel" (Just 10113) CompositeType,+      TypeInfo _pg_rolesOid "_pg_roles" Nothing (ArrayType (ArrayTypeDetails 12002)),+      TypeInfo pg_rolesOid "pg_roles" (Just 12001) CompositeType,+      TypeInfo _pg_shadowOid "_pg_shadow" Nothing (ArrayType (ArrayTypeDetails 12007)),+      TypeInfo pg_shadowOid "pg_shadow" (Just 12006) CompositeType,+      TypeInfo _pg_groupOid "_pg_group" Nothing (ArrayType (ArrayTypeDetails 12012)),+      TypeInfo pg_groupOid "pg_group" (Just 12011) CompositeType,+      TypeInfo _pg_userOid "_pg_user" Nothing (ArrayType (ArrayTypeDetails 12016)),+      TypeInfo pg_userOid "pg_user" (Just 12015) CompositeType,+      TypeInfo _pg_policiesOid "_pg_policies" Nothing (ArrayType (ArrayTypeDetails 12020)),+      TypeInfo pg_policiesOid "pg_policies" (Just 12019) CompositeType,+      TypeInfo _pg_rulesOid "_pg_rules" Nothing (ArrayType (ArrayTypeDetails 12025)),+      TypeInfo pg_rulesOid "pg_rules" (Just 12024) CompositeType,+      TypeInfo _pg_viewsOid "_pg_views" Nothing (ArrayType (ArrayTypeDetails 12030)),+      TypeInfo pg_viewsOid "pg_views" (Just 12029) CompositeType,+      TypeInfo _pg_tablesOid "_pg_tables" Nothing (ArrayType (ArrayTypeDetails 12035)),+      TypeInfo pg_tablesOid "pg_tables" (Just 12034) CompositeType,+      TypeInfo _pg_matviewsOid "_pg_matviews" Nothing (ArrayType (ArrayTypeDetails 12040)),+      TypeInfo pg_matviewsOid "pg_matviews" (Just 12039) CompositeType,+      TypeInfo _pg_indexesOid "_pg_indexes" Nothing (ArrayType (ArrayTypeDetails 12045)),+      TypeInfo pg_indexesOid "pg_indexes" (Just 12044) CompositeType,+      TypeInfo _pg_sequencesOid "_pg_sequences" Nothing (ArrayType (ArrayTypeDetails 12050)),+      TypeInfo pg_sequencesOid "pg_sequences" (Just 12049) CompositeType,+      TypeInfo _pg_statsOid "_pg_stats" Nothing (ArrayType (ArrayTypeDetails 12055)),+      TypeInfo pg_statsOid "pg_stats" (Just 12054) CompositeType,+      TypeInfo _pg_stats_extOid "_pg_stats_ext" Nothing (ArrayType (ArrayTypeDetails 12060)),+      TypeInfo pg_stats_extOid "pg_stats_ext" (Just 12059) CompositeType,+      TypeInfo _pg_stats_ext_exprsOid "_pg_stats_ext_exprs" Nothing (ArrayType (ArrayTypeDetails 12065)),+      TypeInfo pg_stats_ext_exprsOid "pg_stats_ext_exprs" (Just 12064) CompositeType,+      TypeInfo _pg_publication_tablesOid "_pg_publication_tables" Nothing (ArrayType (ArrayTypeDetails 12070)),+      TypeInfo pg_publication_tablesOid "pg_publication_tables" (Just 12069) CompositeType,+      TypeInfo _pg_locksOid "_pg_locks" Nothing (ArrayType (ArrayTypeDetails 12075)),+      TypeInfo pg_locksOid "pg_locks" (Just 12074) CompositeType,+      TypeInfo _pg_cursorsOid "_pg_cursors" Nothing (ArrayType (ArrayTypeDetails 12079)),+      TypeInfo pg_cursorsOid "pg_cursors" (Just 12078) CompositeType,+      TypeInfo _pg_available_extensionsOid "_pg_available_extensions" Nothing (ArrayType (ArrayTypeDetails 12083)),+      TypeInfo pg_available_extensionsOid "pg_available_extensions" (Just 12082) CompositeType,+      TypeInfo _pg_available_extension_versionsOid "_pg_available_extension_versions" Nothing (ArrayType (ArrayTypeDetails 12087)),+      TypeInfo pg_available_extension_versionsOid "pg_available_extension_versions" (Just 12086) CompositeType,+      TypeInfo _pg_prepared_xactsOid "_pg_prepared_xacts" Nothing (ArrayType (ArrayTypeDetails 12092)),+      TypeInfo pg_prepared_xactsOid "pg_prepared_xacts" (Just 12091) CompositeType,+      TypeInfo _pg_prepared_statementsOid "_pg_prepared_statements" Nothing (ArrayType (ArrayTypeDetails 12097)),+      TypeInfo pg_prepared_statementsOid "pg_prepared_statements" (Just 12096) CompositeType,+      TypeInfo _pg_seclabelsOid "_pg_seclabels" Nothing (ArrayType (ArrayTypeDetails 12101)),+      TypeInfo pg_seclabelsOid "pg_seclabels" (Just 12100) CompositeType,+      TypeInfo _pg_settingsOid "_pg_settings" Nothing (ArrayType (ArrayTypeDetails 12106)),+      TypeInfo pg_settingsOid "pg_settings" (Just 12105) CompositeType,+      TypeInfo _pg_file_settingsOid "_pg_file_settings" Nothing (ArrayType (ArrayTypeDetails 12112)),+      TypeInfo pg_file_settingsOid "pg_file_settings" (Just 12111) CompositeType,+      TypeInfo _pg_hba_file_rulesOid "_pg_hba_file_rules" Nothing (ArrayType (ArrayTypeDetails 12116)),+      TypeInfo pg_hba_file_rulesOid "pg_hba_file_rules" (Just 12115) CompositeType,+      TypeInfo _pg_ident_file_mappingsOid "_pg_ident_file_mappings" Nothing (ArrayType (ArrayTypeDetails 12120)),+      TypeInfo pg_ident_file_mappingsOid "pg_ident_file_mappings" (Just 12119) CompositeType,+      TypeInfo _pg_timezone_abbrevsOid "_pg_timezone_abbrevs" Nothing (ArrayType (ArrayTypeDetails 12124)),+      TypeInfo pg_timezone_abbrevsOid "pg_timezone_abbrevs" (Just 12123) CompositeType,+      TypeInfo _pg_timezone_namesOid "_pg_timezone_names" Nothing (ArrayType (ArrayTypeDetails 12128)),+      TypeInfo pg_timezone_namesOid "pg_timezone_names" (Just 12127) CompositeType,+      TypeInfo _pg_configOid "_pg_config" Nothing (ArrayType (ArrayTypeDetails 12132)),+      TypeInfo pg_configOid "pg_config" (Just 12131) CompositeType,+      TypeInfo _pg_shmem_allocationsOid "_pg_shmem_allocations" Nothing (ArrayType (ArrayTypeDetails 12136)),+      TypeInfo pg_shmem_allocationsOid "pg_shmem_allocations" (Just 12135) CompositeType,+      TypeInfo _pg_backend_memory_contextsOid "_pg_backend_memory_contexts" Nothing (ArrayType (ArrayTypeDetails 12140)),+      TypeInfo pg_backend_memory_contextsOid "pg_backend_memory_contexts" (Just 12139) CompositeType,+      TypeInfo _pg_stat_all_tablesOid "_pg_stat_all_tables" Nothing (ArrayType (ArrayTypeDetails 12144)),+      TypeInfo pg_stat_all_tablesOid "pg_stat_all_tables" (Just 12143) CompositeType,+      TypeInfo _pg_stat_xact_all_tablesOid "_pg_stat_xact_all_tables" Nothing (ArrayType (ArrayTypeDetails 12149)),+      TypeInfo pg_stat_xact_all_tablesOid "pg_stat_xact_all_tables" (Just 12148) CompositeType,+      TypeInfo _pg_stat_sys_tablesOid "_pg_stat_sys_tables" Nothing (ArrayType (ArrayTypeDetails 12154)),+      TypeInfo pg_stat_sys_tablesOid "pg_stat_sys_tables" (Just 12153) CompositeType,+      TypeInfo _pg_stat_xact_sys_tablesOid "_pg_stat_xact_sys_tables" Nothing (ArrayType (ArrayTypeDetails 12159)),+      TypeInfo pg_stat_xact_sys_tablesOid "pg_stat_xact_sys_tables" (Just 12158) CompositeType,+      TypeInfo _pg_stat_user_tablesOid "_pg_stat_user_tables" Nothing (ArrayType (ArrayTypeDetails 12163)),+      TypeInfo pg_stat_user_tablesOid "pg_stat_user_tables" (Just 12162) CompositeType,+      TypeInfo _pg_stat_xact_user_tablesOid "_pg_stat_xact_user_tables" Nothing (ArrayType (ArrayTypeDetails 12168)),+      TypeInfo pg_stat_xact_user_tablesOid "pg_stat_xact_user_tables" (Just 12167) CompositeType,+      TypeInfo _pg_statio_all_tablesOid "_pg_statio_all_tables" Nothing (ArrayType (ArrayTypeDetails 12172)),+      TypeInfo pg_statio_all_tablesOid "pg_statio_all_tables" (Just 12171) CompositeType,+      TypeInfo _pg_statio_sys_tablesOid "_pg_statio_sys_tables" Nothing (ArrayType (ArrayTypeDetails 12177)),+      TypeInfo pg_statio_sys_tablesOid "pg_statio_sys_tables" (Just 12176) CompositeType,+      TypeInfo _pg_statio_user_tablesOid "_pg_statio_user_tables" Nothing (ArrayType (ArrayTypeDetails 12181)),+      TypeInfo pg_statio_user_tablesOid "pg_statio_user_tables" (Just 12180) CompositeType,+      TypeInfo _pg_stat_all_indexesOid "_pg_stat_all_indexes" Nothing (ArrayType (ArrayTypeDetails 12185)),+      TypeInfo pg_stat_all_indexesOid "pg_stat_all_indexes" (Just 12184) CompositeType,+      TypeInfo _pg_stat_sys_indexesOid "_pg_stat_sys_indexes" Nothing (ArrayType (ArrayTypeDetails 12190)),+      TypeInfo pg_stat_sys_indexesOid "pg_stat_sys_indexes" (Just 12189) CompositeType,+      TypeInfo _pg_stat_user_indexesOid "_pg_stat_user_indexes" Nothing (ArrayType (ArrayTypeDetails 12194)),+      TypeInfo pg_stat_user_indexesOid "pg_stat_user_indexes" (Just 12193) CompositeType,+      TypeInfo _pg_statio_all_indexesOid "_pg_statio_all_indexes" Nothing (ArrayType (ArrayTypeDetails 12198)),+      TypeInfo pg_statio_all_indexesOid "pg_statio_all_indexes" (Just 12197) CompositeType,+      TypeInfo _pg_statio_sys_indexesOid "_pg_statio_sys_indexes" Nothing (ArrayType (ArrayTypeDetails 12203)),+      TypeInfo pg_statio_sys_indexesOid "pg_statio_sys_indexes" (Just 12202) CompositeType,+      TypeInfo _pg_statio_user_indexesOid "_pg_statio_user_indexes" Nothing (ArrayType (ArrayTypeDetails 12207)),+      TypeInfo pg_statio_user_indexesOid "pg_statio_user_indexes" (Just 12206) CompositeType,+      TypeInfo _pg_statio_all_sequencesOid "_pg_statio_all_sequences" Nothing (ArrayType (ArrayTypeDetails 12211)),+      TypeInfo pg_statio_all_sequencesOid "pg_statio_all_sequences" (Just 12210) CompositeType,+      TypeInfo _pg_statio_sys_sequencesOid "_pg_statio_sys_sequences" Nothing (ArrayType (ArrayTypeDetails 12216)),+      TypeInfo pg_statio_sys_sequencesOid "pg_statio_sys_sequences" (Just 12215) CompositeType,+      TypeInfo _pg_statio_user_sequencesOid "_pg_statio_user_sequences" Nothing (ArrayType (ArrayTypeDetails 12220)),+      TypeInfo pg_statio_user_sequencesOid "pg_statio_user_sequences" (Just 12219) CompositeType,+      TypeInfo _pg_stat_activityOid "_pg_stat_activity" Nothing (ArrayType (ArrayTypeDetails 12224)),+      TypeInfo pg_stat_activityOid "pg_stat_activity" (Just 12223) CompositeType,+      TypeInfo _pg_stat_replicationOid "_pg_stat_replication" Nothing (ArrayType (ArrayTypeDetails 12229)),+      TypeInfo pg_stat_replicationOid "pg_stat_replication" (Just 12228) CompositeType,+      TypeInfo _pg_stat_slruOid "_pg_stat_slru" Nothing (ArrayType (ArrayTypeDetails 12234)),+      TypeInfo pg_stat_slruOid "pg_stat_slru" (Just 12233) CompositeType,+      TypeInfo _pg_stat_wal_receiverOid "_pg_stat_wal_receiver" Nothing (ArrayType (ArrayTypeDetails 12238)),+      TypeInfo pg_stat_wal_receiverOid "pg_stat_wal_receiver" (Just 12237) CompositeType,+      TypeInfo _pg_stat_recovery_prefetchOid "_pg_stat_recovery_prefetch" Nothing (ArrayType (ArrayTypeDetails 12242)),+      TypeInfo pg_stat_recovery_prefetchOid "pg_stat_recovery_prefetch" (Just 12241) CompositeType,+      TypeInfo _pg_stat_subscriptionOid "_pg_stat_subscription" Nothing (ArrayType (ArrayTypeDetails 12246)),+      TypeInfo pg_stat_subscriptionOid "pg_stat_subscription" (Just 12245) CompositeType,+      TypeInfo _pg_stat_sslOid "_pg_stat_ssl" Nothing (ArrayType (ArrayTypeDetails 12251)),+      TypeInfo pg_stat_sslOid "pg_stat_ssl" (Just 12250) CompositeType,+      TypeInfo _pg_stat_gssapiOid "_pg_stat_gssapi" Nothing (ArrayType (ArrayTypeDetails 12255)),+      TypeInfo pg_stat_gssapiOid "pg_stat_gssapi" (Just 12254) CompositeType,+      TypeInfo _pg_replication_slotsOid "_pg_replication_slots" Nothing (ArrayType (ArrayTypeDetails 12259)),+      TypeInfo pg_replication_slotsOid "pg_replication_slots" (Just 12258) CompositeType,+      TypeInfo _pg_stat_replication_slotsOid "_pg_stat_replication_slots" Nothing (ArrayType (ArrayTypeDetails 12264)),+      TypeInfo pg_stat_replication_slotsOid "pg_stat_replication_slots" (Just 12263) CompositeType,+      TypeInfo _pg_stat_databaseOid "_pg_stat_database" Nothing (ArrayType (ArrayTypeDetails 12268)),+      TypeInfo pg_stat_databaseOid "pg_stat_database" (Just 12267) CompositeType,+      TypeInfo _pg_stat_database_conflictsOid "_pg_stat_database_conflicts" Nothing (ArrayType (ArrayTypeDetails 12273)),+      TypeInfo pg_stat_database_conflictsOid "pg_stat_database_conflicts" (Just 12272) CompositeType,+      TypeInfo _pg_stat_user_functionsOid "_pg_stat_user_functions" Nothing (ArrayType (ArrayTypeDetails 12277)),+      TypeInfo pg_stat_user_functionsOid "pg_stat_user_functions" (Just 12276) CompositeType,+      TypeInfo _pg_stat_xact_user_functionsOid "_pg_stat_xact_user_functions" Nothing (ArrayType (ArrayTypeDetails 12282)),+      TypeInfo pg_stat_xact_user_functionsOid "pg_stat_xact_user_functions" (Just 12281) CompositeType,+      TypeInfo _pg_stat_archiverOid "_pg_stat_archiver" Nothing (ArrayType (ArrayTypeDetails 12287)),+      TypeInfo pg_stat_archiverOid "pg_stat_archiver" (Just 12286) CompositeType,+      TypeInfo _pg_stat_bgwriterOid "_pg_stat_bgwriter" Nothing (ArrayType (ArrayTypeDetails 12291)),+      TypeInfo pg_stat_bgwriterOid "pg_stat_bgwriter" (Just 12290) CompositeType,+      TypeInfo _pg_stat_ioOid "_pg_stat_io" Nothing (ArrayType (ArrayTypeDetails 12295)),+      TypeInfo pg_stat_ioOid "pg_stat_io" (Just 12294) CompositeType,+      TypeInfo _pg_stat_walOid "_pg_stat_wal" Nothing (ArrayType (ArrayTypeDetails 12299)),+      TypeInfo pg_stat_walOid "pg_stat_wal" (Just 12298) CompositeType,+      TypeInfo _pg_stat_progress_analyzeOid "_pg_stat_progress_analyze" Nothing (ArrayType (ArrayTypeDetails 12303)),+      TypeInfo pg_stat_progress_analyzeOid "pg_stat_progress_analyze" (Just 12302) CompositeType,+      TypeInfo _pg_stat_progress_vacuumOid "_pg_stat_progress_vacuum" Nothing (ArrayType (ArrayTypeDetails 12308)),+      TypeInfo pg_stat_progress_vacuumOid "pg_stat_progress_vacuum" (Just 12307) CompositeType,+      TypeInfo _pg_stat_progress_clusterOid "_pg_stat_progress_cluster" Nothing (ArrayType (ArrayTypeDetails 12313)),+      TypeInfo pg_stat_progress_clusterOid "pg_stat_progress_cluster" (Just 12312) CompositeType,+      TypeInfo _pg_stat_progress_create_indexOid "_pg_stat_progress_create_index" Nothing (ArrayType (ArrayTypeDetails 12318)),+      TypeInfo pg_stat_progress_create_indexOid "pg_stat_progress_create_index" (Just 12317) CompositeType,+      TypeInfo _pg_stat_progress_basebackupOid "_pg_stat_progress_basebackup" Nothing (ArrayType (ArrayTypeDetails 12323)),+      TypeInfo pg_stat_progress_basebackupOid "pg_stat_progress_basebackup" (Just 12322) CompositeType,+      TypeInfo _pg_stat_progress_copyOid "_pg_stat_progress_copy" Nothing (ArrayType (ArrayTypeDetails 12328)),+      TypeInfo pg_stat_progress_copyOid "pg_stat_progress_copy" (Just 12327) CompositeType,+      TypeInfo _pg_user_mappingsOid "_pg_user_mappings" Nothing (ArrayType (ArrayTypeDetails 12333)),+      TypeInfo pg_user_mappingsOid "pg_user_mappings" (Just 12332) CompositeType,+      TypeInfo _pg_replication_origin_statusOid "_pg_replication_origin_status" Nothing (ArrayType (ArrayTypeDetails 12338)),+      TypeInfo pg_replication_origin_statusOid "pg_replication_origin_status" (Just 12337) CompositeType,+      TypeInfo _pg_stat_subscription_statsOid "_pg_stat_subscription_stats" Nothing (ArrayType (ArrayTypeDetails 12342)),+      TypeInfo pg_stat_subscription_statsOid "pg_stat_subscription_stats" (Just 12341) CompositeType,+      TypeInfo _cardinal_numberOid "_cardinal_number" Nothing (ArrayType (ArrayTypeDetails 13292)),+      TypeInfo cardinal_numberOid "cardinal_number" (Just 13291) DomainType,+      TypeInfo _character_dataOid "_character_data" Nothing (ArrayType (ArrayTypeDetails 13295)),+      TypeInfo character_dataOid "character_data" (Just 13294) DomainType,+      TypeInfo _sql_identifierOid "_sql_identifier" Nothing (ArrayType (ArrayTypeDetails 13297)),+      TypeInfo sql_identifierOid "sql_identifier" (Just 13296) DomainType,+      TypeInfo _information_schema_catalog_nameOid "_information_schema_catalog_name" Nothing (ArrayType (ArrayTypeDetails 13300)),+      TypeInfo information_schema_catalog_nameOid "information_schema_catalog_name" (Just 13299) CompositeType,+      TypeInfo _time_stampOid "_time_stamp" Nothing (ArrayType (ArrayTypeDetails 13303)),+      TypeInfo time_stampOid "time_stamp" (Just 13302) DomainType,+      TypeInfo _yes_or_noOid "_yes_or_no" Nothing (ArrayType (ArrayTypeDetails 13305)),+      TypeInfo yes_or_noOid "yes_or_no" (Just 13304) DomainType,+      TypeInfo _applicable_rolesOid "_applicable_roles" Nothing (ArrayType (ArrayTypeDetails 13309)),+      TypeInfo applicable_rolesOid "applicable_roles" (Just 13308) CompositeType,+      TypeInfo _administrable_role_authorizationsOid "_administrable_role_authorizations" Nothing (ArrayType (ArrayTypeDetails 13314)),+      TypeInfo administrable_role_authorizationsOid "administrable_role_authorizations" (Just 13313) CompositeType,+      TypeInfo _attributesOid "_attributes" Nothing (ArrayType (ArrayTypeDetails 13318)),+      TypeInfo attributesOid "attributes" (Just 13317) CompositeType,+      TypeInfo _character_setsOid "_character_sets" Nothing (ArrayType (ArrayTypeDetails 13323)),+      TypeInfo character_setsOid "character_sets" (Just 13322) CompositeType,+      TypeInfo _check_constraint_routine_usageOid "_check_constraint_routine_usage" Nothing (ArrayType (ArrayTypeDetails 13328)),+      TypeInfo check_constraint_routine_usageOid "check_constraint_routine_usage" (Just 13327) CompositeType,+      TypeInfo _check_constraintsOid "_check_constraints" Nothing (ArrayType (ArrayTypeDetails 13333)),+      TypeInfo check_constraintsOid "check_constraints" (Just 13332) CompositeType,+      TypeInfo _collationsOid "_collations" Nothing (ArrayType (ArrayTypeDetails 13338)),+      TypeInfo collationsOid "collations" (Just 13337) CompositeType,+      TypeInfo _collation_character_set_applicabilityOid "_collation_character_set_applicability" Nothing (ArrayType (ArrayTypeDetails 13343)),+      TypeInfo collation_character_set_applicabilityOid "collation_character_set_applicability" (Just 13342) CompositeType,+      TypeInfo _column_column_usageOid "_column_column_usage" Nothing (ArrayType (ArrayTypeDetails 13348)),+      TypeInfo column_column_usageOid "column_column_usage" (Just 13347) CompositeType,+      TypeInfo _column_domain_usageOid "_column_domain_usage" Nothing (ArrayType (ArrayTypeDetails 13353)),+      TypeInfo column_domain_usageOid "column_domain_usage" (Just 13352) CompositeType,+      TypeInfo _column_privilegesOid "_column_privileges" Nothing (ArrayType (ArrayTypeDetails 13358)),+      TypeInfo column_privilegesOid "column_privileges" (Just 13357) CompositeType,+      TypeInfo _column_udt_usageOid "_column_udt_usage" Nothing (ArrayType (ArrayTypeDetails 13363)),+      TypeInfo column_udt_usageOid "column_udt_usage" (Just 13362) CompositeType,+      TypeInfo _columnsOid "_columns" Nothing (ArrayType (ArrayTypeDetails 13368)),+      TypeInfo columnsOid "columns" (Just 13367) CompositeType,+      TypeInfo _constraint_column_usageOid "_constraint_column_usage" Nothing (ArrayType (ArrayTypeDetails 13373)),+      TypeInfo constraint_column_usageOid "constraint_column_usage" (Just 13372) CompositeType,+      TypeInfo _constraint_table_usageOid "_constraint_table_usage" Nothing (ArrayType (ArrayTypeDetails 13378)),+      TypeInfo constraint_table_usageOid "constraint_table_usage" (Just 13377) CompositeType,+      TypeInfo _domain_constraintsOid "_domain_constraints" Nothing (ArrayType (ArrayTypeDetails 13383)),+      TypeInfo domain_constraintsOid "domain_constraints" (Just 13382) CompositeType,+      TypeInfo _domain_udt_usageOid "_domain_udt_usage" Nothing (ArrayType (ArrayTypeDetails 13388)),+      TypeInfo domain_udt_usageOid "domain_udt_usage" (Just 13387) CompositeType,+      TypeInfo _domainsOid "_domains" Nothing (ArrayType (ArrayTypeDetails 13393)),+      TypeInfo domainsOid "domains" (Just 13392) CompositeType,+      TypeInfo _enabled_rolesOid "_enabled_roles" Nothing (ArrayType (ArrayTypeDetails 13398)),+      TypeInfo enabled_rolesOid "enabled_roles" (Just 13397) CompositeType,+      TypeInfo _key_column_usageOid "_key_column_usage" Nothing (ArrayType (ArrayTypeDetails 13402)),+      TypeInfo key_column_usageOid "key_column_usage" (Just 13401) CompositeType,+      TypeInfo _parametersOid "_parameters" Nothing (ArrayType (ArrayTypeDetails 13407)),+      TypeInfo parametersOid "parameters" (Just 13406) CompositeType,+      TypeInfo _referential_constraintsOid "_referential_constraints" Nothing (ArrayType (ArrayTypeDetails 13412)),+      TypeInfo referential_constraintsOid "referential_constraints" (Just 13411) CompositeType,+      TypeInfo _role_column_grantsOid "_role_column_grants" Nothing (ArrayType (ArrayTypeDetails 13417)),+      TypeInfo role_column_grantsOid "role_column_grants" (Just 13416) CompositeType,+      TypeInfo _routine_column_usageOid "_routine_column_usage" Nothing (ArrayType (ArrayTypeDetails 13421)),+      TypeInfo routine_column_usageOid "routine_column_usage" (Just 13420) CompositeType,+      TypeInfo _routine_privilegesOid "_routine_privileges" Nothing (ArrayType (ArrayTypeDetails 13426)),+      TypeInfo routine_privilegesOid "routine_privileges" (Just 13425) CompositeType,+      TypeInfo _role_routine_grantsOid "_role_routine_grants" Nothing (ArrayType (ArrayTypeDetails 13431)),+      TypeInfo role_routine_grantsOid "role_routine_grants" (Just 13430) CompositeType,+      TypeInfo _routine_routine_usageOid "_routine_routine_usage" Nothing (ArrayType (ArrayTypeDetails 13435)),+      TypeInfo routine_routine_usageOid "routine_routine_usage" (Just 13434) CompositeType,+      TypeInfo _routine_sequence_usageOid "_routine_sequence_usage" Nothing (ArrayType (ArrayTypeDetails 13440)),+      TypeInfo routine_sequence_usageOid "routine_sequence_usage" (Just 13439) CompositeType,+      TypeInfo _routine_table_usageOid "_routine_table_usage" Nothing (ArrayType (ArrayTypeDetails 13445)),+      TypeInfo routine_table_usageOid "routine_table_usage" (Just 13444) CompositeType,+      TypeInfo _routinesOid "_routines" Nothing (ArrayType (ArrayTypeDetails 13450)),+      TypeInfo routinesOid "routines" (Just 13449) CompositeType,+      TypeInfo _schemataOid "_schemata" Nothing (ArrayType (ArrayTypeDetails 13455)),+      TypeInfo schemataOid "schemata" (Just 13454) CompositeType,+      TypeInfo _sequencesOid "_sequences" Nothing (ArrayType (ArrayTypeDetails 13459)),+      TypeInfo sequencesOid "sequences" (Just 13458) CompositeType,+      TypeInfo _sql_featuresOid "_sql_features" Nothing (ArrayType (ArrayTypeDetails 13464)),+      TypeInfo sql_featuresOid "sql_features" (Just 13463) CompositeType,+      TypeInfo _sql_implementation_infoOid "_sql_implementation_info" Nothing (ArrayType (ArrayTypeDetails 13469)),+      TypeInfo sql_implementation_infoOid "sql_implementation_info" (Just 13468) CompositeType,+      TypeInfo _sql_partsOid "_sql_parts" Nothing (ArrayType (ArrayTypeDetails 13474)),+      TypeInfo sql_partsOid "sql_parts" (Just 13473) CompositeType,+      TypeInfo _sql_sizingOid "_sql_sizing" Nothing (ArrayType (ArrayTypeDetails 13479)),+      TypeInfo sql_sizingOid "sql_sizing" (Just 13478) CompositeType,+      TypeInfo _table_constraintsOid "_table_constraints" Nothing (ArrayType (ArrayTypeDetails 13484)),+      TypeInfo table_constraintsOid "table_constraints" (Just 13483) CompositeType,+      TypeInfo _table_privilegesOid "_table_privileges" Nothing (ArrayType (ArrayTypeDetails 13489)),+      TypeInfo table_privilegesOid "table_privileges" (Just 13488) CompositeType,+      TypeInfo _role_table_grantsOid "_role_table_grants" Nothing (ArrayType (ArrayTypeDetails 13494)),+      TypeInfo role_table_grantsOid "role_table_grants" (Just 13493) CompositeType,+      TypeInfo _tablesOid "_tables" Nothing (ArrayType (ArrayTypeDetails 13498)),+      TypeInfo tablesOid "tables" (Just 13497) CompositeType,+      TypeInfo _transformsOid "_transforms" Nothing (ArrayType (ArrayTypeDetails 13503)),+      TypeInfo transformsOid "transforms" (Just 13502) CompositeType,+      TypeInfo _triggered_update_columnsOid "_triggered_update_columns" Nothing (ArrayType (ArrayTypeDetails 13508)),+      TypeInfo triggered_update_columnsOid "triggered_update_columns" (Just 13507) CompositeType,+      TypeInfo _triggersOid "_triggers" Nothing (ArrayType (ArrayTypeDetails 13513)),+      TypeInfo triggersOid "triggers" (Just 13512) CompositeType,+      TypeInfo _udt_privilegesOid "_udt_privileges" Nothing (ArrayType (ArrayTypeDetails 13518)),+      TypeInfo udt_privilegesOid "udt_privileges" (Just 13517) CompositeType,+      TypeInfo _role_udt_grantsOid "_role_udt_grants" Nothing (ArrayType (ArrayTypeDetails 13523)),+      TypeInfo role_udt_grantsOid "role_udt_grants" (Just 13522) CompositeType,+      TypeInfo _usage_privilegesOid "_usage_privileges" Nothing (ArrayType (ArrayTypeDetails 13527)),+      TypeInfo usage_privilegesOid "usage_privileges" (Just 13526) CompositeType,+      TypeInfo _role_usage_grantsOid "_role_usage_grants" Nothing (ArrayType (ArrayTypeDetails 13532)),+      TypeInfo role_usage_grantsOid "role_usage_grants" (Just 13531) CompositeType,+      TypeInfo _user_defined_typesOid "_user_defined_types" Nothing (ArrayType (ArrayTypeDetails 13536)),+      TypeInfo user_defined_typesOid "user_defined_types" (Just 13535) CompositeType,+      TypeInfo _view_column_usageOid "_view_column_usage" Nothing (ArrayType (ArrayTypeDetails 13541)),+      TypeInfo view_column_usageOid "view_column_usage" (Just 13540) CompositeType,+      TypeInfo _view_routine_usageOid "_view_routine_usage" Nothing (ArrayType (ArrayTypeDetails 13546)),+      TypeInfo view_routine_usageOid "view_routine_usage" (Just 13545) CompositeType,+      TypeInfo _view_table_usageOid "_view_table_usage" Nothing (ArrayType (ArrayTypeDetails 13551)),+      TypeInfo view_table_usageOid "view_table_usage" (Just 13550) CompositeType,+      TypeInfo _viewsOid "_views" Nothing (ArrayType (ArrayTypeDetails 13556)),+      TypeInfo viewsOid "views" (Just 13555) CompositeType,+      TypeInfo _data_type_privilegesOid "_data_type_privileges" Nothing (ArrayType (ArrayTypeDetails 13561)),+      TypeInfo data_type_privilegesOid "data_type_privileges" (Just 13560) CompositeType,+      TypeInfo _element_typesOid "_element_types" Nothing (ArrayType (ArrayTypeDetails 13566)),+      TypeInfo element_typesOid "element_types" (Just 13565) CompositeType,+      TypeInfo __pg_foreign_table_columnsOid "__pg_foreign_table_columns" Nothing (ArrayType (ArrayTypeDetails 13571)),+      TypeInfo _pg_foreign_table_columnsOid "_pg_foreign_table_columns" (Just 13570) CompositeType,+      TypeInfo _column_optionsOid "_column_options" Nothing (ArrayType (ArrayTypeDetails 13576)),+      TypeInfo column_optionsOid "column_options" (Just 13575) CompositeType,+      TypeInfo __pg_foreign_data_wrappersOid "__pg_foreign_data_wrappers" Nothing (ArrayType (ArrayTypeDetails 13580)),+      TypeInfo _pg_foreign_data_wrappersOid "_pg_foreign_data_wrappers" (Just 13579) CompositeType,+      TypeInfo _foreign_data_wrapper_optionsOid "_foreign_data_wrapper_options" Nothing (ArrayType (ArrayTypeDetails 13584)),+      TypeInfo foreign_data_wrapper_optionsOid "foreign_data_wrapper_options" (Just 13583) CompositeType,+      TypeInfo _foreign_data_wrappersOid "_foreign_data_wrappers" Nothing (ArrayType (ArrayTypeDetails 13588)),+      TypeInfo foreign_data_wrappersOid "foreign_data_wrappers" (Just 13587) CompositeType,+      TypeInfo __pg_foreign_serversOid "__pg_foreign_servers" Nothing (ArrayType (ArrayTypeDetails 13592)),+      TypeInfo _pg_foreign_serversOid "_pg_foreign_servers" (Just 13591) CompositeType,+      TypeInfo _foreign_server_optionsOid "_foreign_server_options" Nothing (ArrayType (ArrayTypeDetails 13597)),+      TypeInfo foreign_server_optionsOid "foreign_server_options" (Just 13596) CompositeType,+      TypeInfo _foreign_serversOid "_foreign_servers" Nothing (ArrayType (ArrayTypeDetails 13601)),+      TypeInfo foreign_serversOid "foreign_servers" (Just 13600) CompositeType,+      TypeInfo __pg_foreign_tablesOid "__pg_foreign_tables" Nothing (ArrayType (ArrayTypeDetails 13605)),+      TypeInfo _pg_foreign_tablesOid "_pg_foreign_tables" (Just 13604) CompositeType,+      TypeInfo _foreign_table_optionsOid "_foreign_table_options" Nothing (ArrayType (ArrayTypeDetails 13610)),+      TypeInfo foreign_table_optionsOid "foreign_table_options" (Just 13609) CompositeType,+      TypeInfo _foreign_tablesOid "_foreign_tables" Nothing (ArrayType (ArrayTypeDetails 13614)),+      TypeInfo foreign_tablesOid "foreign_tables" (Just 13613) CompositeType,+      TypeInfo __pg_user_mappingsOid "__pg_user_mappings" Nothing (ArrayType (ArrayTypeDetails 13618)),+      TypeInfo _pg_user_mappingsOid "_pg_user_mappings" (Just 13617) CompositeType,+      TypeInfo _user_mapping_optionsOid "_user_mapping_options" Nothing (ArrayType (ArrayTypeDetails 13623)),+      TypeInfo user_mapping_optionsOid "user_mapping_options" (Just 13622) CompositeType,+      TypeInfo _user_mappingsOid "_user_mappings" Nothing (ArrayType (ArrayTypeDetails 13628)),+      TypeInfo user_mappingsOid "user_mappings" (Just 13627) CompositeType+    ]++boolOid :: Oid+boolOid = Oid 16++byteaOid :: Oid+byteaOid = Oid 17++charOid :: Oid+charOid = Oid 18++nameOid :: Oid+nameOid = Oid 19++int8Oid :: Oid+int8Oid = Oid 20++int2Oid :: Oid+int2Oid = Oid 21++int2vectorOid :: Oid+int2vectorOid = Oid 22++int4Oid :: Oid+int4Oid = Oid 23++regprocOid :: Oid+regprocOid = Oid 24++textOid :: Oid+textOid = Oid 25++oidOid :: Oid+oidOid = Oid 26++tidOid :: Oid+tidOid = Oid 27++xidOid :: Oid+xidOid = Oid 28++cidOid :: Oid+cidOid = Oid 29++oidvectorOid :: Oid+oidvectorOid = Oid 30++pg_ddl_commandOid :: Oid+pg_ddl_commandOid = Oid 32++pg_typeOid :: Oid+pg_typeOid = Oid 71++pg_attributeOid :: Oid+pg_attributeOid = Oid 75++pg_procOid :: Oid+pg_procOid = Oid 81++pg_classOid :: Oid+pg_classOid = Oid 83++jsonOid :: Oid+jsonOid = Oid 114++xmlOid :: Oid+xmlOid = Oid 142++_xmlOid :: Oid+_xmlOid = Oid 143++pg_node_treeOid :: Oid+pg_node_treeOid = Oid 194++_jsonOid :: Oid+_jsonOid = Oid 199++_pg_typeOid :: Oid+_pg_typeOid = Oid 210++table_am_handlerOid :: Oid+table_am_handlerOid = Oid 269++_pg_attributeOid :: Oid+_pg_attributeOid = Oid 270++_xid8Oid :: Oid+_xid8Oid = Oid 271++_pg_procOid :: Oid+_pg_procOid = Oid 272++_pg_classOid :: Oid+_pg_classOid = Oid 273++index_am_handlerOid :: Oid+index_am_handlerOid = Oid 325++pointOid :: Oid+pointOid = Oid 600++lsegOid :: Oid+lsegOid = Oid 601++pathOid :: Oid+pathOid = Oid 602++boxOid :: Oid+boxOid = Oid 603++polygonOid :: Oid+polygonOid = Oid 604++lineOid :: Oid+lineOid = Oid 628++_lineOid :: Oid+_lineOid = Oid 629++cidrOid :: Oid+cidrOid = Oid 650++_cidrOid :: Oid+_cidrOid = Oid 651++float4Oid :: Oid+float4Oid = Oid 700++float8Oid :: Oid+float8Oid = Oid 701++unknownOid :: Oid+unknownOid = Oid 705++circleOid :: Oid+circleOid = Oid 718++_circleOid :: Oid+_circleOid = Oid 719++macaddr8Oid :: Oid+macaddr8Oid = Oid 774++_macaddr8Oid :: Oid+_macaddr8Oid = Oid 775++moneyOid :: Oid+moneyOid = Oid 790++_moneyOid :: Oid+_moneyOid = Oid 791++macaddrOid :: Oid+macaddrOid = Oid 829++inetOid :: Oid+inetOid = Oid 869++_boolOid :: Oid+_boolOid = Oid 1000++_byteaOid :: Oid+_byteaOid = Oid 1001++_charOid :: Oid+_charOid = Oid 1002++_nameOid :: Oid+_nameOid = Oid 1003++_int2Oid :: Oid+_int2Oid = Oid 1005++_int2vectorOid :: Oid+_int2vectorOid = Oid 1006++_int4Oid :: Oid+_int4Oid = Oid 1007++_regprocOid :: Oid+_regprocOid = Oid 1008++_textOid :: Oid+_textOid = Oid 1009++_tidOid :: Oid+_tidOid = Oid 1010++_xidOid :: Oid+_xidOid = Oid 1011++_cidOid :: Oid+_cidOid = Oid 1012++_oidvectorOid :: Oid+_oidvectorOid = Oid 1013++_bpcharOid :: Oid+_bpcharOid = Oid 1014++_varcharOid :: Oid+_varcharOid = Oid 1015++_int8Oid :: Oid+_int8Oid = Oid 1016++_pointOid :: Oid+_pointOid = Oid 1017++_lsegOid :: Oid+_lsegOid = Oid 1018++_pathOid :: Oid+_pathOid = Oid 1019++_boxOid :: Oid+_boxOid = Oid 1020++_float4Oid :: Oid+_float4Oid = Oid 1021++_float8Oid :: Oid+_float8Oid = Oid 1022++_polygonOid :: Oid+_polygonOid = Oid 1027++_oidOid :: Oid+_oidOid = Oid 1028++aclitemOid :: Oid+aclitemOid = Oid 1033++_aclitemOid :: Oid+_aclitemOid = Oid 1034++_macaddrOid :: Oid+_macaddrOid = Oid 1040++_inetOid :: Oid+_inetOid = Oid 1041++bpcharOid :: Oid+bpcharOid = Oid 1042++varcharOid :: Oid+varcharOid = Oid 1043++dateOid :: Oid+dateOid = Oid 1082++timeOid :: Oid+timeOid = Oid 1083++timestampOid :: Oid+timestampOid = Oid 1114++_timestampOid :: Oid+_timestampOid = Oid 1115++_dateOid :: Oid+_dateOid = Oid 1182++_timeOid :: Oid+_timeOid = Oid 1183++timestamptzOid :: Oid+timestamptzOid = Oid 1184++_timestamptzOid :: Oid+_timestamptzOid = Oid 1185++intervalOid :: Oid+intervalOid = Oid 1186++_intervalOid :: Oid+_intervalOid = Oid 1187++_numericOid :: Oid+_numericOid = Oid 1231++pg_databaseOid :: Oid+pg_databaseOid = Oid 1248++_cstringOid :: Oid+_cstringOid = Oid 1263++timetzOid :: Oid+timetzOid = Oid 1266++_timetzOid :: Oid+_timetzOid = Oid 1270++bitOid :: Oid+bitOid = Oid 1560++_bitOid :: Oid+_bitOid = Oid 1561++varbitOid :: Oid+varbitOid = Oid 1562++_varbitOid :: Oid+_varbitOid = Oid 1563++numericOid :: Oid+numericOid = Oid 1700++refcursorOid :: Oid+refcursorOid = Oid 1790++_refcursorOid :: Oid+_refcursorOid = Oid 2201++regprocedureOid :: Oid+regprocedureOid = Oid 2202++regoperOid :: Oid+regoperOid = Oid 2203++regoperatorOid :: Oid+regoperatorOid = Oid 2204++regclassOid :: Oid+regclassOid = Oid 2205++regtypeOid :: Oid+regtypeOid = Oid 2206++_regprocedureOid :: Oid+_regprocedureOid = Oid 2207++_regoperOid :: Oid+_regoperOid = Oid 2208++_regoperatorOid :: Oid+_regoperatorOid = Oid 2209++_regclassOid :: Oid+_regclassOid = Oid 2210++_regtypeOid :: Oid+_regtypeOid = Oid 2211++recordOid :: Oid+recordOid = Oid 2249++cstringOid :: Oid+cstringOid = Oid 2275++anyOid :: Oid+anyOid = Oid 2276++anyarrayOid :: Oid+anyarrayOid = Oid 2277++voidOid :: Oid+voidOid = Oid 2278++triggerOid :: Oid+triggerOid = Oid 2279++language_handlerOid :: Oid+language_handlerOid = Oid 2280++internalOid :: Oid+internalOid = Oid 2281++anyelementOid :: Oid+anyelementOid = Oid 2283++_recordOid :: Oid+_recordOid = Oid 2287++anynonarrayOid :: Oid+anynonarrayOid = Oid 2776++pg_authidOid :: Oid+pg_authidOid = Oid 2842++pg_auth_membersOid :: Oid+pg_auth_membersOid = Oid 2843++_txid_snapshotOid :: Oid+_txid_snapshotOid = Oid 2949++uuidOid :: Oid+uuidOid = Oid 2950++_uuidOid :: Oid+_uuidOid = Oid 2951++txid_snapshotOid :: Oid+txid_snapshotOid = Oid 2970++fdw_handlerOid :: Oid+fdw_handlerOid = Oid 3115++pg_lsnOid :: Oid+pg_lsnOid = Oid 3220++_pg_lsnOid :: Oid+_pg_lsnOid = Oid 3221++tsm_handlerOid :: Oid+tsm_handlerOid = Oid 3310++pg_ndistinctOid :: Oid+pg_ndistinctOid = Oid 3361++pg_dependenciesOid :: Oid+pg_dependenciesOid = Oid 3402++anyenumOid :: Oid+anyenumOid = Oid 3500++tsvectorOid :: Oid+tsvectorOid = Oid 3614++tsqueryOid :: Oid+tsqueryOid = Oid 3615++gtsvectorOid :: Oid+gtsvectorOid = Oid 3642++_tsvectorOid :: Oid+_tsvectorOid = Oid 3643++_gtsvectorOid :: Oid+_gtsvectorOid = Oid 3644++_tsqueryOid :: Oid+_tsqueryOid = Oid 3645++regconfigOid :: Oid+regconfigOid = Oid 3734++_regconfigOid :: Oid+_regconfigOid = Oid 3735++regdictionaryOid :: Oid+regdictionaryOid = Oid 3769++_regdictionaryOid :: Oid+_regdictionaryOid = Oid 3770++jsonbOid :: Oid+jsonbOid = Oid 3802++_jsonbOid :: Oid+_jsonbOid = Oid 3807++anyrangeOid :: Oid+anyrangeOid = Oid 3831++event_triggerOid :: Oid+event_triggerOid = Oid 3838++int4rangeOid :: Oid+int4rangeOid = Oid 3904++_int4rangeOid :: Oid+_int4rangeOid = Oid 3905++numrangeOid :: Oid+numrangeOid = Oid 3906++_numrangeOid :: Oid+_numrangeOid = Oid 3907++tsrangeOid :: Oid+tsrangeOid = Oid 3908++_tsrangeOid :: Oid+_tsrangeOid = Oid 3909++tstzrangeOid :: Oid+tstzrangeOid = Oid 3910++_tstzrangeOid :: Oid+_tstzrangeOid = Oid 3911++daterangeOid :: Oid+daterangeOid = Oid 3912++_daterangeOid :: Oid+_daterangeOid = Oid 3913++int8rangeOid :: Oid+int8rangeOid = Oid 3926++_int8rangeOid :: Oid+_int8rangeOid = Oid 3927++pg_shseclabelOid :: Oid+pg_shseclabelOid = Oid 4066++jsonpathOid :: Oid+jsonpathOid = Oid 4072++_jsonpathOid :: Oid+_jsonpathOid = Oid 4073++regnamespaceOid :: Oid+regnamespaceOid = Oid 4089++_regnamespaceOid :: Oid+_regnamespaceOid = Oid 4090++regroleOid :: Oid+regroleOid = Oid 4096++_regroleOid :: Oid+_regroleOid = Oid 4097++regcollationOid :: Oid+regcollationOid = Oid 4191++_regcollationOid :: Oid+_regcollationOid = Oid 4192++int4multirangeOid :: Oid+int4multirangeOid = Oid 4451++nummultirangeOid :: Oid+nummultirangeOid = Oid 4532++tsmultirangeOid :: Oid+tsmultirangeOid = Oid 4533++tstzmultirangeOid :: Oid+tstzmultirangeOid = Oid 4534++datemultirangeOid :: Oid+datemultirangeOid = Oid 4535++int8multirangeOid :: Oid+int8multirangeOid = Oid 4536++anymultirangeOid :: Oid+anymultirangeOid = Oid 4537++anycompatiblemultirangeOid :: Oid+anycompatiblemultirangeOid = Oid 4538++pg_brin_bloom_summaryOid :: Oid+pg_brin_bloom_summaryOid = Oid 4600++pg_brin_minmax_multi_summaryOid :: Oid+pg_brin_minmax_multi_summaryOid = Oid 4601++pg_mcv_listOid :: Oid+pg_mcv_listOid = Oid 5017++pg_snapshotOid :: Oid+pg_snapshotOid = Oid 5038++_pg_snapshotOid :: Oid+_pg_snapshotOid = Oid 5039++xid8Oid :: Oid+xid8Oid = Oid 5069++anycompatibleOid :: Oid+anycompatibleOid = Oid 5077++anycompatiblearrayOid :: Oid+anycompatiblearrayOid = Oid 5078++anycompatiblenonarrayOid :: Oid+anycompatiblenonarrayOid = Oid 5079++anycompatiblerangeOid :: Oid+anycompatiblerangeOid = Oid 5080++pg_subscriptionOid :: Oid+pg_subscriptionOid = Oid 6101++_int4multirangeOid :: Oid+_int4multirangeOid = Oid 6150++_nummultirangeOid :: Oid+_nummultirangeOid = Oid 6151++_tsmultirangeOid :: Oid+_tsmultirangeOid = Oid 6152++_tstzmultirangeOid :: Oid+_tstzmultirangeOid = Oid 6153++_datemultirangeOid :: Oid+_datemultirangeOid = Oid 6155++_int8multirangeOid :: Oid+_int8multirangeOid = Oid 6157++_pg_attrdefOid :: Oid+_pg_attrdefOid = Oid 10000++pg_attrdefOid :: Oid+pg_attrdefOid = Oid 10001++_pg_constraintOid :: Oid+_pg_constraintOid = Oid 10002++pg_constraintOid :: Oid+pg_constraintOid = Oid 10003++_pg_inheritsOid :: Oid+_pg_inheritsOid = Oid 10004++pg_inheritsOid :: Oid+pg_inheritsOid = Oid 10005++_pg_indexOid :: Oid+_pg_indexOid = Oid 10006++pg_indexOid :: Oid+pg_indexOid = Oid 10007++_pg_operatorOid :: Oid+_pg_operatorOid = Oid 10008++pg_operatorOid :: Oid+pg_operatorOid = Oid 10009++_pg_opfamilyOid :: Oid+_pg_opfamilyOid = Oid 10010++pg_opfamilyOid :: Oid+pg_opfamilyOid = Oid 10011++_pg_opclassOid :: Oid+_pg_opclassOid = Oid 10012++pg_opclassOid :: Oid+pg_opclassOid = Oid 10013++_pg_amOid :: Oid+_pg_amOid = Oid 10014++pg_amOid :: Oid+pg_amOid = Oid 10015++_pg_amopOid :: Oid+_pg_amopOid = Oid 10016++pg_amopOid :: Oid+pg_amopOid = Oid 10017++_pg_amprocOid :: Oid+_pg_amprocOid = Oid 10018++pg_amprocOid :: Oid+pg_amprocOid = Oid 10019++_pg_languageOid :: Oid+_pg_languageOid = Oid 10020++pg_languageOid :: Oid+pg_languageOid = Oid 10021++_pg_largeobject_metadataOid :: Oid+_pg_largeobject_metadataOid = Oid 10022++pg_largeobject_metadataOid :: Oid+pg_largeobject_metadataOid = Oid 10023++_pg_largeobjectOid :: Oid+_pg_largeobjectOid = Oid 10024++pg_largeobjectOid :: Oid+pg_largeobjectOid = Oid 10025++_pg_aggregateOid :: Oid+_pg_aggregateOid = Oid 10026++pg_aggregateOid :: Oid+pg_aggregateOid = Oid 10027++_pg_statisticOid :: Oid+_pg_statisticOid = Oid 10028++pg_statisticOid :: Oid+pg_statisticOid = Oid 10029++_pg_statistic_extOid :: Oid+_pg_statistic_extOid = Oid 10030++pg_statistic_extOid :: Oid+pg_statistic_extOid = Oid 10031++_pg_statistic_ext_dataOid :: Oid+_pg_statistic_ext_dataOid = Oid 10032++pg_statistic_ext_dataOid :: Oid+pg_statistic_ext_dataOid = Oid 10033++_pg_rewriteOid :: Oid+_pg_rewriteOid = Oid 10034++pg_rewriteOid :: Oid+pg_rewriteOid = Oid 10035++_pg_triggerOid :: Oid+_pg_triggerOid = Oid 10036++pg_triggerOid :: Oid+pg_triggerOid = Oid 10037++_pg_event_triggerOid :: Oid+_pg_event_triggerOid = Oid 10038++pg_event_triggerOid :: Oid+pg_event_triggerOid = Oid 10039++_pg_descriptionOid :: Oid+_pg_descriptionOid = Oid 10040++pg_descriptionOid :: Oid+pg_descriptionOid = Oid 10041++_pg_castOid :: Oid+_pg_castOid = Oid 10042++pg_castOid :: Oid+pg_castOid = Oid 10043++_pg_enumOid :: Oid+_pg_enumOid = Oid 10044++pg_enumOid :: Oid+pg_enumOid = Oid 10045++_pg_namespaceOid :: Oid+_pg_namespaceOid = Oid 10046++pg_namespaceOid :: Oid+pg_namespaceOid = Oid 10047++_pg_conversionOid :: Oid+_pg_conversionOid = Oid 10048++pg_conversionOid :: Oid+pg_conversionOid = Oid 10049++_pg_dependOid :: Oid+_pg_dependOid = Oid 10050++pg_dependOid :: Oid+pg_dependOid = Oid 10051++_pg_databaseOid :: Oid+_pg_databaseOid = Oid 10052++_pg_db_role_settingOid :: Oid+_pg_db_role_settingOid = Oid 10053++pg_db_role_settingOid :: Oid+pg_db_role_settingOid = Oid 10054++_pg_tablespaceOid :: Oid+_pg_tablespaceOid = Oid 10055++pg_tablespaceOid :: Oid+pg_tablespaceOid = Oid 10056++_pg_authidOid :: Oid+_pg_authidOid = Oid 10057++_pg_auth_membersOid :: Oid+_pg_auth_membersOid = Oid 10058++_pg_shdependOid :: Oid+_pg_shdependOid = Oid 10059++pg_shdependOid :: Oid+pg_shdependOid = Oid 10060++_pg_shdescriptionOid :: Oid+_pg_shdescriptionOid = Oid 10061++pg_shdescriptionOid :: Oid+pg_shdescriptionOid = Oid 10062++_pg_ts_configOid :: Oid+_pg_ts_configOid = Oid 10063++pg_ts_configOid :: Oid+pg_ts_configOid = Oid 10064++_pg_ts_config_mapOid :: Oid+_pg_ts_config_mapOid = Oid 10065++pg_ts_config_mapOid :: Oid+pg_ts_config_mapOid = Oid 10066++_pg_ts_dictOid :: Oid+_pg_ts_dictOid = Oid 10067++pg_ts_dictOid :: Oid+pg_ts_dictOid = Oid 10068++_pg_ts_parserOid :: Oid+_pg_ts_parserOid = Oid 10069++pg_ts_parserOid :: Oid+pg_ts_parserOid = Oid 10070++_pg_ts_templateOid :: Oid+_pg_ts_templateOid = Oid 10071++pg_ts_templateOid :: Oid+pg_ts_templateOid = Oid 10072++_pg_extensionOid :: Oid+_pg_extensionOid = Oid 10073++pg_extensionOid :: Oid+pg_extensionOid = Oid 10074++_pg_foreign_data_wrapperOid :: Oid+_pg_foreign_data_wrapperOid = Oid 10075++pg_foreign_data_wrapperOid :: Oid+pg_foreign_data_wrapperOid = Oid 10076++_pg_foreign_serverOid :: Oid+_pg_foreign_serverOid = Oid 10077++pg_foreign_serverOid :: Oid+pg_foreign_serverOid = Oid 10078++_pg_user_mappingOid :: Oid+_pg_user_mappingOid = Oid 10079++pg_user_mappingOid :: Oid+pg_user_mappingOid = Oid 10080++_pg_foreign_tableOid :: Oid+_pg_foreign_tableOid = Oid 10081++pg_foreign_tableOid :: Oid+pg_foreign_tableOid = Oid 10082++_pg_policyOid :: Oid+_pg_policyOid = Oid 10083++pg_policyOid :: Oid+pg_policyOid = Oid 10084++_pg_replication_originOid :: Oid+_pg_replication_originOid = Oid 10085++pg_replication_originOid :: Oid+pg_replication_originOid = Oid 10086++_pg_default_aclOid :: Oid+_pg_default_aclOid = Oid 10087++pg_default_aclOid :: Oid+pg_default_aclOid = Oid 10088++_pg_init_privsOid :: Oid+_pg_init_privsOid = Oid 10089++pg_init_privsOid :: Oid+pg_init_privsOid = Oid 10090++_pg_seclabelOid :: Oid+_pg_seclabelOid = Oid 10091++pg_seclabelOid :: Oid+pg_seclabelOid = Oid 10092++_pg_shseclabelOid :: Oid+_pg_shseclabelOid = Oid 10093++_pg_collationOid :: Oid+_pg_collationOid = Oid 10094++pg_collationOid :: Oid+pg_collationOid = Oid 10095++_pg_parameter_aclOid :: Oid+_pg_parameter_aclOid = Oid 10096++pg_parameter_aclOid :: Oid+pg_parameter_aclOid = Oid 10097++_pg_partitioned_tableOid :: Oid+_pg_partitioned_tableOid = Oid 10098++pg_partitioned_tableOid :: Oid+pg_partitioned_tableOid = Oid 10099++_pg_rangeOid :: Oid+_pg_rangeOid = Oid 10100++pg_rangeOid :: Oid+pg_rangeOid = Oid 10101++_pg_transformOid :: Oid+_pg_transformOid = Oid 10102++pg_transformOid :: Oid+pg_transformOid = Oid 10103++_pg_sequenceOid :: Oid+_pg_sequenceOid = Oid 10104++pg_sequenceOid :: Oid+pg_sequenceOid = Oid 10105++_pg_publicationOid :: Oid+_pg_publicationOid = Oid 10106++pg_publicationOid :: Oid+pg_publicationOid = Oid 10107++_pg_publication_namespaceOid :: Oid+_pg_publication_namespaceOid = Oid 10108++pg_publication_namespaceOid :: Oid+pg_publication_namespaceOid = Oid 10109++_pg_publication_relOid :: Oid+_pg_publication_relOid = Oid 10110++pg_publication_relOid :: Oid+pg_publication_relOid = Oid 10111++_pg_subscriptionOid :: Oid+_pg_subscriptionOid = Oid 10112++_pg_subscription_relOid :: Oid+_pg_subscription_relOid = Oid 10113++pg_subscription_relOid :: Oid+pg_subscription_relOid = Oid 10114++_pg_rolesOid :: Oid+_pg_rolesOid = Oid 12001++pg_rolesOid :: Oid+pg_rolesOid = Oid 12002++_pg_shadowOid :: Oid+_pg_shadowOid = Oid 12006++pg_shadowOid :: Oid+pg_shadowOid = Oid 12007++_pg_groupOid :: Oid+_pg_groupOid = Oid 12011++pg_groupOid :: Oid+pg_groupOid = Oid 12012++_pg_userOid :: Oid+_pg_userOid = Oid 12015++pg_userOid :: Oid+pg_userOid = Oid 12016++_pg_policiesOid :: Oid+_pg_policiesOid = Oid 12019++pg_policiesOid :: Oid+pg_policiesOid = Oid 12020++_pg_rulesOid :: Oid+_pg_rulesOid = Oid 12024++pg_rulesOid :: Oid+pg_rulesOid = Oid 12025++_pg_viewsOid :: Oid+_pg_viewsOid = Oid 12029++pg_viewsOid :: Oid+pg_viewsOid = Oid 12030++_pg_tablesOid :: Oid+_pg_tablesOid = Oid 12034++pg_tablesOid :: Oid+pg_tablesOid = Oid 12035++_pg_matviewsOid :: Oid+_pg_matviewsOid = Oid 12039++pg_matviewsOid :: Oid+pg_matviewsOid = Oid 12040++_pg_indexesOid :: Oid+_pg_indexesOid = Oid 12044++pg_indexesOid :: Oid+pg_indexesOid = Oid 12045++_pg_sequencesOid :: Oid+_pg_sequencesOid = Oid 12049++pg_sequencesOid :: Oid+pg_sequencesOid = Oid 12050++_pg_statsOid :: Oid+_pg_statsOid = Oid 12054++pg_statsOid :: Oid+pg_statsOid = Oid 12055++_pg_stats_extOid :: Oid+_pg_stats_extOid = Oid 12059++pg_stats_extOid :: Oid+pg_stats_extOid = Oid 12060++_pg_stats_ext_exprsOid :: Oid+_pg_stats_ext_exprsOid = Oid 12064++pg_stats_ext_exprsOid :: Oid+pg_stats_ext_exprsOid = Oid 12065++_pg_publication_tablesOid :: Oid+_pg_publication_tablesOid = Oid 12069++pg_publication_tablesOid :: Oid+pg_publication_tablesOid = Oid 12070++_pg_locksOid :: Oid+_pg_locksOid = Oid 12074++pg_locksOid :: Oid+pg_locksOid = Oid 12075++_pg_cursorsOid :: Oid+_pg_cursorsOid = Oid 12078++pg_cursorsOid :: Oid+pg_cursorsOid = Oid 12079++_pg_available_extensionsOid :: Oid+_pg_available_extensionsOid = Oid 12082++pg_available_extensionsOid :: Oid+pg_available_extensionsOid = Oid 12083++_pg_available_extension_versionsOid :: Oid+_pg_available_extension_versionsOid = Oid 12086++pg_available_extension_versionsOid :: Oid+pg_available_extension_versionsOid = Oid 12087++_pg_prepared_xactsOid :: Oid+_pg_prepared_xactsOid = Oid 12091++pg_prepared_xactsOid :: Oid+pg_prepared_xactsOid = Oid 12092++_pg_prepared_statementsOid :: Oid+_pg_prepared_statementsOid = Oid 12096++pg_prepared_statementsOid :: Oid+pg_prepared_statementsOid = Oid 12097++_pg_seclabelsOid :: Oid+_pg_seclabelsOid = Oid 12100++pg_seclabelsOid :: Oid+pg_seclabelsOid = Oid 12101++_pg_settingsOid :: Oid+_pg_settingsOid = Oid 12105++pg_settingsOid :: Oid+pg_settingsOid = Oid 12106++_pg_file_settingsOid :: Oid+_pg_file_settingsOid = Oid 12111++pg_file_settingsOid :: Oid+pg_file_settingsOid = Oid 12112++_pg_hba_file_rulesOid :: Oid+_pg_hba_file_rulesOid = Oid 12115++pg_hba_file_rulesOid :: Oid+pg_hba_file_rulesOid = Oid 12116++_pg_ident_file_mappingsOid :: Oid+_pg_ident_file_mappingsOid = Oid 12119++pg_ident_file_mappingsOid :: Oid+pg_ident_file_mappingsOid = Oid 12120++_pg_timezone_abbrevsOid :: Oid+_pg_timezone_abbrevsOid = Oid 12123++pg_timezone_abbrevsOid :: Oid+pg_timezone_abbrevsOid = Oid 12124++_pg_timezone_namesOid :: Oid+_pg_timezone_namesOid = Oid 12127++pg_timezone_namesOid :: Oid+pg_timezone_namesOid = Oid 12128++_pg_configOid :: Oid+_pg_configOid = Oid 12131++pg_configOid :: Oid+pg_configOid = Oid 12132++_pg_shmem_allocationsOid :: Oid+_pg_shmem_allocationsOid = Oid 12135++pg_shmem_allocationsOid :: Oid+pg_shmem_allocationsOid = Oid 12136++_pg_backend_memory_contextsOid :: Oid+_pg_backend_memory_contextsOid = Oid 12139++pg_backend_memory_contextsOid :: Oid+pg_backend_memory_contextsOid = Oid 12140++_pg_stat_all_tablesOid :: Oid+_pg_stat_all_tablesOid = Oid 12143++pg_stat_all_tablesOid :: Oid+pg_stat_all_tablesOid = Oid 12144++_pg_stat_xact_all_tablesOid :: Oid+_pg_stat_xact_all_tablesOid = Oid 12148++pg_stat_xact_all_tablesOid :: Oid+pg_stat_xact_all_tablesOid = Oid 12149++_pg_stat_sys_tablesOid :: Oid+_pg_stat_sys_tablesOid = Oid 12153++pg_stat_sys_tablesOid :: Oid+pg_stat_sys_tablesOid = Oid 12154++_pg_stat_xact_sys_tablesOid :: Oid+_pg_stat_xact_sys_tablesOid = Oid 12158++pg_stat_xact_sys_tablesOid :: Oid+pg_stat_xact_sys_tablesOid = Oid 12159++_pg_stat_user_tablesOid :: Oid+_pg_stat_user_tablesOid = Oid 12162++pg_stat_user_tablesOid :: Oid+pg_stat_user_tablesOid = Oid 12163++_pg_stat_xact_user_tablesOid :: Oid+_pg_stat_xact_user_tablesOid = Oid 12167++pg_stat_xact_user_tablesOid :: Oid+pg_stat_xact_user_tablesOid = Oid 12168++_pg_statio_all_tablesOid :: Oid+_pg_statio_all_tablesOid = Oid 12171++pg_statio_all_tablesOid :: Oid+pg_statio_all_tablesOid = Oid 12172++_pg_statio_sys_tablesOid :: Oid+_pg_statio_sys_tablesOid = Oid 12176++pg_statio_sys_tablesOid :: Oid+pg_statio_sys_tablesOid = Oid 12177++_pg_statio_user_tablesOid :: Oid+_pg_statio_user_tablesOid = Oid 12180++pg_statio_user_tablesOid :: Oid+pg_statio_user_tablesOid = Oid 12181++_pg_stat_all_indexesOid :: Oid+_pg_stat_all_indexesOid = Oid 12184++pg_stat_all_indexesOid :: Oid+pg_stat_all_indexesOid = Oid 12185++_pg_stat_sys_indexesOid :: Oid+_pg_stat_sys_indexesOid = Oid 12189++pg_stat_sys_indexesOid :: Oid+pg_stat_sys_indexesOid = Oid 12190++_pg_stat_user_indexesOid :: Oid+_pg_stat_user_indexesOid = Oid 12193++pg_stat_user_indexesOid :: Oid+pg_stat_user_indexesOid = Oid 12194++_pg_statio_all_indexesOid :: Oid+_pg_statio_all_indexesOid = Oid 12197++pg_statio_all_indexesOid :: Oid+pg_statio_all_indexesOid = Oid 12198++_pg_statio_sys_indexesOid :: Oid+_pg_statio_sys_indexesOid = Oid 12202++pg_statio_sys_indexesOid :: Oid+pg_statio_sys_indexesOid = Oid 12203++_pg_statio_user_indexesOid :: Oid+_pg_statio_user_indexesOid = Oid 12206++pg_statio_user_indexesOid :: Oid+pg_statio_user_indexesOid = Oid 12207++_pg_statio_all_sequencesOid :: Oid+_pg_statio_all_sequencesOid = Oid 12210++pg_statio_all_sequencesOid :: Oid+pg_statio_all_sequencesOid = Oid 12211++_pg_statio_sys_sequencesOid :: Oid+_pg_statio_sys_sequencesOid = Oid 12215++pg_statio_sys_sequencesOid :: Oid+pg_statio_sys_sequencesOid = Oid 12216++_pg_statio_user_sequencesOid :: Oid+_pg_statio_user_sequencesOid = Oid 12219++pg_statio_user_sequencesOid :: Oid+pg_statio_user_sequencesOid = Oid 12220++_pg_stat_activityOid :: Oid+_pg_stat_activityOid = Oid 12223++pg_stat_activityOid :: Oid+pg_stat_activityOid = Oid 12224++_pg_stat_replicationOid :: Oid+_pg_stat_replicationOid = Oid 12228++pg_stat_replicationOid :: Oid+pg_stat_replicationOid = Oid 12229++_pg_stat_slruOid :: Oid+_pg_stat_slruOid = Oid 12233++pg_stat_slruOid :: Oid+pg_stat_slruOid = Oid 12234++_pg_stat_wal_receiverOid :: Oid+_pg_stat_wal_receiverOid = Oid 12237++pg_stat_wal_receiverOid :: Oid+pg_stat_wal_receiverOid = Oid 12238++_pg_stat_recovery_prefetchOid :: Oid+_pg_stat_recovery_prefetchOid = Oid 12241++pg_stat_recovery_prefetchOid :: Oid+pg_stat_recovery_prefetchOid = Oid 12242++_pg_stat_subscriptionOid :: Oid+_pg_stat_subscriptionOid = Oid 12245++pg_stat_subscriptionOid :: Oid+pg_stat_subscriptionOid = Oid 12246++_pg_stat_sslOid :: Oid+_pg_stat_sslOid = Oid 12250++pg_stat_sslOid :: Oid+pg_stat_sslOid = Oid 12251++_pg_stat_gssapiOid :: Oid+_pg_stat_gssapiOid = Oid 12254++pg_stat_gssapiOid :: Oid+pg_stat_gssapiOid = Oid 12255++_pg_replication_slotsOid :: Oid+_pg_replication_slotsOid = Oid 12258++pg_replication_slotsOid :: Oid+pg_replication_slotsOid = Oid 12259++_pg_stat_replication_slotsOid :: Oid+_pg_stat_replication_slotsOid = Oid 12263++pg_stat_replication_slotsOid :: Oid+pg_stat_replication_slotsOid = Oid 12264++_pg_stat_databaseOid :: Oid+_pg_stat_databaseOid = Oid 12267++pg_stat_databaseOid :: Oid+pg_stat_databaseOid = Oid 12268++_pg_stat_database_conflictsOid :: Oid+_pg_stat_database_conflictsOid = Oid 12272++pg_stat_database_conflictsOid :: Oid+pg_stat_database_conflictsOid = Oid 12273++_pg_stat_user_functionsOid :: Oid+_pg_stat_user_functionsOid = Oid 12276++pg_stat_user_functionsOid :: Oid+pg_stat_user_functionsOid = Oid 12277++_pg_stat_xact_user_functionsOid :: Oid+_pg_stat_xact_user_functionsOid = Oid 12281++pg_stat_xact_user_functionsOid :: Oid+pg_stat_xact_user_functionsOid = Oid 12282++_pg_stat_archiverOid :: Oid+_pg_stat_archiverOid = Oid 12286++pg_stat_archiverOid :: Oid+pg_stat_archiverOid = Oid 12287++_pg_stat_bgwriterOid :: Oid+_pg_stat_bgwriterOid = Oid 12290++pg_stat_bgwriterOid :: Oid+pg_stat_bgwriterOid = Oid 12291++_pg_stat_ioOid :: Oid+_pg_stat_ioOid = Oid 12294++pg_stat_ioOid :: Oid+pg_stat_ioOid = Oid 12295++_pg_stat_walOid :: Oid+_pg_stat_walOid = Oid 12298++pg_stat_walOid :: Oid+pg_stat_walOid = Oid 12299++_pg_stat_progress_analyzeOid :: Oid+_pg_stat_progress_analyzeOid = Oid 12302++pg_stat_progress_analyzeOid :: Oid+pg_stat_progress_analyzeOid = Oid 12303++_pg_stat_progress_vacuumOid :: Oid+_pg_stat_progress_vacuumOid = Oid 12307++pg_stat_progress_vacuumOid :: Oid+pg_stat_progress_vacuumOid = Oid 12308++_pg_stat_progress_clusterOid :: Oid+_pg_stat_progress_clusterOid = Oid 12312++pg_stat_progress_clusterOid :: Oid+pg_stat_progress_clusterOid = Oid 12313++_pg_stat_progress_create_indexOid :: Oid+_pg_stat_progress_create_indexOid = Oid 12317++pg_stat_progress_create_indexOid :: Oid+pg_stat_progress_create_indexOid = Oid 12318++_pg_stat_progress_basebackupOid :: Oid+_pg_stat_progress_basebackupOid = Oid 12322++pg_stat_progress_basebackupOid :: Oid+pg_stat_progress_basebackupOid = Oid 12323++_pg_stat_progress_copyOid :: Oid+_pg_stat_progress_copyOid = Oid 12327++pg_stat_progress_copyOid :: Oid+pg_stat_progress_copyOid = Oid 12328++pg_user_mappingsOid :: Oid+pg_user_mappingsOid = Oid 12333++_pg_replication_origin_statusOid :: Oid+_pg_replication_origin_statusOid = Oid 12337++pg_replication_origin_statusOid :: Oid+pg_replication_origin_statusOid = Oid 12338++_pg_stat_subscription_statsOid :: Oid+_pg_stat_subscription_statsOid = Oid 12341++pg_stat_subscription_statsOid :: Oid+pg_stat_subscription_statsOid = Oid 12342++_cardinal_numberOid :: Oid+_cardinal_numberOid = Oid 13291++cardinal_numberOid :: Oid+cardinal_numberOid = Oid 13292++_character_dataOid :: Oid+_character_dataOid = Oid 13294++character_dataOid :: Oid+character_dataOid = Oid 13295++_sql_identifierOid :: Oid+_sql_identifierOid = Oid 13296++sql_identifierOid :: Oid+sql_identifierOid = Oid 13297++_information_schema_catalog_nameOid :: Oid+_information_schema_catalog_nameOid = Oid 13299++information_schema_catalog_nameOid :: Oid+information_schema_catalog_nameOid = Oid 13300++_time_stampOid :: Oid+_time_stampOid = Oid 13302++time_stampOid :: Oid+time_stampOid = Oid 13303++_yes_or_noOid :: Oid+_yes_or_noOid = Oid 13304++yes_or_noOid :: Oid+yes_or_noOid = Oid 13305++_applicable_rolesOid :: Oid+_applicable_rolesOid = Oid 13308++applicable_rolesOid :: Oid+applicable_rolesOid = Oid 13309++_administrable_role_authorizationsOid :: Oid+_administrable_role_authorizationsOid = Oid 13313++administrable_role_authorizationsOid :: Oid+administrable_role_authorizationsOid = Oid 13314++_attributesOid :: Oid+_attributesOid = Oid 13317++attributesOid :: Oid+attributesOid = Oid 13318++_character_setsOid :: Oid+_character_setsOid = Oid 13322++character_setsOid :: Oid+character_setsOid = Oid 13323++_check_constraint_routine_usageOid :: Oid+_check_constraint_routine_usageOid = Oid 13327++check_constraint_routine_usageOid :: Oid+check_constraint_routine_usageOid = Oid 13328++_check_constraintsOid :: Oid+_check_constraintsOid = Oid 13332++check_constraintsOid :: Oid+check_constraintsOid = Oid 13333++_collationsOid :: Oid+_collationsOid = Oid 13337++collationsOid :: Oid+collationsOid = Oid 13338++_collation_character_set_applicabilityOid :: Oid+_collation_character_set_applicabilityOid = Oid 13342++collation_character_set_applicabilityOid :: Oid+collation_character_set_applicabilityOid = Oid 13343++_column_column_usageOid :: Oid+_column_column_usageOid = Oid 13347++column_column_usageOid :: Oid+column_column_usageOid = Oid 13348++_column_domain_usageOid :: Oid+_column_domain_usageOid = Oid 13352++column_domain_usageOid :: Oid+column_domain_usageOid = Oid 13353++_column_privilegesOid :: Oid+_column_privilegesOid = Oid 13357++column_privilegesOid :: Oid+column_privilegesOid = Oid 13358++_column_udt_usageOid :: Oid+_column_udt_usageOid = Oid 13362++column_udt_usageOid :: Oid+column_udt_usageOid = Oid 13363++_columnsOid :: Oid+_columnsOid = Oid 13367++columnsOid :: Oid+columnsOid = Oid 13368++_constraint_column_usageOid :: Oid+_constraint_column_usageOid = Oid 13372++constraint_column_usageOid :: Oid+constraint_column_usageOid = Oid 13373++_constraint_table_usageOid :: Oid+_constraint_table_usageOid = Oid 13377++constraint_table_usageOid :: Oid+constraint_table_usageOid = Oid 13378++_domain_constraintsOid :: Oid+_domain_constraintsOid = Oid 13382++domain_constraintsOid :: Oid+domain_constraintsOid = Oid 13383++_domain_udt_usageOid :: Oid+_domain_udt_usageOid = Oid 13387++domain_udt_usageOid :: Oid+domain_udt_usageOid = Oid 13388++_domainsOid :: Oid+_domainsOid = Oid 13392++domainsOid :: Oid+domainsOid = Oid 13393++_enabled_rolesOid :: Oid+_enabled_rolesOid = Oid 13397++enabled_rolesOid :: Oid+enabled_rolesOid = Oid 13398++_key_column_usageOid :: Oid+_key_column_usageOid = Oid 13401++key_column_usageOid :: Oid+key_column_usageOid = Oid 13402++_parametersOid :: Oid+_parametersOid = Oid 13406++parametersOid :: Oid+parametersOid = Oid 13407++_referential_constraintsOid :: Oid+_referential_constraintsOid = Oid 13411++referential_constraintsOid :: Oid+referential_constraintsOid = Oid 13412++_role_column_grantsOid :: Oid+_role_column_grantsOid = Oid 13416++role_column_grantsOid :: Oid+role_column_grantsOid = Oid 13417++_routine_column_usageOid :: Oid+_routine_column_usageOid = Oid 13420++routine_column_usageOid :: Oid+routine_column_usageOid = Oid 13421++_routine_privilegesOid :: Oid+_routine_privilegesOid = Oid 13425++routine_privilegesOid :: Oid+routine_privilegesOid = Oid 13426++_role_routine_grantsOid :: Oid+_role_routine_grantsOid = Oid 13430++role_routine_grantsOid :: Oid+role_routine_grantsOid = Oid 13431++_routine_routine_usageOid :: Oid+_routine_routine_usageOid = Oid 13434++routine_routine_usageOid :: Oid+routine_routine_usageOid = Oid 13435++_routine_sequence_usageOid :: Oid+_routine_sequence_usageOid = Oid 13439++routine_sequence_usageOid :: Oid+routine_sequence_usageOid = Oid 13440++_routine_table_usageOid :: Oid+_routine_table_usageOid = Oid 13444++routine_table_usageOid :: Oid+routine_table_usageOid = Oid 13445++_routinesOid :: Oid+_routinesOid = Oid 13449++routinesOid :: Oid+routinesOid = Oid 13450++_schemataOid :: Oid+_schemataOid = Oid 13454++schemataOid :: Oid+schemataOid = Oid 13455++_sequencesOid :: Oid+_sequencesOid = Oid 13458++sequencesOid :: Oid+sequencesOid = Oid 13459++_sql_featuresOid :: Oid+_sql_featuresOid = Oid 13463++sql_featuresOid :: Oid+sql_featuresOid = Oid 13464++_sql_implementation_infoOid :: Oid+_sql_implementation_infoOid = Oid 13468++sql_implementation_infoOid :: Oid+sql_implementation_infoOid = Oid 13469++_sql_partsOid :: Oid+_sql_partsOid = Oid 13473++sql_partsOid :: Oid+sql_partsOid = Oid 13474++_sql_sizingOid :: Oid+_sql_sizingOid = Oid 13478++sql_sizingOid :: Oid+sql_sizingOid = Oid 13479++_table_constraintsOid :: Oid+_table_constraintsOid = Oid 13483++table_constraintsOid :: Oid+table_constraintsOid = Oid 13484++_table_privilegesOid :: Oid+_table_privilegesOid = Oid 13488++table_privilegesOid :: Oid+table_privilegesOid = Oid 13489++_role_table_grantsOid :: Oid+_role_table_grantsOid = Oid 13493++role_table_grantsOid :: Oid+role_table_grantsOid = Oid 13494++_tablesOid :: Oid+_tablesOid = Oid 13497++tablesOid :: Oid+tablesOid = Oid 13498++_transformsOid :: Oid+_transformsOid = Oid 13502++transformsOid :: Oid+transformsOid = Oid 13503++_triggered_update_columnsOid :: Oid+_triggered_update_columnsOid = Oid 13507++triggered_update_columnsOid :: Oid+triggered_update_columnsOid = Oid 13508++_triggersOid :: Oid+_triggersOid = Oid 13512++triggersOid :: Oid+triggersOid = Oid 13513++_udt_privilegesOid :: Oid+_udt_privilegesOid = Oid 13517++udt_privilegesOid :: Oid+udt_privilegesOid = Oid 13518++_role_udt_grantsOid :: Oid+_role_udt_grantsOid = Oid 13522++role_udt_grantsOid :: Oid+role_udt_grantsOid = Oid 13523++_usage_privilegesOid :: Oid+_usage_privilegesOid = Oid 13526++usage_privilegesOid :: Oid+usage_privilegesOid = Oid 13527++_role_usage_grantsOid :: Oid+_role_usage_grantsOid = Oid 13531++role_usage_grantsOid :: Oid+role_usage_grantsOid = Oid 13532++_user_defined_typesOid :: Oid+_user_defined_typesOid = Oid 13535++user_defined_typesOid :: Oid+user_defined_typesOid = Oid 13536++_view_column_usageOid :: Oid+_view_column_usageOid = Oid 13540++view_column_usageOid :: Oid+view_column_usageOid = Oid 13541++_view_routine_usageOid :: Oid+_view_routine_usageOid = Oid 13545++view_routine_usageOid :: Oid+view_routine_usageOid = Oid 13546++_view_table_usageOid :: Oid+_view_table_usageOid = Oid 13550++view_table_usageOid :: Oid+view_table_usageOid = Oid 13551++_viewsOid :: Oid+_viewsOid = Oid 13555++viewsOid :: Oid+viewsOid = Oid 13556++_data_type_privilegesOid :: Oid+_data_type_privilegesOid = Oid 13560++data_type_privilegesOid :: Oid+data_type_privilegesOid = Oid 13561++_element_typesOid :: Oid+_element_typesOid = Oid 13565++element_typesOid :: Oid+element_typesOid = Oid 13566++__pg_foreign_table_columnsOid :: Oid+__pg_foreign_table_columnsOid = Oid 13570++_pg_foreign_table_columnsOid :: Oid+_pg_foreign_table_columnsOid = Oid 13571++_column_optionsOid :: Oid+_column_optionsOid = Oid 13575++column_optionsOid :: Oid+column_optionsOid = Oid 13576++__pg_foreign_data_wrappersOid :: Oid+__pg_foreign_data_wrappersOid = Oid 13579++_pg_foreign_data_wrappersOid :: Oid+_pg_foreign_data_wrappersOid = Oid 13580++_foreign_data_wrapper_optionsOid :: Oid+_foreign_data_wrapper_optionsOid = Oid 13583++foreign_data_wrapper_optionsOid :: Oid+foreign_data_wrapper_optionsOid = Oid 13584++_foreign_data_wrappersOid :: Oid+_foreign_data_wrappersOid = Oid 13587++foreign_data_wrappersOid :: Oid+foreign_data_wrappersOid = Oid 13588++__pg_foreign_serversOid :: Oid+__pg_foreign_serversOid = Oid 13591++_pg_foreign_serversOid :: Oid+_pg_foreign_serversOid = Oid 13592++_foreign_server_optionsOid :: Oid+_foreign_server_optionsOid = Oid 13596++foreign_server_optionsOid :: Oid+foreign_server_optionsOid = Oid 13597++_foreign_serversOid :: Oid+_foreign_serversOid = Oid 13600++foreign_serversOid :: Oid+foreign_serversOid = Oid 13601++__pg_foreign_tablesOid :: Oid+__pg_foreign_tablesOid = Oid 13604++_pg_foreign_tablesOid :: Oid+_pg_foreign_tablesOid = Oid 13605++_foreign_table_optionsOid :: Oid+_foreign_table_optionsOid = Oid 13609++foreign_table_optionsOid :: Oid+foreign_table_optionsOid = Oid 13610++_foreign_tablesOid :: Oid+_foreign_tablesOid = Oid 13613++foreign_tablesOid :: Oid+foreign_tablesOid = Oid 13614++__pg_user_mappingsOid :: Oid+__pg_user_mappingsOid = Oid 13617++_pg_user_mappingsOid :: Oid+_pg_user_mappingsOid = Oid 13618++_user_mapping_optionsOid :: Oid+_user_mapping_optionsOid = Oid 13622++user_mapping_optionsOid :: Oid+user_mapping_optionsOid = Oid 13623++_user_mappingsOid :: Oid+_user_mappingsOid = Oid 13627++user_mappingsOid :: Oid+user_mappingsOid = Oid 13628
+ src/Hpgsql/Types.hs view
@@ -0,0 +1,129 @@+module Hpgsql.Types+  ( Only (..),+    Aeson (..),+    PgJson, -- Do not export ctor+    PGArray (..),+    (:.) (..),+    pgJsonByteString,+  )+where++import Control.Monad (replicateM)+import Data.Aeson (FromJSON, ToJSON)+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encoding as AesonInternal+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as LBS+import Data.Tuple.Only (Only (..))+import Data.Typeable (Proxy (..), Typeable)+import Hpgsql.Builder (BinaryField (..))+import Hpgsql.Encoding (FieldDecoder (..), FieldEncoder (..), FieldInfo (..), FromPgField (..), FromPgRow (..), RowEncoder (..), ToPgField (..), ToPgRow (..), arrayField, toPgVectorField)+import Hpgsql.TypeInfo (EncodingContext (..), TypeInfo (..), jsonOid, jsonbOid, lookupTypeByOid)++-- | Encodes a Haskell list as a postgres array. You can also use `Vector` if you prefer.+-- The reason for this type instead of allowing @[a]@ to be a field is that an instance+-- for @[a]@ would require an overlappable instance for @String@, and that is not ideal.+newtype PGArray a = PGArray {fromPGArray :: [a]}+  deriving (Eq, Ord, Read, Show, Functor)++instance forall a. (ToPgField a) => ToPgField (PGArray a) where+  fieldEncoder =+    let fe = fieldEncoder @a+     in FieldEncoder+          { toTypeOid = \encodingContext -> do+              elOid <- fe.toTypeOid encodingContext+              arrayTypInfo <- lookupTypeByOid elOid encodingContext.typeInfoCache+              arrayTypInfo.oidOfArrayType,+            toPgField = \encCtx -> toPgVectorField encCtx . fromPGArray+          }++instance forall a. (FromPgField a) => FromPgField (PGArray a) where+  fieldDecoder = PGArray <$> arrayField replicateM fieldDecoder++-- | A way to compose two rows.+data h :. t = !h :. !t deriving (Eq, Ord, Show, Read)++infixr 3 :.++instance forall a b. (ToPgRow a, ToPgRow b) => ToPgRow (a :. b) where+  rowEncoder =+    let !re1 = rowEncoder @a+        !re2 = rowEncoder @b+     in RowEncoder+          { toPgParams = \(a :. b) -> re1.toPgParams a ++ re2.toPgParams b,+            toTypeOids = \_ -> re1.toTypeOids (Proxy @a) ++ re2.toTypeOids (Proxy @b),+            toBinaryCopyBytes = \encCtx ->+              let !toBytes1 = re1.toBinaryCopyBytes encCtx+                  !toBytes2 = re2.toBinaryCopyBytes encCtx+               in \(a :. b) -> toBytes1 a <> toBytes2 b+          }++instance (FromPgRow a, FromPgRow b) => FromPgRow (a :. b) where+  rowDecoder = (:.) <$> rowDecoder <*> rowDecoder++-- | A JSON type that does not incur the costs of deserializing+-- in its `FromPgField` instance because it assumes postgres only generates+-- valid JSON. Useful for extra performance if its opaqueness is not a problem.+-- Although it does have a `toJSON` method, using it will incur a+-- deserialization cost, so if you find yourself using that too much consider just using+-- `Aeson.Value` or the `Aeson` newtype instead of this.+newtype PgJson = PgJson ByteString++instance ToJSON PgJson where+  toJSON (PgJson bs) = case Aeson.eitherDecodeStrict' bs of+    Left err -> error $ "Bug in Hpgsql. PgJson not valid JSON: " ++ err+    Right v -> v++  toEncoding (PgJson bs) = AesonInternal.unsafeToEncoding (Builder.byteString bs)++-- | A valid UTF8 representation of the JSON value.+pgJsonByteString :: PgJson -> ByteString+pgJsonByteString (PgJson bs) = bs++instance FromPgField PgJson where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder =+          \FieldInfo {fieldTypeOid} ->+            let+              -- jsonb has a byte prepended to the contents and json does not+              !fixJsonb = if fieldTypeOid == jsonbOid then BS.drop 1 else Prelude.id+             in+              \case+                Just bs -> Right $ PgJson $ fixJsonb bs+                Nothing -> Left "Cannot decode SQL null as the Haskell PgJson type. Use a `Maybe PgJson` if you want SQL nulls",+        allowedPgTypes = (`elem` [jsonOid, jsonbOid]) . fieldTypeOid+      }++-- | A newtype wrapper to decode a JSON value with Aeson+-- into your type (from either json or jsonb), and to encode+-- to jsonb.+newtype Aeson a = Aeson {getAeson :: a}+  deriving (Eq, Show, Read, Typeable, Functor)++instance (FromJSON a) => FromPgField (Aeson a) where+  fieldDecoder =+    FieldDecoder+      { fieldValueDecoder =+          \FieldInfo {fieldTypeOid} ->+            let+              -- jsonb has a byte prepended to the contents and json does not+              !fixJsonb = if fieldTypeOid == jsonbOid then BS.drop 1 else Prelude.id+             in+              \case+                Just bs -> case Aeson.decodeStrict $ fixJsonb bs of+                  Just v -> Right $ Aeson v+                  Nothing -> Left "Failed to decode postgres JSON value into your `Aeson a` type. Are you sure it's proper JSON?"+                Nothing -> Left "Cannot decode SQL null as a Haskell (Aeson a) type. Use a `Maybe (Aeson a)` if you want SQL nulls",+        allowedPgTypes = (`elem` [jsonOid, jsonbOid]) . fieldTypeOid+      }++instance (ToJSON a) => ToPgField (Aeson a) where+  fieldEncoder =+    FieldEncoder+      { toTypeOid = \_ -> Just jsonbOid,+        toPgField = \_ (Aeson v) ->+          NotNull $ BS.cons 1 (LBS.toStrict $ Aeson.encode v)+      }