Contract.hs

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

import Data.Aeson (Value, object, withObject, withText, parseJSON, (.=))
import Data.Aeson.Types (Parser, explicitParseField, parseEither, (<?>))
import qualified Data.Aeson.Types as Aeson
import Data.KindID (KindID)
import qualified Data.KindID as KindID
import Conformance.ContractListFields.Domain (ClaimId)
import Generated.ContractListFields.Nominals qualified as Nominals
import Generated.ContractListFields.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 TemplatesReassignedData = TemplatesReassignedData {typeId :: !Nominals.TemplateId, templateIds :: ![Nominals.TemplateId], claimIds :: ![ClaimId], legacyTemplateIds :: ![(KindID "template")], labels :: ![Text], positions :: ![Int]}
  deriving stock (Eq, Show)

data IndexData = IndexData {offsets :: ![Int]}
  deriving stock (Eq, Show)

data TemplatesPayload
  = TemplatesReassigned !TemplatesReassignedData
  | Index !IndexData
  deriving stock (Eq, Show)

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

encodeTemplatesPayload :: TemplatesPayload -> Value
encodeTemplatesPayload = \case
  TemplatesReassigned payload ->
    object
      [ "messageType" .= ("TemplatesReassigned" :: Text),
        "typeId" .= NominalLeaves.encodeTemplateIdLeaf payload.typeId,
        "templateIds" .= map NominalLeaves.encodeTemplateIdLeaf payload.templateIds,
        "claimIds" .= map NominalLeaves.encodeClaimIdLeaf payload.claimIds,
        "legacyTemplateIds" .= map KindID.toText payload.legacyTemplateIds,
        "labels" .= payload.labels,
        "positions" .= payload.positions
      ]
  Index payload ->
    object
      [ "messageType" .= ("Index" :: Text),
        "offsets" .= payload.offsets
      ]

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
        "TemplatesReassigned" ->
          TemplatesReassigned
            <$> ( TemplatesReassignedData
                    <$> explicitParseField NominalLeaves.parseTemplateIdLeaf o "typeId"
                    <*> explicitParseField (parseContractList NominalLeaves.parseTemplateIdLeaf) o "templateIds"
                    <*> explicitParseField (parseContractList NominalLeaves.parseClaimIdLeaf) o "claimIds"
                    <*> explicitParseField (parseContractList (parseKindIdV7Value @"template")) o "legacyTemplateIds"
                    <*> explicitParseField (parseContractList parseJSON) o "labels"
                    <*> explicitParseField (parseContractList parseJSON) o "positions"
                )
        "Index" ->
          Index
            <$> ( IndexData
                    <$> explicitParseField (parseContractList parseJSON) o "offsets"
                )
        _ -> 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` ["TemplatesReassigned", "Index"] = pure kind
  | otherwise = fail ("unknown message type " <> show kind <> "; expected one of: TemplatesReassigned, Index")

parseContractList :: (Value -> Parser a) -> Value -> Parser [a]
parseContractList element value = do
  items <- parseJSON value :: Parser [Value]
  traverse (\(index, item) -> element item <?> Aeson.Index index) (zip [0 :: Int ..] items)