{-# Language OverloadedStrings #-}
{-|
Module      : Client.Hook.Matterbridge
Description : Hook for intergrating Matterbridge bridged messages
Copyright   : (c) Felix Friedlander 2021
License     : ISC
Maintainer  : felix@ffetc.net

Matterbridge is a simple multi-protocol chat bridge, supporting
dozens of different protocols. This hook makes Matterbridged messages
appear native in the client.

message-hooks configuration takes one of two forms;
to operate on all channels:

> ["matterbridge", "nick"]

or, to operate only on selected channels:

> ["matterbridge", "nick", "#chan1", "#chan2", ..., "#chann"]

This hook assumes the Matterbridge RemoteNickFormat is simply
"<{NICK}> ".

-}
module Client.Hook.Matterbridge (matterbridgeHook) where

import Data.Text (Text)

import Control.Lens (set, view)

import Text.Regex.TDFA ((=~))

import Client.Hook (MessageHook(..), MessageResult(..))
import Irc.Message
import Irc.Identifier (mkId, Identifier)
import Irc.UserInfo (UserInfo(..), uiNick)

data MbMsg = Msg | Act

matterbridgeHook :: [Text] -> Maybe MessageHook
matterbridgeHook :: [Text] -> Maybe MessageHook
matterbridgeHook [] = Maybe MessageHook
forall a. Maybe a
Nothing
matterbridgeHook (Text
nick:[Text]
chans) = MessageHook -> Maybe MessageHook
forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"matterbridge" Bool
False (Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult
remap (Text -> Identifier
mkId Text
nick) Identifier -> Bool
chanfilter))
 where
  chanfilter :: Identifier -> Bool
chanfilter
    | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
chans = Bool -> Identifier -> Bool
forall a b. a -> b -> a
const Bool
True
    | Bool
otherwise  = (Identifier -> [Identifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
mkId [Text]
chans)

remap :: Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult
remap :: Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult
remap Identifier
nick Identifier -> Bool
chanfilter IrcMsg
ircmsg =
  case IrcMsg
ircmsg of
    Privmsg (Source UserInfo
ui Text
_) Identifier
chan Text
msg
      | Getting Identifier UserInfo Identifier -> UserInfo -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier UserInfo Identifier
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick UserInfo
ui Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
nick, Identifier -> Bool
chanfilter Identifier
chan -> MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' MbMsg
Msg UserInfo
ui Identifier
chan Text
msg
    Ctcp (Source UserInfo
ui Text
_) Identifier
chan Text
"ACTION" Text
msg
      | Getting Identifier UserInfo Identifier -> UserInfo -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier UserInfo Identifier
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick UserInfo
ui Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
nick, Identifier -> Bool
chanfilter Identifier
chan -> MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' MbMsg
Act UserInfo
ui Identifier
chan Text
msg
    IrcMsg
_ -> MessageResult
PassMessage

remap' :: MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' :: MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' MbMsg
mbmsg UserInfo
ui Identifier
chan Text
msg =
  case Text
msg Text -> Text -> [[Text]]
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (Text
"^<([^>]+)> (.*)$"::Text) of
    [Text
_,Text
nick,Text
msg']:[[Text]]
_ -> IrcMsg -> MessageResult
RemapMessage (MbMsg -> Source -> Identifier -> Text -> IrcMsg
newmsg MbMsg
mbmsg (Text -> UserInfo -> Source
fakeUser Text
nick UserInfo
ui) Identifier
chan Text
msg')
    [[Text]]
_               -> MessageResult
PassMessage

newmsg :: MbMsg -> Source -> Identifier -> Text -> IrcMsg
newmsg :: MbMsg -> Source -> Identifier -> Text -> IrcMsg
newmsg MbMsg
Msg Source
src Identifier
chan Text
msg = Source -> Identifier -> Text -> IrcMsg
Privmsg Source
src Identifier
chan Text
msg
newmsg MbMsg
Act Source
src Identifier
chan Text
msg = Source -> Identifier -> Text -> Text -> IrcMsg
Ctcp Source
src Identifier
chan Text
"ACTION" Text
msg

fakeUser :: Text -> UserInfo -> Source
fakeUser :: Text -> UserInfo -> Source
fakeUser Text
nick UserInfo
ui = UserInfo -> Text -> Source
Source (ASetter UserInfo UserInfo Identifier Identifier
-> Identifier -> UserInfo -> UserInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UserInfo UserInfo Identifier Identifier
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick (Text -> Identifier
mkId Text
nick) UserInfo
ui) Text
""