Contract.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from contract myContract; do not edit.
module SkelIntake.Generated.MyService.MyContract.Contract
  ( MyContractPayload (..)
  , ThingHappenedData (..)
  , eventsTopic
  , messageTypeOf
  , encodeMyContractPayload
  , parseMyContractPayload
  ) 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 Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.IdDomain (parseKindIdV7Value)

-- topic constants
eventsTopic :: Text
eventsTopic = "my-service.events"

-- the closed payload set (discriminated by "messageType")
data ThingHappenedData = ThingHappenedData {thingId :: !(KindID "thing")}
  deriving stock (Eq, Show)

data MyContractPayload
  = ThingHappened !ThingHappenedData
  deriving stock (Eq, Show)

messageTypeOf :: MyContractPayload -> Text
messageTypeOf = \case
  ThingHappened {} -> "ThingHappened"

encodeMyContractPayload :: MyContractPayload -> Value
encodeMyContractPayload = \case
  ThingHappened payload ->
    object
      [ "messageType" .= ("ThingHappened" :: Text),
        "thingId" .= KindID.toText payload.thingId
      ]

parseMyContractPayload :: Value -> Either Text MyContractPayload
parseMyContractPayload = mapLeftText . parseEither (withObject "MyContractPayload" go)
  where
    go o = do
      kind <- explicitParseField (withText "messageType" validateMessageType) o "messageType"
      case kind of
        "ThingHappened" ->
          ThingHappened
            <$> ( ThingHappenedData
                    <$> explicitParseField (parseKindIdV7Value @"thing") o "thingId"
                )
        _ -> 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` ["ThingHappened"] = pure kind
  | otherwise = fail ("unknown message type " <> show kind <> "; expected one of: ThingHappened")