{-# 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 Client.Hook (MessageHook(..), MessageResult(..))
import Control.Lens (set, view)
import Data.Text (Text)
import Irc.Identifier (mkId, Identifier)
import Irc.Message (IrcMsg(Ctcp, Privmsg), Source(Source))
import Irc.UserInfo (UserInfo(..), uiNick)
import Text.Regex.TDFA ((=~))

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 a. [a] -> 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 a. Eq a => a -> [a] -> 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
"^(\x03\&[0-9]{2})?<([^>]+)> \x0f?(.*)$"::Text) of
    [Text
_,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
""