{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}

module MatrixBot.Bot.EventsListener.Handlers.ReplyToMedia
  ( replyToMedia
  ) where

import qualified Control.Lens as Lens
import qualified Control.Monad.Logger as ML
import qualified Control.Monad.Trans.Except as Except
import qualified Data.Attoparsec.Text as AP
import Data.Text (pack, Text)
import qualified MatrixBot.Bot.BotConfig as BotConfig
import MatrixBot.Bot.BotM (BotM)
import qualified MatrixBot.Bot.EventsListener.Filters as Filters
import MatrixBot.Bot.Jobs.BotJob (BotJob (BotJobSendMessage))
import MatrixBot.Bot.Jobs.Queue (HasBotJobsWriter (botJobsWriter))
import qualified MatrixBot.Log as L
import qualified MatrixBot.MatrixApi as Api
import qualified MatrixBot.SharedTypes as T
import qualified UnliftIO.STM as STM
import Data.Functor ((<&>))


-- | Process @m.room.message@ event and see if there is a need to reply to an event with a message
--   template.
replyToMedia
  ∷ ∀r m. (BotM r m, HasBotJobsWriter r)
  ⇒ [BotConfig.BotConfigReplyToMedia]
  -- ^ Bot configuration for “react to users” feature
  → T.RoomId
  -- ^ Matrix room where there event was sent to
  → T.Mxid
  -- ^ User ID (who sent the event)
  → T.EventId
  -- ^ Unique identifier of the event
  → Api.MRoomMessageClientEventContent
  -- ^ Client content for the event
  → m ()
replyToMedia :: forall r (m :: * -> *).
(BotM r m, HasBotJobsWriter r) =>
[BotConfigReplyToMedia]
-> RoomId
-> Mxid
-> EventId
-> MRoomMessageClientEventContent
-> m ()
replyToMedia [] RoomId
_ Mxid
_ EventId
_ MRoomMessageClientEventContent
_ =
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"There is no configuration entries for “reply to media” feature. "
    , Text
"No replies/messages will be posted for the event."
    ]
replyToMedia [BotConfigReplyToMedia]
configEntries RoomId
roomId Mxid
userId EventId
eventId MRoomMessageClientEventContent
clientContent = do
  case MRoomMessageClientEventContent
clientContent of
    (MRoomMessageClientEventContent -> Maybe MediaEventData
mkMediaEventDataFromClientContent → Just MediaEventData
mediaData) →
      MediaEventData -> (ExtractedMediaValues -> m ()) -> m ()
forall (m :: * -> *).
MonadLogger m =>
MediaEventData -> (ExtractedMediaValues -> m ()) -> m ()
withExtractedMediaValues MediaEventData
mediaData ((ExtractedMediaValues -> m ()) -> m ())
-> (ExtractedMediaValues -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ExtractedMediaValues
extractMediaValues →
        m ()
logProcessing m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (BotConfigReplyToMedia -> m ()) -> [BotConfigReplyToMedia] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (MediaEventData
-> ExtractedMediaValues -> BotConfigReplyToMedia -> m ()
handleEntry MediaEventData
mediaData ExtractedMediaValues
extractMediaValues) [BotConfigReplyToMedia]
configEntries
    MRoomMessageClientEventContent
_ →
      Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"This event type is not a detected media file one. "
        , Text
"“Reply to media” handling is skipped for this event."
        ]

  where
    logProcessing :: m ()
logProcessing =
      Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug Text
"Going through “reply to media” configuration to see if this event is matching…"

    resolveFilter :: Either Text () -> m ()
resolveFilter =
      ((Text -> m ()) -> (() -> m ()) -> Either Text () -> m ())
-> (() -> m ()) -> (Text -> m ()) -> Either Text () -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> m ()) -> (() -> m ()) -> Either Text () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text -> m ()) -> Either Text () -> m ())
-> (Text -> m ()) -> Either Text () -> m ()
forall a b. (a -> b) -> a -> b
$
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Event mismatched filter (skipping this replying to media config entry): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

    handleEntry ∷ MediaEventData → ExtractedMediaValues → BotConfig.BotConfigReplyToMedia → m ()
    handleEntry :: MediaEventData
