Repro attempt using postgresql-libpq instead of squeal for https://github.com/morphismtech/squeal/discussions/334

libpq_squeal_bug_repro_attempt.hs

#!/usr/bin/env stack
{- stack script
    --resolver lts-19.30
    --package postgresql-libpq
    --package bytestring
 -}

{-# LANGUAGE OverloadedStrings #-}

-- | To run, start a local postgresql database, potentially alter the
-- connection string as appropriate and then run the script
module Main where

import qualified Database.PostgreSQL.LibPQ as LibPQ
import Control.Exception (Exception, throwIO)
import Control.Monad (unless)
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)

exec :: LibPQ.Connection -> ByteString -> IO ()
exec connection query = do
  result <- LibPQ.exec connection query
  maybe (error $ "query failed: " <> show query) resultOkOrThrow result

cleanupDb :: LibPQ.Connection -> IO ()
cleanupDb connection = do
  exec connection "drop table if exists referencing_table;"
  exec connection "drop table if exists referenced_table;"

setupDb :: LibPQ.Connection -> IO ()
setupDb connection = do
  exec connection "create table referenced_table (id text not null primary key);"
  exec connection "create table referencing_table (foreign_key text not null references referenced_table);"
  exec connection "insert into referenced_table (id) values ('foo');"

data LibPQError = LibPQError LibPQ.Result ByteString ByteString
  deriving (Show)

instance Exception LibPQError

resultOkOrThrow :: LibPQ.Result -> IO ()
resultOkOrThrow result = do
  status <- LibPQ.resultStatus result
  case status of
    LibPQ.CommandOk -> pure ()
    LibPQ.TuplesOk -> pure ()
    _ -> do
      statusCode <- fromMaybe (error "no status code") <$> LibPQ.resultErrorField result LibPQ.DiagSqlstate
      errorMessage <- fromMaybe (error "no error message") <$> LibPQ.resultErrorMessage result
      throwIO $ LibPQError result statusCode errorMessage


main :: IO ()
main = do
  connection <- LibPQ.connectdb "dbname=postgres"
  connectionStatus <- LibPQ.status connection
  unless (connectionStatus == LibPQ.ConnectionOk) $ error $ "connection failed: " <> show connectionStatus
  cleanupDb connection
  setupDb connection
  exec connection "begin;"
  let temp = "temporary_statement"
  prepareResult <- LibPQ.prepare connection temp "insert into referencing_table (foreign_key) values ($1::text);" Nothing
  maybe (error "failed to prepare!") resultOkOrThrow prepareResult
  queryResult <- LibPQ.execPrepared connection temp [Just ("bar", LibPQ.Binary)] LibPQ.Binary
  maybe (error "didn't get result from query!") resultOkOrThrow queryResult