├── LICENSE
├── README.md
├── Setup.hs
├── exe
    ├── bot-1-getting-started.hs
    ├── bot-2-talking-irc.hs
    ├── bot-3-a-simple-interpreter.hs
    ├── bot-4-roll-your-own-monad.hs
    └── bot-5-extending-the-bot.hs
├── roll-your-own-irc-bot.cabal
└── stack.yaml


/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright Li-yao Xia (c) 2019
 2 | 
 3 | All rights reserved.
 4 | 
 5 | Redistribution and use in source and binary forms, with or without
 6 | modification, are permitted provided that the following conditions are met:
 7 | 
 8 |     * Redistributions of source code must retain the above copyright
 9 |       notice, this list of conditions and the following disclaimer.
10 | 
11 |     * Redistributions in binary form must reproduce the above
12 |       copyright notice, this list of conditions and the following
13 |       disclaimer in the documentation and/or other materials provided
14 |       with the distribution.
15 | 
16 |     * Neither the name of Li-yao Xia nor the names of other
17 |       contributors may be used to endorse or promote products derived
18 |       from this software without specific prior written permission.
19 | 
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | Roll your own IRC bot (2024 version)
 2 | ====================================
 3 | 
 4 | Updated code for the tutorial on the Haskell Wiki, using current versions of
 5 | *network* and *time*.
 6 | 
 7 | https://wiki.haskell.org/Roll_your_own_IRC_bot (by Don Stewart)
 8 | 
 9 | Build
10 | -----
11 | 
12 | ```
13 | # If you use cabal
14 | cabal build
15 | 
16 | # If you use stack
17 | stack build
18 | ```
19 | 
20 | Execute
21 | -------
22 | 
23 | ```
24 | # Bot versions: bot-1, bot-2, bot-3, bot-4, bot-5
25 | 
26 | # If you use cabal
27 | cabal exec bot-5
28 | 
29 | # If you use stack
30 | stack exec bot-5
31 | ```
32 | 
33 | Example transcript
34 | ------------------
35 | 
36 | On IRC:
37 | 
38 | ```
39 | 08:29 --> tutbot (~tutbot@XYZ) has joined #tutbot-testing
40 | 08:31 <lyxia> !id Hello!
41 | 08:31 <tutbot> Hello!
42 | 08:31 <lyxia> !uptime
43 | 08:31 <tutbot> 1m 52s
44 | 08:31 <lyxia> !uptime
45 | 08:31 <tutbot> 2m 3s
46 | 08:31 <lyxia> !id Stop copying me!
47 | 08:31 <tutbot> Stop copying me!
48 | 08:31 <lyxia> !quit
49 | 08:31 <-- tutbot (~tutbot@XYZ) has quit (Client Quit)
50 | ```
51 | 
52 | Command line output:
53 | 
54 | ```
55 | > NICK tutbot
56 | > USER tutbot 0 * :tutorial bot
57 | > JOIN #tutbot-testing
58 | :iridium.libera.chat NOTICE * :*** Checking Ident
59 | 
60 | ... long welcome message ...
61 | 
62 | :lyxia!~lyxia@XYZ PRIVMSG #tutbot-testing :!id Hello!
63 | > PRIVMSG #tutbot-testing :Hello!
64 | PING :orwell.freenode.net
65 | > PONG :orwell.freenode.net
66 | :lyxia!~lyxia@XYZ PRIVMSG #tutbot-testing :!uptime
67 | > PRIVMSG #tutbot-testing :1m 52s
68 | :lyxia!~lyxia@XYZ PRIVMSG #tutbot-testing :!uptime
69 | > PRIVMSG #tutbot-testing :2m 3s
70 | :lyxia!~lyxia@XYZ PRIVMSG #tutbot-testing :!id Stop copying me!
71 | > PRIVMSG #tutbot-testing :Stop copying me!
72 | :lyxia!~lyxia@XYZ PRIVMSG #tutbot-testing :!quit
73 | > QUIT :Exiting
74 | ```
75 | 


--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 | 


--------------------------------------------------------------------------------
/exe/bot-1-getting-started.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wno-missing-signatures #-}
 2 | 
 3 | {- First step: connecting to a server -}
 4 | 
 5 | import System.IO                      -- base
 6 | import qualified Network.Socket as N  -- network
 7 | 
 8 | -- Configuration options
 9 | myServer = "irc.libera.chat" :: String
