irc-core 2.5.0 → 2.6.0

raw patch · 5 files changed

+125/−48 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• irc-core.cabal +2/−2
• src/Irc/Codes.hs +4/−0
• src/Irc/Commands.hs +49/−18
• src/Irc/Message.hs +64/−28

@@ -1,5 +1,11 @@ # Revision history for irc-core +## 2.6.0++* Process CAP commands in library instead of client+* Add support for SASL EXTERNAL+* Add support for CHGHOST+ ## 2.5.0  * Add support for extended JOIN and ACCOUNT messages

@@ -1,5 +1,5 @@ name:                irc-core-version:             2.5.0+version:             2.6.0 synopsis:            IRC core library for glirc description:         IRC core library for glirc                      .@@ -32,7 +32,7 @@                        Irc.UserInfo   other-modules:       View -  build-depends:       base       >=4.11 && <4.12,+  build-depends:       base       >=4.11 && <4.13,                        base64-bytestring >= 1.0.0.1 && <1.1,                        attoparsec >=0.13 && <0.14,                        bytestring >=0.10 && <0.11,

@@ -57,6 +57,7 @@ pattern RPL_SAVENICK                = ReplyCode 043 pattern RPL_ATTEMPTINGJUNC          = ReplyCode 050 pattern RPL_ATTEMPTINGREROUTE       = ReplyCode 051+pattern RPL_REMOTESUPPORT           = ReplyCode 105 -- ircd-seven unnamed code pattern RPL_TRACELINK               = ReplyCode 200 pattern RPL_TRACECONNECTING         = ReplyCode 201 pattern RPL_TRACEHANDSHAKE          = ReplyCode 202@@ -402,6 +403,7 @@ pattern RPL_TESTMASK                = ReplyCode 724 pattern RPL_TESTLINE                = ReplyCode 725 pattern RPL_NOTESTLINE              = ReplyCode 726+pattern RPL_TESTMASKGECOS           = ReplyCode 727 pattern RPL_QUIETLIST               = ReplyCode 728 pattern RPL_ENDOFQUIETLIST          = ReplyCode 729 pattern RPL_MONONLINE               = ReplyCode 730@@ -484,6 +486,7 @@   , (RPL_SAVENICK              , ReplyCodeInfo ClientServerReply "save-nick")   , (RPL_ATTEMPTINGJUNC        , ReplyCodeInfo ClientServerReply "attempting-junc")   , (RPL_ATTEMPTINGREROUTE     , ReplyCodeInfo ClientServerReply "attempting-reroute")+  , (RPL_REMOTESUPPORT         , ReplyCodeInfo ClientServerReply "remote-support")   , (RPL_TRACELINK             , ReplyCodeInfo CommandReply "trace-link")   , (RPL_TRACECONNECTING       , ReplyCodeInfo CommandReply "trace-connecting")   , (RPL_TRACEHANDSHAKE        , ReplyCodeInfo CommandReply "trace-handshake")@@ -829,6 +832,7 @@   , (RPL_TESTMASK              , ReplyCodeInfo CommandReply "test-mask")   , (RPL_TESTLINE              , ReplyCodeInfo CommandReply "test-line")   , (RPL_NOTESTLINE            , ReplyCodeInfo CommandReply "no-test-line")+  , (RPL_TESTMASKGECOS         , ReplyCodeInfo CommandReply "testmask-gecos")   , (RPL_QUIETLIST             , ReplyCodeInfo CommandReply "quiet-list")   , (RPL_ENDOFQUIETLIST        , ReplyCodeInfo CommandReply "end-of-quiet-list")   , (RPL_MONONLINE             , ReplyCodeInfo CommandReply "mon-online")

