IrcHandlers.hs

{- This file is part of funbot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

-- For byte strings
{-# LANGUAGE OverloadedStrings #-}

module FunBot.IrcHandlers
    ( handleBotMsg
    , handleJoin
    , handleMsg
    , handleNickChange
    )
where

import Control.Exception (catch)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Data.Char (toLower)
import Data.List (isPrefixOf)
import FunBot.Memos (reportMemos, reportMemosAll)
import Network.HTTP.Client
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.IRC.Fun.Bot.Chat (sendToChannel)
import Text.HTML.TagSoup

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.UTF8 as BU

helloWords :: [String]
helloWords = ["hello", "hi", "hey", "yo"]

waveWordsL :: [String]
waveWordsL = ["\\o", "\\O", "\\0"]

waveWordsR :: [String]
waveWordsR = ["o/", "O/", "0/"]

isHello :: String -> Bool
isHello s =
    let s' = map toLower s
    in     null s
        || s' `elem` helloWords
        || init s' `elem` helloWords && last s' `elem` ".!?"

handleBotMsg chan nick msg
    | isHello msg               = sendToChannel chan $ "Hello, " ++ nick
    | map toLower msg == "ping" = sendToChannel chan $ nick ++ ", pong"
    | msg `elem` waveWordsL     = sendToChannel chan $ nick ++ ": o/"
    | msg `elem` waveWordsR     = sendToChannel chan $ nick ++ ": \\o"
    | otherwise                 = return ()

handleJoin chan nick = reportMemos nick chan

goodHost h =
    let n = B.length h
        suffix6 = B.drop (n - 6) h
        suffix4 = B.drop 2 suffix6
        isCo = B.length suffix6 == 6 && ".co." `B.isPrefixOf` suffix6
        isCom = suffix4 == ".com"
    in  not $ isCom || isCo

findTitle page =
    let tags = parseTags page
        from = drop 1 $ dropWhile (not . isTagOpenName "title") tags
        range = takeWhile (not . isTagCloseName "title") from
        text = unwords $ words $ innerText range
    in  if null text then Nothing else Just text

handleMsg chan _nick msg _mention = when ("http" `isPrefixOf` msg) $ do
    manager <- liftIO $ newManager tlsManagerSettings
    let action = do
            request <- parseUrl msg
            let h = host request
            if goodHost h
                then do
                    response <- httpLbs request manager
                    let page = BU.toString $ responseBody response
                    return $ Right $ findTitle page
                else return $ Right Nothing
        handler e = return $ Left (e :: HttpException)
        getTitle = action `catch` handler
    etitle <- liftIO getTitle
    case etitle of
        Right (Just title) -> sendToChannel chan $ '"' : title ++ "\""
        _                  -> return ()

handleNickChange _old new = reportMemosAll new