-- | Plain, comparable snapshots of a connection or result.
--
-- Every adapter produces the same concrete 'Pqi.Connection'\/'Pqi.Result'
-- record, so comparing candidate and reference values directly would also
-- compare the per-connection identity fields (@backendPID@, @socket@), which
-- are structurally incomparable across two independently-opened connections.
-- Projecting each into one of these driver-independent records first keeps
-- the comparison to protocol-derived information only.
--
-- Only protocol-derived information is captured: both adapters parse the same
-- wire bytes, so these fields genuinely agree. All result fields — including
-- the flat error message text and all structured error fields — are captured
-- in full and compared byte-identically.
module Pqi.Conformance.Observation
  ( ResultObservation (..),
    FieldObservation (..),
    CellObservation (..),
    observeResult,
    ConnectionObservation (..),
    observeConnection,
  )
where

import qualified Pqi as Lq
import Pqi.Conformance.Prelude

-- | A snapshot of an entire result: its status, structured error report,
-- shape, per-field metadata, and every cell.
data ResultObservation = ResultObservation
  { ResultObservation -> ExecStatus
status :: Lq.ExecStatus,
    -- | Every structured field of the error report, keyed by 'Lq.FieldCode'.
    -- All of them are carried by the wire error response.
    ResultObservation -> [(FieldCode, Maybe ByteString)]
errorFields :: [(Lq.FieldCode, Maybe ByteString)],
    -- | The flat formatted error message, byte-identical to libpq's
    -- @PQresultErrorMessage@ at DEFAULT verbosity.
    ResultObservation -> Maybe ByteString
errorMessage :: Maybe ByteString,
    ResultObservation -> Int32
ntuples :: Int32,
    ResultObservation -> Int32
nfields :: Int32,
    ResultObservation -> Int32
nparams :: Int32,
    ResultObservation -> [Word32]
paramTypes :: [Word32],
    ResultObservation -> [FieldObservation]
fields :: [FieldObservation],
    ResultObservation -> [[CellObservation]]
rows :: [[CellObservation]],
    ResultObservation -> Maybe ByteString
cmdStatus :: Maybe ByteString,
    ResultObservation -> Maybe ByteString
cmdTuples :: Maybe ByteString
  }
  deriving stock (ResultObservation -> ResultObservation -> Bool
(ResultObservation -> ResultObservation -> Bool)
-> (ResultObservation -> ResultObservation -> Bool)
-> Eq ResultObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResultObservation -> ResultObservation -> Bool
== :: ResultObservation -> ResultObservation -> Bool
$c/= :: ResultObservation -> ResultObservation -> Bool
/= :: ResultObservation -> ResultObservation -> Bool
Eq, Int -> ResultObservation -> ShowS
[ResultObservation] -> ShowS
ResultObservation -> String
(Int -> ResultObservation -> ShowS)
-> (ResultObservation -> String)
-> ([ResultObservation] -> ShowS)
-> Show ResultObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResultObservation -> ShowS
showsPrec :: Int -> ResultObservation -> ShowS
$cshow :: ResultObservation -> String
show :: ResultObservation -> String
$cshowList :: [ResultObservation] -> ShowS
showList :: [ResultObservation] -> ShowS
Show)

