Add BackendPid

hpqtypes.cabal

@@ -77,6 +77,7 @@ library
                      , Database.PostgreSQL.PQTypes.SQL.Class
                      , Database.PostgreSQL.PQTypes.Transaction.Settings
                      , Database.PostgreSQL.PQTypes.XML
+                     , Database.PostgreSQL.PQTypes.Internal.BackendPid
                      , Database.PostgreSQL.PQTypes.Internal.Error
                      , Database.PostgreSQL.PQTypes.Internal.Error.Code
                      , Database.PostgreSQL.PQTypes.Internal.Composite
@@ -146,6 +147,7 @@ library
                     , ConstraintKinds
                     , DataKinds
                     , DeriveFunctor
+                    , DerivingStrategies
                     , ExistentialQuantification
                     , FlexibleContexts
                     , FlexibleInstances
@@ -213,6 +215,7 @@ test-suite hpqtypes-tests
                     , ConstraintKinds
                     , DataKinds
                     , DeriveFunctor
+                    , DerivingStrategies
                     , ExistentialQuantification
                     , FlexibleContexts
                     , FlexibleInstances

src/Database/PostgreSQL/PQTypes/Class.hs

@@ -1,13 +1,18 @@
 module Database.PostgreSQL.PQTypes.Class
-  ( QueryName (..)
-  , MonadDB (..)
+  ( -- * Class
+    MonadDB (..)
+
+    -- * Misc
+  , BackendPid (..)
+  , QueryName (..)
   ) where
 
 import Control.Monad.Trans
 import Control.Monad.Trans.Control
 import GHC.Stack
 
 import Database.PostgreSQL.PQTypes.FromRow
+import Database.PostgreSQL.PQTypes.Internal.BackendPid
 import Database.PostgreSQL.PQTypes.Internal.Connection
 import Database.PostgreSQL.PQTypes.Internal.Notification
 import Database.PostgreSQL.PQTypes.Internal.QueryResult
@@ -33,7 +38,7 @@ class (Applicative m, Monad m) => MonadDB m where
   withFrozenLastQuery :: m a -> m a
 
   -- | Get ID of the server process attached to the current session.
-  getBackendPid :: m Int
+  getBackendPid :: m BackendPid
 
   -- | Get current connection statistics.
   getConnectionStats :: HasCallStack => m ConnectionStats

src/Database/PostgreSQL/PQTypes/Internal/BackendPid.hs

@@ -0,0 +1,7 @@
+module Database.PostgreSQL.PQTypes.Internal.BackendPid
+  ( BackendPid (..)
+  ) where
+
+-- | Process ID of the server process attached to the current session.
+newtype BackendPid = BackendPid Int
+  deriving newtype (Eq, Ord, Show)

src/Database/PostgreSQL/PQTypes/Internal/Connection.hs

@@ -46,6 +46,7 @@ import Foreign.Ptr
 import GHC.Conc (closeFdWith)
 import GHC.Stack
 
+import Database.PostgreSQL.PQTypes.Internal.BackendPid
 import Database.PostgreSQL.PQTypes.Internal.C.Interface
 import Database.PostgreSQL.PQTypes.Internal.C.Types
 import Database.PostgreSQL.PQTypes.Internal.Composite
@@ -119,7 +120,7 @@ initialStats =
 data ConnectionData = ConnectionData
   { cdPtr :: !(Ptr PGconn)
   -- ^ Pointer to connection object.
-  , cdBackendPid :: !Int
+  , cdBackendPid :: !BackendPid
   -- ^ Process ID of the server process attached to the current session.
   , cdStats :: !ConnectionStats
   -- ^ Statistics associated with the connection.
@@ -132,7 +133,7 @@ newtype Connection = Connection
   { unConnection :: MVar (Maybe ConnectionData)
   }
 
-getBackendPidIO :: Connection -> IO Int
+getBackendPidIO :: Connection -> IO BackendPid
 getBackendPidIO conn = do
   withConnectionData conn "getBackendPidIO" $ \cd -> do
     pure (cd, cdBackendPid cd)
@@ -229,23 +230,25 @@ connect ConnectionSettings {..} = mask $ \unmask -> do
         Just
           ConnectionData
             { cdPtr = connPtr
-            , cdBackendPid = 0
+            , cdBackendPid = noBackendPid
             , cdStats = initialStats
             , cdPreparedQueries = preparedQueries
             }
     F.forM_ csRole $ \role -> runQueryIO conn $ "SET ROLE " <> role
 
     let selectPid = "SELECT pg_backend_pid()" :: RawSQL ()
     (_, res) <- runQueryIO conn selectPid
-    case F.toList $ mkQueryResult @(Identity Int32) selectPid 0 res of
+    case F.toList $ mkQueryResult @(Identity Int32) selectPid noBackendPid res of
       [pid] -> withConnectionData conn fname $ \cd -> do
-        pure (cd {cdBackendPid = fromIntegral pid}, ())
+        pure (cd {cdBackendPid = BackendPid $ fromIntegral pid}, ())
       pids -> do
         let err = HPQTypesError $ "unexpected backend pid: " ++ show pids
-        rethrowWithContext selectPid 0 $ toException err
+        rethrowWithContext selectPid noBackendPid $ toException err
 
     pure conn
   where
+    noBackendPid = BackendPid 0
+
     fname = "connect"
 
     openConnection :: (forall r. IO r -> IO r) -> CString -> IO (Ptr PGconn)
@@ -424,7 +427,7 @@ runQueryImpl fname conn sql execSql = do
 verifyResult
   :: (HasCallStack, IsSQL sql)
   => sql
-  -> Int
+  -> BackendPid
   -> Ptr PGconn
   -> Ptr PGresult
   -> IO (Either Int Int)

src/Database/PostgreSQL/PQTypes/Internal/Exception.hs

@@ -7,14 +7,15 @@ module Database.PostgreSQL.PQTypes.Internal.Exception
 import Control.Exception qualified as E
 import GHC.Stack
 
+import Database.PostgreSQL.PQTypes.Internal.BackendPid
 import Database.PostgreSQL.PQTypes.SQL.Class
 
 -- | Main exception type. All exceptions thrown by
 -- the library are additionally wrapped in this type.
 data DBException = forall e sql. (E.Exception e, Show sql) => DBException
   { dbeQueryContext :: !sql
   -- ^ Last SQL query that was executed.
-  , dbeBackendPid :: !Int
+  , dbeBackendPid :: !BackendPid
   -- ^ Process ID of the server process attached to the current session.
   , dbeError :: !e
   -- ^ Specific error.
@@ -26,7 +27,12 @@ deriving instance Show DBException
 instance E.Exception DBException
 
 -- | Rethrow supplied exception enriched with given SQL.
-rethrowWithContext :: (HasCallStack, IsSQL sql) => sql -> Int -> E.SomeException -> IO a
+rethrowWithContext
+  :: (HasCallStack, IsSQL sql)
+  => sql
+  -> BackendPid
+  -> E.SomeException
+  -> IO a
 rethrowWithContext sql pid (E.SomeException e) =
   E.throwIO
     DBException

src/Database/PostgreSQL/PQTypes/Internal/QueryResult.hs

@@ -25,6 +25,7 @@ import System.IO.Unsafe
 
 import Database.PostgreSQL.PQTypes.Format
 import Database.PostgreSQL.PQTypes.FromRow
+import Database.PostgreSQL.PQTypes.Internal.BackendPid
 import Database.PostgreSQL.PQTypes.Internal.C.Interface
 import Database.PostgreSQL.PQTypes.Internal.C.Types
 import Database.PostgreSQL.PQTypes.Internal.Error
@@ -36,15 +37,15 @@ import Database.PostgreSQL.PQTypes.SQL.Class
 -- extraction appropriately.
 data QueryResult t = forall row. FromRow row => QueryResult
   { qrSQL :: !SomeSQL
-  , qrBackendPid :: !Int
+  , qrBackendPid :: !BackendPid
   , qrResult :: !(ForeignPtr PGresult)
   , qrFromRow :: !(row -> t)
   }
 
 mkQueryResult
   :: (FromRow t, IsSQL sql)
   => sql
-  -> Int
+  -> BackendPid
   -> ForeignPtr PGresult
   -> QueryResult t
 mkQueryResult sql pid res =