Matterbridge.hs

{-# 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) ""