@@ -22,6 +22,7 @@   , ircJoin   , ircKick   , ircKill+  , ircKline   , ircKnock   , ircLinks   , ircList@@ -37,26 +38,29 @@   , ircPing   , ircPong   , ircPrivmsg-  , ircRules   , ircQuit   , ircRemove+  , ircRules   , ircStats+  , ircTestline+  , ircTestmask   , ircTime   , ircTopic+  , ircUnkline   , ircUser   , ircUserhost+  , ircVersion   , ircWho   , ircWhois   , ircWhowas-  , ircVersion    -- * ZNC support   , ircZnc    -- * SASL support   , ircAuthenticate-  , plainAuthenticationMode   , encodePlainAuthentication+  , encodeExternalAuthentication   ) where  import           Irc.RawIrcMsg@@ -193,6 +197,33 @@   RawIrcMsg ircKill who msg = rawIrcMsg "KILL" (who : nonempty msg) +-- | KLINE command+ircKline ::+  Text {- ^ minutes -} ->+  Text {- ^ mask    -} ->+  Text {- ^ reason  -} ->+  RawIrcMsg+ircKline minutes mask reason = rawIrcMsg "KLINE" [minutes, mask, reason]++-- | UNKLINE command+ircUnkline ::+  Text {- ^ mask -} ->+  RawIrcMsg+ircUnkline mask = rawIrcMsg "UNKLINE" [mask]++-- | TESTLINE command+ircTestline ::+  Text {- ^ mask -} ->+  RawIrcMsg+ircTestline mask = rawIrcMsg "TESTLINE" [mask]++-- | TESTLINE command+ircTestmask ::+  Text {- ^ mask  -} ->+  Text {- ^ gecos -} ->+  RawIrcMsg+ircTestmask mask gecos = rawIrcMsg "TESTMASK" (mask : nonempty gecos)+ -- | REMOVE command ircRemove ::   Identifier {- ^ channel  -} ->@@ -329,15 +360,8 @@ -- | USER command ircUser ::   Text {- ^ username -} ->-  Bool {- ^ set +w   -} ->-  Bool {- ^ set +i   -} ->   Text {- ^ realname -} -> RawIrcMsg-ircUser user set_w set_i real = rawIrcMsg "USER" [user, modeTxt, "*", real]-  where-    modeTxt = Text.pack (show mode)-    mode :: Int-    mode = (if set_w then 4 else 0) -- bit 2-         + (if set_i then 8 else 0) -- bit 3+ircUser user real = rawIrcMsg "USER" [user, "0", "*", real]  -- | CAP REQ command ircCapReq ::@@ -349,9 +373,9 @@ ircCapEnd :: RawIrcMsg ircCapEnd = rawIrcMsg "CAP" ["END"] --- | CAP LS command+-- | CAP LS command - support CAP version 3.2 ircCapLs :: RawIrcMsg-ircCapLs = rawIrcMsg "CAP" ["LS"]+ircCapLs = rawIrcMsg "CAP" ["LS", "302"]  -- | ZNC command --@@ -362,13 +386,11 @@ ircZnc = rawIrcMsg "ZNC"  -- | AUTHENTICATE command-ircAuthenticate :: Text -> RawIrcMsg+ircAuthenticate ::+  Text {- ^ authentication mechanism -} ->+  RawIrcMsg ircAuthenticate msg = rawIrcMsg "AUTHENTICATE" [msg] --- | PLAIN authentiation mode-plainAuthenticationMode :: Text-plainAuthenticationMode = "PLAIN"- -- | Encoding of username and password in PLAIN authentication encodePlainAuthentication ::   Text {- ^ username -} ->@@ -379,3 +401,12 @@   $ Enc.encode   $ Text.encodeUtf8   $ Text.intercalate "\0" [user,user,pass]++-- | Encoding of username in EXTERNAL authentication+encodeExternalAuthentication ::+  Text {- ^ username -} ->+  Text+encodeExternalAuthentication user+  = Text.decodeUtf8+  $ Enc.encode+  $ Text.encodeUtf8 user

