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

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


-- | Reason why the message handle failed.
data FailureReason
  = HandleFailure HandleError
  | UnknownFailure Text
  deriving (Int -> FailureReason -> ShowS
[FailureReason] -> ShowS
FailureReason -> String
(Int -> FailureReason -> ShowS)
-> (FailureReason -> String)
-> ([FailureReason] -> ShowS)
-> Show FailureReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureReason] -> ShowS
$cshowList :: [FailureReason] -> ShowS
show :: FailureReason -> String
$cshow :: FailureReason -> String
showsPrec :: Int -> FailureReason -> ShowS
$cshowsPrec :: Int -> FailureReason -> ShowS
Show, FailureReason -> FailureReason -> Bool
(FailureReason -> FailureReason -> Bool)
-> (FailureReason -> FailureReason -> Bool) -> Eq FailureReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureReason -> FailureReason -> Bool
$c/= :: FailureReason -> FailureReason -> Bool
== :: FailureReason -> FailureReason -> Bool
$c== :: FailureReason -> FailureReason -> Bool
Eq, (forall x. FailureReason -> Rep FailureReason x)
-> (forall x. Rep FailureReason x -> FailureReason)
-> Generic FailureReason
forall x. Rep FailureReason x -> FailureReason
forall x. FailureReason -> Rep FailureReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FailureReason x -> FailureReason
$cfrom :: forall x. FailureReason -> Rep FailureReason x
Generic)


instance Exception FailureReason
instance Aeson.ToJSON FailureReason
instance Aeson.FromJSON FailureReason


-- | A message that was unable to be handled.
data FailedMessage = FailedMessage
  { FailedMessage -> Message
failedMessage :: Message
  , FailedMessage -> FailureReason
failedReason :: FailureReason
  }
  deriving (Int -> FailedMessage -> ShowS
[FailedMessage] -> ShowS
FailedMessage -> String
(Int -> FailedMessage -> ShowS)
-> (FailedMessage -> String)
-> ([FailedMessage] -> ShowS)
-> Show FailedMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailedMessage] -> ShowS
$cshowList :: [FailedMessage] -> ShowS
show :: FailedMessage -> String
$cshow :: FailedMessage -> String
showsPrec :: Int -> FailedMessage -> ShowS
$cshowsPrec :: Int -> FailedMessage -> ShowS
Show, FailedMessage -> FailedMessage -> Bool
(FailedMessage -> FailedMessage -> Bool)
-> (FailedMessage -> FailedMessage -> Bool) -> Eq FailedMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailedMessage -> FailedMessage -> Bool
$c/= :: FailedMessage -> FailedMessage -> Bool
== :: FailedMessage -> FailedMessage -> Bool
$c== :: FailedMessage -> FailedMessage -> Bool
Eq)


-- | 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{Message
FailureReason
failedReason :: FailureReason
failedMessage :: Message
failedReason :: FailedMessage -> FailureReason
failedMessage :: FailedMessage -> Message
..} =
  [ Key
"message" Key -> Message -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message
failedMessage
  , Key
"reason" Key -> FailureReason -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FailureReason
failedReason
  ]


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
failedMessage <- Object
object Object -> Key -> Parser Message
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
    FailureReason
failedReason <- Object
object Object -> Key -> Parser FailureReason
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 -> FailureReason -> FailedMessage
FailedMessage{Message
FailureReason
failedReason :: FailureReason
failedMessage :: Message
failedReason :: FailureReason
failedMessage :: 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
failedMessage 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