From c0a8b7b64de54b035dabc74469ebbe774e997a16 Mon Sep 17 00:00:00 2001
From: opfez <opfez@disroot.org>
Date: Fri, 8 Oct 2021 12:45:40 +0200
Subject: [PATCH] initial, greets support is in babyyyy

---
 Anna.hs | 132 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 132 insertions(+)
 create mode 100644 Anna.hs

diff --git a/Anna.hs b/Anna.hs
new file mode 100644
index 0000000..0a6f2e7
--- /dev/null
+++ b/Anna.hs
@@ -0,0 +1,132 @@
+module Main where
+
+import Data.List
+import Data.Char (isSpace)
+import System.IO
+import System.Directory
+import Control.Monad
+import Control.Monad.IO.Class
+import qualified Network.Socket as N
+import Control.Monad.Trans.Reader
+
+-- Configuration
+hostname = "127.0.0.1"
+port     = 6667
+name     = "anna"
+channels = ["#bots"]
+
+data Bot = Bot { socket :: Handle }
+type Net = ReaderT Bot IO
+
+-- Entrypoint
+main :: IO ()
+main = do
+  handle <- connectTo hostname port
+  hSetBuffering stdout NoBuffering
+  runReaderT run Bot { socket = handle }
+
+run :: Net ()
+run = do
+  sendNick
+  sendUser
+  joinChannels
+  listen
+
+listen :: Net ()
+listen = forever $ do
+  h <- asks socket
+  line <- liftIO $ hGetLine h
+  -- Debug print
+  liftIO $ putStrLn line
+  tokenDispatch (parseUser $ tail line) (words line)
+    where parseUser str = userName
+            where userName = getName str
+
+                  getName :: String -> Maybe String
+                  getName s
+                    | comesBefore ' ' '!' s = Nothing
+                    | otherwise = Just $ takeWhile (\c -> (c /= '!')) s
+
+                  comesBefore :: Eq a => a -> a -> [a] -> Bool
+                  comesBefore c1 c2 arr
+                    | elemIndex c1 arr == Nothing = False
+                    | elemIndex c2 arr == Nothing = True
+                    | otherwise = elemIndex c1 arr < elemIndex c2 arr
+
+tokenDispatch :: Maybe String -> [String] -> Net ()
+tokenDispatch _ ("PING":_) = pong
+tokenDispatch _ []         = return ()
+tokenDispatch (Just userName) ts = if elem "PRIVMSG" ts
+                                   then helper
+                                   else return ()
+  where helper
+          | elem "o/" tokens  = updateRightGreets
+          | elem "\\o" tokens = updateLeftGreets
+          | otherwise         = case head tokens of
+              "!greets" -> greets $ head channels
+              _         -> return ()
+        tokens = case length msgTokens of
+          1 -> [rstrip $ tail $ head msgTokens]
+          _ -> (tail $ head msgTokens) : ((init $ tail msgTokens) ++ [(rstrip $ last msgTokens)])
+        msgTokens = drop 3 ts
+        rstrip = reverse . dropWhile isSpace . reverse
+tokenDispatch Nothing _         = return ()
+
+-- Bot commands
+updateRightGreets :: Net ()
+updateRightGreets = do
+  content <- liftIO $ readFile "greets"
+  let contentLines = lines content
+      rightGreets  = show $ 1 + (read $ head contentLines :: Int)
+      leftGreets   = head $ tail contentLines
+  liftIO $ removeFile "greets"
+  liftIO $ writeFile "greets" $ rightGreets ++ "\n" ++ leftGreets ++ "\n"
+
+updateLeftGreets :: Net ()
+updateLeftGreets = do
+  content <- liftIO $ readFile "greets"
+  let contentLines = lines content
+      rightGreets  = head contentLines
+      leftGreets   = show $ 1 + (read $ head $ tail contentLines :: Int)
+  liftIO $ removeFile "greets"
+  liftIO $ writeFile "greets" $ rightGreets ++ "\n" ++ leftGreets ++ "\n"
+
+greets :: String -> Net ()
+greets chn = do
+  content <- liftIO $ readFile "greets"
+  let contentLines = lines content
+      displayLine = "o/ - " ++ (head contentLines) ++ " vs \\o - " ++ (head $ tail contentLines)
+  liftIO $ putStrLn displayLine
+  sendMessage chn displayLine
+
+-- Basic commands
+write :: String -> String -> Net ()
+write cmd args = do
+  h <- asks socket
+  liftIO $ hPutStr h $ cmd ++ " " ++ args ++ "\r\n"
+
+sendNick :: Net ()
+sendNick = write "NICK" name
+
+sendUser :: Net ()
+sendUser = write "USER" $ name ++ " 0.0.0.0 " ++ name ++ " :" ++ name
+
+sendMessage :: String -> String -> Net ()
+sendMessage channel message = write "PRIVMSG" $ channel ++ " :" ++ message
+
+sendAction :: String -> String -> Net ()
+sendAction channel action = sendMessage channel $ "\x01ACTION " ++ action ++ "\x01"
+
+joinChannels :: Net ()
+joinChannels = mapM_ (\chn -> write "JOIN" chn) channels
+
+pong :: Net ()
+pong = write "PONG" $ ":" ++ name ++ "\r\n"
+
+-- Connect to a server given its name and port number
+connectTo :: N.HostName -> N.PortNumber -> IO Handle
+connectTo host port = do
+    addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
+    sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
+    N.connect sock (N.addrAddress addr)
+    N.socketToHandle sock ReadWriteMode