This commit is contained in:
nek0 2021-03-27 06:06:34 +01:00
parent fea38a6d9c
commit b7da959c06
4 changed files with 82 additions and 39 deletions

View File

@ -23,11 +23,12 @@ executable parrotbot
main-is: Main.hs main-is: Main.hs
-- Modules included in this executable, other than Main. -- Modules included in this executable, other than Main.
-- other-modules: other-modules: Types
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:
build-depends: base >=4.14.1.0 build-depends: base >=4.14.1.0
, network , network
, mtl
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View File

@ -4,14 +4,14 @@ let
inherit (nixpkgs) pkgs; inherit (nixpkgs) pkgs;
f = { mkDerivation, base, lib, network }: f = { mkDerivation, base, lib, mtl, network }:
mkDerivation { mkDerivation {
pname = "parrotbot"; pname = "parrotbot";
version = "0.0.0.0"; version = "0.0.0.0";
src = ./.; src = ./.;
isLibrary = false; isLibrary = false;
isExecutable = true; isExecutable = true;
executableHaskellDepends = [ base network ]; executableHaskellDepends = [ base mtl network ];
description = "polly wanna cracker"; description = "polly wanna cracker";
license = lib.licenses.gpl3Plus; license = lib.licenses.gpl3Plus;
}; };

View File

@ -4,30 +4,62 @@ module Main where
import System.IO import System.IO
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import Control.Exception (bracket, bracket_)
import Control.Monad.Reader
import Control.Monad.IO.Class (liftIO)
import Data.List (intercalate, isPrefixOf) import Data.List (intercalate, isPrefixOf)
import qualified Network.Socket as N import qualified Network.Socket as N
-- internal imports
import Types
-- configuration options (TODO: Move to yaml and read from there) -- configuration options (TODO: Move to yaml and read from there)
server = "irc.freenode.org" server = "irc.freenode.org"
port = 6667 port = 6667
chan = "#parrotbot-testing" chan = "#parrotbot-testing"
nick = "parrotbot" nick = "parrotbot"
-- | Entry point
main :: IO () main :: IO ()
main = do main =
handle <- connect server port bracket connect disconnect loop
write handle "NICK" nick where
write handle "USER" (nick <> " 0 * :parrot bot") disconnect = hClose . botSocket
write handle "JOIN" chan loop st = runReaderT run st
listen handle
-- | Connect to an IRC server given domain name and port -- | Process bot comands inside of its monad
run
:: Net ()
run = do
write "NICK" nick
write "USER" (nick <> " 0 * :parrot bot")
write "JOIN" chan
listen
-- | Connect to the server und return the initial bot state
connect connect
:: IO Bot
connect = notify $ do
handle <- connectTo server port
return (Bot handle)
where
notify a = bracket_
(do
putStrLn ("Connecting to " <> server <> "")
hFlush stdout
)
(putStrLn "done.")
a
-- | Connect to an IRC server given domain name and port (Helper for 'connect'
connectTo
:: N.HostName -- ^ Domain to connect to :: N.HostName -- ^ Domain to connect to
-> N.PortNumber -- ^ Port to connect to -> N.PortNumber -- ^ Port to connect to
-> IO Handle -- ^ Handle for the connection -> IO Handle -- ^ Handle for the connection
connect chost cport = do connectTo chost cport = do
(addr:_) <- N.getAddrInfo Nothing (Just chost) (Just (show cport)) (addr:_) <- N.getAddrInfo Nothing (Just chost) (Just (show cport))
sock <- N.socket sock <- N.socket
(N.addrFamily addr) (N.addrFamily addr)
@ -38,37 +70,37 @@ connect chost cport = do
-- | Send messages to IRC -- | Send messages to IRC
write write
:: Handle -- ^ Connection handle :: String -- ^ Command to issue
-> String -- ^ Command to issue
-> String -- ^ Command argument(s) -> String -- ^ Command argument(s)
-> IO () -> Net ()
write handle cmd args = do write cmd args = do
let msg = intercalate " " [cmd, args, "\r\n"] let msg = intercalate " " [cmd, args, "\r\n"]
hPutStr handle msg handle <- asks botSocket
print ("> " <> msg) liftIO $ do
hPutStr handle msg
putStr ("> " <> msg)
-- | Send Messages via PRIVMSG to the connected Channel -- | Send Messages via PRIVMSG to the connected Channel
privmsg privmsg
:: Handle -- ^ Connection handle :: String -- ^ Message Content
-> String -- ^ Message Content -> Net ()
-> IO () privmsg msg = write "PRIVMSG" (chan <> " :" <> msg)
privmsg handle msg = write handle "PRIVMSG" (chan <> " :" <> msg)
-- | Listen to and process messages from IRC -- | Listen to and process messages from IRC
listen listen
:: Handle -- ^ Connection handle :: Net ()
-> IO () listen = forever $ do
listen handle = forever $ do handle <- asks botSocket
line <- hGetLine handle line <- liftIO $ hGetLine handle
putStrLn line liftIO $ putStrLn line
let s = init line let s = init line
if isPing s if isPing s
then then
pong s pong s
else else
evaluate handle (clean s) evaluate (clean s)
where where
forever :: IO () -> IO () forever :: Net () -> Net ()
forever a = do forever a = do
a a
forever a forever a
@ -79,18 +111,17 @@ listen handle = forever $ do
isPing :: String -> Bool isPing :: String -> Bool
isPing s = "PING" `isPrefixOf` s isPing s = "PING" `isPrefixOf` s
pong :: String -> IO () pong :: String -> Net ()
pong x = write handle "PONG" (':' : drop 6 x) pong x = write "PONG" (':' : drop 6 x)
-- | Evaluate input from IRC -- | Evaluate input from IRC
evaluate evaluate
:: Handle -- ^ Connection handle :: String -- ^ Input to be processed
-> String -- ^ Input to be processed -> Net ()
-> IO () evaluate "!quit" = do
evaluate handle "!quit" = do write "QUIT" ":I have been orderd to go"
write handle "QUIT" ":I have been orderd to go" liftIO exitSuccess
exitSuccess evaluate text | "!say " `isPrefixOf` text =
evaluate handle text | "!say " `isPrefixOf` text = privmsg (drop 5 text)
privmsg handle (drop 4 text) evaluate _ =
evaluate _ _ =
return () return ()

11
src/Types.hs Normal file
View File

@ -0,0 +1,11 @@
module Types where
import Control.Monad.Reader (ReaderT(..))
import System.IO (Handle)
data Bot = Bot
{ botSocket :: Handle
}
type Net = ReaderT Bot IO