module MessageDb.Subscription.FailureStrategy
  ( FailureReason (..)
  , FailureStrategy (..)
  , ignoreFailures
  , writeToCategory
  , writeUnknownFailuresToCategory
  , writeAllToCategory
  )
where

import Control.Exception.Safe (finally)
import Control.Monad (void, when)
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID.V4
import qualified MessageDb.Functions as Functions
import qualified MessageDb.Message as Message
import qualified MessageDb.StreamName as StreamName
import MessageDb.Subscription.FailedMessage (FailedMessage (FailedMessage), FailureReason)
import qualified MessageDb.Subscription.FailedMessage as FailedMessage


-- | Strategy for logging failures.
newtype FailureStrategy = FailureStrategy
  { FailureStrategy -> FailedMessage -> IO ()
logFailure :: FailedMessage -> IO ()
  }


-- | Do nothing, ignore all failures.
ignoreFailures :: FailureStrategy
ignoreFailures :: FailureStrategy
ignoreFailures = (FailedMessage -> IO ()) -> FailureStrategy
FailureStrategy ((FailedMessage -> IO ()) -> FailureStrategy)
-> (FailedMessage -> IO ()) -> FailureStrategy
forall a b. (a -> b) -> a -> b
$ \FailedMessage
_ ->
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Combine a strategy with another so that they both run for a failure.
combine :: FailureStrategy -> FailureStrategy -> FailureStrategy
combine :: FailureStrategy -> FailureStrategy -> FailureStrategy
combine FailureStrategy
first FailureStrategy
second = (FailedMessage -> IO ()) -> FailureStrategy
FailureStrategy ((FailedMessage -> IO ()) -> FailureStrategy)
-> (FailedMessage -> IO ()) -> FailureStrategy
forall a b. (a -> b) -> a -> b
$ \FailedMessage
message ->
  FailureStrategy -> FailedMessage -> IO ()
logFailure FailureStrategy
first FailedMessage
message IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` FailureStrategy -> FailedMessage -> IO ()
logFailure FailureStrategy
second FailedMessage
message


instance Semigroup FailureStrategy where
  <> :: FailureStrategy -> FailureStrategy -> FailureStrategy
(<>) = FailureStrategy -> FailureStrategy -> FailureStrategy
combine


instance Monoid FailureStrategy where
  mempty :: FailureStrategy
mempty = FailureStrategy
ignoreFailures


-- | Write a failure to a category. Use @shouldKeep@ to filter out message failures you don't want to log.
writeToCategory ::
  (FailureReason -> Bool) ->
  Functions.WithConnection ->
  StreamName.Category ->
  FailureStrategy
writeToCategory :: (FailureReason -> Bool)
-> WithConnection -> Category -> FailureStrategy
writeToCategory FailureReason -> Bool
shouldKeep WithConnection
withConnection Category
categoryName =
  let logFailureToCategory :: FailedMessage -> IO ()
logFailureToCategory payload :: FailedMessage
payload@FailedMessage{Message
FailureReason
failedReason :: FailedMessage -> FailureReason
failedMessage :: FailedMessage -> Message
failedReason :: FailureReason
failedMessage :: Message
..} =
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FailureReason -> Bool
shouldKeep FailureReason
failedReason) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Identifier
identity <-
            case StreamName -> Maybe Identifier
StreamName.identifierOfStream (Message -> StreamName
Message.messageStream Message
failedMessage) of
              Maybe Identifier
Nothing -> (UUID -> Identifier) -> IO UUID -> IO Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
StreamName.Identifier (Text -> Identifier) -> (UUID -> Text) -> UUID -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText) IO UUID
UUID.V4.nextRandom
              Just Identifier
value -> Identifier -> IO Identifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure Identifier
value

          let streamName :: StreamName
streamName =
                Category -> Identifier -> StreamName
StreamName.addIdentifierToCategory Category
categoryName Identifier
identity

              metadata :: Metadata
metadata = Message -> Metadata
Message.messageMetadata Message
failedMessage

          IO (MessageId, StreamPosition) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (MessageId, StreamPosition) -> IO ())
-> ((Connection -> IO (MessageId, StreamPosition))
    -> IO (MessageId, StreamPosition))
-> (Connection -> IO (MessageId, StreamPosition))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> IO (MessageId, StreamPosition))
-> IO (MessageId, StreamPosition)
WithConnection
withConnection ((Connection -> IO (MessageId, StreamPosition)) -> IO ())
-> (Connection -> IO (MessageId, StreamPosition)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
connection ->
            Connection
-> StreamName
-> MessageType
-> FailedMessage
-> Maybe Metadata
-> Maybe ExpectedVersion
-> IO (MessageId, StreamPosition)
forall payload metadata.
(ToJSON payload, ToJSON metadata) =>
Connection
-> StreamName
-> MessageType
-> payload
-> Maybe metadata
-> Maybe ExpectedVersion
-> IO (MessageId, StreamPosition)
Functions.writeMessage
              Connection
connection
              StreamName
streamName
              MessageType
FailedMessage.messageType
              FailedMessage
payload
              (Metadata -> Maybe Metadata
forall a. a -> Maybe a
Just Metadata
metadata)
              Maybe ExpectedVersion
forall a. Maybe a
Nothing
   in (FailedMessage -> IO ()) -> FailureStrategy
FailureStrategy FailedMessage -> IO ()
logFailureToCategory


-- | Only write 'UnknownFailure's to a category.
writeUnknownFailuresToCategory :: Functions.WithConnection -> StreamName.Category -> FailureStrategy
writeUnknownFailuresToCategory :: WithConnection -> Category -> FailureStrategy
writeUnknownFailuresToCategory =
  (FailureReason -> Bool)
-> WithConnection -> Category -> FailureStrategy
writeToCategory ((FailureReason -> Bool)
 -> WithConnection -> Category -> FailureStrategy)
-> (FailureReason -> Bool)
-> WithConnection
-> Category
-> FailureStrategy
forall a b. (a -> b) -> a -> b
$ \case
    FailedMessage.UnknownFailure Text
_ -> Bool
True
    FailureReason
_ -> Bool
False


-- | Write either 'UnknownFailure's or 'HandleFailure's to a category.
writeAllToCategory :: Functions.WithConnection -> StreamName.Category -> FailureStrategy
writeAllToCategory :: WithConnection -> Category -> FailureStrategy
writeAllToCategory =
  (FailureReason -> Bool)
-> WithConnection -> Category -> FailureStrategy
writeToCategory ((FailureReason -> Bool)
 -> WithConnection -> Category -> FailureStrategy)
-> (FailureReason -> Bool)
-> WithConnection
-> Category
-> FailureStrategy
forall a b. (a -> b) -> a -> b
$ Bool -> FailureReason -> Bool
forall a b. a -> b -> a
const Bool
True