Codec.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from aggregate IdentityLedger; do not edit.
module Generated.IdAdmissionDomains.IdentityLedger.Codec (
    identityLedgerCodec,
    parseIdentityLedgerEvent,
    encodeIdentityLedgerEvent,
    encodeIdentityEnvelopeMapped,
    decodeIdentityEnvelopeMapped,
) where

import Generated.IdAdmissionDomains.IdentityLedger.Domain
import Generated.IdAdmissionDomains.Nominals (legacyIdText)
import Generated.IdAdmissionDomains.Nominals.Internal (unsafeLegacyIdFromLegacyText)
import Control.Monad (unless)
import Data.Aeson (Value (..), object, parseJSON, toJSON, withObject, (.:), (.=))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser, JSONPathElement (..), (<?>), explicitParseField, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.Structural (bindingFromShape, bindingToShape)
import Keiro.Codec (Codec (..), EventType (..))


import Generated.IdAdmissionDomains.Structural.NominalLeaves (encodeLegacyIdLeaf, parseLegacyIdLeaf)
import Generated.IdAdmissionDomains.Structural.NominalLeaves (parseLegacyIdLeafKey, renderLegacyIdLeafKey)
import Conformance.IdAdmissionDomains.Bindings qualified as Bindings
import Conformance.IdAdmissionDomains.Domain (IdentityEnvelope)
import Generated.IdAdmissionDomains.Structural.Shape.IdentityEnvelope qualified as ShapeIdentityEnvelope



encodeIdentityEnvelopeMapped :: IdentityEnvelope -> Value
encodeIdentityEnvelopeMapped = encodeIdentityEnvelopeShape . bindingToShape Bindings.identityEnvelopeBinding

parseIdentityEnvelopeMapped :: Value -> Parser IdentityEnvelope
parseIdentityEnvelopeMapped value = bindingFromShape Bindings.identityEnvelopeBinding <$> parseIdentityEnvelopeShape value

decodeIdentityEnvelopeMapped :: Value -> Either Text IdentityEnvelope
decodeIdentityEnvelopeMapped = mapLeftText . parseEither parseIdentityEnvelopeMapped

encodeIdentityEnvelopeShape :: ShapeIdentityEnvelope.IdentityEnvelopeShape -> Value
encodeIdentityEnvelopeShape shape =
  object
      [ "legacyId" .= encodeLegacyIdLeaf shape.legacyId
      , "previousId" .= maybe Null (\item0 -> encodeLegacyIdLeaf item0) (shape.previousId)
      , "labelsById" .= Object (KeyMap.fromList [(Key.fromText (renderLegacyIdLeafKey key0), toJSON (item0)) | (key0, item0) <- Map.toList (shape.labelsById)])
      ]

parseIdentityEnvelopeShape :: Value -> Parser ShapeIdentityEnvelope.IdentityEnvelopeShape
parseIdentityEnvelopeShape = withObject "IdentityEnvelopeShape" $ \objectValue -> do
  rejectUnknownFields "IdentityEnvelope" ["legacyId", "previousId", "labelsById"] objectValue
  ShapeIdentityEnvelope.IdentityEnvelope
    <$> explicitParseField (parseLegacyIdLeaf) objectValue "legacyId"
    <*> parseOptionalField (pure Nothing) (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseLegacyIdLeaf) other0) objectValue "previousId"
    <*> explicitParseField (\value0 -> withObject "Map[LegacyId]" (\object0 -> Map.fromList <$> traverse (\(rawKey0, item0) -> do key0 <- parseLegacyIdLeafKey (Key.toText rawKey0) <?> Key rawKey0; parsedItem0 <- (parseJSON) item0 <?> Key rawKey0; pure (key0, parsedItem0)) (KeyMap.toList object0)) value0) objectValue "labelsById"

identityLedgerEventTypes :: NonEmpty EventType
identityLedgerEventTypes = EventType "IdentityRecorded" :| [EventType "IdentityAudited", EventType "LegacyIdentityImported"]

identityLedgerCodec :: Codec IdentityLedgerEvent
identityLedgerCodec =
  Codec
    { eventTypes = identityLedgerEventTypes
    , eventType = \case
        IdentityRecorded{} -> EventType "IdentityRecorded"
        IdentityAudited{} -> EventType "IdentityAudited"
        LegacyIdentityImported{} -> EventType "LegacyIdentityImported"
    , schemaVersion = 1
    , encode = encodeIdentityLedgerEvent
    , decode = parseIdentityLedgerEvent
    , upcasters = []
    }

encodeIdentityLedgerEvent :: IdentityLedgerEvent -> Value
encodeIdentityLedgerEvent = \case
  IdentityRecorded payload ->
    object
      [ "kind" .= ("IdentityRecorded" :: Text)
      , "legacyId" .= legacyIdText payload.legacyId
      , "envelope" .= encodeIdentityEnvelopeMapped payload.envelope
      ]
  IdentityAudited payload ->
    object
      [ "kind" .= ("IdentityAudited" :: Text)
      , "legacyId" .= legacyIdText payload.legacyId
      , "envelope" .= encodeIdentityEnvelopeMapped payload.envelope
      ]
  LegacyIdentityImported payload ->
    object
      [ "kind" .= ("LegacyIdentityImported" :: Text)
      , "legacyId" .= legacyIdText payload.legacyId
      , "envelope" .= encodeIdentityEnvelopeMapped payload.envelope
      ]

parseIdentityLedgerEvent :: EventType -> Value -> Either Text IdentityLedgerEvent
parseIdentityLedgerEvent (EventType tag) = mapLeftText . parseEither (withObject "IdentityLedgerEvent" go)
  where
    go o = do
      case tag of
        "IdentityRecorded" ->
          IdentityRecorded
            <$> ( IdentityRecordedData
                    <$> (unsafeLegacyIdFromLegacyText <$> o .: "legacyId")
                    <*> explicitParseField parseIdentityEnvelopeMapped o "envelope"
                )
        "IdentityAudited" ->
          IdentityAudited
            <$> ( IdentityAuditedData
                    <$> (unsafeLegacyIdFromLegacyText <$> o .: "legacyId")
                    <*> explicitParseField parseIdentityEnvelopeMapped o "envelope"
                )
        "LegacyIdentityImported" ->
          LegacyIdentityImported
            <$> ( LegacyIdentityImportedData
                    <$> (unsafeLegacyIdFromLegacyText <$> o .: "legacyId")
                    <*> explicitParseField parseIdentityEnvelopeMapped o "envelope"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes identityLedgerEventTypes)

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

renderExpectedEventTypes :: NonEmpty EventType -> String
renderExpectedEventTypes =
  T.unpack
    . T.intercalate ", "
    . map (\(EventType eventTypeName) -> eventTypeName)
    . NonEmpty.toList

parseOptionalField :: Parser fieldValue -> (Value -> Parser fieldValue) -> KeyMap.KeyMap Value -> Key.Key -> Parser fieldValue
parseOptionalField onMissing parseItem objectValue key =
  case KeyMap.lookup key objectValue of
    Nothing -> onMissing
    Just _ -> explicitParseField parseItem objectValue key

rejectUnknownFields :: String -> [Text] -> KeyMap.KeyMap Value -> Parser ()
rejectUnknownFields label allowed objectValue =
  unless (null extras) (fail (label <> " contains unknown fields: " <> show extras))
  where
    extras = filter (`notElem` allowed) (map Key.toText (KeyMap.keys objectValue))