diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + Version 2, December 2004 + + Copyright (C) 2004 Sam Hocevar + + Everyone is permitted to copy and distribute verbatim or modified + copies of this license document, and changing it is allowed as long + as the name is changed. + + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. You just DO WHAT THE FUCK YOU WANT TO. diff --git a/Network/IRC/CTCP.hs b/Network/IRC/CTCP.hs new file mode 100644 --- /dev/null +++ b/Network/IRC/CTCP.hs @@ -0,0 +1,124 @@ +-- |Functions for encoding and decoding CTCPs. +module Network.IRC.CTCP + ( -- *Types + CTCPByteString + , getUnderlyingByteString + + -- *Encoding and decoding + , toCTCP + , fromCTCP + , encodeCTCP + , decodeCTCP + + -- *Utilities + , isCTCP + , asCTCP + , orCTCP + ) where + +import Data.ByteString (ByteString, pack, singleton, unpack) +import Data.List (mapAccumL) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Text (Text, splitOn) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Tuple (swap) + +import qualified Data.ByteString as B +import qualified Data.Text as T + +-- |Type representing a CTCP-encoded bytestring. +newtype CTCPByteString = CBS + { getUnderlyingByteString :: ByteString + -- ^Get the underlying (encoded) bytestring from a CTCP + -- bytestring. + } + +-- |Turn a command name and arguments into a CTCP-encoded bytestring. +-- +-- This encodes the text with UTF-8. If another encoding is desired, +-- 'encodeCTCP' should be used directly. +toCTCP :: Text -> [Text] -> CTCPByteString +toCTCP cmd args = encodeCTCP . encodeUtf8 . T.unwords $ cmd : args + +-- |Encode a bytestring according to the CTCP spec. +encodeCTCP :: ByteString -> CTCPByteString +encodeCTCP bs = CBS $ B.concat [ singleton soh + , escape bs + , singleton soh + ] + + where escape = B.concatMap escape' + escape' x = case lookup x encodings of + -- If there is an encoding, escape it and use + -- that. + Just x' -> pack [esc, x'] + + -- Otherwise, just return the original + -- character. + Nothing -> singleton x + +-- |Decode a CTCP-encoded bytestring and turn it into a command name +-- and arguments. +-- +-- This decodes the text with UTF-8. If another encoding is desired, +-- 'decodeCTCP' should be used directly. +fromCTCP :: CTCPByteString -> (Text, [Text]) +fromCTCP bs = case splitOn (T.pack " ") . decodeUtf8 . decodeCTCP $ bs of + (cmd : args) -> (cmd, args) + _ -> (T.pack "", []) + +-- |Decode a CTCP bytestring. Extraeneous escapes are dropped. +decodeCTCP :: CTCPByteString -> ByteString +decodeCTCP (CBS bs) = unescape . B.tail . B.init $ bs + + where unescape = pack . catMaybes . snd . mapAccumL step False . unpack + + -- If we fail to find a decoding, ignore the escape. + step True x = (False, Just . fromMaybe x $ lookup x decodings) + + -- Enter escape mode, this doesn't add a character to the + -- output. + step False 0o020 = (True, Nothing) + + step _ x = (False, Just x) + +soh :: Integral i => i +soh = 0o001 + +esc :: Integral i => i +esc = 0o020 + +encodings :: Integral i => [(i, i)] +encodings = [ (0o000, 0o060) + , (0o012, 0o156) + , (0o015, 0o162) + , (0o020, 0o020) + ] + +decodings :: Integral i => [(i, i)] +decodings = map swap encodings + +-- |Check if a bytestring represents a CTCP. +-- +-- This is intentionally very lenient, in particular it doesn't check +-- that there are no extra escape characters. This is because the spec +-- states that misplaced escape characters should be discarded by the +-- decoding process. +isCTCP :: ByteString -> Bool +isCTCP bs = and $ (B.length bs >= 2) : (B.head bs == soh) : (B.last bs == soh) : map (flip B.notElem bs . fst) encodings + +-- |Check if a bytestring looks like a CTCP, and if so, wrap it up in +-- the 'CTCPByteString' type. +-- +-- This uses 'isCTCP', and so is lenient with escapes. +asCTCP :: ByteString -> Maybe CTCPByteString +asCTCP bs = if isCTCP bs + then Just $ CBS bs + else Nothing + +-- |Apply one of two functions depending on whether the bytestring +-- looks like a CTCP or not. +-- +-- This uses 'asCTCP', and so is lenient with escapes. +orCTCP :: (ByteString -> a) -> (CTCPByteString -> a) -> ByteString -> a +orCTCP f g bs = maybe (f bs) g (asCTCP bs) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/irc-ctcp.cabal b/irc-ctcp.cabal new file mode 100644 --- /dev/null +++ b/irc-ctcp.cabal @@ -0,0 +1,109 @@ +-- Initial irc-ctcp.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: irc-ctcp + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: A CTCP encoding and decoding library for IRC clients. + +-- A longer description of the package. +description: + CTCP (Client To Client Protocol) is a way of sending arbitrary data + over an IRC network, which may include bytes not allowed in standard + IRC messages. CTCPs are sent as a PRIVMSG or NOTICE, where the first + and last characters as @\\001@ (SOH), and special bytes are escaped + by encoding them into a two-byte sequence beginning with @\\020@ + (DLE). CTCPs consist of command name (typically in upper-case) + followed by list of space-separated arguments, which may be empty. + . + One use of CTCPs supported by the vast majority of IRC clients today + is the ACTION command, typically invoked with /me. For example, if + the user @foo@ in the channel @#bar@ were to issue + . + > /me dances + . + everyone in the channel would receive the message + . + > :foo PRIVMSG #bar :\001ACTION dances\001 + . + Other common uses of CTCP include requesting the name and version of + a user's IRC client, their local time, determining ping times, and + initiating file transfers (DCC). + . + Characters are escaped as follows: + . + [@\\000@ (NUL)] @\\020 \\060@ ("0") + . + [@\\012@ (NL)] @\\020 \\156@ ("n") + . + [@\\015@ (CR)] @\\020 \\162@ ("r") + . + [@\\020@ (DLE)] @\\020 \\020@ + . + All other appearences of the escape character are errors, and are + dropped. + . + See for more + details. + +-- URL for the project homepage or repository. +homepage: https://github.com/barrucadu/yukibot + +-- The license under which the package is released. +license: OtherLicense + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Michael Walker + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: mike@barrucadu.co.uk + +-- A copyright notice. +-- copyright: + +category: Network + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +-- extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: Network.IRC.CTCP + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <5 + , bytestring >=0.10 + , text >=1.1 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010 +