AcceptorSpec.hs

module Keiki.AcceptorSpec (spec) where

import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime)
import Keiki.Acceptor
import Keiki.Core (InFlight (..), initialRegs, isFinal, reconstitute)
import Keiki.Fixtures.EmailDelivery
  ( EmailEvent (..),
    EmailSentData (..),
    emailDelivery,
  )
import Keiki.Fixtures.UserRegistration
  ( AccountConfirmedData (..),
    AccountDeletedData (..),
    ConfirmAccountData (..),
    ConfirmationEmailSentData (..),
    ConfirmationResentData (..),
    FulfillGDPRRequestData (..),
    RegistrationStartedData (..),
    StartRegistrationData (..),
    UserCmd (..),
    UserEvent (..),
    Vertex (..),
    userReg,
  )
import Test.Hspec

-- | A trivial UTC-time fixture: every test moment is on the same day,
-- offset by N seconds.
t :: Integer -> UTCTime
t s = UTCTime (fromGregorian 2026 5 1) (secondsToDiffTime s)

-- | The canonical four-step command sequence on 'userReg' that lands
-- in the final 'Deleted' vertex.
--
--   PotentialCustomer    --StartRegistration->  Registering
--   Registering          --Continue->           RequiresConfirmation
--   RequiresConfirmation --ConfirmAccount->     Confirmed
--   Confirmed            --FulfillGDPRRequest-> Deleted
--
-- The 'ConfirmAccount' code matches the code stored at registration,
-- so the @PEq@ guard on the confirmation edge is satisfied.
-- EP-19 M7: 'Continue' retired with the collapsed entrance.
-- StartRegistration alone now drives PotentialCustomer →
-- RequiresConfirmation as one transition emitting both
-- RegistrationStarted and ConfirmationEmailSent.
canonicalUserCmds :: [UserCmd]
canonicalUserCmds =
  [ StartRegistration (StartRegistrationData "alice@x" "Z9F4" (t 0)),
    ConfirmAccount (ConfirmAccountData "Z9F4" (t 100)),
    FulfillGDPRRequest (FulfillGDPRRequestData (t 200))
  ]

-- | The canonical event log on 'emailDelivery' that lands in the
-- terminal 'EmailSentVertex'.
canonicalEmailLog :: [EmailEvent]
canonicalEmailLog =
  [EmailSent (EmailSentData "alice@x" "Welcome" (t 0))]

canonicalUserLog :: [UserEvent]
canonicalUserLog =
  [ RegistrationStarted (RegistrationStartedData "alice@x" "Z9F4" (t 0)),
    ConfirmationEmailSent (ConfirmationEmailSentData "alice@x"),
    ConfirmationResent (ConfirmationResentData "alice@x" "K2P7" (t 100)),
    AccountConfirmed (AccountConfirmedData "alice@x" "K2P7" (t 200)),
    AccountDeleted (AccountDeletedData "alice@x" (t 300))
  ]

spec :: Spec
spec = do
  describe "inputAcceptor userReg" $ do
    it "accepts the canonical command sequence" $
      accepts (inputAcceptor userReg) canonicalUserCmds
        `shouldBe` True

    it "rejects ConfirmAccount from PotentialCustomer" $
      accepts
        (inputAcceptor userReg)
        [ConfirmAccount (ConfirmAccountData "Z9F4" (t 0))]
        `shouldBe` False

  describe "outputAcceptor emailDelivery" $ do
    it "accepts the canonical event log" $
      accepts (outputAcceptor emailDelivery) canonicalEmailLog
        `shouldBe` True

    it "rejects an event that no edge from PotentialCustomer produces" $ do
      -- userReg's only outgoing edge from PotentialCustomer produces
      -- 'RegistrationStarted'; 'AccountConfirmed' has no matching
      -- inverse, so applyEvent returns Nothing on the first step.
      let badLog =
            [ AccountConfirmed
                (AccountConfirmedData "alice@x" "Z9F4" (t 0))
            ]
      accepts (outputAcceptor userReg) badLog `shouldBe` False

    it "agrees with reconstitute on the canonical log" $
      accepts (outputAcceptor emailDelivery) canonicalEmailLog
        `shouldBe` maybe
          False
          (isFinal emailDelivery . fst)
          (reconstitute emailDelivery canonicalEmailLog)

  describe "outputAcceptor userReg multi-event replay" $
    do
      it "accepts the canonical multi-event log" $
        accepts (outputAcceptor userReg) canonicalUserLog `shouldBe` True

      it "rejects a truncated chain while preserving its InFlight carrier" $ do
        accepts (outputAcceptor userReg) (take 1 canonicalUserLog)
          `shouldBe` False
        fmap fst (runAcceptor (outputAcceptor userReg) (take 1 canonicalUserLog))
          `shouldBe` Just
            ( InFlight
                RequiresConfirmation
                [ConfirmationEmailSent (ConfirmationEmailSentData "alice@x")]
            )

      it "agrees with reconstitute for complete, truncated, and foreign logs" $ do
        let foreignLog =
              [AccountConfirmed (AccountConfirmedData "alice@x" "Z9F4" (t 0))]
        accepts (outputAcceptor userReg) canonicalUserLog
          `shouldBe` maybe
            False
            (isFinal userReg . fst)
            (reconstitute userReg canonicalUserLog)
        accepts (outputAcceptor userReg) (take 1 canonicalUserLog)
          `shouldBe` maybe
            False
            (isFinal userReg . fst)
            (reconstitute userReg (take 1 canonicalUserLog))
        accepts (outputAcceptor userReg) foreignLog
          `shouldBe` maybe
            False
            (isFinal userReg . fst)
            (reconstitute userReg foreignLog)

  describe "aIsFinal" $ do
    it "matches isFinal on userReg under fst" $ do
      let a = inputAcceptor userReg
      aIsFinal a (Deleted, initialRegs userReg) `shouldBe` True
      aIsFinal a (Confirmed, initialRegs userReg) `shouldBe` False
      aIsFinal a (PotentialCustomer, initialRegs userReg) `shouldBe` False
      -- And the same predicate on the bare vertex.
      isFinal userReg Deleted `shouldBe` True
      isFinal userReg Confirmed `shouldBe` False