10 | myPort   = 6667 :: N.PortNumber
11 | 
12 | -- Toplevel program
13 | main :: IO ()
14 | main = do
15 |     h <- connectTo myServer myPort
16 |     t <- hGetContents h
17 |     hSetBuffering stdout NoBuffering
18 |     print t
19 | 
20 | -- Connect to a server given its name and port number
21 | connectTo :: N.HostName -> N.PortNumber -> IO Handle
22 | connectTo host port = do
23 |     addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
24 |     sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
25 |     N.connect sock (N.addrAddress addr)
26 |     N.socketToHandle sock ReadWriteMode
27 | 


--------------------------------------------------------------------------------
/exe/bot-2-talking-irc.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wno-missing-signatures #-}
 2 | 
 3 | {- Second step: sending and receiving messages -}
 4 | 
 5 | import System.IO                      -- base
 6 | import qualified Network.Socket as N  -- network
 7 | 
 8 | -- Configuration options
 9 | myServer = "irc.libera.chat" :: String
10 | myPort   = 6667 :: N.PortNumber
11 | myChan   = "#tutbot-testing" :: String
12 | myNick   = "tutbot" :: String
13 | 
14 | -- Toplevel program
15 | main :: IO ()
16 | main = do
17 |     h <- connectTo myServer myPort
18 |     write h "NICK" myNick
19 |     write h "USER" (myNick ++ " 0 * :tutorial bot")
20 |     write h "JOIN" myChan
21 |     listen h
22 | 
23 | -- Connect to a server given its name and port number
24 | connectTo :: N.HostName -> N.PortNumber -> IO Handle
25 | connectTo host port = do
26 |     addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
27 |     sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
28 |     N.connect sock (N.addrAddress addr)
29 |     N.socketToHandle sock ReadWriteMode
30 | 
31 | -- Send a message to a handle
32 | write :: Handle -> String -> String -> IO ()
33 | write h cmd args = do
34 |     let msg = cmd ++ " " ++ args ++ "\r\n"
35 |     hPutStr h msg          -- Send message on the wire
36 |     putStr ("> " ++ msg)   -- Show sent message on the command line
37 | 
38 | -- Process each line from the server
39 | listen :: Handle -> IO ()
40 | listen h = forever $ do
41 |     line <- hGetLine h
42 |     putStrLn line
43 |   where
44 |     forever :: IO () -> IO ()
45 |     forever a = do a; forever a
46 | 


--------------------------------------------------------------------------------
/exe/bot-3-a-simple-interpreter.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wno-missing-signatures #-}
 2 | 
 3 | {- Third step: interpreting commands -}
 4 | 
 5 | import Data.List                      -- base
 6 | import System.Exit                    --
 7 | import System.IO                      --
 8 | import qualified Network.Socket as N  -- network
 9 | 
10 | -- Configuration options
11 | myServer = "irc.libera.chat" :: String
12 | myPort   = 6667 :: N.PortNumber
13 | myChan   = "#tutbot-testing" :: String
14 | myNick   = "tutbot" :: String
15 | 
16 | -- Toplevel program
17 | main :: IO ()
18 | main = do
19 |     h <- connectTo myServer myPort
20 |     write h "NICK" myNick
21 |     write h "USER" (myNick ++ " 0 * :tutorial bot")
22 |     write h "JOIN" myChan
23 |     listen h
24 | 
25 | -- Connect to a server given its name and port number
26 | connectTo :: N.HostName -> N.PortNumber -> IO Handle
27 | connectTo host port = do
28 |     addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
29 |     sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
30 |     N.connect sock (N.addrAddress addr)
31 |     N.socketToHandle sock ReadWriteMode
32 | 
33 | -- Send a message to a handle
34 | write :: Handle -> String -> String -> IO ()
35 | write h cmd args = do
36 |     let msg = cmd ++ " " ++ args ++ "\r\n"
37 |     hPutStr h msg          -- Send message on the wire
38 |     putStr ("> " ++ msg)   -- Show sent message on the command line
39 | 
40 | -- Process each line from the server
41 | listen :: Handle -> IO ()
42 | listen h = forever $ do
43 |     line <- hGetLine h
44 |     putStrLn line
45 |     let s = init line
46 |     if isPing s then pong s else eval h (clean s)
47 |   where
48 |     forever :: IO () -> IO ()
49 |     forever a = do a; forever a
50 | 
51 |     clean :: String -> String
52 |     clean = drop 1 . dropWhile (/= ':') . drop 1
53 | 
54 |     isPing :: String -> Bool
55 |     isPing x = "PING :" `isPrefixOf` x
56 | 
57 |     pong :: String -> IO ()
58 |     pong x = write h "PONG" (':' : drop 6 x)
59 | 
60 | -- Dispatch a command
61 | eval :: Handle -> String -> IO ()
62 | eval h "!quit" = write h "QUIT" ":Exiting" >> exitSuccess
63 | eval h x | "!id " `isPrefixOf` x = privmsg h (drop 4 x)
64 | eval _ _ = return ()  -- ignore everything else
65 | 
66 | -- Send a privmsg to the channel
67 | privmsg :: Handle -> String -> IO ()
68 | privmsg h msg = write h "PRIVMSG" (myChan ++ " :" ++ msg)
69 | 


