An IRC bot for learning, fun and collaboration in the Freepost community.
Clone
HTTPS:
git clone https://vervis.peers.community/repos/VvM9v
SSH:
git clone USERNAME@vervis.peers.community:VvM9v
Branches
Tags
Puppet.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | {- 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
|