hulk 0.1.2 → 0.2.0

raw patch · 26 files changed

+1481/−1154 lines, 26 filesdep +aesondep +bytestringdep +case-insensitivedep −ircdep ~ConfigFiledep ~Cryptodep ~base

Dependencies added: aeson, bytestring, case-insensitive, directory, fastirc, filepath, ghc-prim, monad-extras, strict, text

Dependencies removed: irc

Dependency ranges changed: ConfigFile, Crypto, base, cmdargs, containers, mtl, network, split, time, unix, utf8-string

Files

• README.md +11/−23
• example/auth/passwd +2/−0
• example/auth/passwd-key +1/−0
• example/hulk.conf +18/−0
• example/log/events.log +32/−0
• example/txt/MOTD +7/−0
• example/txt/PREFACE +14/−0
• example/users/hulk +1/−0
• example/users/hulk2 +1/−0
• hulk.cabal +77/−39
• hulk.conf.example +0/−11
• src/Control/Concurrent/Delay.hs +0/−10
• src/Control/Monad/IO.hs +0/−6
• src/Data/String.hs +0/−8
• src/GeneratePass.hs +10/−7
• src/Hulk/Auth.hs +28/−14
• src/Hulk/Client.hs +871/−697
• src/Hulk/Concurrent.hs +0/−18
• src/Hulk/Config.hs +21/−12
• src/Hulk/Event.hs +0/−9
• src/Hulk/Log.hs +0/−49
• src/Hulk/Providers.hs +0/−23
• src/Hulk/Server.hs +146/−55
• src/Hulk/Types.hs +241/−152
• txt/MOTD +0/−7
• txt/PREFACE +0/−14

@@ -14,12 +14,18 @@  ## Usage +See a complete example in the `example/` directory in the root of the+project. You can go into that directory and run `hulk -chulk.conf` to+have an immediate server running on localhost port 6667.+ ### Configuration -    $ cp hulk.conf.example hulk.conf-    +    $ cp example/hulk.conf hulk.conf+ You can edit the port, server name and MOTD file in here.-    ++Detailed instructions follow.+ ### Auth      $ mkdir auth@@ -67,9 +73,9 @@     [hulk]     connect = 127.0.0.1:6666     accept = 6667-    + Then run it:-    +     stunnel stunnel.conf  (It may be in `/usr/sbin/stunnel` depending on your system.)@@ -105,21 +111,3 @@      $ rss2irc http://myserver/foo.atom announce@127.0.0.1/#dev \       -p 6667 -i 1 -l  --pass myannouncepass--## Utility for 'telling' people things externally--Sometimes you want automatic scripts to send notices to the IRC.--Save this script in `tell.sh`:--    (cat /mypath/tell-login; echo "NICK $1"; echo "TELL $2 :$3") | nc serverip 6667 -w 1 > /dev/null--Run it like this:--    $ tell announce '#dev' 'Stuff happened!'--And put this in your /mypath/tell-login:--    $ cat /opt/hulk/tell-login-    PASS mypassword-    USER myuser * * *

@@ -0,0 +1,2 @@+hulk bac95aac1e4e1a3791b4aa044be19bb11b3b+hulk2 bac95aac1e4e1a3791b4aa044be19bb11b3b

@@ -0,0 +1,1 @@+:-)

@@ -0,0 +1,18 @@+[LISTEN]+port = 6667+hostname = hulk-server++[STRINGS]+motd_file = txt/MOTD+preface_file = txt/PREFACE++[AUTH]+passwd_file = auth/passwd+passwd_key = auth/passwd-key++[USERS]+data_dir=users/++[LOGS]+event_log=log/events.log+channels=#hulk

@@ -0,0 +1,32 @@+["2013-11-02T17:06:35.619Z","hulk","RPL_PRIVMSG",["#hulk","Hello!"]]+["2013-11-03T01:53:58.106Z","hulk2","RPL_PRIVMSG",["#hulk","hrm"]]+["2013-11-03T01:54:02.393Z","hulk","RPL_PRIVMSG",["#hulk","yeah"]]+["2013-11-03T01:57:28.112Z","hulk2","RPL_PRIVMSG",["#hulk","2"]]+["2013-11-03T01:57:30.952Z","hulk","RPL_PRIVMSG",["#hulk","sdf"]]+["2013-11-03T01:57:35.393Z","hulk2","RPL_PRIVMSG",["#hulk","hmer"]]+["2013-11-03T01:57:38.809Z","hulk","RPL_PRIVMSG",["#hulk","heymar"]]+["2013-11-03T01:58:44.009Z","hulk2","RPL_PRIVMSG",["#hulk","sfsdfsdf"]]+["2013-11-03T01:58:44.114Z","hulk","RPL_PRIVMSG",["#hulk","sdf"]]+["2013-11-03T01:59:06.823Z","hulk","RPL_PRIVMSG",["#hulk","hello"]]+["2013-11-03T01:59:09.807Z","hulk2","RPL_PRIVMSG",["#hulk","hai"]]+["2013-11-03T01:59:30.808Z","hulk","RPL_PRIVMSG",["#hulk","apples"]]+["2013-11-03T01:59:33.231Z","hulk2","RPL_PRIVMSG",["#hulk","pears"]]+["2013-11-03T01:59:37.615Z","hulk","RPL_PRIVMSG",["#hulk","bacon"]]+["2013-11-03T01:59:41.175Z","hulk2","RPL_PRIVMSG",["#hulk","chop liver"]]+["2013-11-03T01:59:44.591Z","hulk","RPL_PRIVMSG",["#hulk","eh?"]]+["2013-11-03T01:59:48.471Z","hulk2","RPL_PRIVMSG",["#hulk","hurrr"]]+["2013-11-03T02:00:13.543Z","hulk","RPL_PRIVMSG",["#hulk","zer"]]+["2013-11-03T02:00:16.591Z","hulk2","RPL_PRIVMSG",["#hulk","var"]]+["2013-11-03T02:03:08.485Z","hulk2","RPL_PRIVMSG",["#hulk","hello"]]+["2013-11-03T02:03:10.813Z","hulk","RPL_PRIVMSG",["#hulk","world"]]+["2013-11-03T02:03:12.073Z","hulk","RPL_PRIVMSG",["#hulk","world"]]+["2013-11-03T02:03:13.581Z","hulk2","RPL_PRIVMSG",["#hulk","yup"]]+["2013-11-03T02:21:41.371Z","hulk","RPL_PRIVMSG",["#hulk","test"]]+["2013-11-03T02:32:02.087Z","hulk","RPL_PRIVMSG",["#foo","hey"]]+["2013-11-03T02:32:19.997Z","hulk","RPL_PRIVMSG",["hulk","sup"]]+["2013-11-03T02:41:55.108Z","hulk","RPL_PRIVMSG",["#hulk","huh"]]+["2013-11-03T02:44:26.426Z","hulk","RPL_PRIVMSG",["#hulk","jl"]]+["2013-11-03T02:45:20.923Z","hulk","RPL_PRIVMSG",["#hulk",",."]]+["2013-11-03T03:35:31.801Z","hulk2","RPL_PRIVMSG",["#hulk","dfg"]]+["2013-11-03T03:35:34.505Z","hulk","RPL_PRIVMSG",["#hulk","berk"]]+["2013-11-03T03:35:36.777Z","hulk2","RPL_PRIVMSG",["#hulk","heh"]]

@@ -0,0 +1,7 @@+Hello and welcome to this IRC server. I am your host, Dr. Bruce Banner+PhD in nuclear physics and HRRRRRNNNNNNNNNNNNGGGGGGGGGGGGGGGGGGGGGGGGG+HRRRRRNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN+NNRUN FOR YOUR LIFENNNNNNNNNNNNNNNNNNNNNNNNNGGGGGGGGNNNNNNNNNNNNNNNNNN+NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN+GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG+GG..

@@ -0,0 +1,14 @@+You must login with a username and password. If you have not already+created one, you should do so by generating one and adding it to the+Hulk passwd file in passwd. To generate a user/password+key/pair, use:++ $ genpass myusername++It will prompt for a password. Inspect it first to confirm it is+correct. To write it to the passwd file use++ $ genpass myusername >> /path/to/hulk/data/passwd++And configure your IRC client to use your username and to send a+*server* password.

@@ -0,0 +1,1 @@+{"userDataUser":"hulk","userDataLastSeen":"2013-11-03T02:51:50.980Z"}

@@ -0,0 +1,1 @@+{"userDataUser":"hulk2","userDataLastSeen":"2013-11-03T02:30:29.083Z"}

@@ -1,55 +1,93 @@ Name:                hulk-Version:             0.1.2-Synopsis:            IRC daemon.-Description:         An IRC daemon with mandatory authentication.+Version:             0.2.0+Synopsis:            IRC server written in Haskell.+Description:         An IRC server with (mandatory) server authentication, log recall, bumping.+                     Intended for private business use or hobby work. License:             BSD3+Stability:           Stable License-file:        LICENSE Author:              Chris Done Maintainer:          chrisdone@gmail.com-Copyright:           2010 Chris Done +Copyright:           2010-2013 Chris Done Category:            Network Build-type:          Simple Cabal-version:       >=1.2-Extra-source-files:  README.md, hulk.conf.example, txt/MOTD, txt/PREFACE+Extra-source-files:+  README.md+  example/log/events.log+  example/auth/passwd+  example/auth/passwd-key+  example/txt/PREFACE+  example/txt/MOTD+  example/hulk.conf+  example/users/hulk2+  example/users/hulk +Library+  Exposed-Modules:+     Hulk.Server+     Hulk.Options+     Hulk.Client+     Hulk.Config+     Hulk.Types+     Hulk.Auth+  Ghc-options:       -threaded -O2 -Wall+  Hs-Source-Dirs:    src+  Build-depends:     base >= 4 && <5,+                     text,+                     ConfigFile,+                     fastirc,+                     network,+                     ghc-prim,+                     time,+                     containers,+                     aeson,+                     mtl,+                     utf8-string,+                     Crypto,+                     cmdargs,+                     strict,+                     filepath,+                     directory,+                     bytestring,+                     split,+                     unix,+                     case-insensitive,+                     monad-extras == 0.3.2.0+ Executable hulk   Main-is:           Main.hs-  Other-Modules:     Control.Concurrent.Delay, Control.Monad.IO,-                     Data.String,-                     Hulk.Auth, Hulk.Client, Hulk.Concurrent, Hulk.Config,-                     Hulk.Event, Hulk.Log, Hulk.Options, Hulk.Providers,-                     Hulk.Server, Hulk.Types-  Ghc-options:       -threaded+  Other-Modules:     Hulk.Auth,+                     Hulk.Client,+                     Hulk.Config,+                     Hulk.Server,+                     Hulk.Types+  Ghc-options:       -threaded -O2 -Wall   Hs-Source-Dirs:    src-  Build-depends:     base >= 4 && <5-                    ,cmdargs >= 0.6 && <0.7-                    ,network >= 2.2 && < 2.4-                    ,ConfigFile >= 1.0 && < 1.1-                    ,unix >= 2.4 && < 2.5-                    ,mtl >= 1.1 && < 1.2-                    ,containers >= 0.3 && < 0.4-                    ,irc >= 0.4 && < 0.5-                    ,split >= 0.1 && < 0.2-                    ,utf8-string >= 0.3 && < 0.4-                    ,Crypto>=4.2 && < 4.3-                    ,time >= 1.1 && < 1.2+  Build-depends:     base >= 4 && <5,+                     text,+                     ConfigFile,+                     fastirc,+                     network,+                     ghc-prim,+                     time,+                     containers,+                     aeson,+                     mtl,+                     utf8-string,+                     Crypto,+                     cmdargs,+                     strict,+                     filepath,+                     directory,+                     bytestring,+                     split,+                     unix,+                     case-insensitive,+                     monad-extras == 0.3.2.0  Executable hulk-generate-pass   Main-is:          GeneratePass.hs-  Other-Modules:     Control.Concurrent.Delay, Control.Monad.IO,-                     Data.String,-                     Hulk.Auth, Hulk.Client, Hulk.Concurrent, Hulk.Config,-                     Hulk.Event, Hulk.Log, Hulk.Options, Hulk.Providers,-                     Hulk.Server, Hulk.Types   Hs-Source-Dirs:   src-  Build-depends:    base >= 4 && <5-                    ,cmdargs >= 0.6 && <0.7-                    ,network >= 2.2 && < 2.4-                    ,ConfigFile >= 1.0 && < 1.1-                    ,unix >= 2.4 && < 2.5-                    ,mtl >= 1.1 && < 1.2-                    ,containers >= 0.3 && < 0.4-                    ,irc >= 0.4 && < 0.5-                    ,split >= 0.1 && < 0.2-                    ,utf8-string >= 0.3 && <0.4-                    ,Crypto>=4.2 && <4.3+  Build-depends:    base+  Ghc-options:       -threaded -O2 -Wall

