Transducer.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE QualifiedDo #-}
-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from aggregate IdentityLedger; do not edit.
module Generated.IdAdmissionDomains.IdentityLedger.Transducer
  ( identityLedgerTransducer
  , identityLedgerFoldFingerprint
  , BehaviorOwnership (..)
  , identityLedgerPredicateVerifications
  ) where

import Generated.IdAdmissionDomains.IdentityLedger.Domain
import Data.Text (Text)
import Keiki.Builder qualified as B
import Keiki.Core (HsPred, SymTransducer)
import Keiki.Core qualified as K
import Keiki.Symbolic qualified as S
import Keiki.Builder ((=:))

identityLedgerTransducer
  :: SymTransducer
       (HsPred IdentityLedgerRegs IdentityLedgerCommand)
       IdentityLedgerRegs
       IdentityLedgerVertex
       IdentityLedgerCommand
       IdentityLedgerEvent
identityLedgerTransducer =
  B.buildTransducer IdentityLedgerOpen initialIdentityLedgerRegs isTerminal do
    B.from IdentityLedgerOpen do
      B.onCmd inCtorRecordIdentity $ \d -> B.do
        B.slot @"current" =: d.legacyId
        B.emit wireIdentityRecorded (IdentityRecordedTermFields
          { legacyId = d.legacyId
          , envelope = d.envelope
          })
        B.emit wireIdentityAudited (IdentityAuditedTermFields
          { legacyId = d.legacyId
          , envelope = d.envelope
          })
        B.goto IdentityLedgerOpen
      B.onCmd inCtorImportLegacyIdentity $ \d -> B.do
        B.replayOnly
        B.slot @"current" =: d.legacyId
        B.emit wireLegacyIdentityImported (LegacyIdentityImportedTermFields
          { legacyId = d.legacyId
          , envelope = d.envelope
          })
        B.goto IdentityLedgerOpen
 where
  isTerminal = \case

    _ -> False

identityLedgerFoldFingerprint :: Text
identityLedgerFoldFingerprint = "ad6ef591515ea2fb83140c5d44bc7576"

data BehaviorOwnership = GeneratedOwned | HoleOwned
  deriving stock (Eq, Show)

-- Every checked transition predicate is audited through Keiki's conservative
-- symbolic verifier. Opaque Hole terms remain explicitly unverified.
identityLedgerPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]
identityLedgerPredicateVerifications = sequence
  [ verifyTransition "transition1OpenRecordIdentity" GeneratedOwned IdentityLedgerOpen 0
  , verifyTransition "transition2OpenImportLegacyIdentity" GeneratedOwned IdentityLedgerOpen 1
  ]
 where
  verifyTransition label owner source edgeIndex =
    case drop edgeIndex (K.edgesOut identityLedgerTransducer source) of
      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate
      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")