diff --git a/hpgsql/src/Hpgsql/Internal.hs b/hpgsql/src/Hpgsql/Internal.hs index 6d23031..8512c49 100644 --- a/hpgsql/src/Hpgsql/Internal.hs +++ b/hpgsql/src/Hpgsql/Internal.hs @@ -262,7 +262,7 @@ internalConnectOrCancel connectOrCancel connOpts originalConnStr@ConnectionStrin preparedStatementNames = mempty, transactionStatusBeforeCurrentPipeline = TransIdle } - let hpgConnPartialDoNotReturn = HPgConnection sock socketIsClosed recvBuffer sendBuffer socketMutex originalConnStr addrInfo encodingContext connParams currentConnectionState 0 0 connOpts + let hpgConnPartialDoNotReturn = HPgConnection sock socketIsClosed recvBuffer sendBuffer socketMutex originalConnStr addrInfo encodingContext connParams currentConnectionState 0 "" connOpts case connectOrCancel of CancelNotConnect cancelRequest _ -> do nonAtomicSendMsg hpgConnPartialDoNotReturn cancelRequest @@ -650,7 +650,7 @@ sendCancellationRequest conn = do () -- Already cancelled, no need to send another Nothing -> internalConnectOrCancel - (CancelNotConnect (CancelRequest (connPid conn) (cancelSecretKey conn)) (connectedTo conn)) + (CancelNotConnect (CancelRequest conn.connPid conn.cancelSecretKey) conn.connectedTo) (connOpts conn) (originalConnStr conn) (secondsToDiffTime 30) diff --git a/hpgsql/src/Hpgsql/InternalTypes.hs b/hpgsql/src/Hpgsql/InternalTypes.hs index 287e3b6..7234954 100644 --- a/hpgsql/src/Hpgsql/InternalTypes.hs +++ b/hpgsql/src/Hpgsql/InternalTypes.hs @@ -466,7 +466,7 @@ data HPgConnection = HPgConnection parameterStatusMap :: !(MVar (Map Text Text)), internalConnectionState :: !(TVar InternalConnectionState), connPid :: !Int32, - cancelSecretKey :: !Int32, + cancelSecretKey :: !ByteString, connOpts :: !ConnectOpts } diff --git a/hpgsql/src/Hpgsql/Msgs.hs b/hpgsql/src/Hpgsql/Msgs.hs index dc2e638..c1f432e 100644 --- a/hpgsql/src/Hpgsql/Msgs.hs +++ b/hpgsql/src/Hpgsql/Msgs.hs @@ -87,14 +87,14 @@ data PasswordMessage PasswordMessage AuthenticationMethod String String deriving stock (Show) -data BackendKeyData = BackendKeyData {backendPid :: Int32, backendSecretKey :: Int32} +data BackendKeyData = BackendKeyData {backendPid :: !Int32, backendSecretKey :: !BS.ByteString} 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 +data CancelRequest = CancelRequest Int32 ByteString deriving stock (Show) newtype CopyData = CopyData Builder @@ -160,9 +160,9 @@ instance FromPgMessage AuthenticationResponse where _ -> 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} + msgParser = PgMsgParser $ \c (LBS.splitAt 4 -> (pidBS, backendSecretKey)) -> case c of + 'K' -> case Cereal.decodeLazy @Int32 pidBS of + Right pid -> Just $ BackendKeyData {backendPid = pid, backendSecretKey = LBS.toStrict backendSecretKey} Left _ -> Nothing _ -> Nothing @@ -191,7 +191,7 @@ instance FromPgMessage CommandComplete where instance ToPgMessage CancelRequest where toPgMessage (CancelRequest pid secret) = - Builder.int32BE (4 + 4 + 4 + 4) <> Builder.int32BE 80877102 <> Builder.int32BE pid <> Builder.int32BE secret + Builder.int32BE (fromIntegral $ 4 + 4 + 4 + BS.length secret) <> Builder.int32BE 80877102 <> Builder.int32BE pid <> Builder.byteString secret instance ToPgMessage CopyData where toPgMessage (CopyData bs) =