HaskellNet 0.2.1 → 0.2.2
raw patch · 12 files changed
+822/−2 lines, 12 filesdep ~HaXmldep ~basedep ~haskell98PVP ok
version bump matches the API change (PVP)
Dependency ranges changed: HaXml, base, haskell98, mtl, network
API changes (from Hackage documentation)
Files
- HaskellNet.cabal +2/−2
- INSTALL +7/−0
- LICENSE +28/−0
- Text/URI.hs +233/−0
- example/DebugStream.hs +92/−0
- example/TLSStream.hs +88/−0
- example/imap.hs +20/−0
- example/pop3.hs +22/−0
- example/smtp.hs +15/−0
- test/AtomTest.hs +81/−0
- test/IMAPParsersTest.hs +174/−0
- test/RSSTest.hs +60/−0
HaskellNet.cabal view
@@ -1,5 +1,5 @@ Name: HaskellNet-Version: 0.2.1+Version: 0.2.2 Author: Jun Mukai Maintainer: Robert Wills <wrwills@gmail.com> License: BSD3@@ -7,7 +7,7 @@ Description: Originally written for Google SOC, provides network related libraries such as POP3, SMTP, IMAP. All I have done is get the project to compile using cabal and check that these libraries basically work. -Build-Depends: base, haskell98, network, mtl, parsec, time, bytestring, pretty, array, Crypto, base64-string, containers, HaXml, old-locale, old-time+Build-Depends: base >= 2 && < 4, haskell98, network, mtl, parsec, time, bytestring, pretty, array, Crypto, base64-string, containers, HaXml<1.19, old-locale, old-time Synopsis: network related libraries such as POP3, SMTP, IMAP cabal-version: >=1.2 build-type: Simple
+ INSTALL view
@@ -0,0 +1,7 @@++cabal configure+cabal build+cabal install++You can run imap, smtp, and pop3 examples using ghci.+NB: you might need to add "-hide-package transformers" to the ghci command
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2006, Jun Mukai +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+ 1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ 2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ 3. Neither the name of the author nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS+``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS+BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.+
+ Text/URI.hs view
@@ -0,0 +1,233 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# LINE 1 "Text/URI.hsc" #-}+{-# OPTIONS -fglasgow-exts #-}+{-# LINE 2 "Text/URI.hsc" #-}+----------------------------------------------------------------------+-- |+-- Module : Text.URI+-- Copyright : (c) Jun Mukai 2006+-- License : BSD-style (see the file LICENSE)+-- +-- Maintainer : mukai@jmuk.org+-- Stability : stable+-- Portability : portable+-- +-- URI parser and utilities+-- +++module Text.URI+ ( URI(..)+ , port'+ , uri, uri'+ , escape, unescape+ , parseURI, parseURI'+ , portToName, nameToPort+ )+ where++import Network+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS++import Text.Packrat.Parse+import Text.Packrat.Pos++import Data.Array+import Data.Char+import Data.List+import Data.Maybe+import Data.Word (Word8)+import Numeric++import Network.BSD (getServicePortNumber, getServiceByPort, serviceName, servicePort)+import System.IO.Unsafe++data URI = URI { scheme :: String+ , host :: String+ , user :: String+ , password :: String+ , port :: Maybe PortNumber+ , path :: String+ , query :: String+ , fragment :: String+ }++{-# LINE 55 "Text/URI.hsc" #-}+ deriving (Eq)++instance Show URI where+ showsPrec d uri = showParen (d>app_prec) $ foldl1 (.) $ show' uri+ where app_prec = 10+ show' (URI sch host u p port path q f) =+ [ showScheme sch+ , showUserInfo (escape $ map c2w u) (escape $ map c2w p)+ , showString $ escape $ map c2w host+ , showPort port+ , showString $ escape $ map c2w path+ , showQuery $ escape $ map c2w q+ , showFragment $ escape $ map c2w f ]+ showScheme "" = id+ showScheme s = showString s . ("://"++)+ showUserInfo "" "" = id+ showUserInfo u "" = showString u . ('@':)+ showUserInfo u p = showString u . (':':)+ . showString p . ('@':)+ showPort Nothing = id+ showPort (Just p) = (':':) . showInt p+ showQuery "" = id+ showQuery q = ('?':) . showString q+ showFragment "" = id+ showFragment f = ('#':) . showFragment f+ c2w = toEnum . fromEnum++{-# LINE 82 "Text/URI.hsc" #-}++-- | Obtain the port number for the URI. If no port number exists,+-- port' would like to estimate the port number from the scheme name.+-- If both failed, it raises an error.+port' :: URI -> PortNumber+port' (URI { port = Just p }) = p+port' (URI { scheme = s }) =+ case nameToPort s of+ Just p -> p+ Nothing -> error ("no service entries for " ++ s)++ +-- | Parse URI string simiar to 'parseURI'. The difference is that it+-- raises an error for the case of parse failed, not returns Nothing.+uri' :: ByteString -> URI+uri' u = case dvURI (parse (Pos "<uri>" 1 1) u) of+ Parsed v d' e' -> v+ NoParse e -> error (show e)+uri :: String -> URI+uri = uri' . BS.pack++-- | Parse URI string and returns the result. If the parse is failed,+-- it simply returns Nothing.+parseURI :: String -> Maybe URI+parseURI = parseURI' . BS.pack+parseURI' :: ByteString -> Maybe URI+parseURI' u = case dvURI (parse (Pos "<uri>" 1 1) u) of+ Parsed v d' e' -> Just v+ NoParse e -> Nothing ++parse pos s = d+ where d = URIDerivs puri psch phost pui pport pabs ppath pq pf pch pos+ puri = pURI d+ psch = pScheme d+ phost = pHost d+ pui = pUserInfo d+ pport = pPort d+ pabs = pPathAbs d+ ppath = pPath d+ pq = pQuery d+ pf = pFragment d+ pch | BS.null s = NoParse (eofError d)+ | otherwise =+ let (c, s') = (BS.head s, BS.tail s)+ in Parsed c (parse (nextPos pos c) s') (nullError d)++ ++data URIDerivs = URIDerivs { dvURI :: Result URIDerivs URI+ , dvScheme :: Result URIDerivs String+ , dvHost :: Result URIDerivs String+ , dvUserInfo :: Result URIDerivs [String]+ , dvPort :: Result URIDerivs PortNumber+ , dvPathAbs :: Result URIDerivs String+ , dvPath :: Result URIDerivs String+ , dvQuery :: Result URIDerivs String+ , dvFragment :: Result URIDerivs String+ , advChar :: Result URIDerivs Char+ , advPos :: Pos+ }++instance Derivs URIDerivs where+ dvChar = advChar+ dvPos = advPos+++unescape :: String -> String+unescape ('%':c1:c2:cs) = chr ((hex c1)*16+(hex c2)) : unescape cs+ where arr = array ('0', 'f') $ zip "0123456789abcdef" [0..]+ hex = (arr!) . toLower+unescape (c:cs) = c : unescape cs+unescape "" = ""++escape :: [Word8] -> String+escape [] = ""+escape (c:cs) | c' `elem` validChars = c' : escape cs+ | otherwise = escChar c ++ escape cs+ where validChars = ['a'..'z']++['A'..'Z']++['0'..'9']++"!$^&*-_=+|/."+ escChar c = '%' : map (arr!) [c `div` 16, c `mod` 16]+ arr = listArray (0, 15) "0123456789abcdef"+ w2c = toEnum . fromEnum+ c' = w2c c++consURI :: String -- ^ scheme+ -> String -- ^ host name+ -> String -- ^ user+ -> String -- ^ password+ -> Maybe PortNumber+ -> String -- ^ path+ -> String -- ^ query+ -> String -- ^ fragment+ -> URI+consURI s h u p port path q f =+ URI (unescape s) (unescape h) (unescape u) (unescape p) port (unescape path) (unescape q) (unescape f)+++pURI :: URIDerivs -> Result URIDerivs URI+Parser pURI = do sch <- Parser dvScheme+ char ':'+ uri <- hierPart sch+ q <- option "" (Parser dvQuery)+ f <- option "" (Parser dvFragment)+ eof+ return (uri { query = q, fragment = f })+ where hierPart sch = do string "//"+ ui <- option [] (Parser dvUserInfo)+ host <- Parser dvHost+ port <- optional (Parser dvPort)+ path <- option "" (Parser dvPathAbs)+ let uri = consURI sch host "" "" port path "" ""+ case ui of+ [u, p] -> return $ uri { user = u, password = p }+ [u] -> return $ uri { user = u }+ [] -> return uri+ <|> do path <- option "" (Parser dvPath)+ return $ URI sch "" "" "" Nothing path "" ""++pScheme, pHost, pPath, pQuery, pFragment :: URIDerivs+ -> Result URIDerivs String+Parser pScheme = do c <- oneOf (['a'..'z']++['A'..'Z'])+ rest <- many $ oneOf (['a'..'z']++['A'..'Z']++['0'..'9']++"+-.")+ return (c:rest)+Parser pHost = many1 (noneOf ":/")+Parser pPathAbs = char '/' >> Parser dvPath >>= return . ('/':)+Parser pPath = many1 (noneOf "#?")+Parser pQuery = char '?' >> many1 (noneOf "#")+Parser pFragment = char '#' >> many1 anyChar+++pUserInfo :: URIDerivs -> Result URIDerivs [String]+Parser pUserInfo = do ui <- many1 (noneOf ":@") `sepBy1` char ':'+ char '@'+ return ui++pPort :: URIDerivs -> Result URIDerivs PortNumber+Parser pPort = char ':' >> many1 digit >>= return . toEnum . read+++portToName :: PortNumber -> Maybe String+portToName p = unsafePerformIO $+ (do s <- getServiceByPort p "tcp"+ return $ Just $ serviceName s)+ `catch`+ (\_ -> return Nothing)++nameToPort :: String -> Maybe PortNumber+nameToPort n = unsafePerformIO $+ fmap Just (getServicePortNumber n)+ `catch` (\_ -> return Nothing)
+ example/DebugStream.hs view
@@ -0,0 +1,92 @@+{-# OPTIONS_GHC -cpp -fglasgow-exts -package hsgnutls -package HaskellNet #-}+-- examples to connect server by hsgnutls++module DebugStream+ ( connectD+ , connectDPort+ , DebugStream+ , withDebug+ , module BS+ )+ where++import Network+import HaskellNet.BSStream++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Base as BSB++import System.IO++import Data.IORef+import Control.Monad++import Foreign.ForeignPtr+import Foreign.Ptr++newtype (BSStream s) => DebugStream s = DS s++withDebug :: BSStream s => s -> DebugStream s+withDebug = DS++connectD :: HostName -> PortNumber -> IO (DebugStream Handle)+connectD host port = connectDPort host (PortNumber port)++connectDPort :: HostName -> PortID -> IO (DebugStream Handle)+connectDPort host port =+ do h <- connectTo host port+ hPutStrLn stderr "connected"+ return $ DS h+++instance (BSStream s) => BSStream (DebugStream s) where+ bsGetLine (DS h) =+ do hPutStr stderr "reading with bsGetLine..."+ hFlush stderr+ l <- bsGetLine h+ BS.hPutStrLn stderr l+ return l+ bsGet (DS h) len =+ do hPutStr stderr $ "reading with bsGet "++show len++"..."+ hFlush stderr+ chunk <- bsGet h len+ BS.hPutStrLn stderr chunk+ return chunk+ bsPut (DS h) s =+ do hPutStr stderr "putting with bsPut ("+ BS.hPutStrLn stderr s+ hPutStr stderr (")...")+ hFlush stderr+ bsPut h s+ bsFlush h+ hPutStrLn stderr "done"+ return ()+ bsPutStrLn (DS h) s =+ do hPutStr stderr "putting with bsPutStrLn("+ BS.hPutStrLn stderr s+ hPutStr stderr (")...")+ hFlush stderr+ bsPutStrLn h s+ bsFlush h+ hPutStrLn stderr "done"+ return ()+ bsPutCrLf (DS h) s =+ do hPutStr stderr "putting with bsPutCrLf("+ BS.hPutStrLn stderr s+ hPutStr stderr (")...")+ hFlush stderr+ bsPutCrLf h s+ bsFlush h+ hPutStrLn stderr "done"+ return ()+ bsPutNoFlush (DS h) s =+ do hPutStr stderr "putting with bsPutNoFlush ("+ BS.hPutStrLn stderr s+ hPutStr stderr (")...")+ hFlush stderr+ bsPut h s+ hPutStrLn stderr "done"+ return ()+ bsFlush (DS h) = bsFlush h+ bsClose (DS h) = bsClose h
+ example/TLSStream.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_GHC -cpp -fglasgow-exts -package hsgnutls -package HaskellNet #-}+-- examples to connect server by hsgnutls++module TLSStream+ ( connectTLS+ , connectTLSPort+ , TlsSession+ , sess+ )+ where++import Network.GnuTLS+import Network+import HaskellNet.BSStream++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Base as BSB++import System.IO++import Data.IORef+import Control.Monad++import Foreign.ForeignPtr+import Foreign.Ptr++data TlsSession t = TlsSession { sess :: Session t+ , hdl :: Handle+ , buf :: IORef ByteString }++fromSession :: Handle -> Session t -> IO (TlsSession t)+fromSession h s = do newbuf <- newIORef BS.empty+ return $ TlsSession s h newbuf++connectTLS :: HostName -> PortNumber -> IO (TlsSession Client)+connectTLS host port = connectTLSPort host (PortNumber port)++connectTLSPort :: HostName -> PortID -> IO (TlsSession Client)+connectTLSPort host port =+ do h <- connectTo host port+ s <- tlsClient [ handle :=> return h+ , priorities := [CrtX509, CrtOpenpgp]]+ cred <- certificateCredentials+ set s [ credentials := cred]+ handshake s+ fromSession h s++++bufLen = 4096+waiting = 500 -- miliseconds++extendBuf sess@(TlsSession s _ buf) =+ do res <- mallocForeignPtrBytes bufLen+ len <- withForeignPtr res (\p -> tlsRecv s p bufLen)+ modifyIORef buf (flip BS.append $ BSB.fromForeignPtr res len)+ return len++doWhile cond execute =+ do f <- cond+ when f $ (execute >> doWhile cond execute)+ ++instance BSStream (TlsSession t) where+ bsGetLine sess@(TlsSession s _ buf) =+ do doWhile (readIORef buf >>= return . BS.notElem '\n')+ (extendBuf sess)+ bufstr' <- readIORef buf+ let (line, rest) = BS.span (/='\n') bufstr'+ writeIORef buf $ BS.tail rest+ return line+ bsGet sess@(TlsSession s _ buf) len =+ do doWhile (readIORef buf >>= return . (<len) . BS.length)+ (extendBuf sess)+ bufstr' <- readIORef buf+ let (r, bufstr'') = BS.splitAt len bufstr'+ writeIORef buf bufstr''+ return r+ bsPut (TlsSession s h _) bs =+ do withForeignPtr fptr $ \ptr -> (tlsSend s (plusPtr ptr off) len)+ return ()+ where (fptr, off, len) = BSB.toForeignPtr bs+ bsPutNoFlush = bsPut+ bsFlush _ = return ()+ bsClose (TlsSession s _ _) = bye s ShutRdwr++
+ example/imap.hs view
@@ -0,0 +1,20 @@+import System.IO+import HaskellNet.IMAP+import Text.Mime+import qualified Data.ByteString.Char8 as BS+import Control.Monad++imapServer = "imap.mail.org"+user = ""+pass = ""++main = do+ con <- connectIMAP imapServer+ login con user pass+ mboxes <- list con+ mapM print mboxes+ select con "INBOX"+ msgs <- search con [ALLs]+ mapM_ (\x -> print x) (take 4 msgs)+ forM_ (take 4msgs) (\x -> fetch con x >>= print)+
+ example/pop3.hs view
@@ -0,0 +1,22 @@+import System.IO+import HaskellNet.POP3++import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Char8 as BS+import Data.Char +import Data.ByteString (ByteString)++popServer = "pop3.mail.org"+user = ""+pass = ""++main = do+ con <- connectPop3 popServer+ print "connected"+ userPass con user pass+ num <- list con 4+ print $ "num " ++ (show num)+ msg <- retr con 1+ print msg+ closePop3 con+
+ example/smtp.hs view
@@ -0,0 +1,15 @@+import System.IO+import HaskellNet.SMTP+import Text.Mime+import qualified Data.ByteString.Char8 as BS++smtpServer = "mysmtpserver"+sendFrom = "test@test.org"+sendTo = ["wrwills@gmail.com"]++main = do+ con <- connectSMTP smtpServer+ let msg = ([("From", "HaskellNet <" ++ sendFrom ++ ">"),("Subject","Test")], BS.pack "\r\nhello from haskellnet")+ sendMail sendFrom sendTo (BS.pack $ show $ showMessage "utf-8" msg) con+ closeSMTP con+
+ test/AtomTest.hs view
@@ -0,0 +1,81 @@+module Main(main) where++import Data.Maybe+import Text.Atom+import Text.XML.HaXml.Xml2Haskell+import Test.HUnit++sample1 = "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n\+ \<feed xmlns=\"http://www.w3.org/2005/Atom\">\n\+ \\n\+ \ <title>Example Feed</title>\n\+ \ <link href=\"http://example.org/\"/>\n\+ \ <updated>2003-12-13T18:30:02Z</updated>\n\+ \ <author>\n\+ \ <name>John Doe</name>\n\+ \ </author>\n\+ \ <id>urn:uuid:60a76c80-d399-11d9-b93C-0003939e0af6</id>\n\+ \\n\+ \ <entry>\n\+ \ <title>Atom-Powered Robots Run Amok</title>\n\+ \ <link href=\"http://example.org/2003/12/13/atom03\"/>\n\+ \ <id>urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a</id>\n\+ \ <updated>2003-12-13T18:30:02Z</updated>\n\+ \ <summary>Some text.</summary>\n\+ \ </entry>\n\+ \ \n\+ \</feed>\n"++sample2 = "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n\+ \<feed xmlns=\"http://www.w3.org/2005/Atom\">\n\+ \ <title type=\"text\">dive into mark</title>\n\+ \ <subtitle type=\"html\">\n\+ \ A <em>lot</em> of effort\n\+ \ went into making this effortless\n\+ \ </subtitle>\n\+ \ <updated>2005-07-31T12:29:29Z</updated>\n\+ \ <id>tag:example.org,2003:3</id>\n\+ \ <link rel=\"alternate\" type=\"text/html\"\n\+ \ hreflang=\"en\" href=\"http://example.org/\"/>\n\+ \ <link rel=\"self\" type=\"application/atom+xml\"\n\+ \ href=\"http://example.org/feed.atom\"/>\n\+ \ <rights>Copyright (c) 2003, Mark Pilgrim</rights>\n\+ \ <generator uri=\"http://www.example.com/\" version=\"1.0\">\n\+ \ Example Toolkit\n\+ \ </generator>\n\+ \ <entry>\n\+ \ <title>Atom draft-07 snapshot</title>\n\+ \ <link rel=\"alternate\" type=\"text/html\"\n\+ \ href=\"http://example.org/2005/04/02/atom\"/>\n\+ \ <link rel=\"enclosure\" type=\"audio/mpeg\" length=\"1337\"\n\+ \ href=\"http://example.org/audio/ph34r_my_podcast.mp3\"/>\n\+ \ <id>tag:example.org,2003:3.2397</id>\n\+ \ <updated>2005-07-31T12:29:29Z</updated>\n\+ \ <published>2003-12-13T08:29:29-04:00</published>\n\+ \ <author>\n\+ \ <name>Mark Pilgrim</name>\n\+ \ <uri>http://example.org/</uri>\n\+ \ <email>f8dy@example.com</email>\n\+ \ </author>\n\+ \ <contributor>\n\+ \ <name>Sam Ruby</name>\n\+ \ </contributor>\n\+ \ <contributor>\n\+ \ <name>Joe Gregorio</name>\n\+ \ </contributor>\n\+ \ <content type=\"xhtml\" xml:lang=\"en\"\n\+ \ xml:base=\"http://diveintomark.org/\">\n\+ \ <div xmlns=\"http://www.w3.org/1999/xhtml\">\n\+ \ <p><i>[Update: The Atom draft is finished.]</i></p>\n\+ \ </div>\n\+ \ </content>\n\+ \ </entry>\n\+ \</feed>\n"++feed1, feed2 :: Feed+feed1 = fromJust $ readXml sample1+feed2 = fromJust $ readXml sample2++main = runTestTT $ test [ showXml feed1 ~=? (showXml (readXml (showXml feed1) :: Maybe Feed))+ , showXml feed2 ~=? (showXml (readXml (showXml feed2) :: Maybe Feed))+ ]
+ test/IMAPParsersTest.hs view
@@ -0,0 +1,174 @@+module Main (main) where++import Text.IMAPParsers++import Test.HUnit++baseTest =+ [(OK Nothing "LOGIN Completed", MboxUpdate Nothing Nothing, ())+ ~=? eval' pNone "A001"+ "* OK [ALERT] System shutdown in 10 minutes\r\n\+ \A001 OK LOGIN Completed\r\n"+ ,(NO Nothing "COPY failed: disk is full", MboxUpdate Nothing Nothing, ())+ ~=? eval' pNone "A223"+ "* NO Disk is 98% full, please delete unnecessary data\r\n\+ \* NO Disk is 99% full, please delete unnecessary data\r\n\+ \A223 NO COPY failed: disk is full\r\n"+ ,(OK Nothing "LOGOUT completed", MboxUpdate Nothing Nothing, ())+ ~=? eval' pNone "a006"+ "* BYE Courier-IMAP server shutting down\r\n\+ \a006 OK LOGOUT completed\r\n"+ ]++capabilityTest =+ (OK Nothing "CAPABILITY completed"+ , MboxUpdate Nothing Nothing+ , ["IMAP4rev1", "STARTTLS", "AUTH=GSSAPI", "LOGINDISABLED"])+ ~=? eval' pCapability "abcd"+ "* CAPABILITY IMAP4rev1 STARTTLS AUTH=GSSAPI LOGINDISABLED\r\n\+ \abcd OK CAPABILITY completed\r\n"++noopTest =+ ( OK Nothing "NOOP completed", MboxUpdate (Just 23) (Just 3), ())+ ~=? eval' pNone "a047"+ "* 22 EXPUNGE\r\n\+ \* 23 EXISTS\r\n\+ \* 3 RECENT\r\n\+ \* 14 FETCH (FLAGS (\\Seen \\Deleted))\r\n\+ \a047 OK NOOP completed\r\n"++selectTest =+ [ ( OK (Just READ_WRITE) "SELECT completed"+ , MboxUpdate Nothing Nothing+ , MboxInfo "" 172 1 [Answered, Flagged, Deleted, Seen, Draft]+ [Deleted, Seen] True True 4392 3857529045 )+ ~=? eval' pSelect "A142"+ "* 172 EXISTS\r\n\+ \* 1 RECENT\r\n\+ \* OK [UNSEEN 12] Message 12 is first unseen\r\n\+ \* OK [UIDVALIDITY 3857529045] UIDs valid\r\n\+ \* OK [UIDNEXT 4392] Predicted next UID\r\n\+ \* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)\r\n\+ \* OK [PERMANENTFLAGS (\\Deleted \\Seen \\*)] Limited\r\n\+ \A142 OK [READ-WRITE] SELECT completed\r\n"+ , (OK (Just READ_ONLY) "EXAMINE completed"+ , MboxUpdate Nothing Nothing+ , MboxInfo "" 17 2 [Answered, Flagged, Deleted, Seen, Draft]+ [] False False 4392 3857529045 )+ ~=? eval' pSelect "A932"+ "* 17 EXISTS\r\n\+ \* 2 RECENT\r\n\+ \* OK [UNSEEN 8] Message 8 is first unseen\r\n\+ \* OK [UIDVALIDITY 3857529045] UIDs valid\r\n\+ \* OK [UIDNEXT 4392] Predicted next UID\r\n\+ \* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)\r\n\+ \* OK [PERMANENTFLAGS ()] No permanent flags permitted\r\n\+ \A932 OK [READ-ONLY] EXAMINE completed\r\n"+ ]++listTest =+ [ ( OK Nothing "LIST completed"+ , MboxUpdate Nothing Nothing+ , [([], "/", "blurdybloop")+ ,([Noselect], "/", "foo")+ ,([], "/", "foo/bar")])+ ~=? eval' pList "A682" "* LIST () \"/\" blurdybloop\r\n\+ \* LIST (\\Noselect) \"/\" foo\r\n\+ \* LIST () \"/\" foo/bar\r\n\+ \A682 OK LIST completed\r\n"+ , ( OK Nothing "LSUB completed"+ , MboxUpdate Nothing Nothing+ , [([], ".", "#news.comp.mail.mime")+ ,([], ".", "#news.comp.mail.misc")])+ ~=? eval' pLsub "A002" "* LSUB () \".\" #news.comp.mail.mime\r\n\+ \* LSUB () \".\" #news.comp.mail.misc\r\n\+ \A002 OK LSUB completed\r\n"+ ]++statusTest =+ ( OK Nothing "STATUS completed"+ , MboxUpdate Nothing Nothing+ , [(MESSAGES, 231), (UIDNEXT, 44292)])+ ~=? eval' pStatus "A042"+ "* STATUS blurdybloop (MESSAGES 231 UIDNEXT 44292)\r\n\+ \A042 OK STATUS completed\r\n"++expungeTest =+ ( OK Nothing "EXPUNGE completed"+ , MboxUpdate Nothing Nothing+ , [3, 3, 5, 8])+ ~=? eval' pExpunge "A202" "* 3 EXPUNGE\r\n\+ \* 3 EXPUNGE\r\n\+ \* 5 EXPUNGE\r\n\+ \* 8 EXPUNGE\r\n\+ \A202 OK EXPUNGE completed\r\n"++searchTest =+ [ ( OK Nothing "SEARCH completed"+ , MboxUpdate Nothing Nothing+ , [2, 84, 882])+ ~=? eval' pSearch "A282" "* SEARCH 2 84 882\r\n\+ \A282 OK SEARCH completed\r\n"+ , ( OK Nothing "SEARCH completed"+ , MboxUpdate Nothing Nothing+ , [] )+ ~=? eval' pSearch "A283" "* SEARCH\r\n\+ \A283 OK SEARCH completed\r\n"+ ]++fetchTest =+ [ ( OK Nothing "FETCH completed"+ , MboxUpdate Nothing Nothing+ , [ (12, [("FLAGS", "(\\Seen)")+ ,("INTERNALDATE", "\"17-Jul-1996 02:44:25 -0700\"")+ ,("RFC822.SIZE", "4286")+ ,("ENVELOPE", "(\"Wed, 17 Jul 1996 02:23:25 -0700 (PDT)\" \"IMAP4rev1 WG mtg summary and minutes\" ((\"Terry Gray\" NIL \"gray\" \"cac.washington.edu\")) ((\"Terry Gray\" NIL \"gray\" \"cac.washington.edu\")) ((\"Terry Gray\" NIL \"gray\" \"cac.washington.edu\")) ((NIL NIL \"imap\" \"cac.washington.edu\")) ((NIL NIL \"minutes\" \"CNRI.Reston.VA.US\") (\"John Klensin\" NIL \"KLENSIN\" \"MIT.EDU\")) NIL NIL \"<B27397-0100000@cac.washington.edu>\")")+ ,("BODY", "(\"TEXT\" \"PLAIN\" (\"CHARSET\" \"US-ASCII\") NIL NIL \"7BIT\" 3028 92)")+ ])])+ ~=? eval' pFetch "a003" "* 12 FETCH (FLAGS (\\Seen) INTERNALDATE \"17-Jul-1996 02:44:25 -0700\" RFC822.SIZE 4286 ENVELOPE (\"Wed, 17 Jul 1996 02:23:25 -0700 (PDT)\" \"IMAP4rev1 WG mtg summary and minutes\" ((\"Terry Gray\" NIL \"gray\" \"cac.washington.edu\")) ((\"Terry Gray\" NIL \"gray\" \"cac.washington.edu\")) ((\"Terry Gray\" NIL \"gray\" \"cac.washington.edu\")) ((NIL NIL \"imap\" \"cac.washington.edu\")) ((NIL NIL \"minutes\" \"CNRI.Reston.VA.US\") (\"John Klensin\" NIL \"KLENSIN\" \"MIT.EDU\")) NIL NIL \"<B27397-0100000@cac.washington.edu>\") BODY (\"TEXT\" \"PLAIN\" (\"CHARSET\" \"US-ASCII\") NIL NIL \"7BIT\" 3028 92))\r\n\+ \a003 OK FETCH completed\r\n"+ , ( OK Nothing "FETCH completed"+ , MboxUpdate Nothing Nothing+ , [ (12, [( "BODY[HEADER]"+ , "Date: Wed, 17 Jul 1996 02:23:25 -0700 (PDT)\r\n\+ \From: Terry Gray <gray@cac.washington.edu>\r\n\+ \Subject: IMAP4rev1 WG mtg summary and minutes\r\n\+ \To: imap@cac.washington.edu\r\n\+ \cc: minutes@CNRI.Reston.VA.US, John Klensin <KLENSIN@MIT.EDU>\r\n\+ \Message-Id: <B27397-0100000@cac.washington.edu>\r\n\+ \MIME-Version: 1.0\r\n\+ \Content-Type: TEXT/PLAIN; CHARSET=US-ASCII\r\n\+ \\r\n" )])])+ ~=? eval' pFetch "a004"+ "* 12 FETCH (BODY[HEADER] {342}\r\n\+ \Date: Wed, 17 Jul 1996 02:23:25 -0700 (PDT)\r\n\+ \From: Terry Gray <gray@cac.washington.edu>\r\n\+ \Subject: IMAP4rev1 WG mtg summary and minutes\r\n\+ \To: imap@cac.washington.edu\r\n\+ \cc: minutes@CNRI.Reston.VA.US, John Klensin <KLENSIN@MIT.EDU>\r\n\+ \Message-Id: <B27397-0100000@cac.washington.edu>\r\n\+ \MIME-Version: 1.0\r\n\+ \Content-Type: TEXT/PLAIN; CHARSET=US-ASCII\r\n\r\n\+ \)\r\n\+ \a004 OK FETCH completed\r\n"+ , ( OK Nothing "+FLAGS completed"+ , MboxUpdate Nothing Nothing+ , [(12, [("FLAGS", "(\\Seen \\Deleted)")])])+ ~=? eval' pFetch "a005" "* 12 FETCH (FLAGS (\\Seen \\Deleted))\r\n\+ \a005 OK +FLAGS completed\r\n"+ ]+++testData = [ "base" ~: baseTest+ , "capability" ~: capabilityTest+ , "noop" ~: noopTest+ , "select" ~: selectTest+ , "list" ~: listTest+ , "status" ~: statusTest+ , "expunge" ~: expungeTest+ , "search" ~: searchTest+ , "fetch" ~: fetchTest+ ]+++main = runTestTT (test testData)
+ test/RSSTest.hs view
@@ -0,0 +1,60 @@+module Main(main) where++import Text.RSS+import Test.HUnit+import Data.Time.Calendar+import Data.Time.LocalTime++testChannel :: RSSChannel+testChannel = RSSChannel { chTitle = "Example Channel"+ , chLink = "http://example.com/"+ , chDescription = "My example channel"+ , chDC = [], chImage = Nothing }++testItems :: [RSSItem]+testItems = [ RSSItem { title = "News for September the First"+ , link = "http://example.com/2002/09/01/"+ , description = Just "other things happend today"+ , content = Nothing+ , dc = [DCDate sep1] }+ , RSSItem { title = "News for September the Second"+ , link = "http://example.com/2002/09/02/"+ , description = Nothing+ , content = Nothing+ , dc = [DCDate sep2] }+ ]+ where sep1 = ZonedTime (LocalTime (fromGregorian 2002 9 1) (TimeOfDay 0 0 0))+ (minutesToTimeZone 0)+ sep2 = ZonedTime (LocalTime (fromGregorian 2002 9 2) (TimeOfDay 0 0 0))+ (minutesToTimeZone 0)++testResult = + "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\+ \<rdf:RDF xmlns=\"http://purl.org/rss/1.0/\"\n\+ \ xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"\n\+ \ xmlns:dc=\"http://purl.org/dc/elements/1.1/\"\n\+ \ xmlns:content=\"http://purl.org/rss/1.0/modules/content/\">\n\+ \ <channel rdf:about=\"http://example.com/\">\n\+ \ <title>Example Channel</title><link>http://example.com/</link>\n\+ \ <description>My example channel</description>\n\+ \ <items>\n\+ \ <rdf:Seq>\n\+ \ <rdf:li rdf:resource=\"http://example.com/2002/09/01/\" />\n\+ \ <rdf:li rdf:resource=\"http://example.com/2002/09/02/\" />\n\+ \ </rdf:Seq>\n\+ \ </items>\n\+ \ </channel>\n\+ \ <item rdf:about=\"http://example.com/2002/09/01/\">\n\+ \ <title>News for September the First</title>\n\+ \ <link>http://example.com/2002/09/01/</link>\n\+ \ <description>other things happend today</description>\n\+ \ <dc:date>2002-09-01T00:00:00+00:00</dc:date>\n\+ \ </item>\n\+ \ <item rdf:about=\"http://example.com/2002/09/02/\">\n\+ \ <title>News for September the Second</title>\n\+ \ <link>http://example.com/2002/09/02/</link>\n\+ \ <dc:date>2002-09-02T00:00:00+00:00</dc:date>\n\+ \ </item>\n\+ \</rdf:RDF>"++main = runTestTT $ test $ renderRSS testChannel testItems ~=? testResult