Harness.hs

{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl 0.11.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.
module Generated.Billing.Subscription.Harness (harnessAssertions) where

import Generated.Billing.Subscription.Domain
import Generated.Billing.Subscription.Codec (encodeSubscriptionEvent, parseSubscriptionEvent, subscriptionCodec)
import Generated.Billing.Subscription.Transducer (subscriptionTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer, (!))
import Keiro.Codec (eventType)
import Generated.Billing.Nominals (CustomerId, parseCustomerId, Plan (..), SubscriptionId, parseSubscriptionId)

-- | (label, passed). A driver runs these and exits non-zero on any False,
-- naming the failing assertion. Filling a hole wrongly turns a specific
-- entry False; the scaffold cannot.
harnessAssertions :: [(String, Bool)]
harnessAssertions =
  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions subscriptionTransducer))
  -- clock-free: spec samples no wall clock (verified at scaffold time)
  , ("golden round-trip: SubscriptionActivated", roundTrips sampleEventSubscriptionActivated)
  , ("golden round-trip: SubscriptionCancelled", roundTrips sampleEventSubscriptionCancelled)
  , ("accepts ActivateSubscription from SubscriptionInactive", acceptActivateSubscription)
  ]
  ++ forwardReplayActivateSubscription

roundTrips :: SubscriptionEvent -> Bool
roundTrips e = parseSubscriptionEvent (eventType subscriptionCodec e) (encodeSubscriptionEvent e) == Right e

sampleCustomerId :: CustomerId
sampleCustomerId =
  case parseCustomerId "cust_01h455vb4pex5vsknk084sn02q" of
    Right parsed -> parsed
    Left problem -> error (show problem)

sampleSubscriptionId :: SubscriptionId
sampleSubscriptionId =
  case parseSubscriptionId "sub_01h455vb4pex5vsknk084sn02q" of
    Right parsed -> parsed
    Left problem -> error (show problem)

sampleEventSubscriptionActivated :: SubscriptionEvent
sampleEventSubscriptionActivated = SubscriptionActivated (SubscriptionActivatedData sampleSubscriptionId sampleCustomerId Paid)

sampleEventSubscriptionCancelled :: SubscriptionEvent
sampleEventSubscriptionCancelled = SubscriptionCancelled (SubscriptionCancelledData sampleSubscriptionId sampleCustomerId)

acceptActivateSubscription :: Bool
acceptActivateSubscription =
  case step subscriptionTransducer (SubscriptionInactive, initialSubscriptionRegs) (ActivateSubscription (ActivateSubscriptionData sampleSubscriptionId sampleCustomerId Paid)) of
    Just (v, _, _) -> v == SubscriptionActive
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayActivateSubscription :: [(String, Bool)]
forwardReplayActivateSubscription =
  case step subscriptionTransducer (SubscriptionInactive, initialSubscriptionRegs) (ActivateSubscription (ActivateSubscriptionData sampleSubscriptionId sampleCustomerId Paid)) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, forwardRegs, emitted) ->
      case mapM (\event -> parseSubscriptionEvent (eventType subscriptionCodec event) (encodeSubscriptionEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither subscriptionTransducer (SubscriptionInactive, initialSubscriptionRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              , (prefix <> "register plan", (replayRegs ! #plan) == (forwardRegs ! #plan))
              ]
  where
    prefix = "forward/replay equality: ActivateSubscription from SubscriptionInactive -- "