--------------------------------------------------------------------------------
/exe/bot-4-roll-your-own-monad.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wno-missing-signatures #-}
 2 | 
 3 | {- Fourth step: refactoring -}
 4 | 
 5 | import Control.Exception              -- base
 6 | import Control.Monad.IO.Class         --
 7 | import Data.List                      --
 8 | import System.Exit                    --
 9 | import System.IO                      --
10 | import qualified Network.Socket as N  -- network
11 | import Control.Monad.Trans.Reader     -- transformers
12 | 
13 | -- Configuration options
14 | myServer = "irc.libera.chat" :: String
15 | myPort   = 6667 :: N.PortNumber
16 | myChan   = "#tutbot-testing" :: String
17 | myNick   = "tutbot" :: String
18 | 
19 | -- Toplevel program: set up actions to start (connect) and end (disconnect),
20 | -- and run the main loop
21 | main :: IO ()
22 | main = bracket connect disconnect loop
23 |   where
24 |     disconnect = hClose . botSocket
25 |     loop st = runReaderT run st
26 | 
27 | -- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
28 | data Bot = Bot { botSocket :: Handle }
29 | type Net = ReaderT Bot IO
30 | 
31 | -- Connect to the server and return the initial bot state
32 | connect :: IO Bot
33 | connect = notify $ do
34 |     h <- connectTo myServer myPort
35 |     return (Bot h)
36 |   where
37 |     notify a = bracket_
38 |       (putStrLn ("Connecting to " ++ myServer ++ " ...") >> hFlush stdout)
39 |       (putStrLn "done.")
40 |       a
41 | 
42 | -- Connect to a server given its name and port number (helper for connect)
43 | connectTo :: N.HostName -> N.PortNumber -> IO Handle
44 | connectTo host port = do
45 |     addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
46 |     sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
47 |     N.connect sock (N.addrAddress addr)
48 |     N.socketToHandle sock ReadWriteMode
49 | 
50 | -- We're in the Net monad now, so we've connected successfully
51 | -- Join a channel, and start processing commands
52 | run :: Net ()
53 | run = do
54 |     write "NICK" myNick
55 |     write "USER" (myNick ++ " 0 * :tutorial bot")
56 |     write "JOIN" myChan
57 |     listen
58 | 
59 | -- Send a message to the server we're currently connected to
60 | write :: String -> String -> Net ()
61 | write cmd args = do
62 |     h <- asks botSocket
63 |     let msg = cmd ++ " " ++ args ++ "\r\n"
64 |     liftIO $ hPutStr h msg          -- Send message on the wire
65 |     liftIO $ putStr ("> " ++ msg)   -- Show sent message on the command line
66 | 
67 | -- Process each line from the server
68 | listen :: Net ()
69 | listen = forever $ do
70 |     h <- asks botSocket
71 |     line <- liftIO $ hGetLine h
72 |     liftIO (putStrLn line)
73 |     let s = init line
74 |     if isPing s then pong s else eval (clean s)
75 |   where
76 |     forever :: Net () -> Net ()
77 |     forever a = do a; forever a
78 | 
79 |     clean :: String -> String
80 |     clean = drop 1 . dropWhile (/= ':') . drop 1
81 | 
82 |     isPing :: String -> Bool
83 |     isPing x = "PING :" `isPrefixOf` x
84 | 
85 |     pong :: String -> Net ()
86 |     pong x = write "PONG" (':' : drop 6 x)
87 | 
88 | -- Dispatch a command
89 | eval :: String -> Net ()
90 | eval "!quit" = write "QUIT" ":Exiting" >> liftIO exitSuccess
91 | eval x | "!id " `isPrefixOf` x = privmsg (drop 4 x)
92 | eval _ = return ()  -- ignore everything else
93 | 
94 | -- Send a privmsg to the channel
95 | privmsg :: String -> Net ()
96 | privmsg msg = write "PRIVMSG" (myChan ++ " :" ++ msg)
97 | 