@@ -1,11 +0,0 @@-[LISTEN]-port = 6667-hostname = myhostname--[STRINGS]-motd_file = txt/MOTD-preface_file = txt/PREFACE--[AUTH]-passwd_file = auth/passwd-passwd_key = auth/passwd-key

@@ -1,10 +0,0 @@-module Control.Concurrent.Delay where--import Control.Concurrent--delaySeconds :: Integer -> IO ()-delaySeconds 0 = return ()-delaySeconds n = do threadDelay (1000 * 1000); delaySeconds (n-1)--delayMinutes :: Integer -> IO ()-delayMinutes = delaySeconds . (*60)

@@ -1,6 +0,0 @@-module Control.Monad.IO (io) where--import Control.Monad.Trans--io :: MonadIO m => IO a -> m a-io = liftIO

@@ -1,8 +0,0 @@-module Data.String where--import Data.List-import Data.Char--downcase = map toLower--digilet c = isDigit c || isLetter c

@@ -2,16 +2,16 @@ {-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing #-} module Main where -import System.Console.CmdArgs-import Data.HMAC-import Codec.Binary.UTF8.String-import Numeric-import Data.String-import Control.Applicative- import Hulk.Types import Hulk.Config +import Codec.Binary.UTF8.String+import Control.Applicative+import Data.Char+import Data.HMAC+import Numeric+import System.Console.CmdArgs+ data Options = Options   { conf      :: FilePath   , user      :: String@@ -35,3 +35,6 @@   putStrLn $ ((user options ++ " ") ++)            $ concat $ map (\x -> showHex x "")            $ hmac_sha1 (encode key) (encode pass)++  where downcase = map toLower+        digilet c = isDigit c || isLetter c

@@ -1,25 +1,39 @@-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}-module Hulk.Auth where+-- | Password authorization for the server. +module Hulk.Auth+  (authenticate+  ,sha1)+  where+ import Codec.Binary.UTF8.String import Control.Arrow-import Control.Monad+ import Data.Char import Data.HMAC+import Data.Text (Text,unpack) import Numeric -import Hulk.Types+-- | Authenticate the user.+authenticate :: String -- ^ Salt.+             -> String -- ^ Password file.+             -> Text   -- ^ User.+             -> Text   -- ^ Password.+             -> Bool   -- ^ Authenticated?+authenticate keystr passwords user pass =+  any (== (unpack user,sha1 key (unpack pass)))+      passwds -sha1 :: String -> String -> String-sha1 key str =-  concat $ map (\x -> showHex x "")-         $ hmac_sha1 (encode key) (encode str)+  where key = filter keyChars keystr+        passwds = getPasswds passwords -authenticate :: MonadProvider m => String -> String -> m Bool-authenticate user pass = do-  key <- filter keyChars `liftM` provideKey-  passwds <- liftM getPasswds $ providePasswords-  return $ any (== (user,sha1 key pass)) passwds-  where getPasswds = map readPair . lines+        getPasswds = map readPair . lines             where readPair = second (drop 1) . span (/=' ')         keyChars c = elem c ['a'..'z'] || isDigit c++-- | Make a sha1 string with the given salt.+sha1 :: String -- ^ Salt.+     -> String -- ^ String.+     -> String -- ^ Hashed string.+sha1 key str =+  concat $ map (\x -> showHex x "")+         $ hmac_sha1 (encode key) (encode str)

