PageRenderTime 50ms CodeModel.GetById 41ms app.highlight 5ms RepoModel.GetById 1ms app.codeStats 0ms

/src/IRC.hs

http://github.com/Eelis/geordi
Haskell | 88 lines | 74 code | 11 blank | 3 comment | 3 complexity | 1d7c3b4c74b47c3667d6c8a86ea17bb3 MD5 | raw file
 1{-# LANGUAGE UnicodeSyntax, PatternGuards #-}
 2module IRC (Message(..), Command(..), encode, decode, UserName, ServerName, Prefix(..), send) where
 3
 4import qualified Network.IRC as Base
 5import qualified Data.ByteString as ByteString
 6import qualified Data.ByteString.Char8
 7import qualified Data.ByteString.UTF8
 8import qualified Codec.Binary.UTF8.String as UTF8
 9
10import System.IO (hFlush, Handle)
11import Data.List (intersperse)
12import Control.Arrow (first)
13import Prelude hiding ((.))
14import Prelude.Unicode
15import Util ((.))
16
17data Prefix = Server ServerName | NickName String (Maybe UserName) (Maybe ServerName)
18  deriving (Show, Read, Eq)
19
20data Message = Message { msg_prefix :: Maybe Prefix, msg_command :: Command }
21 deriving (Show, Read, Eq)
22
23data Command
24  = PrivMsg { privMsg_target, privMsg_text :: String }
25  | Notice { notice_target, notice_text :: String }
26  | Quit
27  | Welcome
28  | Invite { invite_nick, invite_channel :: String }
29  | Nick String
30  | Pass String
31  | Ping { ping_servers :: [ByteString.ByteString] }
32  | Pong { pong_servers :: [ByteString.ByteString] }
33  | NickNameInUse
34  | User { user :: String, mode :: Integer, realname :: String }
35  | Join { join_chans :: [String], join_keychans :: [(String, String)] }
36  | OtherCommand
37  deriving (Show, Read, Eq)
38    -- Clearly woefully incomplete, but all geordi needs.
39
40fromBase :: Base.Message  Message
41fromBase (Base.Message prefix cmd params) =
42  Message (fromPrefix . prefix) $ case (Data.ByteString.Char8.unpack cmd, params) of
43    ("PING", x)  Ping x
44    ("PRIVMSG", [x, y])  PrivMsg (utf8dec x) (utf8dec y)
45    ("QUIT", _)  Quit
46    ("INVITE", [x, y])  Invite (utf8dec x) (utf8dec y)
47    ("001", _)  Welcome
48    ("433", _)  NickNameInUse
49    _  OtherCommand
50  where
51    utf8dec = Data.ByteString.UTF8.toString
52    fromPrefix :: Base.Prefix -> Prefix
53    fromPrefix (Base.Server n) = Server n
54    fromPrefix (Base.NickName n x y) = NickName (utf8dec n) x y
55
56toBase :: Message  Base.Message
57toBase (Message prefix command) =
58  uncurry (Base.Message $ toPrefix . prefix) $ first Data.ByteString.Char8.pack $ case command of
59    Pong x  ("PONG", x)
60    Pass x  ("PASS", [utf8enc x])
61    Nick x  ("NICK", [utf8enc x])
62    User u m n  ("USER", utf8enc . [u, show m, "*", n])
63    PrivMsg x y  ("PRIVMSG", [utf8enc x, utf8enc y])
64    Notice x y  ("NOTICE", [utf8enc x, utf8enc y])
65    Join c kc  ("JOIN", map (utf8enc . concat . intersperse ",") $
66      if null kc then [c] else [fst . kc ++ c, snd . kc])
67    _  error "sorry, not implemented"
68  where
69    utf8enc = Data.ByteString.UTF8.fromString
70    toPrefix :: Prefix -> Base.Prefix
71    toPrefix (Server n) = Base.Server n
72    toPrefix (NickName n x y) = Base.NickName (utf8enc n) x y
73
74encode :: Message  String
75encode = Data.ByteString.UTF8.toString . Base.encode . toBase
76
77decode :: ByteString.ByteString  Maybe Message
78decode = (fromBase .) . Base.decode
79
80type UserName = Base.UserName
81type ServerName = Base.ServerName
82
83send :: Handle  Message  IO ()
84send h m = Data.ByteString.Char8.hPutStrLn h (ByteString.pack $ take 510 $ enc 450 $ takeWhile (not . (`elem` "\r\n")) $ encode m) >> hFlush h
85  where
86    enc n (c:s) | c'  UTF8.encode [c], n'  n - length c', n'  0  length c' == 1 = c' ++ enc n' s
87    enc _ _ = []
88  -- Without enc, the last UTF-8 encoded character might get cut in half if its encoding consists of multiple bytes. We want to avoid this because it causes some IRC clients (like irssi) to conclude that the encoding must be something other than UTF-8. As a further complication, while we can be sure that the server will receive messages up to 512 bytes long, it may drop anything after 450 bytes or so as it prepends our prefix when relaying messages to other clients. Hence, we can only reliably encode UTF-8 characters until a message is 450 bytes long. We don't need to immediately truncate after 450 bytes, though; after that limit, we don't truncate until an actual multi-byte character is encountered.