{-# Language QuasiQuotes, OverloadedStrings #-}
{-|
Module      : Client.Hook.Snotice
Description : Hook for sorting some service notices into separate windows.
Copyright   : (c) Eric Mertens 2019
License     : ISC
Maintainer  : emertens@gmail.com

These sorting rules are based on the solanum server notices.

-}
module Client.Hook.Snotice
  ( snoticeHook
  ) where

import qualified Data.Text as Text
import           Data.Text (Text)
import           Data.List (find)
import           Text.Regex.TDFA
import           Text.Regex.TDFA.String

import           Client.Hook
import           Irc.Message
import           Irc.Identifier (mkId, Identifier)
import           Irc.UserInfo
import           StrQuote (str)

snoticeHook :: MessageHook
snoticeHook :: MessageHook
snoticeHook = Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"snotice" Bool
True IrcMsg -> MessageResult
remap

remap ::
  IrcMsg -> MessageResult

remap :: IrcMsg -> MessageResult
remap (Notice (Source (UserInfo Identifier
u Text
"" Text
"") Text
_) Identifier
_ Text
msg)
  | Just Text
msg1 <- Text -> Text -> Maybe Text
Text.stripPrefix Text
"*** Notice -- " Text
msg
  , let msg2 :: Text
msg2 = (Char -> Bool) -> Text -> Text
Text.filter (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x02' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x0f') Text
msg1
  , Just (Int
lvl, Identifier
cat) <- Text -> Maybe (Int, Identifier)
characterize Text
msg2
  = if Int
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then MessageResult
OmitMessage
               else IrcMsg -> MessageResult
RemapMessage (Source -> Identifier -> Text -> IrcMsg
Notice (UserInfo -> Text -> Source
Source (Identifier -> Text -> Text -> UserInfo
UserInfo Identifier
u Text
"" Text
"*") Text
"") Identifier
cat Text
msg1)

remap IrcMsg
_ = MessageResult
PassMessage

toPattern :: (Int, String, String) -> (Int, Identifier, Regex)
toPattern :: (Int, String, String) -> (Int, Identifier, Regex)
toPattern (Int
lvl, String
cat, String
reStr) =
  case CompOption -> ExecOption -> String -> Either String Regex
compile CompOption
co ExecOption
eo String
reStr of
    Left String
e  -> String -> (Int, Identifier, Regex)
forall a. HasCallStack => String -> a
error String
e
    Right Regex
r -> (Int
lvl, Text -> Identifier
mkId (String -> Text
Text.pack (Char
'~'Char -> String -> String
forall a. a -> [a] -> [a]
:String
cat)), Regex
r)
  where
    co :: CompOption
co = CompOption :: Bool -> Bool -> Bool -> Bool -> Bool -> CompOption
CompOption
      { caseSensitive :: Bool
caseSensitive  = Bool
True
      , multiline :: Bool
multiline      = Bool
False
      , rightAssoc :: Bool
rightAssoc     = Bool
True
      , newSyntax :: Bool
newSyntax      = Bool
True
      , lastStarGreedy :: Bool
lastStarGreedy = Bool
True }
    eo :: ExecOption
eo = ExecOption :: Bool -> ExecOption
ExecOption
      { captureGroups :: Bool
captureGroups  = Bool
False }

characterize :: Text -> Maybe (Int, Identifier)
characterize :: Text -> Maybe (Int, Identifier)
characterize Text
txt =
  do let s :: String
s = Text -> String
Text.unpack Text
txt
     (Int
lvl, Identifier
cat, Regex
_) <- ((Int, Identifier, Regex) -> Bool)
-> [(Int, Identifier, Regex)] -> Maybe (Int, Identifier, Regex)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Int
_, Identifier
_, Regex
re) -> Regex -> String -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
matchTest Regex
re String
s) [(Int, Identifier, Regex)]
patterns
     (Int, Identifier) -> Maybe (Int, Identifier)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
lvl, Identifier
cat)