@@ -1,697 +1,871 @@-{-# LANGUAGE RecordWildCards, ViewPatterns #-}-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}-module Hulk.Client -    (handleLine)-    where--import           Control.Applicative-import           Control.Monad.Reader-import           Control.Monad.State-import           Control.Monad.Writer-import           Data.Char-import           Data.List.Split-import           Data.Map             (Map)-import qualified Data.Map             as M-import           Data.Maybe-import           Data.Time-import           Network.IRC          hiding (Channel)-import           Prelude              hiding (log)--import           Hulk.Auth-import           Hulk.Event-import           Hulk.Types---- Entry point handler---- | Handle an incoming line, try to parse it and handle the message.-handleLine :: MonadProvider m-              => Env -> UTCTime -> Conn -> String -              -> m ([Reply],Env)-handleLine env now conn line = runClient env now conn $-  case decode line of-    Just Message{..} -> handleMsg line (readEventType msg_command,msg_params)-    Nothing  -> errorReply $ "Unable to parse " ++ show line---- | Run the client monad.    -runClient :: MonadProvider m -          => Env -> UTCTime -> Conn -> IRC m () -          -> m ([Reply],Env)-runClient env now conn m = do-  flip runStateT env $ -    execWriterT $ -      flip runReaderT (now,conn) $-        runIRC m---- | Handle an incoming message.-handleMsg :: MonadProvider m => String -> (Event,[String]) -> IRC m ()-handleMsg line msg = do-  case msg of-    (NOTHING,_)   -> invalidMessage line-    (PASS,[pass]) -> asUnregistered $ handlePass pass-    (PINGPONG,_)  -> do incoming line; handlePingPong-    safeToLog     -> handleMsgSafeToLog line safeToLog-    --- | Handle messages that are safe to log.-handleMsgSafeToLog :: MonadProvider m => String -> (Event,[String]) -                   -> IRC m ()-handleMsgSafeToLog line safeToLog = do-  incoming line-  updateLastPong-  case safeToLog of-    (PONG,_)      -> return ()-    (USER,[user,_,_,realname]) -> asUnregistered $ handleUser user realname-    (NICK,[nick])   -> handleNick nick-    (PING,[param])  -> handlePing param-    (QUIT,[msg])    -> handleQuit RequestedQuit msg-    (TELL,[to,msg]) -> handleTell to msg-    (DISCONNECT,[msg]) -> handleQuit SocketQuit msg-    (CONNECT,_)        -> handleConnect-    mustBeReg'd -> handleMsgReg'd line mustBeReg'd---- | Handle messages that can only be used when registered.-handleMsgReg'd :: Monad m => String -> (Event,[String]) -> IRC m ()-handleMsgReg'd line mustBeReg'd =-  asRegistered $-   case mustBeReg'd of-     (JOIN,(name:_))    -> handleJoin name-     (PART,[chan,msg])  -> handlePart chan msg-     (PRIVMSG,[to,msg]) -> handlePrivmsg to msg-     (TOPIC,[chan,topic]) -> handleTopic chan topic-     (NOTICE,[to,msg])  -> handleNotice to msg-     (WHOIS,(nick:_))   -> handleWhoIs nick-     (ISON,people)      -> handleIsOn people-     _                  -> invalidMessage line---- | Log an invalid message.-invalidMessage :: Monad m => String -> IRC m ()-invalidMessage line = do-    incoming line-    errorReply $ "Invalid or unknown message type, or not" ++ -                 " enough parameters: " ++ show line---- Message handlers---- | Handle the PINGPONG event. Disconnect the client if timedout.-handlePingPong :: Monad m => IRC m ()-handlePingPong = do-  lastPong <- clientLastPong <$> getClient-  now <- asks fst-  let n = diffUTCTime now lastPong-  if n > 60*4-     then handleQuit RequestedQuit $ "Ping timeout: " ++ show n ++ " seconds"-     else do hostname <- asks $ connServerName . snd-             thisCmdReply RPL_PING [hostname]---- | Handle the CONNECT event.-handleConnect :: MonadProvider m => IRC m ()-handleConnect = do-  motd <- fmap lines <$> lift providePreface-  case motd of-    Nothing -> return ()-    Just lines -> mapM_ notice lines---- | Handle the PASS message.-handlePass :: MonadProvider m => String -> IRC m ()-handlePass pass = do-  modifyUnregistered $ \u -> u { unregUserPass = Just pass }-  notice "Received password."-  tryRegister---- | Handle the USER message.-handleUser :: MonadProvider m => String -> String -> IRC m ()-handleUser user realname = do-  withSentPass $-    if validUser user-       then do modifyUnregistered $ \u -> u { unregUserUser = Just user-                                            , unregUserName = Just realname }-               notice "Recieved user details."-               tryRegister-       else errorReply "Invalid user format."---- | Handle the USER message.-handleNick :: MonadProvider m => String -> IRC m ()-handleNick nick =-  withSentPass $-    withValidNick nick $ \nick ->-      ifUniqueNick nick $ do-        ref <- getRef-        withRegistered $ \RegUser{regUserNick=nick} -> -          modifyNicks $ M.delete nick-        withUnegistered $ \UnregUser{unregUserNick=nick} -> -          maybe (return ()) (modifyNicks . M.delete) nick-        modifyNicks $ M.insert nick ref-        modifyUnregistered $ \u -> u { unregUserNick = Just nick }-        tryRegister-        asRegistered $ do-          thisClientReply RPL_NICK [unNick nick]-          (myChannels >>=) $ mapM_ $ \Channel{..} -> do-            channelReply channelName RPL_NICK [unNick nick] ExcludeMe-          modifyRegistered $ \u -> u { regUserNick = nick }---- | Handle the PING message.-handlePing :: Monad m => String -> IRC m ()-handlePing p = do-  hostname <- asks $ connServerName . snd-  thisServerReply RPL_PONG [hostname,p]---- | Handle the QUIT message.-handleQuit :: Monad m => QuitType -> String -> IRC m ()-handleQuit quitType msg = do- (myChannels >>=) $ mapM_ $ \Channel{..} -> do-   channelReply channelName RPL_QUIT [msg] ExcludeMe-   removeFromChan channelName- withRegistered $ \RegUser{regUserNick=nick} -> do-   modifyNicks $ M.delete nick- withUnegistered $ \UnregUser{unregUserNick=nick} -> do-   maybe (return ()) (modifyNicks . M.delete) nick- ref <- getRef- modifyClients $ M.delete ref- notice msg- when (quitType == RequestedQuit) $ tell [Close]---- | Handle the TELL message.-handleTell :: Monad m => String -> String -> IRC m ()-handleTell name msg = sendMsgTo RPL_NOTICE name msg---- | Handle the JOIN message.-handleJoin :: Monad m => String -> IRC m ()-handleJoin chans = do-  let names = splitWhen (==',') chans-  forM_ names $ flip withValidChanName $ \name -> do-      exists <- M.member name <$> gets envChannels-      unless exists $ insertChannel name-      joined <- inChannel name-      unless joined $ joinChannel name---- | Handle the PART message.-handlePart :: Monad m => String -> String -> IRC m ()-handlePart name msg =-  withValidChanName name $ \name -> do-    removeFromChan name-    channelReply name RPL_PART [msg] IncludeMe---- | Remove a user from a channel.-removeFromChan :: Monad m => ChannelName -> IRC m ()-removeFromChan name = do-  ref <- getRef-  let remMe c = c { channelUsers = filter (/=ref) (channelUsers c) }-  modifyChannels $ M.adjust remMe name---- | Handle the TOPIC message.-handleTopic :: Monad m => String -> String -> IRC m ()-handleTopic name topic =-  withValidChanName name $ \name -> do-    let setTopic c = c { channelTopic = Just topic }-    modifyChannels $ M.adjust setTopic name-    channelReply name RPL_TOPIC [unChanName name,topic] IncludeMe---- | Handle the PRIVMSG message.-handlePrivmsg :: Monad m => String -> String -> IRC m ()-handlePrivmsg name msg = sendMsgTo RPL_PRIVMSG name msg---- | Handle the NOTICE message.-handleNotice :: Monad m => String -> String -> IRC m ()-handleNotice name msg = sendMsgTo RPL_NOTICE name msg---- | Handle WHOIS message.-handleWhoIs :: Monad m => String -> IRC m ()-handleWhoIs nick =-  withValidNick nick $ \nick ->-    withClientByNick nick $ \Client{..} ->-      withRegUserByNick nick $ \RegUser{..} -> do-        thisNickServerReply RPL_WHOISUSER -                            [unNick regUserNick-                            ,regUserUser-                            ,clientHostname-                            ,"*"-                            ,regUserName]-        thisNickServerReply RPL_ENDOFWHOIS-                            [unNick regUserNick-                            ,"End of WHOIS list."]---- | Handle the ISON ('is on?') message.-handleIsOn :: Monad m => [String] -> IRC m ()-handleIsOn (catMaybes . map readNick -> nicks) =-  asRegistered $ do-    online <- catMaybes <$> mapM regUserByNick nicks-    let nicks = unwords $ map (unNick.regUserNick) online-    unless (null nicks) $ thisNickServerReply RPL_ISON [nicks ++ " "]---- Generic message functions---- | Send a message to a user or a channel (it figures it out).-sendMsgTo :: Monad m => RPL -> String -> String -> IRC m ()-sendMsgTo typ name msg =-  if validChannel name-     then withValidChanName name $ \name -> -            channelReply name typ [unChanName name,msg] ExcludeMe-     else userReply name typ [name,msg]-     --- Channel functions---- | Get channels that the current client is in.-myChannels :: Monad m => IRC m [Channel]-myChannels = do-  ref <- getRef-  filter (elem ref . channelUsers) . map snd . M.toList <$> gets envChannels---- | Join a channel.-joinChannel :: Monad m => ChannelName -> IRC m ()-joinChannel name = do-  ref <- getRef-  let addMe c = c { channelUsers = channelUsers c ++ [ref] }-  modifyChannels $ M.adjust addMe name-  channelReply name RPL_JOIN [unChanName name] IncludeMe-  sendNamesList name-  withChannel name $ \Channel{..} -> do-    case channelTopic of-      Just topic -> thisServerReply RPL_TOPIC [unChanName name,topic]-      Nothing -> return ()---- | Send the names list of a channel.-sendNamesList :: Monad m => ChannelName -> IRC m ()-sendNamesList name = do-  asRegistered $-    withChannel name $ \Channel{..} -> do-      clients <- catMaybes <$> mapM getClientByRef channelUsers-      let nicks = map regUserNick . catMaybes . map clientRegUser $ clients-      forM_ (splitEvery 10 nicks) $ \nicks ->-        thisNickServerReply RPL_NAMEREPLY ["@",unChanName name-                                          ,unwords $ map unNick nicks]-      thisNickServerReply RPL_ENDOFNAMES [unChanName name-                                         ,"End of /NAMES list."]---- | Am I in a channel?-inChannel :: Monad m => ChannelName -> IRC m Bool-inChannel name = do-  chan <- M.lookup name <$> gets envChannels-  case chan of-    Nothing -> return False-    Just Channel{..} -> (`elem` channelUsers) <$> getRef---- | Insert a new channel.-insertChannel :: Monad m => ChannelName -> IRC m ()-insertChannel name = modifyChannels $ M.insert name newChan where-  newChan = Channel { channelName  = name-                    , channelTopic = Nothing-                    , channelUsers = []-                    }---- | Modify the channel map.-modifyChannels :: Monad m -               => (Map ChannelName Channel -> Map ChannelName Channel) -               -> IRC m ()-modifyChannels f = modify $ \e -> e { envChannels = f (envChannels e) }---- | Perform an action with an existing channel, sends error if not exists.-withChannel :: Monad m => ChannelName -> (Channel -> IRC m ()) -> IRC m ()-withChannel name m = do-  chan <- M.lookup name <$> gets envChannels-  case chan of-    Nothing -> thisServerReply ERR_NOSUCHCHANNEL [unChanName name-                                                 ,"No such channel."]-    Just chan -> m chan-    -withValidChanName :: Monad m => String -> (ChannelName -> IRC m ()) -                  -> IRC m ()-withValidChanName name m -    | validChannel name = m $ ChannelName name-    | otherwise         = errorReply $ "Invalid channel name: " ++ name---- Client/user access functions---- | Update the last pong reply time.-updateLastPong :: Monad m => IRC m ()-updateLastPong = do-  ref <- getRef-  now <- asks fst-  let adjust client@Client{..} = client { clientLastPong = now }-  modifyClients $ M.adjust adjust ref---- | Read a valid nick.-readNick :: String -> Maybe Nick-readNick n | validNick n = Just $ Nick n-           | otherwise   = Nothing---- | Modify the nicks mapping.-modifyNicks :: Monad m => (Map Nick Ref -> Map Nick Ref) -> IRC m ()-modifyNicks f = modify $ \env -> env { envNicks = f (envNicks env) }---- | With a valid nickname, perform an action.-withValidNick :: Monad m => String -> (Nick -> IRC m ()) -> IRC m ()-withValidNick nick m-    | validNick nick = m (Nick nick)-    | otherwise      = errorReply $ "Invalid nick format: " ++ nick---- | Perform an action if a nickname is unique, otherwise send error.-ifUniqueNick :: Monad m => Nick -> IRC m () -> IRC m ()-ifUniqueNick nick m = do-  clients <- gets envClients-  client <- (M.lookup nick >=> (`M.lookup` clients)) <$> gets envNicks-  case client of-    Nothing -> m-    Just{}  -> thisServerReply ERR_NICKNAMEINUSE -                               [unNick nick,"Nick is already in use."]---- | Try to register the user with the USER/NICK/PASS that have been given.-tryRegister :: MonadProvider m => IRC m ()-tryRegister =-  withUnegistered $ \UnregUser{..} -> do-    let details = (,,,) <$> unregUserName-                        <*> unregUserNick-                        <*> unregUserUser-                        <*> unregUserPass-    case details of-      Nothing -> return ()-      Just (name,nick,user,pass) -> do-        authentic <- lift $ authenticate user pass-        if not authentic-           then errorReply $ "Wrong user/pass."-           else do modifyUser $ \_ ->-                     Registered $ RegUser name nick user pass-                   sendWelcome-                   sendMotd---- | Send a client reply to a user.-userReply :: Monad m => String -> RPL -> [String] -> IRC m ()-userReply nick typ ps = -  withValidNick nick $ \nick ->-    withClientByNick nick $ \Client{..} ->-      clientReply clientRef typ ps---- | Perform an action with a client by nickname.-withClientByNick :: Monad m => Nick -> (Client -> IRC m ()) -> IRC m ()-withClientByNick nick m = do-    client <- clientByNick nick-    case client of-      Nothing -> sendNoSuchNick nick-      Just client@Client{..} -          | isRegistered clientUser -> m client-          | otherwise -> sendNoSuchNick nick---- | Perform an action with a registered user by its nickname.-withRegUserByNick :: Monad m => Nick -> (RegUser -> IRC m ()) -> IRC m ()-withRegUserByNick nick m = do-  user <- regUserByNick nick-  case user of-    Just user -> m user-    Nothing -> sendNoSuchNick nick-    --- | Send the RPL_NOSUCHNICK reply.-sendNoSuchNick :: Monad m => Nick -> IRC m ()-sendNoSuchNick nick =-  thisServerReply ERR_NOSUCHNICK [unNick nick,"No such nick."]---- | Get a registered user by nickname.-regUserByNick :: Monad m => Nick -> IRC m (Maybe RegUser)-regUserByNick nick = do-  c <- clientByNick nick-  case clientUser <$> c of-    Just (Registered u) -> return $ Just u-    _ -> return Nothing---- | Get a client by nickname.-clientByNick :: Monad m => Nick -> IRC m (Maybe Client)-clientByNick nick = do-  clients <- gets envClients-  (M.lookup nick >=> (`M.lookup` clients)) <$> gets envNicks---- | Maybe get a registered user from a client.-clientRegUser :: Client -> Maybe RegUser-clientRegUser Client{..} = -    case clientUser of-      Registered u -> Just u-      _ -> Nothing-  --- | Modify the current user if unregistered.-modifyUnregistered :: Monad m => (UnregUser -> UnregUser) -> IRC m ()-modifyUnregistered f = do-  modifyUser $ \user -> -      case user of-        Unregistered user -> Unregistered (f user)-        u -> u---- | Modify the current user if registered.-modifyRegistered :: Monad m => (RegUser -> RegUser) -> IRC m ()-modifyRegistered f = do-  modifyUser $ \user -> -      case user of-        Registered user -> Registered (f user)-        u -> u---- | Modify the current user.-modifyUser :: Monad m => (User -> User) -> IRC m ()-modifyUser f = do-  ref <- getRef-  let modUser c = c { clientUser = f (clientUser c) }-      modClient = M.adjust modUser ref-  modify $ \env -> env { envClients = modClient (envClients env) }---- | Only perform command if the client is registered.-asRegistered :: Monad m => IRC m () -> IRC m ()-asRegistered m = do-  registered <- isRegistered <$> getUser-  when registered m---- | Perform command with a registered user.-withRegistered :: Monad m => (RegUser -> IRC m ()) -> IRC m ()-withRegistered m = do-  user <- getUser-  case user of-    Registered user -> m user-    _ -> return ()-    --- | With sent pass.-withSentPass :: Monad m => IRC m () -> IRC m ()-withSentPass m = do-  asRegistered m-  withUnegistered $ \UnregUser{..} -> do-    case unregUserPass of-      Just{} -> m-      Nothing -> return ()---- | Perform command with a registered user.-withUnegistered :: Monad m => (UnregUser -> IRC m ()) -> IRC m ()-withUnegistered m = do-  user <- getUser-  case user of-    Unregistered user -> m user-    _ -> return ()---- | Only perform command if the client is registered.-asUnregistered :: Monad m => IRC m () -> IRC m ()-asUnregistered m = do-  registered <- isRegistered <$> getUser-  unless registered m---- | Is a user registered?-isRegistered :: User -> Bool-isRegistered Registered{} = True-isRegistered _ = False---- | Get the current client's user.-getUser :: Monad m => IRC m User-getUser = clientUser <$> getClient---- | Get the current client.-getClientByRef :: Monad m => Ref -> IRC m (Maybe Client)-getClientByRef ref = do-  clients <- gets envClients-  return $ M.lookup ref clients---- | Get the current client.-getClient :: Monad m => IRC m Client-getClient = do-  ref <- getRef-  clients <- gets envClients-  case M.lookup ref clients of-    Just client -> return $ client-    Nothing -> makeNewClient-    --- | Modify the clients table.-modifyClients :: Monad m => (Map Ref Client -> Map Ref Client) -> IRC m ()-modifyClients f = modify $ \env -> env { envClients = f (envClients env) }---- | Make a current client based on the current connection.-makeNewClient :: Monad m => IRC m Client-makeNewClient = do-  Conn{..} <- asks snd-  let client = Client { clientRef = connRef-                      , clientHostname = connHostname-                      , clientUser = newUnregisteredUser -                      , clientLastPong = connTime }-  modifyClients $ M.insert connRef client-  return client---- | Make a new unregistered user.-newUnregisteredUser :: User-newUnregisteredUser = Unregistered $ UnregUser {-   unregUserName = Nothing-  ,unregUserNick = Nothing-  ,unregUserUser = Nothing-  ,unregUserPass = Nothing-  }---- Channel replies---- | Send a client reply to everyone in a channel.-channelReply :: Monad m => ChannelName -> RPL -> [String] -             -> ChannelReplyType-             -> IRC m ()-channelReply name cmd params typ = do-  withChannel name $ \Channel{..} -> do-    ref <- getRef-    forM_ channelUsers $ \theirRef -> do-      unless (typ == ExcludeMe && ref == theirRef) $ -        clientReply theirRef cmd params---- Client replies---- | Send a client reply to the current client.-thisClientReply :: Monad m => RPL -> [String] -> IRC m ()-thisClientReply typ params = do-  ref <- getRef-  clientReply ref typ params---- | Send a client reply of the given type with the given params, on--- the given connection reference.-clientReply :: Monad m => Ref -> RPL -> [String] -> IRC m ()-clientReply ref typ params = do-  withRegistered $ \user -> do-    client <- getClient-    msg <- newClientMsg client user typ params-    reply ref msg---- | Make a new IRC message from the current client.-newClientMsg :: Monad m => Client -> RegUser -> RPL -> [String] -             -> IRC m Message-newClientMsg Client{..} RegUser{..} cmd ps = do-  let nickName = NickName (unNick regUserNick)-                          (Just regUserUser)-                          (Just clientHostname)-  return $ Message {-    msg_prefix = Just $ nickName-   ,msg_command = fromRPL cmd-   ,msg_params = ps-  }---- Server replies---- | Send the welcome message.-sendWelcome :: Monad m => IRC m ()-sendWelcome = do-  withRegistered $ \RegUser{..} -> do-    thisNickServerReply RPL_WELCOME ["Welcome."]---- | Send the MOTD.    -sendMotd :: MonadProvider m => IRC m ()-sendMotd = do-  asRegistered $ do-    thisNickServerReply RPL_MOTDSTART ["MOTD"]-    motd <- fmap lines <$> lift provideMotd-    let motdLine line = thisNickServerReply RPL_MOTD [line]-    case motd of-      Nothing -> motdLine "None."-      Just lines -> mapM_ motdLine lines-    thisNickServerReply RPL_ENDOFMOTD ["/MOTD."]---- | Send a message reply.-notice :: Monad m => String -> IRC m ()-notice msg = thisServerReply RPL_NOTICE ["*",msg]--thisNickServerReply :: Monad m => RPL -> [String] -> IRC m ()-thisNickServerReply typ params = do-  withRegistered $ \RegUser{regUserNick=Nick nick} ->-    thisServerReply typ (nick : params)---- | Send a server reply of the given type with the given params.-thisServerReply :: Monad m => RPL -> [String] -> IRC m ()-thisServerReply typ params = do-  ref <- getRef-  serverReply ref typ params---- | Send a server reply of the given type with the given params.-serverReply :: Monad m => Ref -> RPL -> [String] -> IRC m ()-serverReply ref typ params = do-  msg <- newServerMsg typ params-  reply ref msg---- | Make a new IRC message from the server.-newServerMsg :: Monad m => RPL -> [String] -> IRC m Message-newServerMsg cmd ps = do-  hostname <- asks $ connServerName . snd-  return $ Message {-    msg_prefix = Just $ Server hostname-   ,msg_command = fromRPL cmd-   ,msg_params = ps-  }-  --- | Send a cmd reply of the given type with the given params.-thisCmdReply :: Monad m => RPL -> [String] -> IRC m ()-thisCmdReply typ params = do-  ref <- getRef-  cmdReply ref typ params---- | Send a cmd reply of the given type with the given params.-cmdReply :: Monad m => Ref -> RPL -> [String] -> IRC m ()-cmdReply ref typ params = do-  msg <- newCmdMsg typ params-  reply ref msg---- | Make a new IRC message from the cmd.-newCmdMsg :: Monad m => RPL -> [String] -> IRC m Message-newCmdMsg cmd ps = do-  return $ Message {-    msg_prefix = Nothing-   ,msg_command = fromRPL cmd-   ,msg_params = ps-  }---- | Get the current connection ref.-getRef :: Monad m => IRC m Ref-getRef = asks $ connRef . snd---- Output functions---- | Send an error reply.-errorReply :: Monad m => String -> IRC m ()-errorReply m = do-  notice $ "ERROR: " ++ m-  log $ "ERROR: " ++ m---- | Send a message reply.-reply :: Monad m => Ref -> Message -> IRC m ()-reply ref msg = do-  outgoing $ encode msg-  tell . return $ MessageReply ref msg---- | Log an incoming line.-incoming :: Monad m => String -> IRC m ()-incoming = log . ("<- " ++)---- | Log an outgoing line.-outgoing :: Monad m => String -> IRC m ()-outgoing = log . ("-> " ++)---- | Log a line.-log :: Monad m => String -> IRC m ()-log line = do-  ref <- getRef-  tell . return . LogReply $ show (unRef ref) ++ ": " ++ line---- Validation functions---- | Is a username valid?-validUser :: String -> Bool-validUser = validNick---- | Is a nickname valid? Digit/letter or one of these: -_/\\;()[]{}?`'-validNick :: String -> Bool-validNick s = all ok s && length s > 0 where-  ok c = isDigit c || isLetter c || elem c "-_/\\;()[]{}?`'"---- | Valid channel name?-validChannel :: String -> Bool-validChannel ('#':cs) = all ok cs && length cs > 0 where-  ok c = isDigit c || isLetter c || elem c "-_/\\;()[]{}?`'"-validChannel _ = False+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE ViewPatterns      #-}++-- | This module communicates and manages the state of clients+-- connected to the server.++module Hulk.Client+    where++import           Hulk.Auth+import           Hulk.Types++import           Control.Applicative+import           Control.Monad.RWS hiding (pass)+import           Data.CaseInsensitive (mk)+import           Data.Char+import           Data.List+import           Data.List.Split+import           Data.Map             (Map)+import qualified Data.Map             as M+import           Data.Maybe+import qualified Data.Set             as S+import           Data.Text            (Text, pack)+import qualified Data.Text            as T+import           Data.Text.Encoding   (decodeUtf8,encodeUtf8)+import           Data.Time hiding (readTime)+import           Network.FastIRC      (Command (..), CommandArg, Message (..), UserSpec(..))+import qualified Network.FastIRC      as IRC+import           Prelude              hiding (log)++--------------------------------------------------------------------------------+-- * Top-level dispatchers++-- | Run the client monad.+handleCommand+  :: Config                        -- ^ Server configuration.+  -> HulkState                     -- ^ Server state.+  -> UTCTime                       -- ^ Current time.+  -> Conn                          -- ^ Current client connection.+  -> (String,String)               -- ^ Authorization info.+  -> Command                       -- ^ The command.+  -> ((), HulkState, [HulkWriter]) -- ^ The new transformed state and any instructions.+handleCommand config state' now conn auth cmd = do+  runRWS (runHulk (handleCmd cmd))+         (HulkReader now conn config Nothing auth)+         state'++-- | Handle an incoming command.+handleCmd :: Command -- ^ A command which shouldn't be logged (e.g. PASS).+          -> Hulk ()+handleCmd cmd = do+  case cmd of+    PassCmd (decodeUtf8 -> pass) -> do+      incoming cmd+      asUnregistered $ handlePass pass+    StringCmd "PINGPONG" _ -> do+      incoming cmd+      handlePingPong+    _ -> handleMsgSafeToLog cmd++-- | Handle commands that are safe to log.+handleMsgSafeToLog :: Command -- ^ A command which is safe to log+                              -- (PONG, NICK, etc.).+                   -> Hulk ()+handleMsgSafeToLog cmd = do+  incoming cmd+  updateLastPong+  case cmd of+    PongCmd{} -> handlePong+    NickCmd (decodeUtf8 -> nick) _ -> handleNick nick+    PingCmd (decodeUtf8 -> param) _ -> handlePing param+    UserCmd (decodeUtf8 -> user) _ _ (decodeUtf8 -> realname) ->+      asUnregistered $ handleUser user realname+    QuitCmd mmsg ->+      handleQuit RequestedQuit+                 (maybe "Quit (no message given)"+                        decodeUtf8+                        mmsg)+    StringCmd "DISCONNECT" _ ->+      handleQuit SocketQuit "Connection lost."+    _ -> handleMsgReg'd cmd++-- | Handle commands that can only be used when registered.+handleMsgReg'd :: Command -- ^ A command that users use after+                          -- registration (e.g. JOIN, PART, etc.).+               -> Hulk ()+handleMsgReg'd cmd =+  asRegistered $+   case cmd of+     JoinCmd names ->+       mapM_ handleJoin (map decodeUtf8 (M.keys names))+     PartCmd names mmsg  ->+       mapM_ (flip handlePart (maybe "" decodeUtf8 mmsg))+             (map decodeUtf8 (S.toList names))+     PrivMsgCmd targets msg ->+       mapM_ (flip handlePrivmsg (decodeUtf8 msg))+             (map decodeUtf8 (S.toList targets))+     TopicCmd chan (fmap decodeUtf8 -> Just topic) -> handleTopic (decodeUtf8 chan) topic+     NoticeCmd targets msg  ->+       mapM_ (flip handleNotice (decodeUtf8 msg))+             (map decodeUtf8 (S.toList targets))+     StringCmd "WHOIS" [nick] -> handleWhoIs (decodeUtf8 nick)+     StringCmd "ISON" people  -> handleIsOn (map decodeUtf8 people)+     StringCmd "NAMES" [chan] -> handleNames (decodeUtf8 chan)+     _ -> invalidCmd cmd++-- | Log an invalid cmd.+invalidCmd :: Command -- ^ The given command that we don't know how to handle.+           -> Hulk ()+invalidCmd cmd = do+  errorReply $ "Invalid or unknown message type, or not" <>+               " enough parameters: " <> decodeUtf8 (IRC.showCommand cmd)++--------------------------------------------------------------------------------+-- * Command handlers++-- | Handle the PONG command. This updates the user's “last seen”+-- value on file.+handlePong :: Hulk ()+handlePong = do+  now <- asks readTime+  withRegistered $ \RegUser{regUserUser=user} -> do+    tell [UpdateUserData UserData { userDataUser = user+                                  , userDataLastSeen = now+                                  }]++-- | Handle the PINGPONG event. Disconnect the client if timedout.+handlePingPong :: Hulk ()+handlePingPong = do+  lastPong <- clientLastPong <$> getClient+  now <- asks readTime+  let n = diffUTCTime now lastPong+  if n > 60*4+     then handleQuit RequestedQuit $ "Ping timeout: " <> pack (show n) <> " seconds"+     else do hostname <- asks (connServerName . readConn)+             thisCmdReply RPL_PING [hostname]++-- | Handle the PASS message.+handlePass :: Text -> Hulk ()+handlePass pass = do+  modifyUnregistered $ \u -> u { unregUserPass = Just pass }+  notice "Received password."+  tryRegister++-- | Handle the USER message.+handleUser :: Text -> Text -> Hulk ()+handleUser user realname = do+  withSentPass $+    if validUser user+       then do modifyUnregistered $ \u -> u { unregUserUser = Just (UserName (mk user))+                                            , unregUserName = Just realname }+               notice "Recieved user details."+               tryRegister+       else errorReply "Invalid user format."++-- | Handle the USER message.+handleNick :: Text -> Hulk ()+handleNick nick' =+  withSentPass $+    withValidNick nick' $ \nick ->+      ifNotMyNick nick $+        ifUniqueNick nick (updateNickAndTryRegistration nick)+                          (Just (tryBumpingSomeoneElseOff nick))++  where updateNickAndTryRegistration nick = do+          ref <- getRef+          withRegistered $ \RegUser{regUserNick=rnick} ->+            modifyNicks $ M.delete rnick+          withUnregistered $ \UnregUser{unregUserNick=rnick} ->+            maybe (return ()) (modifyNicks . M.delete) rnick+          modifyNicks $ M.insert nick ref+          modifyUnregistered $ \u -> u { unregUserNick = Just nick }+          tryRegister+          asRegistered $ do+            thisClientReply RPL_NICK [nickText nick]+            (myChannels >>=) $ mapM_ $ \Channel{..} -> do+              channelReply channelName RPL_NICK [nickText nick] ExcludeMe+            modifyRegistered $ \u -> u { regUserNick = nick }++        tryBumpingSomeoneElseOff nick = \error_reply -> do+          registered <- isRegistered <$> getUser+          if registered+             then bumpAndRegister nick error_reply+             else do+               withUnregistered $ \unreg -> do+                 (authentic,_) <- isAuthentic unreg { unregUserNick = Just nick }+                 if not authentic+                    then error_reply " (Registration not valid, can't bump off this user.)"+                    else bumpAndRegister nick error_reply++        bumpAndRegister nick error_reply = do+          username <- getUsername+          if fmap (mk.userText) username == Just (mk (nickText nick))+             then do bumpOff nick+                     updateNickAndTryRegistration nick+             else error_reply $+               let x = "username=" <> pack (show username) <> ", nick=" <> nickText nick+               in " (Can only bump the nick that matches your username. Debug: " <> x <> ")"++-- | Handle the PING message.+handlePing :: Text -> Hulk ()+handlePing p = do+  hostname <- asks (connServerName . readConn)+  thisServerReply RPL_PONG [hostname,p]++-- | Handle the QUIT message.+handleQuit :: QuitType -> Text -> Hulk ()+handleQuit quitType msg = do+  clearQuittedUser msg+  when (quitType == RequestedQuit) $+    tell [Close]++-- | Handle the TELL message.+handleTell :: Text -> Text -> Hulk ()+handleTell name msg = sendMsgTo RPL_NOTICE name msg++-- | Handle the NAMES list request.+handleNames :: Text -> Hulk ()+handleNames chan = do+  withValidChanName chan sendNamesList++-- | Handle the JOIN message.+handleJoin :: Text -> Hulk ()+handleJoin chans = do+  let names = T.split (==',') chans+  forM_ names $ flip withValidChanName $ \name -> do+      exists <- M.member name <$> gets stateChannels+      unless exists $ insertChannel name+      joined <- inChannel name+      unless joined $ joinChannel name++-- | Handle the PART message.+handlePart :: Text -> Text -> Hulk ()+handlePart name msg =+  withValidChanName name $ \vname -> do+    removeFromChan vname+    channelReply vname RPL_PART [msg] IncludeMe++-- | Handle the TOPIC message.+handleTopic :: Text -> Text -> Hulk ()+handleTopic name' topic =+  withValidChanName name' $ \name -> do+    let setTopic c = c { channelTopic = Just topic }+    modifyChannels $ M.adjust setTopic name+    channelReply name RPL_TOPIC [channelNameText name,topic] IncludeMe++-- | Handle the PRIVMSG message.+handlePrivmsg :: Text -> Text -> Hulk ()+handlePrivmsg name msg = do+  sendMsgTo RPL_PRIVMSG name msg+  historyLog RPL_PRIVMSG [name,msg]++-- | Handle the NOTICE message.+handleNotice :: Text -> Text -> Hulk ()+handleNotice name msg = sendMsgTo RPL_NOTICE name msg++-- | Handle WHOIS message.+handleWhoIs :: Text -> Hulk ()+handleWhoIs nick' =+  withValidNick nick' $ \nick ->+    withClientByNick nick $ \Client{..} ->+      withRegUserByNick nick $ \RegUser{..} -> do+        thisNickServerReply RPL_WHOISUSER+                            [nickText regUserNick+                            ,userText regUserUser+                            ,clientHostname+                            ,"*"+                            ,regUserName]+        thisNickServerReply RPL_ENDOFWHOIS+                            [nickText regUserNick+                            ,"End of WHOIS list."]++-- | Handle the ISON ('is on?') message.+handleIsOn :: [Text] -> Hulk ()+handleIsOn (catMaybes . map readNick -> nicks') =+  asRegistered $ do+    online <- catMaybes <$> mapM regUserByNick nicks'+    let nicks = T.unwords $ map (nickText.regUserNick) online+    unless (T.null nicks) $ thisNickServerReply RPL_ISON [nicks <> " "]++--------------------------------------------------------------------------------+-- * General actions++-- | Send a message to a user or a channel (it figures it out).+sendMsgTo :: RPL -> Text -> Text -> Hulk ()+sendMsgTo typ name' msg =+  if validChannel name'+     then withValidChanName name' $ \name ->+            channelReply name typ [channelNameText name,msg] ExcludeMe+     else userReply name' typ [name',msg]++--------------------------------------------------------------------------------+-- * Users++-- | Is a username valid?+validUser :: Text -> Bool+validUser = validNick++-- | Get the username.+getUsername :: Hulk (Maybe UserName)+getUsername = do+  user <- getUser+  return $ case user of+    Unregistered (UnregUser{unregUserUser=username}) -> username+    Registered (RegUser{regUserUser=username})       -> Just username++-- | Get the current connection ref.+getRef :: Hulk Ref+getRef = connRef <$> asks readConn++-- | Bump off the given nick.+bumpOff :: Nick -> Hulk ()+bumpOff nick = ifNotMyNick nick $ do+  notice $ "Bumping off user " <> nickText nick <> "…"+  withClientByNick nick $ \Client{clientRef=ref} ->+    local (\r -> r { readConn = (readConn r) { connRef = ref } }) $ do+      clearQuittedUser msg+      tell [Bump ref]++  where msg = "Bumped off."++-- | Clear a quitted user from channels and nick list, and notify+-- people in channels of their leaving.+clearQuittedUser :: Text -> Hulk ()+clearQuittedUser msg = do+  (myChannels >>=) $ mapM_ $ \Channel{..} -> do+    channelReply channelName RPL_QUIT [msg] ExcludeMe+    removeFromChan channelName+  withRegistered $ \RegUser{regUserNick=nick} -> do+    modifyNicks $ M.delete nick+  withUnregistered $ \UnregUser{unregUserNick=nick} -> do+    maybe (return ()) (modifyNicks . M.delete) nick+  ref <- getRef+  modifyClients $ M.delete ref+  notice msg++-- | Update the last pong reply time.+updateLastPong :: Hulk ()+updateLastPong = do+  ref <- getRef+  now <- asks readTime+  let adjust client@Client{..} = client { clientLastPong = now }+  modifyClients $ M.adjust adjust ref++-- | Send a client reply to a user.+userReply :: Text -> RPL -> [Text] -> Hulk ()+userReply nick' typ ps =+  withValidNick nick' $ \nick ->+    withClientByNick nick $ \Client{..} ->+      clientReply clientRef typ ps++-- | Perform an action with a registered user by its nickname.+withRegUserByNick :: Nick -> (RegUser -> Hulk ()) -> Hulk ()+withRegUserByNick nick m = do+  user <- regUserByNick nick+  case user of+    Just user' -> m user'+    Nothing -> sendNoSuchNick nick++-- | Send the RPL_NOSUCHNICK reply.+sendNoSuchNick :: Nick -> Hulk ()+sendNoSuchNick nick =+  thisServerReply ERR_NOSUCHNICK [nickText nick,"No such nick."]++-- | Modify the current user.+modifyUser :: (User -> User) -> Hulk ()+modifyUser f = do+  ref <- getRef+  let modUser c = c { clientUser = f (clientUser c) }+      modClient = M.adjust modUser ref+  modify $ \env -> env { stateClients = modClient (stateClients env) }++-- | Get the current client's user.+getUser :: Hulk User+getUser = clientUser <$> getClient++--------------------------------------------------------------------------------+-- * Clients++-- | Get the current client.+getClientByRef :: Ref -> Hulk (Maybe Client)+getClientByRef ref = do+  clients <- gets stateClients+  return $ M.lookup ref clients++-- | Get a client by nickname.+clientByNick :: Nick -> Hulk (Maybe Client)+clientByNick nick = do+  clients <- gets stateClients+  (M.lookup nick >=> (`M.lookup` clients)) <$> gets stateNicks++-- | Perform an action with a client by nickname.+withClientByNick :: Nick -> (Client -> Hulk ()) -> Hulk ()+withClientByNick nick m = do+  client' <- clientByNick nick+  case client' of+    Nothing -> sendNoSuchNick nick+    Just client@Client{..}+        | isRegistered clientUser -> m client+        | otherwise -> sendNoSuchNick nick++-- | Get the current client.+getClient :: Hulk Client+getClient = do+  ref <- getRef+  clients <- gets stateClients+  case M.lookup ref clients of+    Just client -> return $ client+    Nothing -> makeNewClient++-- | Modify the clients table.+modifyClients :: (Map Ref Client -> Map Ref Client) -> Hulk ()+modifyClients f = modify $ \env -> env { stateClients = f (stateClients env) }++-- | Make a current client based on the current connection.+makeNewClient :: Hulk Client+makeNewClient = do+  Conn{..} <- asks readConn+  let client = Client { clientRef = connRef+                      , clientHostname = connHostname+                      , clientUser = newUnregisteredUser+                      , clientLastPong = connTime }+  modifyClients $ M.insert connRef client+  return client+++--------------------------------------------------------------------------------+-- * Registration++-- | Get a registered user by nickname.+regUserByNick :: Nick -> Hulk (Maybe RegUser)+regUserByNick nick = do+  c <- clientByNick nick+  case clientUser <$> c of+    Just (Registered u) -> return $ Just u+    _ -> return Nothing++-- | Maybe get a registered user from a client.+clientRegUser :: Client -> Maybe RegUser+clientRegUser Client{..} =+    case clientUser of+      Registered u -> Just u+      _ -> Nothing++-- | Modify the current user if unregistered.+modifyUnregistered :: (UnregUser -> UnregUser) -> Hulk ()+modifyUnregistered f = do+  modifyUser $ \user ->+      case user of+        Unregistered user' -> Unregistered (f user')+        u -> u++-- | Modify the current user if registered.+modifyRegistered :: (RegUser -> RegUser) -> Hulk ()+modifyRegistered f = do+  modifyUser $ \user ->+      case user of+        Registered user' -> Registered (f user')+        u -> u++-- | Only perform command if the client is registered.+asRegistered :: Hulk () -> Hulk ()+asRegistered m = do+  registered <- isRegistered <$> getUser+  when registered m++-- | Perform command with a registered user.+withRegistered :: (RegUser -> Hulk ()) -> Hulk ()+withRegistered m = do+  user <- getUser+  case user of+    Registered user' -> m user'+    _ -> return ()++-- | With sent pass.+withSentPass :: Hulk () -> Hulk ()+withSentPass m = do+  asRegistered m+  withUnregistered $ \UnregUser{..} -> do+    case unregUserPass of+      Just{} -> m+      Nothing -> return ()++-- | Perform command with a registered user.+withUnregistered :: (UnregUser -> Hulk ()) -> Hulk ()+withUnregistered m = do+  user <- getUser+  case user of+    Unregistered user' -> m user'+    _ -> return ()++-- | Only perform command if the client is registered.+asUnregistered :: Hulk () -> Hulk ()+asUnregistered m = do+  registered <- isRegistered <$> getUser+  unless registered m++-- | Is a user registered?+isRegistered :: User -> Bool+isRegistered Registered{} = True+isRegistered _ = False+++-- | Make a new unregistered user.+newUnregisteredUser :: User+newUnregisteredUser = Unregistered $ UnregUser {+   unregUserName = Nothing+  ,unregUserNick = Nothing+  ,unregUserUser = Nothing+  ,unregUserPass = Nothing+  }++-- | Try to register the user with the USER/NICK/PASS that have been given.+tryRegister :: Hulk ()+tryRegister =+  withUnregistered $ \unreg -> do+    check <- isAuthentic unreg+    case check of+      (True,Just (name,user,nick)) -> do+        modifyUser $ \_ ->+          Registered $ RegUser name nick user ""+        sendWelcome+        sendMotd+        sendEvents+      (False,Just{}) -> errorReply $ "Wrong user/pass."+      _ -> return ()++isAuthentic :: UnregUser -> Hulk (Bool,Maybe (Text,UserName,Nick))+isAuthentic UnregUser{..} = do+  let details = (,,,) <$> unregUserName+                      <*> unregUserNick+                      <*> unregUserUser+                      <*> unregUserPass+  case details of+    Nothing -> return (False,Nothing)+    Just (name,nick,user,pass) -> do+      (keystr,passwords) <- asks readAuth+      let authentic = authenticate keystr passwords (userText user) pass+      return (authentic,Just (name,user,nick))++--------------------------------------------------------------------------------+-- * Nicknames++-- | Read a valid nick.+readNick :: Text -> Maybe Nick+readNick n | validNick n = Just $ NickName (mk n)+           | otherwise   = Nothing++-- | Modify the nicks mapping.+modifyNicks :: (Map Nick Ref -> Map Nick Ref) -> Hulk ()+modifyNicks f = modify $ \env -> env { stateNicks = f (stateNicks env) }++-- | With a valid nickname, perform an action.+withValidNick :: Text -> (Nick -> Hulk ()) -> Hulk ()+withValidNick nick m+    | validNick nick = m (NickName (mk nick))+    | otherwise      = errorReply $ "Invalid nick format: " <> nick++-- | Perform an action if a nickname is unique, otherwise send error.+ifUniqueNick :: Nick -> Hulk () -> Maybe ((Text -> Hulk ()) -> Hulk ()) -> Hulk ()+ifUniqueNick nick then_m else_m = do+  clients <- gets stateClients+  client <- (M.lookup nick >=> (`M.lookup` clients)) <$> gets stateNicks+  case client of+    Nothing -> then_m+    Just{}  -> do+      case else_m of+        Just else_m' -> else_m' error_reply+        Nothing -> error_reply ""++  where error_reply x = thisServerReply ERR_NICKNAMEINUSE+                                      [nickText nick,"Nick is already in use." <> x]+++-- | Is a nickname valid? Digit/letter or one of these: -_/\\;()[]{}?`'+validNick :: Text -> Bool+validNick s = T.all ok s && T.length s > 0 where+  ok c = isDigit c || isLetter c || elem c "-_/\\;()[]{}?`'"++-- | If the given nick is not my nick name, ….+ifNotMyNick :: Nick -> Hulk () -> Hulk ()+ifNotMyNick nick m = do+  user <- getUser+  case user of+    Registered RegUser{..}     | regUserNick /= nick -> m+    Unregistered UnregUser{..} | unregUserNick /= Just nick -> m+    _ -> return ()++--------------------------------------------------------------------------------+-- * Channels++-- | Valid channel name?+validChannel :: Text -> Bool+validChannel (T.uncons -> Just ('#',cs)) = T.all ok cs && T.length cs > 0 where+  ok c = isDigit c || isLetter c || elem c "-_/\\;()[]{}?`'"+validChannel _ = False++-- | Remove a user from a channel.+removeFromChan :: ChannelName -> Hulk ()+removeFromChan name = do+  ref <- getRef+  let remMe c = c { channelUsers = S.delete ref (channelUsers c) }+  modifyChannels $ M.adjust remMe name++-- | Get channels that the current client is in.+myChannels :: Hulk [Channel]+myChannels = do+  ref <- getRef+  filter (S.member ref . channelUsers) . map snd . M.toList <$> gets stateChannels++-- | Join a channel.+joinChannel :: ChannelName -> Hulk ()+joinChannel name = do+  ref <- getRef+  let addMe c = c { channelUsers = S.insert ref (channelUsers c) }+  modifyChannels $ M.adjust addMe name+  channelReply name RPL_JOIN [channelNameText name] IncludeMe+  sendNamesList name+  withChannel name $ \Channel{..} -> do+    case channelTopic of+      Just topic -> thisServerReply RPL_TOPIC [channelNameText name,topic]+      Nothing -> return ()++-- | Send the names list of a channel.+sendNamesList :: ChannelName -> Hulk ()+sendNamesList name = do+  asRegistered $+    withChannel name $ \Channel{..} -> do+      clients <- catMaybes <$> mapM getClientByRef (S.toList channelUsers)+      let nicks = map regUserNick . catMaybes . map clientRegUser $ clients+      forM_ (chunksOf 10 nicks) $ \nicks' ->+        thisNickServerReply RPL_NAMEREPLY ["@",channelNameText name+                                          ,T.unwords $ map nickText nicks']+      thisNickServerReply RPL_ENDOFNAMES [channelNameText name+                                         ,"End of /NAMES list."]++-- | Am I in a channel?+inChannel :: ChannelName -> Hulk Bool+inChannel name = do+  chan <- M.lookup name <$> gets stateChannels+  case chan of+    Nothing -> return False+    Just Channel{..} -> (`S.member` channelUsers) <$> getRef++-- | Insert a new channel.+insertChannel :: ChannelName -> Hulk ()+insertChannel name = modifyChannels $ M.insert name newChan where+  newChan = Channel { channelName  = name+                    , channelTopic = Nothing+                    , channelUsers = S.empty+                    }++-- | Modify the channel map.+modifyChannels :: (Map ChannelName Channel -> Map ChannelName Channel)+               -> Hulk ()+modifyChannels f = modify $ \e -> e { stateChannels = f (stateChannels e) }++withValidChanName :: Text -> (ChannelName -> Hulk ())+                  -> Hulk ()+withValidChanName name m+    | validChannel name = m $ ChannelName (mk name)+    | otherwise         = errorReply $ "Invalid channel name: " <> name++-- | Perform an action with an existing channel, sends error if not exists.+withChannel :: ChannelName -> (Channel -> Hulk ()) -> Hulk ()+withChannel name m = do+  chan <- M.lookup name <$> gets stateChannels+  case chan of+    Nothing -> thisServerReply ERR_NOSUCHCHANNEL [channelNameText name+                                                 ,"No such channel."]+    Just chan' -> m chan'++-- | Send a client reply to everyone in a channel.+channelReply :: ChannelName -> RPL -> [Text]+             -> ChannelReplyType+             -> Hulk ()+channelReply name cmd params typ = do+  withChannel name $ \Channel{..} -> do+    ref <- getRef+    forM_ (S.toList channelUsers) $ \theirRef -> do+      unless (typ == ExcludeMe && ref == theirRef) $+        clientReply theirRef cmd params++--------------------------------------------------------------------------------+-- * Client replies++-- | Send a client reply to the current client.+thisClientReply :: RPL -> [Text] -> Hulk ()+thisClientReply typ params = do+  ref <- getRef+  clientReply ref typ params++-- | Send a client reply of the given type with the given params, on+-- the given connection reference.+clientReply :: Ref -> RPL -> [Text] -> Hulk ()+clientReply ref typ params = do+  withRegistered $ \user -> do+    client <- getClient+    msg <- newClientMsg client user typ params+    reply ref msg++-- | Make a new IRC message from the current client.+newClientMsg :: Client -> RegUser -> RPL -> [Text]+             -> Hulk Message+newClientMsg Client{..} RegUser{..} cmd ps = do+  return (Message (Just (User (encodeUtf8 (nickText regUserNick))+                              (encodeUtf8 (userText regUserUser))+                              (encodeUtf8 clientHostname)))+                  (makeCommand cmd ps))++--------------------------------------------------------------------------------+-- * Server replies++-- | Send the welcome message.+sendWelcome :: Hulk ()+sendWelcome = do+  withRegistered $ \RegUser{..} -> do+    thisNickServerReply RPL_WELCOME ["Welcome."]++-- | Send the MOTD.+sendMotd :: Hulk ()+sendMotd = do+  asRegistered $ do+    thisNickServerReply RPL_MOTDSTART ["MOTD"]+    motd <- fmap (fmap T.lines) (asks readMotd)+    let motdLine line = thisNickServerReply RPL_MOTD [line]+    case motd of+      Nothing -> motdLine "None."+      Just lines' -> mapM_ motdLine lines'+    thisNickServerReply RPL_ENDOFMOTD ["/MOTD."]++-- | Send events that the user missed.+sendEvents :: Hulk ()+sendEvents = do+  chans <- configLogChans <$> asks readConfig+  unless (null chans) $ do+    withRegistered $ \RegUser{regUserUser=user} -> do+      ref <- getRef+      forM_ chans handleJoin+      tell [SendEvents ref user]++--------------------------------------------------------------------------------+-- * Output functions++-- | Send a message reply.+notice :: Text -> Hulk ()+notice msg = thisServerReply RPL_NOTICE ["*",msg]++thisNickServerReply :: RPL -> [Text] -> Hulk ()+thisNickServerReply typ params = do+  withRegistered $ \RegUser{regUserNick=nick} ->+    thisServerReply typ (nickText nick : params)++-- | Send a server reply of the given type with the given params.+thisServerReply :: RPL -> [Text] -> Hulk ()+thisServerReply typ params = do+  ref <- getRef+  serverReply ref typ params++-- | Send a server reply of the given type with the given params.+serverReply :: Ref -> RPL -> [Text] -> Hulk ()+serverReply ref typ params = do+  msg <- newServerMsg typ params+  reply ref msg++-- | Make a new IRC message from the server.+newServerMsg :: RPL -> [Text] -> Hulk Message+newServerMsg cmd ps = do+  hostname <- asks (connServerName.readConn)+  return (Message (Just (Nick (encodeUtf8 hostname)))+                  (makeCommand cmd ps))++-- | Send a cmd reply of the given type with the given params.+thisCmdReply :: RPL -> [Text] -> Hulk ()+thisCmdReply typ params = do+  ref <- getRef+  cmdReply ref typ params++-- | Send a cmd reply of the given type with the given params.+cmdReply :: Ref -> RPL -> [Text] -> Hulk ()+cmdReply ref typ params = do+  let msg = newCmdMsg typ params+  reply ref msg++-- | Send an error reply.+errorReply :: Text -> Hulk ()+errorReply m = do+  notice $ "ERROR: " <> m+  log $ "ERROR: " <> m++-- | Send a message reply.+reply :: Ref -> Message -> Hulk ()+reply ref msg = do+  outgoing msg+  tell . return $ MessageReply ref msg++-- | Log an incoming line.+incoming :: Command -> Hulk ()+incoming = log . ("<- " <>) . decodeUtf8 . IRC.showCommand++-- | Log an outgoing line.+outgoing :: Message -> Hulk ()+outgoing msg = do+  ref <- getRef+  tell [outgoingWriter ref msg]++-- | Log a line.+log :: Text -> Hulk ()+log line = do+  ref <- getRef+  tell . return . LogReply $ pack (show (unRef ref)) <> ": " <> line++-- | Make a writer reply.+outgoingWriter :: Ref -> Message -> HulkWriter+outgoingWriter ref =+  LogReply .+  (pack (show (unRef ref)) <>) .+  (": -> " <>) .+  decodeUtf8 .+  IRC.showMessage++historyLog :: RPL -> [Text] -> Hulk ()+historyLog rpl params = do+  chans <- asks (configLogChans . readConfig)+  unless (null chans) $ do+    withRegistered $ \RegUser{regUserUser=name} -> do+      let send = tell [SaveLog (userText name) rpl params]+      case (rpl,params) of+        (RPL_PRIVMSG,[chan])+          | chan `elem` chans -> send+          | otherwise         -> return ()+        _                     -> send++--------------------------------------------------------------------------------+-- * Command Construction++-- | Make a command.+makeCommand :: RPL -> [Text] -> Command+makeCommand rpl xs = fromRPL rpl (map encodeUtf8 xs)++-- | Convert from a reply to an appropriate protocol format.+fromRPL :: RPL -> ([CommandArg] -> Command)+fromRPL RPL_NICK          = StringCmd "NICK"+fromRPL RPL_PONG          = StringCmd "PONG"+fromRPL RPL_QUIT          = StringCmd "QUIT"+fromRPL RPL_JOIN          = StringCmd "JOIN"+fromRPL RPL_NOTICE        = StringCmd "NOTICE"+fromRPL RPL_PART          = StringCmd "PART"+fromRPL RPL_PRIVMSG       = StringCmd "PRIVMSG"+fromRPL RPL_JOINS         = StringCmd "JOIN"+fromRPL RPL_TOPIC         = StringCmd "TOPIC"+fromRPL RPL_PING          = StringCmd "PING"+fromRPL RPL_WHOISUSER     = NumericCmd 311+fromRPL RPL_ISON          = NumericCmd 303+fromRPL RPL_NAMEREPLY     = NumericCmd 353+fromRPL RPL_ENDOFNAMES    = NumericCmd 366+fromRPL RPL_WELCOME       = NumericCmd 001+fromRPL RPL_MOTDSTART     = NumericCmd 375+fromRPL RPL_MOTD          = NumericCmd 372+fromRPL RPL_ENDOFMOTD     = NumericCmd 376+fromRPL RPL_WHOISIDLE     = NumericCmd 317+fromRPL RPL_WHOISCHANNELS = NumericCmd 319+fromRPL RPL_ENDOFWHOIS    = NumericCmd 318+fromRPL ERR_NICKNAMEINUSE = NumericCmd 433+fromRPL ERR_NOSUCHNICK    = NumericCmd 401+fromRPL ERR_NOSUCHCHANNEL = NumericCmd 403++-- | Make a new IRC message from the cmd.+newCmdMsg :: RPL -> [Text] -> Message+newCmdMsg cmd ps = Message Nothing (makeCommand cmd ps)

@@ -1,18 +0,0 @@-module Hulk.Concurrent where--import Control.Concurrent-import Control.Monad.Reader-import Control.Monad.IO--import Hulk.Types--fork :: Hulk a -> Hulk ThreadId-fork m = do-  env <- ask-  io $ forkIO $ do _ <- runReaderT (runHulk m) env-                   return ()--withVar :: MVar a -> (a -> Hulk b) -> Hulk b-withVar var m = do-  env <- ask-  io $ withMVar var $ \var -> runReaderT (runHulk (m var)) env

@@ -1,13 +1,15 @@-{-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing #-}+-- | Configuration parser for the server.+ module Hulk.Config     (Config(..)     ,getConfig)     where +import Hulk.Types+ import Data.Word import Data.ConfigFile--import Hulk.Types+import Data.Text (pack)  getConfig :: FilePath -> IO Config getConfig conf = do@@ -20,13 +22,20 @@         preface <- get c "STRINGS" "preface_file"         passwd <- get c "AUTH" "passwd_file"         key <- get c "AUTH" "passwd_key"-        return Config { configListen = fromIntegral (listen::Word16)-                      , configMotd = Just motd -                      , configHostname = hostname-                      , configPasswd = passwd-                      , configPasswdKey = key-                      , configPreface = Just preface-                      }+        users <- get c "USERS" "data_dir"+        logs <- get c "LOGS" "event_log"+        chans <- fmap words $ get c "LOGS" "channels"+        return Config+          { configListen    = fromIntegral (listen::Word16)+          , configMotd      = Just motd+          , configHostname  = pack hostname+          , configPasswd    = passwd+          , configPasswdKey = key+          , configPreface   = Just preface+          , configUserData  = users+          , configLogFile   = logs+          , configLogChans  = map pack chans+          }   case config of-    Left cperr -> error $ show cperr-    Right config -> return config+    Left cperr   -> error $ show cperr+    Right config' -> return config'

@@ -1,9 +0,0 @@-module Hulk.Event where--import Hulk.Types--readEventType :: String -> Event-readEventType str = -  case reads str of-    [(a,"")] -> a-    _        -> NOTHING

@@ -1,49 +0,0 @@-module Hulk.Log -    (doing-    ,tell-    ,performing-    ,incoming-    ,outgoing-    ,note)-    where--import Control.Monad.Reader-import Control.Concurrent-import System.IO-import Control.Monad.IO-import qualified System.IO.UTF8 as UTF8--import Hulk.Types-import Hulk.Config--instance Loggable Hulk where-  tell str = do-    h <- asks envTellHandle-    col <- (*2) `fmap` asks envLogColumn-    io $ withMVar h $ \h -> hPutStrLn h $ replicate col ' ' ++ str--instance Loggable IRC where-  tell str = liftHulk $ tell str--performing :: String -> Hulk a -> Hulk a-performing str m = do -  doing str-  v <- indent  m-  tell "Done."-  return v--doing :: String -> Hulk ()-doing str = tell $ str ++ " ..."--indent :: Hulk a -> Hulk a-indent = local inc where-  inc env = env { envLogColumn = envLogColumn env + 1 }--incoming :: String -> IRC ()-incoming str = tell $ "<- " ++ str--outgoing :: String -> IRC ()-outgoing str = tell $ "-> " ++ str--note :: String -> IRC ()-note str = tell $ "Notice: " ++ str

@@ -1,23 +0,0 @@-{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-orphans #-}-module Hulk.Providers where--import Control.Applicative-import Control.Monad.Reader--import Hulk.Types--instance MonadProvider HulkIO where-  providePreface = maybeReadFile configPreface-  provideMotd = maybeReadFile configMotd-  provideKey = mustReadFile configPasswdKey-  providePasswords = mustReadFile configPasswd--maybeReadFile :: (Config -> Maybe FilePath) -> HulkIO (Maybe String)-maybeReadFile get = do -  path <- asks get-  case path of-    Nothing -> return Nothing-    Just path -> Just <$> liftIO (readFile path)--mustReadFile :: (Config -> FilePath) -> HulkIO String-mustReadFile get = asks get >>= liftIO . readFile

@@ -1,92 +1,183 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}-module Hulk.Server (start) where+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-} +module Hulk.Server where++import           Hulk.Client                (handleCommand, makeCommand,+                                             outgoingWriter)+import           Hulk.Types+ import           Control.Applicative import           Control.Concurrent import           Control.Concurrent.Delay+import           Control.Exception          (IOException, try) import           Control.Monad import           Control.Monad.Fix-import           Control.Monad.Reader-import qualified Data.Map                 as M+import           Data.Aeson+import qualified Data.ByteString.Char8      as S8+import qualified Data.ByteString.Lazy       as L+import qualified Data.ByteString.Lazy.Char8 as L8+import           Data.CaseInsensitive+import           Data.Char+import qualified Data.Map                   as M+import           Data.Maybe+import           Data.Monoid+import           Data.Text                  (Text, pack, unpack)+import qualified Data.Text                  as T+import           Data.Text.Encoding         (encodeUtf8)+import qualified Data.Text.IO               as T import           Data.Time import           Network-import           Network.IRC+import           Network.FastIRC            hiding (UserName)+import qualified Network.FastIRC.IO         as IRC+import           Prelude                    hiding (catch)+import           System.Directory+import           System.FilePath import           System.IO-import           System.IO.UTF8           as UTF8 -import           Hulk.Client-import           Hulk.Providers           ()-import           Hulk.Types- -- | Start an IRC server with the given configuration. start :: Config -> IO () start config = withSocketsDo $ do   hSetBuffering stdout LineBuffering   listenSock <- listenOn $ PortNumber (configListen config)-  envar <- newMVar Env { envClients = M.empty-                       , envNicks = M.empty-                       , envChannels = M.empty }+  statevar <- newMVar HulkState { stateClients  = M.empty+                                , stateNicks    = M.empty+                                , stateChannels = M.empty }+  lvar <- newMVar ()   forever $ do     (handle,host,_port) <- accept listenSock     hSetBuffering handle NoBuffering     now <- getCurrentTime-    let conn = Conn { connRef = newRef handle-                    , connHostname = host+    let conn = Conn { connRef = mkRef handle+                    , connHostname = pack host                     , connServerName = configHostname config                     , connTime = now                     }-    _ <- forkIO $ handleClient config handle envar conn-    return ()+    auth <- getAuth config+    void $ forkIO $ handleClient lvar config handle statevar auth conn  -- | Handle a client connection.-handleClient :: Config -> Handle -> MVar Env -> Conn -> IO ()-handleClient config handle env conn = do-  let runHandle = runClientHandler config env handle conn-      runLine x y = runHandle $ makeLine x y-  pinger <- forkIO $ forever $ do delayMinutes 2; runLine PINGPONG []-  fix $ \loop -> do-    line <- catch (Right <$> UTF8.hGetLine handle)-                  (\e -> do killThread pinger-                            return $ Left e)-    case filter (not.newline) <$> line of-      Right []   -> loop-      Right line -> do runHandle (line++"\r"); loop-      Left _err  -> runLine DISCONNECT ["Connection lost."]+handleClient :: MVar () -> Config -> Handle -> MVar HulkState -> (String,String) -> Conn -> IO ()+handleClient lvar config handle env auth conn = do+  messages <- newChan+  let writeMsg cmd =+        writeChan messages (Message Nothing (StringCmd cmd [])) -  where newline c = c=='\n' || c=='\r'+  pinger <- forkIO $ forever $ do+    delayMinutes 2+    writeMsg "PINGPONG" --- | Make an internal IRC event to give to the client handler.-makeLine :: Event -> [String] -> String-makeLine event params = (++"\r") $ encode $-  Message { msg_prefix = Nothing-          , msg_command = show event-          , msg_params = params }+  void $ forkIO $ fix $ \loop -> do+    eline <- try (S8.hGetLine handle)+    case eline of+      Left (_::IOException) -> do killThread pinger+                                  writeMsg "DISCONNECT"+      Right line ->+        case readMessage line of+          Just msg -> do writeChan messages msg+                         loop+          Nothing -> loop --- | Handle a received line from the client.-runClientHandler :: Config -> MVar Env -> Handle -> Conn -> String -> IO ()-runClientHandler config env handle conn line = do+  fix $ \loop -> do+     msg <- readChan messages+     runClientHandler lvar config env handle conn auth msg+     case msg of+       Message  _  (StringCmd "DISCONNECT" _) -> return ()+       _ -> loop++-- | Handle a received message from the client.+runClientHandler :: MVar () -> Config -> MVar HulkState -> Handle -> Conn -> (String,String) -> Message -> IO ()+runClientHandler lvar config mstate handle conn auth msg = do   now <- getCurrentTime-  modifyMVar_ env $ \env -> do-    (replies,env) <- runReaderT (runHulkIO $ handleLine env now conn line)-                                config-    mapM_ (handleReplies handle) replies-    return env+  instructions <- modifyMVar mstate $ \state -> return $+    let ((),newstate,instructions) = handleCommand config state now conn auth (msgCommand msg)+    in (newstate,instructions)+  forM_ instructions $ handleWriter lvar config handle --- | Act on replies from the client.-handleReplies :: Handle -> Reply -> IO ()-handleReplies handle reply = do-  case reply of+-- | Act on writer from the client.+handleWriter :: MVar () -> Config -> Handle -> HulkWriter -> IO ()+handleWriter lvar config@Config{..} handle writer = do+  case writer of+    SaveLog name rpl params -> saveToLog lvar config name rpl params     MessageReply ref msg -> sendMessage ref msg     LogReply line -> logLine line     Close -> hClose handle+    Bump (Ref h) -> hClose h+    UpdateUserData udata -> do+      L.writeFile (configUserData </> normalizeUser (unpack (userText (userDataUser udata))))+                  (encode udata)+    SendEvents ref user -> do+      writers <- sendEvents config ref user+      mapM_ (handleWriter lvar config handle) (concat writers)  -- | Send a message to a client. sendMessage :: Ref -> Message -> IO ()-sendMessage (Ref handle) msg = do-  catch (UTF8.hPutStrLn handle (encode msg ++ "\r"))-        (\_ -> hClose handle)+sendMessage (Ref handle) msg =+  void $ (try $ IRC.hPutMessage handle msg :: IO (Either IOException ()))  -- | Add a line to the log file.-logLine :: String -> IO ()-logLine = UTF8.putStrLn+logLine :: Text -> IO ()+logLine = T.putStrLn++-- | Normalize the username for a filename.+normalizeUser :: [Char] -> [Char]+normalizeUser = filter (\c -> isDigit c || isLetter c)++-- | Send events that the user missed.+sendEvents :: Config -> Ref -> UserName -> IO [[HulkWriter]]+sendEvents config ref user = do+  events <- getLog config+  UserData{userDataLastSeen=lastSeen} <- getUser config (userText user)+  let filtered = flip filter events $ \(time,_from,_typ,_params) ->+                  time >. lastSeen+  forM filtered $ \msg -> do+    case msg of+      (time,from',rpl@RPL_PRIVMSG,[name,msg'])+        | name == userText user || "#" `T.isPrefixOf` name -> do+        let from = T.filter (\c -> isDigit c || isLetter c) from'+            user' = User (encodeUtf8 from)+                         (encodeUtf8 from)+                         "offline"+            message = Message (Just user')+                              (makeCommand rpl+                                           [name,"[" <> pack (show time) <> "] " <> msg'])+        return [MessageReply ref message+               ,outgoing message]+      _ -> return []++  where x >. y = x `diffUTCTime` y > 0+        outgoing msg = outgoingWriter ref msg++-- | Get the log.+getLog :: FromJSON b => Config -> IO [b]+getLog Config{..} = do+  contents <- L.readFile configLogFile+  return $ mapMaybe decode $ L8.lines contents++-- | Get the user data.+getUser :: Config -> Text -> IO UserData+getUser Config{..} name = do+  let fname = configUserData </> normalizeUser (unpack name)+  now <- getCurrentTime+  exists <- doesFileExist fname+  if exists+     then do contents <- L.readFile fname+             case decode contents of+               Just u -> return u+               Nothing -> error ("unable to parse user file: " ++ fname)+     else return $ UserData (UserName (mk name)) now++-- | Get authorization info.+getAuth :: Config -> IO (String,String)+getAuth Config{..} =+  (,) <$> readFile configPasswdKey+      <*> readFile configPasswd++-- | Save the message to the log.+saveToLog :: MVar () -> Config -> Text -> RPL -> [Text] -> IO ()+saveToLog lvar Config{..} name rpl params = do+  now <- getCurrentTime+  withMVar lvar $ const $+    L.appendFile configLogFile $+      encode ((now,name,rpl,params)) <> "\n"