-> ExtractedMediaValues -> BotConfigReplyToMedia -> m ()
handleEntry MediaEventData
mediaEventData ExtractedMediaValues
extractedMediaValues BotConfigReplyToMedia
entry = (Either Text () -> m ()
resolveFilter (Either Text () -> m ()) -> m (Either Text ()) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (Either Text ()) -> m ()) -> m (Either Text ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ExceptT Text m () -> m (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT (ExceptT Text m () -> m (Either Text ()))
-> ExceptT Text m () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ do
      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text
"Handling reply to media config entry: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text)
-> (BotConfigReplyToMedia -> String)
-> BotConfigReplyToMedia
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotConfigReplyToMedia -> String
forall a. Show a => a -> String
show) BotConfigReplyToMedia
entry

      Maybe UsersFilter -> Mxid -> ExceptT Text m ()
forall (m :: * -> *).
MonadLogger m =>
Maybe UsersFilter -> Mxid -> ExceptT Text m ()
Filters.filterByUser (BotConfigReplyToMedia -> Maybe UsersFilter
BotConfig.botConfigReplyToMediaUsersFilter BotConfigReplyToMedia
entry) Mxid
userId
      Maybe RoomsFilter -> RoomId -> ExceptT Text m ()
forall (m :: * -> *).
MonadLogger m =>
Maybe RoomsFilter -> RoomId -> ExceptT Text m ()
Filters.filterByRoom (BotConfigReplyToMedia -> Maybe RoomsFilter
BotConfig.botConfigReplyToMediaRoomsFilter BotConfigReplyToMedia
entry) RoomId
roomId
      Maybe MediaMsgtypeFilter
-> MRoomMessageClientEventContent -> ExceptT Text m ()
forall (m :: * -> *).
MonadLogger m =>
Maybe MediaMsgtypeFilter
-> MRoomMessageClientEventContent -> ExceptT Text m ()
Filters.filterByMediaMsgtype (BotConfigReplyToMedia -> Maybe MediaMsgtypeFilter
BotConfig.botConfigReplyToMediaMsgtypeFilter BotConfigReplyToMedia
entry) MRoomMessageClientEventContent
clientContent

      let
        replyMessage :: Text
replyMessage =
          [BotConfigReplyToMedia_MessageTemplateEntry]
-> MediaEventData -> ExtractedMediaValues -> Text
renderTemplate
            (BotConfigReplyToMedia
-> [BotConfigReplyToMedia_MessageTemplateEntry]
BotConfig.botConfigReplyToMediaMessageTemplate BotConfigReplyToMedia
entry)
            MediaEventData
mediaEventData
            ExtractedMediaValues
extractedMediaValues

        htmlReplyMessage :: Maybe Text
htmlReplyMessage =
          BotConfigReplyToMedia
-> Maybe [BotConfigReplyToMedia_MessageTemplateEntry]
BotConfig.botConfigReplyToMediaHtmlMessageTemplate BotConfigReplyToMedia
entry Maybe [BotConfigReplyToMedia_MessageTemplateEntry]
-> ([BotConfigReplyToMedia_MessageTemplateEntry] -> Text)
-> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[BotConfigReplyToMedia_MessageTemplateEntry]
x →
            [BotConfigReplyToMedia_MessageTemplateEntry]
-> MediaEventData -> ExtractedMediaValues -> Text
renderTemplate [BotConfigReplyToMedia_MessageTemplateEntry]
x MediaEventData
mediaEventData ExtractedMediaValues
extractedMediaValues

      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Sending a reply message ", (String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) Text
replyMessage
        , Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty ((Text
"(html version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) Maybe Text
htmlReplyMessage
        , Text
" for event ", EventId -> Text
T.unEventId EventId
eventId
        , Text
" in room ", RoomId -> Text
T.printRoomId RoomId
roomId
        , Text
"…"
        ]

      TransactionId
transactionId ← ExceptT Text m TransactionId
forall (m :: * -> *). MonadIO m => m TransactionId
T.genTransactionId
      Getting (BotJob -> STM ()) r (BotJob -> STM ())
-> ExceptT Text m (BotJob -> STM ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting (BotJob -> STM ()) r (BotJob -> STM ())
forall r. HasBotJobsWriter r => Getter r (BotJob -> STM ())
Getter r (BotJob -> STM ())
botJobsWriter ExceptT Text m (BotJob -> STM ())
-> ((BotJob -> STM ()) -> ExceptT Text m ()) -> ExceptT Text m ()
forall a b.
ExceptT Text m a -> (a -> ExceptT Text m b) -> ExceptT Text m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BotJob -> STM ()
sendJob →
        STM () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM () -> ExceptT Text m ())
-> (BotJob -> STM ()) -> BotJob -> ExceptT Text m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotJob -> STM ()
sendJob (BotJob -> ExceptT Text m ()) -> BotJob -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$
          TransactionId
-> RoomId -> Maybe EventId -> Maybe Text -> Text -> BotJob
BotJobSendMessage TransactionId
transactionId RoomId
roomId (EventId -> Maybe EventId
forall a. a -> Maybe a
Just EventId
eventId) Maybe Text
htmlReplyMessage Text
replyMessage


renderTemplate
  ∷ [BotConfig.BotConfigReplyToMedia_MessageTemplateEntry]
  → MediaEventData
  → ExtractedMediaValues
  → Text
renderTemplate :: [BotConfigReplyToMedia_MessageTemplateEntry]
-> MediaEventData -> ExtractedMediaValues -> Text
renderTemplate [BotConfigReplyToMedia_MessageTemplateEntry]
template MediaEventData
mediaEventData ExtractedMediaValues
extractedMediaValues =
  ((BotConfigReplyToMedia_MessageTemplateEntry -> Text)
 -> [BotConfigReplyToMedia_MessageTemplateEntry] -> Text)
-> [BotConfigReplyToMedia_MessageTemplateEntry]
-> (BotConfigReplyToMedia_MessageTemplateEntry -> Text)
-> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (BotConfigReplyToMedia_MessageTemplateEntry -> Text)
-> [BotConfigReplyToMedia_MessageTemplateEntry] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [BotConfigReplyToMedia_MessageTemplateEntry]
template ((BotConfigReplyToMedia_MessageTemplateEntry -> Text) -> Text)
-> (BotConfigReplyToMedia_MessageTemplateEntry -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ \case
    BotConfig.BotConfigReplyToMedia_MessageTemplateEntry_PlainString Text
x → Text
x
    BotConfig.BotConfigReplyToMedia_MessageTemplateEntry_DynamicSubstitution_Field BotConfigReplyToMedia_DynamicFieldName
x →
      case BotConfigReplyToMedia_DynamicFieldName
x of
        BotConfigReplyToMedia_DynamicFieldName
BotConfig.BotConfigReplyToMedia_DynamicFieldName_MsgType → MediaEventData -> Text
msgtype MediaEventData
mediaEventData
        BotConfigReplyToMedia_DynamicFieldName
BotConfig.BotConfigReplyToMedia_DynamicFieldName_Body → MediaEventData -> Text
body MediaEventData
mediaEventData
        BotConfigReplyToMedia_DynamicFieldName
BotConfig.BotConfigReplyToMedia_DynamicFieldName_Url → MediaEventData -> Text
url MediaEventData
mediaEventData
    BotConfig.BotConfigReplyToMedia_MessageTemplateEntry_DynamicSubstitution_ExtractedValue BotConfigReplyToMedia_DynamicExtractedValueName
x →
      case BotConfigReplyToMedia_DynamicExtractedValueName
x of
        BotConfigReplyToMedia_DynamicExtractedValueName
BotConfig.BotConfigReplyToMedia_DynamicExtractedValueName_MediaId →
          ExtractedMediaValues -> Text
extractedMediaId ExtractedMediaValues
extractedMediaValues


data MediaEventData = MediaEventData
  { MediaEventData -> Text
msgtype ∷ Text
  , MediaEventData -> Text
body ∷ Text -- ^ File name
  , MediaEventData -> Text
url ∷ Text
  }
  deriving stock (Int -> MediaEventData -> ShowS
[MediaEventData] -> ShowS
MediaEventData -> String
(Int -> MediaEventData -> ShowS)
-> (MediaEventData -> String)
-> ([MediaEventData] -> ShowS)
-> Show MediaEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MediaEventData -> ShowS
showsPrec :: Int -> MediaEventData -> ShowS
$cshow :: MediaEventData -> String
show :: MediaEventData -> String
$cshowList :: [MediaEventData] -> ShowS
showList :: [MediaEventData] -> ShowS
Show, MediaEventData -> MediaEventData -> Bool
(MediaEventData -> MediaEventData -> Bool)
-> (MediaEventData -> MediaEventData -> Bool) -> Eq MediaEventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MediaEventData -> MediaEventData -> Bool
== :: MediaEventData -> MediaEventData -> Bool
$c/= :: MediaEventData -> MediaEventData -> Bool
/= :: MediaEventData -> MediaEventData -> Bool
Eq)


mkMediaEventDataFromClientContent ∷ Api.MRoomMessageClientEventContent → Maybe MediaEventData
mkMediaEventDataFromClientContent :: MRoomMessageClientEventContent -> Maybe MediaEventData
mkMediaEventDataFromClientContent = \case
  Api.MRoomMessageClientEventContentMImage MRoomMessageMImageMsgtypeClientEventContent
x →
    MediaEventData -> Maybe MediaEventData
forall a. a -> Maybe a
Just (MediaEventData -> Maybe MediaEventData)
-> MediaEventData -> Maybe MediaEventData
forall a b. (a -> b) -> a -> b
$ MediaEventData
      { msgtype :: Text
msgtype = (MImageType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString (MImageType -> Text)
-> (MRoomMessageMImageMsgtypeClientEventContent -> MImageType)
-> MRoomMessageMImageMsgtypeClientEventContent
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MRoomMessageMImageMsgtypeClientEventContent -> MImageType
Api.mRoomMessageMImageMsgtypeClientEventContentMsgtype) MRoomMessageMImageMsgtypeClientEventContent
x
      , body :: Text
body = MRoomMessageMImageMsgtypeClientEventContent -> Text
Api.mRoomMessageMImageMsgtypeClientEventContentBody MRoomMessageMImageMsgtypeClientEventContent
x
      , url :: Text
url = MRoomMessageMImageMsgtypeClientEventContent -> Text
Api.mRoomMessageMImageMsgtypeClientEventContentUrl MRoomMessageMImageMsgtypeClientEventContent
x
      }
  Api.MRoomMessageClientEventContentMVideo MRoomMessageMVideoMsgtypeClientEventContent
x →
    MediaEventData -> Maybe MediaEventData
forall a. a -> Maybe a
Just (MediaEventData -> Maybe MediaEventData)
-> MediaEventData -> Maybe MediaEventData
forall a b. (a -> b) -> a -> b
$ MediaEventData
      { msgtype :: Text
msgtype = (MVideoType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString (MVideoType -> Text)
-> (MRoomMessageMVideoMsgtypeClientEventContent -> MVideoType)
-> MRoomMessageMVideoMsgtypeClientEventContent
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MRoomMessageMVideoMsgtypeClientEventContent -> MVideoType
Api.mRoomMessageMVideoMsgtypeClientEventContentMsgtype) MRoomMessageMVideoMsgtypeClientEventContent
x
      , body :: Text
body = MRoomMessageMVideoMsgtypeClientEventContent -> Text
Api.mRoomMessageMVideoMsgtypeClientEventContentBody MRoomMessageMVideoMsgtypeClientEventContent
x
      , url :: Text
url = MRoomMessageMVideoMsgtypeClientEventContent -> Text
Api.mRoomMessageMVideoMsgtypeClientEventContentUrl MRoomMessageMVideoMsgtypeClientEventContent
x
      }
  Api.MRoomMessageClientEventContentMAudio MRoomMessageMAudioMsgtypeClientEventContent
x →
    MediaEventData -> Maybe MediaEventData
forall a. a -> Maybe a
Just (MediaEventData -> Maybe MediaEventData)
-> MediaEventData -> Maybe MediaEventData
forall a b. (a -> b) -> a -> b
$ MediaEventData
      { msgtype :: Text
msgtype = (MAudioType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString (MAudioType -> Text)
-> (MRoomMessageMAudioMsgtypeClientEventContent -> MAudioType)
-> MRoomMessageMAudioMsgtypeClientEventContent
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MRoomMessageMAudioMsgtypeClientEventContent -> MAudioType
Api.mRoomMessageMAudioMsgtypeClientEventContentMsgtype) MRoomMessageMAudioMsgtypeClientEventContent
x
      , body :: Text
body = MRoomMessageMAudioMsgtypeClientEventContent -> Text
Api.mRoomMessageMAudioMsgtypeClientEventContentBody MRoomMessageMAudioMsgtypeClientEventContent
x
      , url :: Text
url = MRoomMessageMAudioMsgtypeClientEventContent -> Text
Api.mRoomMessageMAudioMsgtypeClientEventContentUrl MRoomMessageMAudioMsgtypeClientEventContent
x
      }
  Api.MRoomMessageClientEventContentMFile MRoomMessageMFileMsgtypeClientEventContent
x →
    MediaEventData -> Maybe MediaEventData
forall a. a -> Maybe a
Just (MediaEventData -> Maybe MediaEventData)
-> MediaEventData -> Maybe MediaEventData
forall a b. (a -> b) -> a -> b
$ MediaEventData
      { msgtype :: Text
msgtype = (MFileType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString (MFileType -> Text)
-> (MRoomMessageMFileMsgtypeClientEventContent -> MFileType)
-> MRoomMessageMFileMsgtypeClientEventContent
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MRoomMessageMFileMsgtypeClientEventContent -> MFileType
Api.mRoomMessageMFileMsgtypeClientEventContentMsgtype) MRoomMessageMFileMsgtypeClientEventContent
x
      , body :: Text
body = MRoomMessageMFileMsgtypeClientEventContent -> Text
Api.mRoomMessageMFileMsgtypeClientEventContentBody MRoomMessageMFileMsgtypeClientEventContent
x
      , url :: Text
url = MRoomMessageMFileMsgtypeClientEventContent -> Text
Api.mRoomMessageMFileMsgtypeClientEventContentUrl MRoomMessageMFileMsgtypeClientEventContent
x
      }
  Api.MRoomMessageClientEventContentMText MRoomMessageMTextMsgtypeClientEventContent
_ → Maybe MediaEventData
forall a. Maybe a
Nothing
  Api.MRoomMessageClientEventContentOther Object
_ → Maybe MediaEventData
forall a. Maybe a
Nothing


-- | Some details extracted out of "MediaEventData" value
newtype ExtractedMediaValues = ExtractedMediaValues
  { ExtractedMediaValues -> Text
extractedMediaId ∷ Text
  }
  deriving stock (Int -> ExtractedMediaValues -> ShowS
[ExtractedMediaValues] -> ShowS
ExtractedMediaValues -> String
(Int -> ExtractedMediaValues -> ShowS)
-> (ExtractedMediaValues -> String)
-> ([ExtractedMediaValues] -> ShowS)
-> Show ExtractedMediaValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtractedMediaValues -> ShowS
showsPrec :: Int -> ExtractedMediaValues -> ShowS
$cshow :: ExtractedMediaValues -> String
show :: ExtractedMediaValues -> String
$cshowList :: [ExtractedMediaValues] -> ShowS
showList :: [ExtractedMediaValues] -> ShowS
Show, ExtractedMediaValues -> ExtractedMediaValues -> Bool
(ExtractedMediaValues -> ExtractedMediaValues -> Bool)
-> (ExtractedMediaValues -> ExtractedMediaValues -> Bool)
-> Eq ExtractedMediaValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtractedMediaValues -> ExtractedMediaValues -> Bool
== :: ExtractedMediaValues -> ExtractedMediaValues -> Bool
$c/= :: ExtractedMediaValues -> ExtractedMediaValues -> Bool
/= :: ExtractedMediaValues -> ExtractedMediaValues -> Bool
Eq)


withExtractedMediaValues
  ∷ ML.MonadLogger m
  ⇒ MediaEventData
  → (ExtractedMediaValues → m ())
  → m ()
withExtractedMediaValues :: forall (m :: * -> *).
MonadLogger m =>
MediaEventData -> (ExtractedMediaValues -> m ()) -> m ()
withExtractedMediaValues MediaEventData
mediaEventData ExtractedMediaValues -> m ()
m = do
  case Text -> Either String Text
extractMediaIdFromUrl (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ MediaEventData -> Text
url MediaEventData
mediaEventData of
    Right Text
x →
      ExtractedMediaValues -> m ()
m ExtractedMediaValues
        { extractedMediaId :: Text
extractedMediaId = Text
x
        }
    Left String
e →
      Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Failed to extract “media_id” out from “url”: ", (String -> Text
pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) String
e
        , Text
" (skipping the event for “reply to media” handling)"
        ]


extractMediaIdFromUrl ∷ Text → Either String Text
extractMediaIdFromUrl :: Text -> Either String Text
extractMediaIdFromUrl = Parser Text -> Text -> Either String Text
forall a. Parser a -> Text -> Either String a
AP.parseOnly Parser Text
parser
  where
    parser ∷ AP.Parser Text
    parser :: Parser Text
parser
      = Text -> Parser Text
AP.string Text
"mxc://"
      Parser Text -> Parser Text String -> Parser Text String
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
AP.many1 (Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
AP.many1 ((Char -> Bool) -> Parser Text Char
AP.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')) Parser Text String -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
AP.char Char
'/')
      Parser Text String -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
AP.takeText
      Parser Text -> Parser Text () -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AP.endOfInput