Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.AggregateScalarExpressions.ScalarAccount.Codec (
    scalarAccountCodec,
    parseScalarAccountEvent,
    encodeScalarAccountEvent,
    encodeLimitsMapped,
    decodeLimitsMapped,
) where

import Generated.AggregateScalarExpressions.ScalarAccount.Domain
import Control.Monad (unless)
import Data.Aeson (Value (..), object, parseJSON, toJSON, withObject, withText, (.:), (.=))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
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.AggregateScalarExpressions.Structural.Shape.Limits qualified
import ScalarExpressions.Bindings qualified
import ScalarExpressions.Domain qualified

parseAccountMode :: Text -> Parser AccountMode
parseAccountMode = \case
  "normal" -> pure Normal
  "restricted" -> pure Restricted
  _ -> fail "unknown AccountMode"

encodeLimitsMapped :: ScalarExpressions.Domain.Limits -> Value
encodeLimitsMapped = encodeLimitsShape . bindingToShape ScalarExpressions.Bindings.limitsBinding

parseLimitsMapped :: Value -> Parser ScalarExpressions.Domain.Limits
parseLimitsMapped value = bindingFromShape ScalarExpressions.Bindings.limitsBinding <$> parseLimitsShape value

decodeLimitsMapped :: Value -> Either Text ScalarExpressions.Domain.Limits
decodeLimitsMapped = mapLeftText . parseEither parseLimitsMapped

encodeLimitsShape :: Generated.AggregateScalarExpressions.Structural.Shape.Limits.LimitsShape -> Value
encodeLimitsShape shape =
  object
      [ "minimum" .= toJSON (Generated.AggregateScalarExpressions.Structural.Shape.Limits.minimum shape)
      , "ceiling" .= toJSON (Generated.AggregateScalarExpressions.Structural.Shape.Limits.ceiling shape)
      ]

parseLimitsShape :: Value -> Parser Generated.AggregateScalarExpressions.Structural.Shape.Limits.LimitsShape
parseLimitsShape = withObject "LimitsShape" $ \objectValue -> do
  rejectUnknownFields "Limits" ["minimum", "ceiling"] objectValue
  Generated.AggregateScalarExpressions.Structural.Shape.Limits.Limits
    <$> ((objectValue .: "minimum" :: Parser Value) >>= (parseJSON))
    <*> ((objectValue .: "ceiling" :: Parser Value) >>= (parseJSON))

scalarAccountCodec :: Codec ScalarAccountEvent
scalarAccountCodec =
  Codec
    { eventTypes = EventType "Adjusted" :| [EventType "ClosedEvent"]
    , eventType = \case
        Adjusted{} -> EventType "Adjusted"
        ClosedEvent{} -> EventType "ClosedEvent"
    , schemaVersion = 1
    , encode = encodeScalarAccountEvent
    , decode = parseScalarAccountEvent
    , upcasters = []
    }

encodeScalarAccountEvent :: ScalarAccountEvent -> Value
encodeScalarAccountEvent = \case
  Adjusted payload ->
    object
      [ "kind" .= ("Adjusted" :: Text)
      , "balance" .= payload.balance
      , "requested" .= payload.requested
      , "machine" .= payload.machine
      , "label" .= payload.label
      , "active" .= payload.active
      , "mode" .= accountModeText payload.mode
      , "requestId" .= requestIdText payload.requestId
      , "observedAt" .= payload.observedAt
      , "limits" .= encodeLimitsMapped payload.limits
      ]
  ClosedEvent payload ->
    object
      [ "kind" .= ("ClosedEvent" :: Text)
      , "balance" .= payload.balance
      ]

parseScalarAccountEvent :: EventType -> Value -> Either Text ScalarAccountEvent
parseScalarAccountEvent (EventType tag) = mapLeftText . parseEither (withObject "ScalarAccountEvent" go)
  where
    go o = do
      case tag of
        "Adjusted" ->
          Adjusted <$> (AdjustedData <$> o .: "balance" <*> o .: "requested" <*> o .: "machine" <*> o .: "label" <*> o .: "active" <*> (o .: "mode" >>= parseAccountMode) <*> (RequestId <$> o .: "requestId") <*> o .: "observedAt" <*> (o .: "limits" >>= parseLimitsMapped))
        "ClosedEvent" ->
          ClosedEvent <$> (ClosedEventData <$> o .: "balance")
        _ -> fail "unknown event type"

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

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))