summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHendrik Jaeger <git-commit@henk.geekmail.org>2019-11-30 15:13:31 +0100
committerHendrik Jaeger <git-commit@henk.geekmail.org>2019-11-30 15:13:31 +0100
commit1ed9472b5de9e6ded7cafde1bacb4bf44389856c (patch)
treeb7e405b74016710a188e8d03e6f7ffb744d5214b
parent5530bd9742bc73c2c6631c20c942d3ecd4b81505 (diff)
Basic functionality
-rw-r--r--app/Main.hs4
-rw-r--r--package.yaml1
-rw-r--r--src/Lib.hs56
3 files changed, 55 insertions, 6 deletions
diff --git a/app/Main.hs b/app/Main.hs
index 46af6cf..c4240c4 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -5,8 +5,8 @@ import qualified Network.Socket as N -- network
myServer = "irc.netwichtig.de" :: String
myPort = 6667 :: N.PortNumber
-myChannels = ["#shelly-testing", "#shelly"] :: [String]
-myNick = "shelly" :: String
+myChannels = ["#nais-testing", "#nais"] :: [String]
+myNick = "nais" :: String
main :: IO ()
main = runBirch myServer myPort myNick myChannels
diff --git a/package.yaml b/package.yaml
index 1acd14e..8272231 100644
--- a/package.yaml
+++ b/package.yaml
@@ -22,6 +22,7 @@ description: bot for IRC in Haskell
dependencies:
- base >= 4.7 && < 5
- network
+- transformers
library:
source-dirs: src
diff --git a/src/Lib.hs b/src/Lib.hs
index 12d4dbc..43da951 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -2,15 +2,28 @@ module Lib
( runBirch
) where
-import System.IO -- base
-import qualified Network.Socket as N -- network
+import System.IO -- base
+import qualified Network.Socket as N -- network
+import Control.Monad.Trans.Reader -- transformers
+import Data.List
+import System.Exit
+
+data Bot = Bot { botSocket :: Handle }
+type Net = ReaderT Bot IO
+
+type Nick = String
+type User = String
+type Realname = String
-- Toplevel program
runBirch :: String -> N.PortNumber -> String -> [String] -> IO ()
runBirch myServer myPort myNick myChannels = do
h <- connectTo myServer myPort
- write h "NICK" myNick
- write h "USER" (myNick ++ " 0 * :tutorial bot")
+ register h myNick "tutorial bot"
+ line <- hGetLine h
+ putStrLn line
+ let s = init line
+ if isPing s then pong h s else eval h (clean s)
-- map (write h "JOIN") myChannels
write h "JOIN" (head myChannels)
listen h
@@ -35,6 +48,41 @@ listen :: Handle -> IO ()
listen h = forever $ do
line <- hGetLine h
putStrLn line
+ let s = init line
+ if isPing s then pong h s else eval h (clean s)
where
forever :: IO () -> IO ()
forever a = do a; forever a
+
+clean :: String -> String
+clean = drop 1 . dropWhile (/= ':') . drop 1
+
+isPing :: String -> Bool
+isPing x = "PING :" `isPrefixOf` x
+
+pong :: Handle -> String -> IO ()
+pong h x = write h "PONG" (':' : drop 6 x)
+
+-- Dispatch a command
+eval :: Handle -> String -> IO ()
+eval h "!quit" = write h "QUIT" ":Exiting" >> exitSuccess
+eval h x | "!id " `isPrefixOf` x = privmsg h (drop 4 x)
+eval _ _ = return () -- ignore everything else
+
+-- Send a privmsg to a channel
+privmsg :: Handle -> String -> IO ()
+privmsg h s = write h "PRIVMSG" ("#nais-testing" ++ " :" ++ s)
+
+-- Register with the server
+register :: Handle -> Nick -> Realname -> IO ()
+register h nick realname = do
+ sendNICK h nick
+ sendUSER h nick realname
+
+-- Send NICK command
+sendNICK :: Handle -> Nick -> IO ()
+sendNICK h nick = write h "NICK" nick
+
+-- Send USER command
+sendUSER :: Handle -> Nick -> Realname -> IO ()
+sendUSER h nick realname = write h "USER" (nick ++ " 0 * :" ++ realname)