{-# 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 [] = Nothing matterbridgeHook (nick:chans) = Just (MessageHook "matterbridge" False (remap (mkId nick) chanfilter)) where chanfilter | null chans = const True | otherwise = (`elem` map mkId chans) remap :: Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult remap nick chanfilter ircmsg = case ircmsg of Privmsg (Source ui _) chan msg | view uiNick ui == nick, chanfilter chan -> remap' Msg ui chan msg Ctcp (Source ui _) chan "ACTION" msg | view uiNick ui == nick, chanfilter chan -> remap' Act ui chan msg _ -> PassMessage remap' :: MbMsg -> UserInfo -> Identifier -> Text -> MessageResult remap' mbmsg ui chan msg = case msg =~ ("^<([^>]+)> (.*)$"::Text) of [_,nick,msg']:_ -> RemapMessage (newmsg mbmsg (fakeUser nick ui) chan msg') _ -> PassMessage newmsg :: MbMsg -> Source -> Identifier -> Text -> IrcMsg newmsg Msg src chan msg = Privmsg src chan msg newmsg Act src chan msg = Ctcp src chan "ACTION" msg fakeUser :: Text -> UserInfo -> Source fakeUser nick ui = Source (set uiNick (mkId nick) ui) ""