--------------------------------------------------------------------------------
/exe/bot-5-extending-the-bot.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wno-missing-signatures #-}
  2 | 
  3 | {- Fifth step: adding a new command -}
  4 | 
  5 | import Control.Exception              -- base
  6 | import Control.Monad.IO.Class         --
  7 | import Data.List                      --
  8 | import System.Exit                    --
  9 | import System.IO                      --
 10 | import qualified Network.Socket as N  -- network
 11 | import Control.Monad.Trans.Reader     -- transformers
 12 | import Data.Time                      -- time
 13 | 
 14 | -- Configuration options
 15 | myServer = "irc.libera.chat" :: String
 16 | myPort   = 6667 :: N.PortNumber
 17 | myChan   = "#tutbot-testing" :: String
 18 | myNick   = "tutbot" :: String
 19 | 
 20 | -- Toplevel program: set up actions to start (connect) and end (disconnect),
 21 | -- and run the main loop
 22 | main :: IO ()
 23 | main = bracket connect disconnect loop
 24 |   where
 25 |     disconnect = hClose . botSocket
 26 |     loop st = runReaderT run st
 27 | 
 28 | -- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
 29 | data Bot = Bot { botSocket :: Handle, startTime :: UTCTime }
 30 | type Net = ReaderT Bot IO
 31 | 
 32 | -- Connect to the server and return the initial bot state
 33 | connect :: IO Bot
 34 | connect = notify $ do
 35 |     t <- getCurrentTime
 36 |     h <- connectTo myServer myPort
 37 |     return (Bot h t)
 38 |   where
 39 |     notify a = bracket_
 40 |       (putStrLn ("Connecting to " ++ myServer ++ " ...") >> hFlush stdout)
 41 |       (putStrLn "done.")
 42 |       a
 43 | 
 44 | -- Connect to a server given its name and port number (helper for connect)
 45 | connectTo :: N.HostName -> N.PortNumber -> IO Handle
 46 | connectTo host port = do
 47 |     addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
 48 |     sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
 49 |     N.connect sock (N.addrAddress addr)
 50 |     N.socketToHandle sock ReadWriteMode
 51 | 
 52 | -- We're in the Net monad now, so we've connected successfully
 53 | -- Join a channel, and start processing commands
 54 | run :: Net ()
 55 | run = do
 56 |     write "NICK" myNick
 57 |     write "USER" (myNick ++ " 0 * :tutorial bot")
 58 |     write "JOIN" myChan
 59 |     listen
 60 | 
 61 | -- Send a message to the server we're currently connected to
 62 | write :: String -> String -> Net ()
 63 | write cmd args = do
 64 |     h <- asks botSocket
 65 |     let msg = cmd ++ " " ++ args ++ "\r\n"
 66 |     liftIO $ hPutStr h msg          -- Send message on the wire
 67 |     liftIO $ putStr ("> " ++ msg)   -- Show sent message on the command line
 68 | 
 69 | -- Process each line from the server
 70 | listen :: Net ()
 71 | listen = forever $ do
 72 |     h <- asks botSocket
 73 |     line <- liftIO $ hGetLine h
 74 |     liftIO (putStrLn line)
 75 |     let s = init line
 76 |     if isPing s then pong s else eval (clean s)
 77 |   where
 78 |     forever :: Net () -> Net ()
 79 |     forever a = do a; forever a
 80 | 
 81 |     clean :: String -> String
 82 |     clean = drop 1 . dropWhile (/= ':') . drop 1
 83 | 
 84 |     isPing :: String -> Bool
 85 |     isPing x = "PING :" `isPrefixOf` x
 86 | 
 87 |     pong :: String -> Net ()
 88 |     pong x = write "PONG" (':' : drop 6 x)
 89 | 
 90 | -- Dispatch a command
 91 | eval :: String -> Net ()
 92 | eval "!uptime" = uptime >>= privmsg
 93 | eval "!quit" = write "QUIT" ":Exiting" >> liftIO exitSuccess
 94 | eval x | "!id " `isPrefixOf` x = privmsg (drop 4 x)
 95 | eval _ = return ()  -- ignore everything else
 96 | 
 97 | -- Send a privmsg to the channel
 98 | privmsg :: String -> Net ()
 99 | privmsg msg = write "PRIVMSG" (myChan ++ " :" ++ msg)