-- | A snapshot of one result column's metadata.
data FieldObservation = FieldObservation
  { FieldObservation -> Maybe ByteString
name :: Maybe ByteString,
    FieldObservation -> Word32
typeOid :: Word32,
    FieldObservation -> Int
modifier :: Int,
    FieldObservation -> Int
size :: Int,
    FieldObservation -> Format
format :: Lq.Format,
    FieldObservation -> Word32
tableOid :: Word32,
    FieldObservation -> Int32
tableColumn :: Int32
  }
  deriving stock (FieldObservation -> FieldObservation -> Bool
(FieldObservation -> FieldObservation -> Bool)
-> (FieldObservation -> FieldObservation -> Bool)
-> Eq FieldObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldObservation -> FieldObservation -> Bool
== :: FieldObservation -> FieldObservation -> Bool
$c/= :: FieldObservation -> FieldObservation -> Bool
/= :: FieldObservation -> FieldObservation -> Bool
Eq, Int -> FieldObservation -> ShowS
[FieldObservation] -> ShowS
FieldObservation -> String
(Int -> FieldObservation -> ShowS)
-> (FieldObservation -> String)
-> ([FieldObservation] -> ShowS)
-> Show FieldObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldObservation -> ShowS
showsPrec :: Int -> FieldObservation -> ShowS
$cshow :: FieldObservation -> String
show :: FieldObservation -> String
$cshowList :: [FieldObservation] -> ShowS
showList :: [FieldObservation] -> ShowS
Show)

-- | A snapshot of one cell.
data CellObservation = CellObservation
  { CellObservation -> Maybe ByteString
value :: Maybe ByteString,
    CellObservation -> Bool
isNull :: Bool,
    CellObservation -> Int
length :: Int
  }
  deriving stock (CellObservation -> CellObservation -> Bool
(CellObservation -> CellObservation -> Bool)
-> (CellObservation -> CellObservation -> Bool)
-> Eq CellObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellObservation -> CellObservation -> Bool
== :: CellObservation -> CellObservation -> Bool
$c/= :: CellObservation -> CellObservation -> Bool
/= :: CellObservation -> CellObservation -> Bool
Eq, Int -> CellObservation -> ShowS
[CellObservation] -> ShowS
CellObservation -> String
(Int -> CellObservation -> ShowS)
-> (CellObservation -> String)
-> ([CellObservation] -> ShowS)
-> Show CellObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellObservation -> ShowS
showsPrec :: Int -> CellObservation -> ShowS
$cshow :: CellObservation -> String
show :: CellObservation -> String
$cshowList :: [CellObservation] -> ShowS
showList :: [CellObservation] -> ShowS
Show)

-- | Project a result into a 'ResultObservation'.
observeResult :: Lq.Result -> IO ResultObservation
observeResult :: Result -> IO ResultObservation
observeResult Result
result = do
  status <- Result -> IO ExecStatus
Lq.resultStatus Result
result
  errorFields <-
    traverse
      (\FieldCode
code -> (,) FieldCode
code (Maybe ByteString -> (FieldCode, Maybe ByteString))
-> IO (Maybe ByteString) -> IO (FieldCode, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> FieldCode -> IO (Maybe ByteString)
Lq.resultErrorField Result
result FieldCode
code)
      [minBound .. maxBound]
  errorMessage <- Lq.resultErrorMessage result
  ntuples <- Lq.ntuples result
  nfields <- Lq.nfields result
  nparams <- Lq.nparams result
  paramTypes <- traverse (Lq.paramtype result) [0 .. nparams - 1]
  fields <- traverse (observeField result) [0 .. nfields - 1]
  rows <- traverse (\Int32
row -> (Int32 -> IO CellObservation) -> [Int32] -> IO [CellObservation]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Result -> Int32 -> Int32 -> IO CellObservation
observeCell Result
result Int32
row) [Int32
0 .. Int32
nfields Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1]) [0 .. ntuples - 1]
  cmdStatus <- Lq.cmdStatus result
  cmdTuples <- Lq.cmdTuples result
  pure ResultObservation {..}

observeField :: Lq.Result -> Int32 -> IO FieldObservation
observeField :: Result -> Int32 -> IO FieldObservation
observeField Result
result Int32
column = do
  name <- Result -> Int32 -> IO (Maybe ByteString)
Lq.fname Result
result Int32
column
  typeOid <- Lq.ftype result column
  modifier <- Lq.fmod result column
  size <- Lq.fsize result column
  format <- Lq.fformat result column
  tableOid <- Lq.ftable result column
  tableColumn <- Lq.ftablecol result column
  pure FieldObservation {..}

