Harness.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.Billing.Subscription.Harness (harnessAssertions) where

import Billing.Subscription.Holes (subscriptionTransducer)
import Generated.Billing.Subscription.Codec (encodeSubscriptionEvent, parseSubscriptionEvent, subscriptionCodec)
import Generated.Billing.Subscription.Domain
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer, (!))
import Keiro.Codec (eventType)

{- | (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", True)
    , ("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

sampleEventSubscriptionActivated :: SubscriptionEvent
sampleEventSubscriptionActivated = (SubscriptionActivated (SubscriptionActivatedData (SubscriptionId "sample") (CustomerId "sample") Paid))

sampleEventSubscriptionCancelled :: SubscriptionEvent
sampleEventSubscriptionCancelled = (SubscriptionCancelled (SubscriptionCancelledData (SubscriptionId "sample") (CustomerId "sample")))

acceptActivateSubscription :: Bool
acceptActivateSubscription =
    case step subscriptionTransducer (SubscriptionInactive, initialSubscriptionRegs) ((ActivateSubscription (ActivateSubscriptionData (SubscriptionId "sample") (CustomerId "sample") 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 (SubscriptionId "sample") (CustomerId "sample") 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))
                            , (prefix <> "register subscriptionState", (replayRegs ! #subscriptionState) == (forwardRegs ! #subscriptionState))
                            ]
  where
    prefix = "forward/replay equality: ActivateSubscription from SubscriptionInactive -- "