Contract.hs

-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from contract templates; do not edit.
module Generated.ContractDeclaredId.Templates.Contract
  ( TemplatesPayload (..)
  , TemplateClaimedData (..)
  , templateEventsTopic
  , messageTypeOf
  , encodeTemplatesPayload
  , parseTemplatesPayload
  ) where

import Data.Aeson (Value, object, withObject, withText, (.=))
import Data.Aeson.Types (Parser, explicitParseField, parseEither)
import Data.KindID (KindID)
import qualified Data.KindID as KindID
import Conformance.ContractDeclaredId.Domain (ClaimId)
import Generated.ContractDeclaredId.Nominals qualified as Nominals
import Generated.ContractDeclaredId.Structural.NominalLeaves qualified as NominalLeaves
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.IdDomain (parseKindIdV7Value)

-- topic constants
templateEventsTopic :: Text
templateEventsTopic = "templates.events"

-- the closed payload set (discriminated by "messageType")
data TemplateClaimedData = TemplateClaimedData {templateId :: !Nominals.TemplateId, claimId :: !ClaimId, legacyTemplateId :: !(KindID "template")}
  deriving stock (Eq, Show)

data TemplatesPayload
  = TemplateClaimed !TemplateClaimedData
  deriving stock (Eq, Show)

messageTypeOf :: TemplatesPayload -> Text
messageTypeOf = \case
  TemplateClaimed {} -> "TemplateClaimed"

encodeTemplatesPayload :: TemplatesPayload -> Value
encodeTemplatesPayload = \case
  TemplateClaimed payload ->
    object
      [ "messageType" .= ("TemplateClaimed" :: Text),
        "templateId" .= NominalLeaves.encodeTemplateIdLeaf payload.templateId,
        "claimId" .= NominalLeaves.encodeClaimIdLeaf payload.claimId,
        "legacyTemplateId" .= KindID.toText payload.legacyTemplateId
      ]

parseTemplatesPayload :: Value -> Either Text TemplatesPayload
parseTemplatesPayload = mapLeftText . parseEither (withObject "TemplatesPayload" go)
  where
    go o = do
      kind <- explicitParseField (withText "messageType" validateMessageType) o "messageType"
      case kind of
        "TemplateClaimed" ->
          TemplateClaimed
            <$> ( TemplateClaimedData
                    <$> explicitParseField NominalLeaves.parseTemplateIdLeaf o "templateId"
                    <*> explicitParseField NominalLeaves.parseClaimIdLeaf o "claimId"
                    <*> explicitParseField (parseKindIdV7Value @"template") o "legacyTemplateId"
                )
        _ -> 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` ["TemplateClaimed"] = pure kind
  | otherwise = fail ("unknown message type " <> show kind <> "; expected one of: TemplateClaimed")