Contract.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from contract identities; do not edit.
module Generated.IdAdmissionDomains.Identities.Contract
  ( IdentitiesPayload (..)
  , IdentityLinkedData (..)
  , identityEventsTopic
  , messageTypeOf
  , encodeIdentitiesPayload
  , parseIdentitiesPayload
  ) where

import Data.Aeson (Value, object, withObject, withText, (.=))
import Data.Aeson.Types (Parser, explicitParseField, parseEither)
import Generated.IdAdmissionDomains.Nominals qualified as Nominals
import Generated.IdAdmissionDomains.Structural.NominalLeaves qualified as NominalLeaves
import Data.Text (Text)
import qualified Data.Text as T

-- topic constants
identityEventsTopic :: Text
identityEventsTopic = "identity.events"

-- the closed payload set (discriminated by "messageType")
data IdentityLinkedData = IdentityLinkedData {legacyId :: !Nominals.LegacyId}
  deriving stock (Eq, Show)

data IdentitiesPayload
  = IdentityLinked !IdentityLinkedData
  deriving stock (Eq, Show)

messageTypeOf :: IdentitiesPayload -> Text
messageTypeOf = \case
  IdentityLinked {} -> "IdentityLinked"

encodeIdentitiesPayload :: IdentitiesPayload -> Value
encodeIdentitiesPayload = \case
  IdentityLinked payload ->
    object
      [ "messageType" .= ("IdentityLinked" :: Text),
        "legacyId" .= NominalLeaves.encodeLegacyIdLeaf payload.legacyId
      ]

parseIdentitiesPayload :: Value -> Either Text IdentitiesPayload
parseIdentitiesPayload = mapLeftText . parseEither (withObject "IdentitiesPayload" go)
  where
    go o = do
      kind <- explicitParseField (withText "messageType" validateMessageType) o "messageType"
      case kind of
        "IdentityLinked" ->
          IdentityLinked
            <$> ( IdentityLinkedData
                    <$> explicitParseField NominalLeaves.parseLegacyIdLeaf o "legacyId"
                )
        _ -> fail "validated message type was not handled"

mapLeftText :: Either String b -> Either Text b
mapLeftText = either (Left . T.pack) Right

validateMessageType :: Text -> Parser Text
validateMessageType kind
  | kind `elem` ["IdentityLinked"] = pure kind
  | otherwise = fail ("unknown message type " <> show kind <> "; expected one of: IdentityLinked")