UniqueViolationMapping.hs

module Test.UniqueViolationMapping (spec) where

import Control.Monad (forM_)
import Data.Text (Text)
import Data.UUID qualified as UUID
import Hasql.Errors qualified as Errors
import Hasql.Pool (UsageError (..))
import Kiroku.Store.Error
import Kiroku.Store.Types
import Test.Hspec

spec :: Spec
spec = describe "unique violation mapping" $ do
  let eid = EventId (UUID.fromWords 0x01234567 0x89ab7def 0x80123456 0x7890abcd)
      scalar = "Key (event_id)=(01234567-89ab-7def-8012-34567890abcd) already exists."
      composite = "Key (event_id, stream_id)=(01234567-89ab-7def-8012-34567890abcd, 42) already exists."
      fallback = WrongExpectedVersion (StreamName "orders-1") AnyVersion (StreamVersion 0)
      mapAppend = mapUsageError "orders-1" AnyVersion
      cases =
        [ ("events_pkey", scalar, DuplicateEvent (Just eid)),
          ("stream_events_pkey", composite, DuplicateEvent (Just eid)),
          ("ix_streams_stream_name", "Key (stream_name)=(orders-1) already exists.", StreamAlreadyExists (StreamName "orders-1")),
          ("ux_stream_events_stream_version", "Key (stream_id, stream_version)=(42, 1) already exists.", UnexpectedServerError "23505" "detail-only error"),
          ("unknown_constraint", scalar, fallback)
        ]
  forM_ cases $ \(name, detail, expected) -> do
    it ("classifies the exact message constraint " <> show name) $ do
      let message = constraintMessage name
          outcome = case expected of
            UnexpectedServerError code _ -> UnexpectedServerError code message
            other -> other
      mapAppend (serverUsage message (Just detail)) `shouldBe` outcome
    it ("classifies a detail-only constraint " <> show name) $
      mapAppend (serverUsage "detail-only error" (Just ("constraint: " <> name <> "; " <> detail)))
        `shouldBe` expected

  it "does not match stream_events_pkey as events_pkey" $
    mapAppend (serverUsage (constraintMessage "stream_events_pkey") (Just composite))
      `shouldBe` DuplicateEvent (Just eid)
  forM_ ["events_pkey", "stream_events_pkey", "ix_streams_stream_name", "ux_stream_events_stream_version"] $ \name ->
    forM_ ["prefix_" <> name, name <> "_suffix", name <> "$suffix"] $ \other -> do
      it ("rejects the message lookalike " <> show other) $
        mapAppend (serverUsage (constraintMessage other) (Just scalar)) `shouldBe` fallback
      it ("rejects the detail lookalike " <> show other) $
        mapAppend (serverUsage "detail-only error" (Just (other <> "; " <> scalar))) `shouldBe` fallback

  it "uses the message constraint ahead of misleading detail tokens" $
    mapAppend (serverUsage (constraintMessage "ux_stream_events_stream_version") (Just ("events_pkey " <> scalar)))
      `shouldBe` UnexpectedServerError "23505" (constraintMessage "ux_stream_events_stream_version")
  it "retains an unknown message constraint even when detail names a known constraint" $
    mapAppend (serverUsage (constraintMessage "unknown_constraint") (Just ("events_pkey " <> scalar)))
      `shouldBe` fallback
  forM_ ["events_pkey", "stream_events_pkey"] $ \name ->
    forM_ [Nothing, Just "unparseable localized detail"] $ \detail ->
      it ("does not fabricate an event id for " <> show (name, detail)) $
        mapAppend (serverUsage (constraintMessage name) detail) `shouldBe` DuplicateEvent Nothing
  it "maps a composite duplicate inside a transaction with its event id" $
    mapTransactionUsageError (serverUsage (constraintMessage "stream_events_pkey") (Just composite))
      `shouldBe` DuplicateEvent (Just eid)
  it "preserves the link-specific duplicate classification" $
    mapLinkUsageError (StreamName "orders-1") (serverUsage (constraintMessage "stream_events_pkey") (Just composite))
      `shouldBe` EventAlreadyLinked (StreamName "orders-1") (Just eid)
  it "accepts a quoted constraint in legacy detail" $
    mapAppend (serverUsage "detail-only error" (Just (constraintMessage "stream_events_pkey" <> "; " <> composite)))
      `shouldBe` DuplicateEvent (Just eid)
  it "keeps an unnamed unique violation on the conservative fallback" $
    mapAppend (serverUsage "localized message" Nothing) `shouldBe` fallback
  it "does not classify a transaction constraint lookalike as a duplicate" $
    mapTransactionUsageError (serverUsage (constraintMessage "other_events_pkey") (Just scalar))
      `shouldBe` UnexpectedServerError "23505" (constraintMessage "other_events_pkey")
  it "does not classify a link constraint lookalike as already linked" $
    mapLinkUsageError (StreamName "orders-1") (serverUsage (constraintMessage "stream_events_pkey_backup") (Just composite))
      `shouldBe` UnexpectedServerError "23505" (constraintMessage "stream_events_pkey_backup")
  it "attributes a multi-stream name violation to the named operation" $
    attributeMultiStreamError
      [(StreamName "orders-1", AnyVersion), (StreamName "orders-2", NoStream)]
      (serverUsage (constraintMessage "ix_streams_stream_name") (Just "Key (stream_name)=(orders-2) already exists."))
      `shouldBe` StreamAlreadyExists (StreamName "orders-2")
  it "does not attribute a multi-stream constraint lookalike to a later operation" $
    attributeMultiStreamError
      [(StreamName "orders-1", AnyVersion), (StreamName "orders-2", NoStream)]
      (serverUsage (constraintMessage "ix_streams_stream_name_backup") (Just "Key (stream_name)=(orders-2) already exists."))
      `shouldBe` fallback

constraintMessage :: Text -> Text
constraintMessage name = "duplicate key value violates unique constraint \"" <> name <> "\""

serverUsage :: Text -> Maybe Text -> UsageError
serverUsage message detail =
  SessionUsageError $
    Errors.StatementSessionError 1 0 "" [] True $
      Errors.ServerStatementError $
        Errors.ServerError "23505" message detail Nothing Nothing