-- | Regression coverage for the stale-cancel bug that corrupts a connection
-- after a pipelined query completes.
--
-- Root cause: in pqi-native, 'Pqi.getResult' returns 'Nothing' (the pipeline
-- separator) __before__ reading the trailing 'ReadyForQuery' message, leaving
-- @asyncPending = True@.  If 'Pqi.cancel' is called while @asyncPending@ is
-- still @True@ — as 'Hasql.Comms.Session.cleanUpAfterInterruption' does after
-- draining results — a cancel request is sent to the server even though the
-- query has already finished.  The server receives the signal, sets
-- @QueryCancelPending@, and the __next__ command (e.g. @ABORT@) is cancelled
-- with SQLSTATE @57014@, leaving the connection unusable.
module Pqi.Conformance.Operation.Cancel.Cleanup
  ( spec,
  )
where

import Control.Exception (bracket)
import qualified Pqi
import qualified Pqi as Lq
import Pqi.Conformance.Prelude
import Test.Hspec

spec :: Pqi.Adapter -> SpecWith ByteString
spec :: Adapter -> SpecWith ByteString
spec Adapter
adapter =
  String -> SpecWith ByteString -> SpecWith ByteString
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"cancel cleanup" do
    -- Reproduces the state that hasql's cleanUpAfterInterruption reaches after
    -- a timeout fires mid-pipeline:
    --
    --   1. drainResults reads CommandComplete → separator, exits loop.
    --      In pqi-native asyncPending is still True here (ReadyForQuery not
    --      yet consumed); in libpq the ReadyForQuery has already been
    --      processed internally.
    --   2. cancel is called.  pqi-native sends a cancel because
    --      asyncPending=True; the query has long since finished so this is
    --      a stale cancel.
    --   3. drainResults reads the remaining ReadyForQuery.
    --   4. The connection re-enters serial mode.
    --   5. exec runs a follow-up command — it must NOT be cancelled by the
    --      stale signal that arrived in step 2.
    String
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does not corrupt subsequent commands when cancel is called after pipeline results are drained" \ByteString
conninfo ->
      IO Connection
-> (Connection -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Adapter -> ByteString -> IO Connection
Lq.connectdb Adapter
adapter ByteString
conninfo) Connection -> IO ()
Lq.finish \Connection
connection -> do
        -- Enter pipeline mode and dispatch a fast query.
        _ <- Connection -> IO Bool
Lq.enterPipelineMode Connection
connection
        _ <- Lq.sendQueryParams connection "select 1" [] Lq.Text
        _ <- Lq.pipelineSync connection

        -- Wait for the server to process the query so both messages
        -- (CommandComplete + ReadyForQuery) are already in the socket by the
        -- time we start reading.
        threadDelay 10_000 -- 10 ms

        -- Drain the command result then the pipeline separator (Nothing).
        -- After this loop exits, asyncPending=True in pqi-native because
        -- ReadyForQuery has not been read yet.
        let drainAll = do
              mr <- Connection -> IO (Maybe Result)
Lq.getResult Connection
connection
              case mr of
                Maybe Result
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Just Result
_ -> IO ()
drainAll
        drainAll

        -- Send cancel.  Because asyncPending=True in pqi-native, a cancel
        -- request is dispatched to the server despite the query being done.
        handle <- Lq.getCancel connection
        for_ handle Lq.cancel

        -- Give the stale cancel enough time to reach the server and set
        -- QueryCancelPending before the next command arrives.
        threadDelay 10_000 -- 10 ms

        -- Read the ReadyForQuery that was still pending.
        drainAll

        -- Exit pipeline mode (sends an implicit Sync in the reference impl).
        _ <- Lq.exitPipelineMode connection

        -- A follow-up command must succeed; 57014 here means the stale cancel
        -- corrupted the connection.
        mResult <- Lq.exec connection "select 1"
        case mResult of
          Maybe Result
Nothing -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure String
"exec returned no result after pipeline cleanup"
          Just Result
result -> do
            status <- Result -> IO ExecStatus
Lq.resultStatus Result
result
            status `shouldBe` Lq.TuplesOk