@@ -17,6 +17,7 @@   -- * High-level messages     IrcMsg(..)   , CapCmd(..)+  , CapMore(..)   , cookIrcMsg    -- * Properties of messages@@ -28,6 +29,7 @@   -- * Helper functions   , nickSplit   , computeMaxMessageLength+  , capCmdText   ) where  import           Control.Monad@@ -58,38 +60,41 @@   | Notice !UserInfo !Identifier !Text -- ^ source target txt   | Mode !UserInfo !Identifier [Text] -- ^ source target txt   | Authenticate !Text -- ^ parameters-  | Cap !CapCmd [Text] -- ^ command parameters+  | Cap !CapCmd -- ^ cap command and parameters   | Ping [Text] -- ^ parameters   | Pong [Text] -- ^ parameters   | Error !Text -- ^ message-  | BatchStart Text Text [Text] -- ^ reference-id type parameters-  | BatchEnd Text -- ^ reference-id-  | Account !UserInfo Text -- ^ user account name changed (account-notify extension)+  | BatchStart !Text !Text [Text] -- ^ reference-id type parameters+  | BatchEnd !Text -- ^ reference-id+  | Account !UserInfo !Text -- ^ user account name changed (account-notify extension)+  | Chghost !UserInfo !Text !Text -- ^ Target, new username and new hostname   deriving Show --- | Sub-commands of the CAP command+data CapMore = CapMore | CapDone+  deriving (Show, Read, Eq, Ord)++-- | Sub-commands of the CAP command sent by server data CapCmd-  = CapLs -- ^ request list of supported caps-  | CapList -- ^ request list of active caps-  | CapReq -- ^ request activation of cap-  | CapAck -- ^ request accepted-  | CapNak -- ^ request denied-  | CapEnd -- ^ end negotiation-  | CapNew -- ^ new capability available (cap-notify extension)-  | CapDel -- ^ capability removed (cap-notify extension)-  deriving (Show, Eq, Ord)+  = CapLs !CapMore [(Text, Maybe Text)] -- ^ list of supported caps+  | CapList [Text] -- ^ list of active caps+  | CapAck [Text] -- ^ request accepted+  | CapNak [Text] -- ^ request denied+  | CapNew [(Text, Maybe Text)] -- ^ new capability available (cap-notify extension)+  | CapDel [Text] -- ^ capability removed (cap-notify extension)+  deriving (Show, Read, Eq, Ord)  -- | Match command text to structured cap sub-command-cookCapCmd :: Text -> Maybe CapCmd-cookCapCmd "LS"   = Just CapLs-cookCapCmd "LIST" = Just CapList-cookCapCmd "ACK"  = Just CapAck-cookCapCmd "NAK"  = Just CapNak-cookCapCmd "END"  = Just CapEnd-cookCapCmd "REQ"  = Just CapReq-cookCapCmd "NEW"  = Just CapNew-cookCapCmd "DEL"  = Just CapDel-cookCapCmd _      = Nothing+cookCapCmd :: Text -> [Text] -> Maybe CapCmd+cookCapCmd cmd args =+  case (cmd, args) of+    ("LS"  , ["*", caps]) -> Just (CapLs CapMore (splitCapList caps))+    ("LS"  , [     caps]) -> Just (CapLs CapDone (splitCapList caps))+    ("LIST", [     caps]) -> Just (CapList (Text.words caps))+    ("ACK" , [     caps]) -> Just (CapAck (Text.words caps))+    ("NAK" , [     caps]) -> Just (CapNak (Text.words caps))+    ("NEW" , [     caps]) -> Just (CapNew (splitCapList caps))+    ("DEL" , [     caps]) -> Just (CapDel (Text.words caps))+    _                     -> Nothing  -- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'. -- Messages that can't be understood are wrapped in 'UnknownMsg'.@@ -99,8 +104,7 @@     cmd | Right (n,"") <- decimal cmd ->         Reply (ReplyCode n) (view msgParams msg)     "CAP" | _target:cmdTxt:rest <- view msgParams msg-          , Just cmd <- cookCapCmd cmdTxt ->-           Cap cmd rest+          , Just cmd <- cookCapCmd cmdTxt rest -> Cap cmd      "AUTHENTICATE" | x:_ <- view msgParams msg ->         Authenticate x@@ -170,6 +174,10 @@               , [acct] <- view msgParams msg ->       Account user (if acct == "*" then "" else acct) +    "CHGHOST" | Just user <- view msgPrefix msg+              , [newuser, newhost] <- view msgParams msg ->+      Chghost user newuser newhost+     _      -> UnknownMsg msg  -- | Parse a CTCP encoded message:@@ -189,6 +197,7 @@   | TargetWindow !Identifier -- ^ Directed message to channel or from user   | TargetNetwork            -- ^ Network-level message   | TargetHidden             -- ^ Completely hidden message+  deriving (Show)  -- | Target information for the window that could be appropriate to -- display this message in.@@ -216,7 +225,8 @@     Reply code args          -> replyTarget code args     BatchStart{}             -> TargetHidden     BatchEnd{}               -> TargetHidden-    Account{}                -> TargetHidden+    Account user _           -> TargetUser (userNick user)+    Chghost user _ _         -> TargetUser (userNick user)   where     directed src tgt       | Text.null (userHost src) = TargetNetwork -- server message@@ -275,13 +285,30 @@     Mode x _ xs    -> Text.unwords (renderUserInfo x:"set mode":xs)     Ping xs        -> Text.unwords xs     Pong xs        -> Text.unwords xs-    Cap _ xs       -> Text.unwords xs+    Cap cmd        -> capCmdText cmd     Error t        -> t     Account x a    -> Text.unwords [renderUserInfo x, a]     Authenticate{} -> ""     BatchStart{}   -> ""     BatchEnd{}     -> "" +capCmdText :: CapCmd -> Text+capCmdText cmd =+  case cmd of+    CapLs more caps -> capMoreText more <> capUnsplitCaps caps+    CapNew     caps -> capUnsplitCaps caps+    CapList    caps -> Text.unwords caps+    CapAck     caps -> Text.unwords caps+    CapNak     caps -> Text.unwords caps+    CapDel     caps -> Text.unwords caps++capMoreText :: CapMore -> Text+capMoreText CapDone = ""+capMoreText CapMore = "* "++capUnsplitCaps :: [(Text, Maybe Text)] -> Text+capUnsplitCaps xs = Text.unwords [ k <> maybe "" ("=" <>) v | (k, v) <- xs ]+ -- nickname   =  ( letter / special ) *8( letter / digit / special / "-" ) -- letter     =  %x41-5A / %x61-7A       ; A-Z / a-z -- digit      =  %x30-39                 ; 0-9@@ -314,3 +341,12 @@   - Text.length (renderUserInfo myUserInfo)   - length (": PRIVMSG  :\r\n"::String)   - Text.length target++splitCapList :: Text -> [(Text, Maybe Text)]+splitCapList caps =+  [ (name, value)+    | kv <- Text.words caps+    , let (name, v) = Text.break ('=' ==) kv+    , let value | Text.null v = Nothing+                | otherwise   = Just $! Text.tail v+    ]