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
|
module IRC where
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
-- import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import Data.Char
import Data.Text (Text)
import qualified Data.Text as T
import Network.IRC.Client hiding (stdoutLogger)
-- import Network.IRC.Client.Events
import Lens.Micro
import System.IO (hFlush, stdout)
connectIRC :: (Text -> Maybe a) -> (a -> Text -> IO [Text]) -> IO ()
connectIRC commandDetect msgFun = do
pass <- readFile "irc-password.txt"
let trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
let conn = tlsConnection (WithDefaultConfig (Char8.pack "irc.libera.chat") 6697)
& username .~ T.pack "yahb2"
& realname .~ T.pack "Bot operated by tomsmeding"
& password .~ Just (T.pack (trim pass))
& logfunc .~ noopLogger
let cfg = defaultInstanceConfig (T.pack "yahb2")
& handlers .~
(-- some of the standard handlers
[pingHandler
,kickHandler
,ctcpPingHandler
,ctcpTimeHandler
,ctcpVersionHandler
,welcomeNick
,joinHandler]
++
-- our custom handlers
[noticeHandler
,privmsgHandler commandDetect msgFun]
)
runClient conn cfg ()
noticeHandler :: EventHandler s
noticeHandler = EventHandler
(\ev -> case ev ^. message of
Notice _ (Right text)
| T.pack "now identified for" `T.isInfixOf` text
-> Just ()
_ -> Nothing)
(\_ () -> do
liftIO $ putStrLn "Identification confirmation received, joining channel"
liftIO $ hFlush stdout
send $ Join (T.pack "#haskell")
send $ Join (T.pack "#haskell-offtopic"))
privmsgHandler :: (Text -> Maybe a) -> (a -> Text -> IO [Text]) -> EventHandler s
privmsgHandler commandDetect msgFun = EventHandler
(\ev -> case ev ^. message of
Privmsg _ (Right text)
| sendingUser (ev ^. source) `notElem` map Just excludedNicks
, Just s <- commandDetect text -> Just (ev ^. source, text, s)
_ -> Nothing)
(\_ (src, text, s) -> do
msgs <- liftIO $ msgFun s text
let mtarget = case src of
User name -> Just name
Channel ch _ -> Just ch
Server _ -> Nothing
forM_ mtarget $ \target ->
forM_ msgs $ \msg ->
send $ Privmsg target (Right msg))
sendingUser :: Source a -> Maybe a
sendingUser (User n) = Just n
sendingUser (Channel _ n) = Just n
sendingUser (Server _) = Nothing
excludedNicks :: [Text]
excludedNicks = [T.pack "lambdabot"]
-- stdoutLogger :: Origin -> ByteString -> IO ()
-- stdoutLogger origin x = do
-- putStrLn $ unwords
-- [ if origin == FromServer then "<---" else "--->"
-- , init . tail $ show x
-- ]
-- hFlush stdout
|
