-- | The message type that is written to failure streams when using the 'writeToCategory' 'FailureStrategy'.
module MessageDb.Subscription.FailedMessage
  ( FailedMessage (..),
    messageType,
    handleFailures,
  )
where

import Control.Monad.Except (liftEither)
import Data.Aeson (KeyValue ((.=)), (.:))
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import MessageDb.Handlers (Handlers)
import qualified MessageDb.Handlers as Handlers
import MessageDb.Message (Message)
import qualified MessageDb.Message as Message


-- | A message that was unable to be handled.
data FailedMessage = FailedMessage
  { FailedMessage -> Message
message :: Message
  , FailedMessage -> Text
reason :: Text
  }


-- | The message type of a 'FailedMessage'.
messageType :: Message.MessageType
messageType :: MessageType
messageType =
  Typeable FailedMessage => MessageType
forall payload. Typeable payload => MessageType
Message.messageTypeOf @FailedMessage


toKeyValues :: Aeson.KeyValue keyValue => FailedMessage -> [keyValue]
toKeyValues :: FailedMessage -> [keyValue]
toKeyValues FailedMessage{Text
Message
reason :: Text
message :: Message
reason :: FailedMessage -> Text
message :: FailedMessage -> Message
..} =
  [ Key
"message" Key -> Message -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message
message
  , Key
"reason" Key -> Text -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reason
  ]


instance Aeson.ToJSON FailedMessage where
  toJSON :: FailedMessage -> Value
toJSON = [Pair] -> Value
Aeson.object ([Pair] -> Value)
-> (FailedMessage -> [Pair]) -> FailedMessage -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailedMessage -> [Pair]
forall keyValue. KeyValue keyValue => FailedMessage -> [keyValue]
toKeyValues
  toEncoding :: FailedMessage -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding)
-> (FailedMessage -> Series) -> FailedMessage -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (FailedMessage -> [Series]) -> FailedMessage -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailedMessage -> [Series]
forall keyValue. KeyValue keyValue => FailedMessage -> [keyValue]
toKeyValues


instance Aeson.FromJSON FailedMessage where
  parseJSON :: Value -> Parser FailedMessage
parseJSON = String
-> (Object -> Parser FailedMessage)
-> Value
-> Parser FailedMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"FailedMessage" ((Object -> Parser FailedMessage) -> Value -> Parser FailedMessage)
-> (Object -> Parser FailedMessage)
-> Value
-> Parser FailedMessage
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Message
message <- Object
object Object -> Key -> Parser Message
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
    Text
reason <- Object
object Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason"
    FailedMessage -> Parser FailedMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FailedMessage -> Parser FailedMessage)
-> FailedMessage -> Parser FailedMessage
forall a b. (a -> b) -> a -> b
$ FailedMessage :: Message -> Text -> FailedMessage
FailedMessage{Text
Message
reason :: Text
message :: Message
reason :: Text
message :: Message
..}


{- | If you have a stream of 'FailedMessage' messages, then you can use
 this function so you can handle the original messages that failed.
-}
handleFailures :: Handlers output -> Handlers output
handleFailures :: Handlers output -> Handlers output
handleFailures Handlers output
originalHandlers =
  let failedMessageHandle :: Handler output
failedMessageHandle = do
        Message.ParsedMessage{FailedMessage
parsedPayload :: forall payload metadata. ParsedMessage payload metadata -> payload
parsedPayload :: FailedMessage
parsedPayload} <- (FromJSON FailedMessage, FromJSON Metadata) =>
Handler (ParsedMessage FailedMessage Metadata)
forall payload metadata.
(FromJSON payload, FromJSON metadata) =>
Handler (ParsedMessage payload metadata)
Handlers.getParsedMessage @FailedMessage @Message.Metadata
        let originalMessage :: Message
originalMessage = FailedMessage -> Message
message FailedMessage
parsedPayload
         in Either HandleError output -> Handler output
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either HandleError output -> Handler output)
-> Either HandleError output -> Handler output
forall a b. (a -> b) -> a -> b
$ Handlers output -> Message -> Either HandleError output
forall output.
Handlers output -> Message -> Either HandleError output
Handlers.handle Handlers output
originalHandlers Message
originalMessage
   in MessageType -> Handler output -> Handlers output -> Handlers output
forall output.
MessageType -> Handler output -> Handlers output -> Handlers output
Handlers.addHandler MessageType
messageType Handler output
failedMessageHandle Handlers output
forall output. Handlers output
Handlers.emptyHandlers