Puppet.hs

{- This file is part of funbot.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ 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/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module FunBot.Puppet
    ( puppetStart
    , puppetPrivateStart
    , puppetEnd
    , puppetPrivateEnd
    , puppetSay
    , puppetPrivateSay
    , puppetCheck
    , puppetCheckChannel
    )
where

import Control.Monad (when)
import Data.Maybe
import Data.Monoid ((<>))
import Data.Foldable (traverse_)
import Formatting ((%))
import FunBot.Types
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Color.Format (formatMsg)
import Network.IRC.Fun.Color.Format.Long
import Network.IRC.Fun.Types.Base

import qualified Data.HashMap.Lazy as M
import qualified Data.HashSet as S

-- | Start puppet mode in the given channel by the given nickname. Return
-- 'Nothing' on success. Otherwise 'False' means the channel is already in
-- puppet mode, and 'True' means it isn't but the user isn't a puppeteer for
-- that channel.
puppetStart :: Channel -> Nickname -> BotSession (Maybe Bool)
puppetStart chan nick = do
    puppet <- getStateS bsPuppet
    if isJust $ M.lookup chan puppet
        then return $ Just False
        else do
            gpts <- getStateS $ stPuppeteers . bsSettings
            mcs <- getStateS $ M.lookup chan . stChannels . bsSettings
            let lpts = fromMaybe S.empty $ fmap csPuppeteers mcs
            if nick `S.member` gpts || nick `S.member` lpts
                then do
                    let puppet' = M.insert chan nick puppet
                    modifyState $ \ s -> s { bsPuppet = puppet' }
                    return Nothing
                else return $ Just True

-- | Start private puppet mode by the given nickname. Return 'Nothing' on
-- success. Otherwise 'False' means private puppet mode is already on, and
-- 'True' means it isn't but the user isn't a global puppeteer.
puppetPrivateStart :: Nickname -> BotSession (Maybe Bool)
puppetPrivateStart nick = do
    mpteer <- getStateS bsPrivPuppet
    if isJust mpteer
        then return $ Just False
        else do
            gpts <- getStateS $ stPuppeteers . bsSettings
            if nick `S.member` gpts
                then do
                    modifyState $ \ s -> s { bsPrivPuppet = Just nick }
                    return Nothing
                else return $ Just True

-- | Stop puppet mode in a channel. Return 'Nothing' on success. Otherwise
-- 'False' means the channel isn't in puppet mode, and 'True' means it is, but
-- the user isn't a puppeteer there.
--
-- Note that any puppeteer can stop puppet mode, not necessarily the one who
-- started it. This can be useful in case the latter forgets to stop it or gets
-- disconnected from IRC, and then someone else can do it.
puppetEnd :: Channel -> Nickname -> BotSession (Maybe Bool)
puppetEnd chan nick = do
    puppet <- getStateS bsPuppet
    if isJust $ M.lookup chan puppet
        then do
            gpts <- getStateS $ stPuppeteers . bsSettings
            mcs <- getStateS $ M.lookup chan . stChannels . bsSettings
            let lpts = fromMaybe S.empty $ fmap csPuppeteers mcs
            if nick `S.member` gpts || nick `S.member` lpts
                then do
                    let puppet' = M.delete chan puppet
                    modifyState $ \ s -> s { bsPuppet = puppet' }
                    return Nothing
                else return $ Just True
        else return $ Just False

-- | Stop private puppet mode. Return 'Nothing' on success. Otherwise
-- 'False' means private puppet mode is off, and 'True' means it's on, but
-- the user isn't a global puppeteer.
--
-- Note that any global puppeteer can stop private puppet mode, not necessarily
-- the one who started it. This can be useful in case the latter forgets to
-- stop it or gets disconnected from IRC, and then someone else can do it.
puppetPrivateEnd :: Nickname -> BotSession (Maybe Bool)
puppetPrivateEnd nick = do
    mpteer <- getStateS bsPrivPuppet
    if isJust mpteer
        then do
            gpts <- getStateS $ stPuppeteers . bsSettings
            if nick `S.member` gpts
                then do
                    modifyState $ \ s -> s { bsPrivPuppet = Nothing }
                    return Nothing
                else return $ Just True
        else return $ Just False

-- | While in puppet mode, ask the bot to send a message into the channel.
-- Return 'Nothing' on success (i.e. the message is sent to the IRC server).
-- Otherwise, 'False' means the channel isn't in puppet mode, and 'True' means
-- it is, but the user isn't the one who started it.
puppetSay
    :: Channel
    -> Nickname
    -> MsgContent
    -> Bool -- ^ Whether to reveal the message comes from the puppeteer
    -> BotSession (Maybe Bool)
puppetSay chan nick msg reveal = do
    puppet <- getStateS bsPuppet
    case M.lookup chan puppet of
        Nothing    -> return $ Just False
        Just pteer ->
            if nick == pteer
                then do
                    let msg' =
                            if reveal
                                then formatMsg
                                        ("[" % nickname % "] " % message)
                                        nick msg
                                else msg
                    sendToChannel chan msg'
                    return Nothing
                else return $ Just True

-- | While in private puppet mode, ask the bot to send a message to a user.
-- Return 'Nothing' on success (i.e. the message is sent to the IRC server).
-- Otherwise, 'False' means private puppet mode is off, and 'True' means
-- it is, but the user isn't the one who started it.
puppetPrivateSay
    :: Nickname -- ^ Recipient
    -> Nickname -- ^ Puppeteer
    -> MsgContent
    -> Bool     -- ^ Whether to reveal the message comes from the puppeteer
    -> BotSession (Maybe Bool)
puppetPrivateSay recip nick msg reveal = do
    mpteer <- getStateS bsPrivPuppet
    case mpteer of
        Nothing    -> return $ Just False
        Just pteer ->
            if nick == pteer
                then do
                    let msg' =
                            if reveal
                                then formatMsg
                                        ("[" % nickname % "] " % message)
                                        nick msg'
                                else msg
                    sendToUser recip msg'
                    return Nothing
                else return $ Just True

-- | Finish puppet mode in all channels. This can be useful for emergency etc.
-- Return whether succeeded, i.e. whether user is a global puppeteer.
puppetReset
    :: Nickname -- ^ Must be a global puppeteer
    -> Bool     -- ^ Whether to announce end of puppet mode
    -> BotSession Bool
puppetReset nick ann = do
    gpteers <- getStateS $ stPuppeteers . bsSettings
    if nick `S.member` gpteers
        then do
            puppetChans <- getStateS $ M.keys . bsPuppet
            muser <- getStateS bsPrivPuppet
            modifyState $
                \ s -> s { bsPuppet = M.empty, bsPrivPuppet = Nothing }
            when ann $ do
                let msg =
                        MsgContent $ "Puppet mode reset by " <> unNickname nick
                traverse_ (flip sendToChannel msg) puppetChans
                traverse_ (flip sendToUser msg) muser
            return True
        else return False

-- | Check in which channels puppet mode is enabled, and whether private puppet
-- mode is enabled.
puppetCheck :: BotSession ([Channel], Bool)
puppetCheck = do
    chans <- getStateS $ M.keys . bsPuppet
    priv <- getStateS $ isJust . bsPrivPuppet
    return (chans, priv)

-- | Check whether puppet mode is enabled in a given channel.
puppetCheckChannel :: Channel -> BotSession Bool
puppetCheckChannel chan = getStateS $ (chan `M.member`) . bsPuppet