observeCell :: Lq.Result -> Int32 -> Int32 -> IO CellObservation
observeCell :: Result -> Int32 -> Int32 -> IO CellObservation
observeCell Result
result Int32
row Int32
column = do
  value <- Result -> Int32 -> Int32 -> IO (Maybe ByteString)
Lq.getvalue Result
result Int32
row Int32
column
  isNull <- Lq.getisnull result row column
  length <- Lq.getlength result row column
  pure CellObservation {..}

-- | A snapshot of the comparable portion of a connection's state. The
-- candidate and the reference open their connections from the same conninfo
-- string, so the conninfo-derived identity accessors agree as well.
data ConnectionObservation = ConnectionObservation
  { ConnectionObservation -> ConnStatus
connectionStatus :: Lq.ConnStatus,
    ConnectionObservation -> TransactionStatus
transactionStatus :: Lq.TransactionStatus,
    ConnectionObservation -> Int
serverVersion :: Int,
    ConnectionObservation -> Maybe ByteString
serverVersionParam :: Maybe ByteString,
    ConnectionObservation -> Int
protocolVersion :: Int,
    ConnectionObservation -> Maybe ByteString
db :: Maybe ByteString,
    ConnectionObservation -> Maybe ByteString
user :: Maybe ByteString,
    ConnectionObservation -> Maybe ByteString
pass :: Maybe ByteString,
    ConnectionObservation -> Maybe ByteString
host :: Maybe ByteString,
    ConnectionObservation -> Maybe ByteString
port :: Maybe ByteString,
    ConnectionObservation -> Maybe ByteString
options :: Maybe ByteString,
    ConnectionObservation -> Bool
connectionNeedsPassword :: Bool,
    ConnectionObservation -> Bool
connectionUsedPassword :: Bool,
    ConnectionObservation -> Bool
connectionIsNull :: Bool
  }
  deriving stock (ConnectionObservation -> ConnectionObservation -> Bool
(ConnectionObservation -> ConnectionObservation -> Bool)
-> (ConnectionObservation -> ConnectionObservation -> Bool)
-> Eq ConnectionObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionObservation -> ConnectionObservation -> Bool
== :: ConnectionObservation -> ConnectionObservation -> Bool
$c/= :: ConnectionObservation -> ConnectionObservation -> Bool
/= :: ConnectionObservation -> ConnectionObservation -> Bool
Eq, Int -> ConnectionObservation -> ShowS
[ConnectionObservation] -> ShowS
ConnectionObservation -> String
(Int -> ConnectionObservation -> ShowS)
-> (ConnectionObservation -> String)
-> ([ConnectionObservation] -> ShowS)
-> Show ConnectionObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionObservation -> ShowS
showsPrec :: Int -> ConnectionObservation -> ShowS
$cshow :: ConnectionObservation -> String
show :: ConnectionObservation -> String
$cshowList :: [ConnectionObservation] -> ShowS
showList :: [ConnectionObservation] -> ShowS
Show)

-- | Project a connection into a 'ConnectionObservation'.
observeConnection :: Lq.Connection -> IO ConnectionObservation
observeConnection :: Connection -> IO ConnectionObservation
observeConnection Connection
connection = do
  connectionStatus <- Connection -> IO ConnStatus
Lq.status Connection
connection
  transactionStatus <- Lq.transactionStatus connection
  serverVersion <- Lq.serverVersion connection
  serverVersionParam <- Lq.parameterStatus connection "server_version"
  protocolVersion <- Lq.protocolVersion connection
  db <- Lq.db connection
  user <- Lq.user connection
  pass <- Lq.pass connection
  host <- Lq.host connection
  port <- Lq.port connection
  options <- Lq.options connection
  connectionNeedsPassword <- Lq.connectionNeedsPassword connection
  connectionUsedPassword <- Lq.connectionUsedPassword connection
  let connectionIsNull = Connection -> Bool
Lq.isNullConnection Connection
connection
  pure ConnectionObservation {..}