100 | 
101 | -- Get the current uptime
102 | uptime :: Net String
103 | uptime = do
104 |   now <- liftIO getCurrentTime
105 |   zero <- asks startTime
106 |   return (pretty (diffUTCTime now zero))
107 | 
108 | -- Pretty print the date in '1d 9h 9m 17s' format
109 | pretty :: NominalDiffTime -> String
110 | pretty diff =
111 |     unwords
112 |       . map (\(t, unit) -> show t ++ unit)
113 |       $ if null diffs then [(0, "s")] else diffs
114 |   where
115 |     diffs :: [(Integer, String)]
116 |     diffs = filter ((/= 0) . fst)
117 |       $ decompose [(86400, "d"), (3600, "h"), (60, "m"), (1, "s")] (floor diff)
118 |     decompose [] _ = []
119 |     decompose ((secs, unit) : metrics) t =
120 |       let (n, t') = t `divMod` secs
121 |       in (n, unit) : decompose metrics t'
122 | 


--------------------------------------------------------------------------------
/roll-your-own-irc-bot.cabal:
--------------------------------------------------------------------------------
 1 | name:                roll-your-own-irc-bot
 2 | version:             0.1.0.0
 3 | -- synopsis:
 4 | -- description:
 5 | homepage:            https://github.com/Lysxia/roll-your-own-irc-bot#readme
 6 | license:             BSD3
 7 | license-file:        LICENSE
 8 | author:              Li-yao Xia
 9 | maintainer:          lysxia@gmail.com
10 | copyright:           2019 Li-yao Xia
11 | category:            Web
12 | build-type:          Simple
13 | extra-source-files:  README.md
14 | cabal-version:       >=1.10
15 | 
16 | executable bot-1
17 |   hs-source-dirs:      exe
18 |   main-is:             bot-1-getting-started.hs
19 |   build-depends:
20 |     network >= 2.7 && < 4,
21 |     base >= 4.7 && < 5
22 |   ghc-options: -Wall -Wno-missing-signatures
23 |   default-language:    Haskell2010
24 | 
25 | executable bot-2
26 |   hs-source-dirs:      exe
27 |   main-is:             bot-2-talking-irc.hs
28 |   build-depends:
29 |     network >= 2.7 && < 4,
30 |     base >= 4.7 && < 5
31 |   ghc-options: -Wall -fno-warn-missing-signatures
32 |   default-language:    Haskell2010
33 | 
34 | executable bot-3
35 |   hs-source-dirs:      exe
36 |   main-is:             bot-3-a-simple-interpreter.hs
37 |   build-depends:
38 |     network >= 2.7 && < 4,
39 |     base >= 4.7 && < 5
40 |   ghc-options: -Wall -fno-warn-missing-signatures
41 |   default-language:    Haskell2010
42 | 
43 | executable bot-4
44 |   hs-source-dirs:      exe
45 |   main-is:             bot-4-roll-your-own-monad.hs
46 |   build-depends:
47 |     network >= 2.7 && < 4,
48 |     transformers,
49 |     base >= 4.7 && < 5
50 |   ghc-options: -Wall -fno-warn-missing-signatures
51 |   default-language:    Haskell2010
52 | 
53 | executable bot-5
54 |   hs-source-dirs:      exe
55 |   main-is:             bot-5-extending-the-bot.hs
56 |   build-depends:
57 |     network >= 2.7 && < 4,
58 |     transformers,
59 |     time,
60 |     base >= 4.7 && < 5
61 |   ghc-options: -Wall -fno-warn-missing-signatures
62 |   default-language:    Haskell2010
63 | 
64 | source-repository head
65 |   type:     git
66 |   location: https://github.com/Lysxia/roll-your-own-irc-bot
67 | 


--------------------------------------------------------------------------------
/stack.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-13.30
2 | packages:
3 | - .
4 | 


--------------------------------------------------------------------------------