patterns :: [(Int, Identifier, Regex)]
patterns :: [(Int, Identifier, Regex)]
patterns = ((Int, String, String) -> (Int, Identifier, Regex))
-> [(Int, String, String)] -> [(Int, Identifier, Regex)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String, String) -> (Int, Identifier, Regex)
toPattern
    [
    -- PATTERN LIST, most common snotes
    -- Client connecting, more complete regex: ^Client connecting: [^ ]+ \([^ ]+@[^ ]+\) \[[^ ]+\] \{[^ ]+\} \[.*\]$
    (Int
1, String
"c", [str|^Client connecting: |]),
    -- Client exiting, more complete regex: ^Client exiting: [^ ]+ \([^ ]+@[^ ]+\) \[.*\] \[[^ ]+\]$
    (Int
0, String
"c", [str|^Client exiting: |]),
    -- Nick change
    (Int
0, String
"c", [str|^Nick change: From |]),
    -- Connection limit, more complete regex: ^Too many user connections for [^ ]+![^ ]+@[^ ]+$
    (Int
1, String
"u", [str|^Too many user connections for |]),
    -- Join alerts, more complete regex: ^User [^ ]+ \([^ ]+@[^ ]+\) trying to join #[^ ]* is a possible spambot$
    (Int
1, String
"a", [str|^User [^ ]+ \([^ ]+\) trying to join #[^ ]* is a possible spambot|]),
    -- Kline hitting user
    (Int
1, String
"k", [str|^K/DLINE active for|]),
    -- Connection limit, more complete regex: ^Too many local connections for [^ ]+![^ ]+@[^ ]+$
    (Int
1, String
"u", [str|^Too many local connections for |]),
    -- Global kline added, more complete regex: ^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} added global [0-9]+ min. K-Line for \[[^ ]+\] \[.*\]$
    (Int
2, String
"k", [str|^[^ ]+ added global [0-9]+ min. K-Line for |]),
    (Int
2, String
"k", [str|^[^ ]+ added global [0-9]+ min. X-Line for |]),
    -- Global kline expiring, more complete regex: ^Propagated ban for \[[^ ]+\] expired$
    (Int
0, String
"k", [str|^Propagated ban for |]),
    -- Chancreate
    (Int
1, String
"u", [str|^[^ ]+ is creating new channel #|]),
    -- m_filter
    (Int
0, String
"u", [str|^FILTER: |]),
    (Int
0, String
"m", [str|^New filters loaded.$|]),
    (Int
0, String
"m", [str|^Filtering enabled.$|]),
    -- Failed login
    (Int
0, String
"f", [str|^Warning: [0-9]+ failed login attempts|]),
    -- Temporary kline added, more complete regex: ^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} added temporary [0-9]+ min. K-Line for \[[^ ]+\] \[.*\]$
    (Int
1, String
"k", [str|^OperServ![^ ]+\{services\.\} added temporary [0-9]+ min. K-Line for \[[^ ]+\] \[Joining #|]), -- klinechans
    (Int
1, String
"k", [str|^OperSyn![^ ]+\{syn\.\} added temporary [0-9]+ min. K-Line for \[[^ ]+\] \[You've been temporarily|]), -- lethals
    (Int
2, String
"k", [str|^[^ ]+ added temporary [0-9]+ min. K-Line for |]),
    -- Nick collision
    (Int
1, String
"m", [str|^Nick collision on|]),
    -- KILLs
    (Int
0, String
"k", [str|^Received KILL message for [^ ]+\. From NickServ |]),
    (Int
0, String
"k", [str|^Received KILL message for [^ ]+\. From syn Path: [^ ]+ \(Facility Blocked\)|]),
    (Int
1, String
"k", [str|^Received KILL message for [^ ]+\. From syn Path: [^ ]+ \(Banned\)|]),
    (Int
2, String
"k", [str|^Received KILL message|]),
    -- Teporary kline expiring, more complete regex: ^Temporary K-line for \[[^ ]+\] expired$
    (Int
0, String
"k", [str|^Temporary K-line for |]),

    -- PATTERN LIST, uncommon snotes. regex performance isn't very important beyond this point
    (Int
2, String
"a", [str|^Possible Flooder|]),
    (Int
0, String
"a", [str|^New Max Local Clients: [0-9]+$|]),
    (Int
1, String
"a", [str|^Excessive target change from|]),

    (Int
1, String
"f", [str|^Failed (OPER|CHALLENGE) attempt - host mismatch|]),
    (Int
3, String
"f", [str|^Failed (OPER|CHALLENGE) attempt|]), -- ORDER IMPORTANT - catch all failed attempts that aren't host mismatch

    (Int
1, String
"k", [str|^Rejecting [XK]-Lined user|]),
    (Int
1, String
"k", [str|^Disconnecting [XK]-Lined user|]),
    (Int
1, String
"k", [str|^KLINE active for|]),
    (Int
1, String
"k", [str|^XLINE active for|]),
    (Int
3, String
"k", [str|^KLINE over-ruled for |]),
    (Int
2, String
"k", [str|^[^ ]+ added global [0-9]+ min. K-Line from [^ ]+![^ ]+@[^ ]+\{[^ ]+\} for \[[^ ]+\] \[.*\]$|]),
    (Int
2, String
"k", [str|^[^ ]+ added global [0-9]+ min. X-Line from [^ ]+![^ ]+@[^ ]+\{[^ ]+\} for \[[^ ]+\] \[.*\]$|]),
    (Int
2, String
"k", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} has removed the global K-Line for: \[.*\]$|]),
    (Int
2, String
"k", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} has removed the temporary K-Line for: \[.*\]$|]),
    (Int
2, String
"k", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} added temporary [0-9]+ min. D-Line for \[[^ ]+\] \[.*\]$|]),
    (Int
2, String
"k", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} has removed the X-Line for:|]),
    (Int
2, String
"k", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is removing the X-Line for|]),
    (Int
2, String
"k", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} has removed the temporary D-Line for:|]),

    (Int
0, String
"m", [str|^Received SAVE message for|]),
    (Int
0, String
"m", [str|^Ignored noop SAVE message for|]),
    (Int
0, String
"m", [str|^Ignored SAVE message for|]),
    (Int
0, String
"m", [str|^TS for #[^ ]+ changed from|]),
    (Int
0, String
"m", [str|^Nick change collision from |]),
    (Int
0, String
"m", [str|^Dropping IDENTIFIED|]),
    (Int
1, String
"m", [str|^Got signal SIGHUP, reloading ircd conf\. file|]),
    (Int
1, String
"m", [str|^Got SIGHUP; reloading|]),
    (Int
1, String
"m", [str|^Updating database by request of system console\.$|]),
    (Int
1, String
"m", [str|^Rehashing .* by request of system console\.$|]),
    (Int
2, String
"m", [str|^Updating database by request of [^ ]+( \([^ ]+\))?\.$|]),
    (Int
2, String
"m", [str|^Rehashing .* by request of [^ ]+( \([^ ]+\))?\.$|]),
    (Int
2, String
"m", [str|.* is rehashing server config file$|]),
    (Int
3, String
"m", [str|^".*", line [0-9+]|]), -- configuration syntax error!
    (Int
0, String
"m", [str|^Ignoring attempt from [^ ]+( \([^ ]+\))? to set login name for|]),
    (Int
1, String
"m", [str|^binding listener socket: 99 \(Cannot assign requested address\)$|]),
    (Int
2, String
"m", [str|^binding listener socket: |]),

    (Int
2, String
"o", [str|^OPERSPY [^ ]+![^ ]+@[^ ]+\{[^ ]+\} |]),
    (Int
2, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is overriding |]),
    (Int
2, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is using oper-override on |]),
    (Int
2, String
"o", [str|^[^ ]+ \([^ ]+@[^ ]+\) is now an operator$|]),
    (Int
1, String
"o", [str|^[^ ]+( \([^ ]+\))? dropped the nick |]),
    (Int
1, String
"o", [str|^[^ ]+( \([^ ]+\))? dropped the account |]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? dropped the channel |]),
    (Int
1, String
"o", [str|^[^ ]+( \([^ ]+\))? set vhost |]),
    (Int
1, String
"o", [str|^[^ ]+( \([^ ]+\))? deleted vhost |]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? is using MODE |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? froze the account |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? thawed the account |]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? transferred foundership of #|]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? marked the channel #|]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? unmarked the channel #|]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? is forcing flags change |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? is clearing channel #|]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? closed the channel #|]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? reopened the channel #|]),
    (Int
2, String
"o", [str|^[^ ]+( \([^ ]+\))? reopened #|]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? reset the password for the account|]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? enabled automatic klines on the channel|]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? disabled automatic klines on the channel|]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? forbade the nickname |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? unforbade the nickname |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? is removing oper class for |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? is changing oper class for |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? set the REGNOLIMIT option for the account |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? set the HOLD option for the account |]),
    (Int
3, String
"o", [str|^[^ ]+( \([^ ]+\))? returned the account |]),
    (Int
1, String
"o", [str|^Not kicking immune user |]),
    (Int
1, String
"o", [str|^Not kicking oper |]),
    (Int
1, String
"o", [str|^Overriding KICK from |]),
    (Int
1, String
"o", [str|^Overriding REMOVE from |]),
    (Int
1, String
"o", [str|^Server [^ ]+ split from |]),
    (Int
3, String
"o", [str|^Netsplit [^ ]+ <->|]),
    (Int
2, String
"o", [str|^Remote SQUIT|]),
    (Int
3, String
"o", [str|^ssld error for |]),
    (Int
1, String
"o", [str|^Finished synchronizing with network|]),
    (Int
3, String
"o", [str|^Link [^ ]+ notable TS delta|]),
    (Int
1, String
"o", [str|^End of burst \(emulated\) from |]),
    (Int
2, String
"o", [str|^Link with [^ ]+ established: |]),
    (Int
2, String
"o", [str|^Connection to [^ ]+ activated$|]),
    (Int
2, String
"o", [str|^Attempt to re-introduce|]),
    (Int
1, String
"o", [str|^Server [^ ]+ being introduced|]),
    (Int
2, String
"o", [str|^Netjoin [^ ]+ <->|]),
    (Int
2, String
"o", [str|^Error connecting to|]),
    (Int
1, String
"o", [str|^[^ ]+![^ ]+@[^ ]+ is sending resvs and xlines|]),
    (Int
3, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is changing the privilege set|]),
    (Int
3, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is opering |]),
    (Int
3, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is deopering |]),
    (Int
3, String
"o", [str|^[^ ]+ is using DEHELPER |]),
    (Int
3, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is clearing the nick delay table|]),
    (Int
3, String
"o", [str|^Module |]),
    (Int
3, String
"o", [str|^Cannot locate module |]),
    (Int
2, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is adding a permanent X-Line for \[.*\]|]),
    (Int
2, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} added X-Line for \[.*\]|]),
    (Int
2, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} is adding a permanent RESV for \[.*\]|]),
    (Int
2, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} added RESV for \[.*\]|]),
    (Int
2, String
"o", [str|^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} has removed the RESV for:|]),
    (Int
3, String
"o", [str|^[^ ]+ is an idiot\. Dropping |]), -- someone k-lined *@*
    (Int
3, String
"o", [str|^Rejecting email for |]), -- registering from a badmailed address won't trigger this, emailing broken?
    (Int
3, String
"o", [str|^ERROR |]),
    (Int
3, String
"o", [str|^No response from [^ ]+, closing link$|]),

    (Int
1, String
"u", [str|^Too many global connections for [^ ]+![^ ]+@[^ ]+$|]),
    (Int
0, String
"u", [str|^Invalid username: |]),
    (Int
0, String
"u", [str|^HTTP Proxy disconnected: |]),
    (Int
2, String
"u", [str|^Unauthorised client connection from |]),
    (Int
2, String
"u", [str|^[^ ]+( \([^ ]+\))? sent the password for the MARKED account|]),
    (Int
2, String
"u", [str|^Not restoring mark|])]
-- -}