@@ -1,186 +1,275 @@-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Hulk.Types where+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-} -import Control.Monad.Identity-import Control.Monad.Reader-import Control.Monad.State-import Control.Monad.Writer-import Data.Char-import Data.Function+module Hulk.Types+  (Config (..)+  ,Nick (..) -- FIXME:+  ,nickText+  ,UserName (..) -- FIXME:+  ,userText+  ,ChannelName (..) -- FIXME:+  ,channelNameText+  ,Channel (..)+  ,Client (..)+  ,User (..)+  ,UnregUser (..)+  ,RegUser (..)+  ,Ref (..)+  ,mkRef+  ,UserData (..)+  ,Conn (..)+  ,Event (..)+  ,RPL (..)+  ,QuitType (..)+  ,ChannelReplyType (..)+  ,Hulk+  ,runHulk+  ,HulkReader(..)+  ,HulkWriter(..)+  ,HulkState(..))+  where++import Control.Applicative+import Control.Monad.RWS+import Data.Aeson+import Data.CaseInsensitive import Data.Map               (Map)+import Data.Set               (Set)+import Data.Text              (Text) import Data.Time+import GHC.Generics import Network-import Network.IRC            hiding (Channel)+import Network.FastIRC        (Message) import System.IO -data Config = Config {-      configListen :: PortNumber-    , configHostname :: String-    , configMotd :: Maybe FilePath-    , configPreface :: Maybe FilePath-    , configPasswd :: FilePath-    , configPasswdKey :: FilePath-    } deriving (Show)+--------------------------------------------------------------------------------+-- Configuration -newtype Ref = Ref { unRef :: Handle } -    deriving (Show,Eq)+-- | Server configuration.+data Config = Config+  { configListen    :: !PortNumber+  , configHostname  :: !Text+  , configMotd      :: !(Maybe FilePath)+  , configPreface   :: !(Maybe FilePath)+  , configPasswd    :: !FilePath+  , configPasswdKey :: !FilePath+  , configUserData  :: !FilePath+  , configLogFile   :: !FilePath+  , configLogChans  :: ![Text]+  } deriving (Show) -instance Ord Ref where-  compare = on compare show+--------------------------------------------------------------------------------+-- Fundamental IRC data types --- | Construct a Ref value.-newRef :: Handle -> Ref-newRef = Ref+-- | A case-insensitive nickname.+newtype Nick = NickName (CI Text)+  deriving (Show,Eq,Ord) -data Error = Error String+-- | Extract the text of a nickname for use in output.+nickText :: Nick -> Text+nickText (NickName ci) = original ci -data Env = Env {-   envClients :: Map Ref Client-  ,envNicks :: Map Nick Ref-  ,envChannels :: Map ChannelName Channel-}+-- | A case-insensitive username.+newtype UserName = UserName (CI Text)+  deriving (Show,Eq,Ord,Generic) -newtype Nick = Nick { unNick :: String } deriving Show+instance ToJSON UserName where+  toJSON (UserName ci) = toJSON (original ci)+instance FromJSON UserName where+  parseJSON = fmap (UserName . mk) . parseJSON -instance Ord Nick where-  compare = on compare (map toLower . unNick)-instance Eq Nick where-  (==) = on (==) (map toLower . unNick)+-- | Extract the text of a username for use in output.+userText :: UserName -> Text+userText (UserName ci) = original ci -newtype ChannelName = ChannelName { unChanName :: String } deriving Show-  -instance Ord ChannelName where-  compare = on compare (map toLower . unChanName)-instance Eq ChannelName where-  (==) = on (==) (map toLower . unChanName)+-- | A case-insensitive channel name.+newtype ChannelName = ChannelName (CI Text)+  deriving (Show,Eq,Ord) -data Channel = Channel {-      channelName :: ChannelName-    , channelTopic :: Maybe String-    , channelUsers :: [Ref]-} deriving Show+-- | Extract the text of a channelname for use in output.+channelNameText :: ChannelName -> Text+channelNameText (ChannelName ci) = original ci -data User = Unregistered UnregUser | Registered RegUser+--------------------------------------------------------------------------------+-- Server state types++-- | A channel.+data Channel = Channel+  { channelName  :: !ChannelName+  , channelTopic :: !(Maybe Text)+  , channelUsers :: !(Set Ref)+  } deriving (Show)++--------------------------------------------------------------------------------+-- Client data types++-- | A connected client.+data Client = Client+  { clientRef      :: !Ref+  , clientUser     :: !User+  , clientHostname :: !Text+  , clientLastPong :: !UTCTime+  } deriving (Show)++-- | Some user, either unregistered or registered.+data User+  = Unregistered UnregUser+  | Registered RegUser   deriving Show -data UnregUser = UnregUser {-   unregUserName :: Maybe String-  ,unregUserNick :: Maybe Nick-  ,unregUserUser :: Maybe String-  ,unregUserPass :: Maybe String-} deriving Show+-- | An unregistered user.+data UnregUser = UnregUser+  { unregUserName :: !(Maybe Text)+  , unregUserNick :: !(Maybe Nick)+  , unregUserUser :: !(Maybe UserName)+  , unregUserPass :: !(Maybe Text)+  } deriving (Show) -data RegUser = RegUser {-   regUserName :: String-  ,regUserNick :: Nick-  ,regUserUser :: String-  ,regUserPass :: String-} deriving Show+-- | A registered user.+data RegUser = RegUser+  { regUserName :: !Text+  , regUserNick :: !Nick+  , regUserUser :: !UserName+  , regUserPass :: !Text+  } deriving (Show) -data Client = Client {-      clientRef      :: Ref-    , clientUser     :: User-    , clientHostname :: String-    , clientLastPong :: UTCTime-    } deriving Show+-- | A reference for a client.+newtype Ref = Ref { unRef :: Handle }+  deriving (Show,Eq) -data Conn = Conn {-   connRef        :: Ref-  ,connHostname   :: String-  ,connServerName :: String-  ,connTime       :: UTCTime-} deriving Show+-- | Make a ref.+mkRef :: Handle -> Ref+mkRef = Ref -data Reply = MessageReply Ref Message | LogReply String | Close+-- | Use for refs in maps.+instance Ord Ref where+  compare x y = if x == y then EQ else LT -newtype IRC m a = IRC { -    runIRC :: ReaderT (UTCTime,Conn) (WriterT [Reply] (StateT Env m)) a-  }-  deriving (Monad-           ,Functor-           ,MonadWriter [Reply]-           ,MonadState Env-           ,MonadReader (UTCTime,Conn))+-- | Data saved about a user for later actions like log recall.+data UserData = UserData+   { userDataUser     :: !UserName+   , userDataLastSeen :: !UTCTime+   } deriving (Show,Generic) -data Event = PASS | USER | NICK | PING | QUIT | TELL | JOIN | PART | PRIVMSG-           | NOTICE | ISON | WHOIS | TOPIC | CONNECT | DISCONNECT | PINGPONG-           | PONG-           | NOTHING-  deriving (Read,Show)+instance ToJSON UserData+instance FromJSON UserData +--------------------------------------------------------------------------------+-- Client handling types -data RPL = RPL_WHOISUSER-         | RPL_NICK-         | RPL_PONG-         | RPL_JOIN-         | RPL_QUIT-         | RPL_NOTICE-         | RPL_PART-         | RPL_PRIVMSG-         | RPL_ISON-         | RPL_JOINS-         | RPL_TOPIC-         | RPL_NAMEREPLY-         | RPL_ENDOFNAMES-         | ERR_NICKNAMEINUSE-         | RPL_WELCOME-         | RPL_MOTDSTART-         | RPL_MOTD-         | RPL_ENDOFMOTD-         | RPL_WHOISIDLE-         | RPL_ENDOFWHOIS-         | RPL_WHOISCHANNELS-         | ERR_NOSUCHNICK-         | ERR_NOSUCHCHANNEL-         | RPL_PING-  deriving Show+-- | The Hulk client monad.+newtype Hulk a = Hulk { runHulk :: RWS HulkReader [HulkWriter] HulkState a }+  deriving (Monad,+            Functor,+            Applicative,+            MonadReader HulkReader,+            MonadWriter [HulkWriter],+            MonadState HulkState) -fromRPL :: RPL -> String-fromRPL RPL_WHOISUSER     = "311"-fromRPL RPL_NICK          = "NICK"-fromRPL RPL_PONG          = "PONG"-fromRPL RPL_QUIT          = "QUIT"-fromRPL RPL_JOIN          = "JOIN"-fromRPL RPL_NOTICE        = "NOTICE"-fromRPL RPL_PART          = "PART"-fromRPL RPL_PRIVMSG       = "PRIVMSG"-fromRPL RPL_ISON          = "303"-fromRPL RPL_JOINS         = "JOIN"-fromRPL RPL_TOPIC         = "TOPIC"-fromRPL RPL_NAMEREPLY     = "353"-fromRPL RPL_ENDOFNAMES    = "366"-fromRPL RPL_WELCOME       = "001"-fromRPL RPL_MOTDSTART     = "375"-fromRPL RPL_MOTD          = "372"-fromRPL RPL_ENDOFMOTD     = "376"-fromRPL RPL_WHOISIDLE     = "317"-fromRPL RPL_WHOISCHANNELS = "319"-fromRPL RPL_ENDOFWHOIS    = "318"-fromRPL ERR_NICKNAMEINUSE = "433"-fromRPL ERR_NOSUCHNICK    = "401"-fromRPL ERR_NOSUCHCHANNEL = "403"-fromRPL RPL_PING          = "PING"+-- | Configuration/environment information for running the client+-- handler.+data HulkReader = HulkReader+  { readTime   :: !UTCTime+  , readConn   :: !Conn+  , readConfig :: !Config+  , readMotd   :: !(Maybe Text)+  , readAuth   :: (String,String)+  } deriving (Show) -data QuitType = RequestedQuit | SocketQuit deriving Eq+-- | State of the whole server, which the client handles.+data HulkState = HulkState+  { stateClients  :: !(Map Ref Client)+  , stateNicks    :: !(Map Nick Ref)+  , stateChannels :: !(Map ChannelName Channel)+  } deriving (Show) -data ChannelReplyType = IncludeMe | ExcludeMe deriving Eq+-- | Replies are generated by the client after some messages.+data HulkWriter+  = MessageReply !Ref !Message+  | LogReply !Text+  | Close+  | Bump !Ref+  | UpdateUserData !UserData+  | SaveLog !Text !RPL ![Text]+  | SendEvents !Ref !UserName+  deriving (Show) -class Monad m => MonadProvider m where-  providePreface   :: m (Maybe String)-  provideMotd      :: m (Maybe String)-  provideKey       :: m String-  providePasswords :: m String+-- | Used when handling a line from a client.+data Conn = Conn+  { connRef        :: !Ref+  , connHostname   :: !Text+  , connServerName :: !Text+  , connTime       :: !UTCTime+  } deriving (Show) -newtype HulkIO a = HulkIO { runHulkIO :: ReaderT Config IO a }- deriving (Monad,MonadReader Config,Functor,MonadIO)+-- | An incoming client message.+data Event+  = PASS+  | USER+  | NICK+  | PING+  | QUIT+  | TELL+  | JOIN+  | PART+  | PRIVMSG+  | NOTICE+  | ISON+  | WHOIS+  | TOPIC+  | CONNECT+  | DISCONNECT+  | PINGPONG+  | PONG+  | NAMES+  | NOTHING+  deriving (Show,Read) -newtype HulkP a = HulkP { runHulkPure :: Identity a }- deriving (Monad)+-- | An outgoing server reply.+data RPL+  = RPL_WHOISUSER+  | RPL_NICK+  | RPL_PONG+  | RPL_JOIN+  | RPL_QUIT+  | RPL_NOTICE+  | RPL_PART+  | RPL_PRIVMSG+  | RPL_ISON+  | RPL_JOINS+  | RPL_TOPIC+  | RPL_NAMEREPLY+  | RPL_ENDOFNAMES+  | ERR_NICKNAMEINUSE+  | RPL_WELCOME+  | RPL_MOTDSTART+  | RPL_MOTD+  | RPL_ENDOFMOTD+  | RPL_WHOISIDLE+  | RPL_ENDOFWHOIS+  | RPL_WHOISCHANNELS+  | ERR_NOSUCHNICK+  | ERR_NOSUCHCHANNEL+  | RPL_PING+  deriving (Show,Generic) -instance MonadTrans IRC where-  lift m = do-    s <- get-    IRC $ ReaderT $ \_ -> WriterT $ StateT $ \_ -> do-      a <- m-      return ((a,[]),s)+instance ToJSON RPL+instance FromJSON RPL++-- | When quitting it can either be due to user request, ping timeout,+-- or the socket was closed.+data QuitType+  = RequestedQuit+  | SocketQuit+  deriving (Show,Eq)++-- | When sending a channel reply, it can either include the current+-- client or exclude them (e.g. when the client sends a message, it's+-- no use echoing it back to that user).+data ChannelReplyType+  = IncludeMe+  | ExcludeMe+  deriving (Show,Eq)

@@ -1,7 +0,0 @@-Hello and welcome to this IRC server. I am your host, Dr. Bruce Banner-PhD in nuclear physics and HRRRRRNNNNNNNNNNNNGGGGGGGGGGGGGGGGGGGGGGGGG-HRRRRRNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN-NNRUN FOR YOUR LIFENNNNNNNNNNNNNNNNNNNNNNNNNGGGGGGGGNNNNNNNNNNNNNNNNNN-NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN-GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG-GG..

@@ -1,14 +0,0 @@-You must login with a username and password. If you have not already-created one, you should do so by generating one and adding it to the-Hulk passwd file in passwd. To generate a user/password-key/pair, use:-- $ genpass myusername--It will prompt for a password. Inspect it first to confirm it is-correct. To write it to the passwd file use-- $ genpass myusername >> /path/to/hulk/data/passwd--And configure your IRC client to use your username and to send a-*server* password.