packages feed

HaskellNet 0.3 → 0.3.1

raw patch · 10 files changed

+247/−272 lines, 10 filesdep −haskell98dep ~basedep ~mime-mailnew-uploader

Dependencies removed: haskell98

Dependency ranges changed: base, mime-mail

Files

HaskellNet.cabal view
@@ -4,7 +4,7 @@                 SMTP, and IMAP protocols.  NOTE: this package will be                 split into smaller, protocol-specific packages in the                 future.-Version:        0.3+Version:        0.3.1 Copyright:      (c) 2006 Jun Mukai Author:         Jun Mukai Maintainer:	Jonathan Daugherty <drcygnus@gmail.com>@@ -24,6 +24,12 @@   type:     git   location: git://github.com/jtdaugherty/HaskellNet.git +Source-Repository this+  type:     git+  location: git://github.com/shapr/HaskellNet.git+  tag:      nonmaintainerupload++ Library   Hs-Source-Dirs: src   GHC-Options: -Wall -fno-warn-unused-do-bind@@ -47,7 +53,6 @@    Build-Depends:     base >= 4 && < 5,-    haskell98,     network,     mtl,     bytestring,@@ -56,5 +61,5 @@     Crypto > 4.2.1,     base64-string,     old-time,-    mime-mail >= 0.3.0 && < 0.4,+    mime-mail >= 0.4,     text
README.md view
@@ -17,3 +17,6 @@    :set -fbreak-on-exception   :trace main+++(The source for the 0.3.1 non-maintainer upload can be found at https://github.com/shapr/HaskellNet)
src/Network/HaskellNet/BSStream.hs view
@@ -1,6 +1,9 @@--- |A library for abstracting sockets suitable to Streams.+-- |This module provides a byte string \"stream\" interface.  This+-- interface provides some common operations on a value which+-- supports reading and writing byte strings. module Network.HaskellNet.BSStream     ( BSStream(..)+    , handleToStream     ) where @@ -8,34 +11,34 @@ import qualified Data.ByteString.Char8 as BS import System.IO -class BSStream h where-    bsGetLine :: h -> IO ByteString-    bsGet :: h -> Int -> IO ByteString-    bsPut :: h -> ByteString -> IO ()-    bsPuts :: h -> [ByteString] -> IO ()-    bsPutStrLn :: h -> ByteString -> IO ()-    bsPutCrLf  :: h -> ByteString -> IO ()-    bsPutNoFlush :: h -> ByteString -> IO ()-    bsFlush :: h -> IO ()-    bsClose :: h -> IO ()-    bsIsOpen :: h -> IO Bool--    bsPuts h strs = mapM_ (bsPut h) strs-    bsPutCrLf h s = bsPut h s >> bsPut h crlf-    bsPutStrLn h s = bsPut h s >> bsPut h lf--lf, crlf :: BS.ByteString-lf   = BS.singleton '\n'-crlf = BS.pack "\r\n"+-- |A byte string stream.+data BSStream =+    BSStream { bsGetLine :: IO ByteString+             -- ^Read a line from the stream.  Should return the line+             -- which was read, including the newline.+             , bsGet :: Int -> IO ByteString+             -- ^Read the specified number of bytes from the stream.+             -- Should block until the requested bytes can be read.+             , bsPut :: ByteString -> IO ()+             -- ^Write the specified byte string to the stream.+             -- Should flush the stream after writing.+             , bsFlush :: IO ()+             -- ^Flush the stream.+             , bsClose :: IO ()+             -- ^Close the stream.+             , bsIsOpen :: IO Bool+             -- ^Is the stream open?+             } -instance BSStream Handle where-    bsGetLine = BS.hGetLine-    bsGet = BS.hGet-    bsPut h s = BS.hPut h s >> bsFlush h-    bsPutStrLn  h s = BS.hPutStrLn h s >> bsFlush h-    bsPutNoFlush = BS.hPut-    bsFlush = hFlush-    bsClose h = do-      op <- hIsOpen h-      if op then (hClose h) else return ()-    bsIsOpen = hIsOpen+-- |Build a byte string stream which operates on a 'Handle'.+handleToStream :: Handle -> BSStream+handleToStream h =+    BSStream { bsGetLine = BS.hGetLine h+             , bsGet = BS.hGet h+             , bsPut = \s -> BS.hPut h s >> hFlush h+             , bsFlush = hFlush h+             , bsClose = do+                 op <- hIsOpen h+                 if op then (hClose h) else return ()+             , bsIsOpen = hIsOpen h+             }
src/Network/HaskellNet/Debug.hs view
@@ -1,81 +1,44 @@ module Network.HaskellNet.Debug-    ( connectD-    , connectDPort-    , DebugStream-    , withDebug+    ( debugStream     )     where -import Network import Network.HaskellNet.BSStream  import qualified Data.ByteString.Char8 as BS  import System.IO -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)+debugStream :: BSStream -> BSStream+debugStream inner =+    inner { bsGetLine = debugBsGetLine inner+          , bsGet = debugBsGet inner+          , bsPut = debugBsPut inner+          } -connectDPort :: HostName -> PortID -> IO (DebugStream Handle)-connectDPort host port =-    do h <- connectTo host port-       hPutStrLn stderr "connected"-       return $ DS h+debugBsGetLine :: BSStream -> IO BS.ByteString+debugBsGetLine s = do+  hPutStr stderr "reading with bsGetLine..."+  hFlush stderr+  l <- bsGetLine s+  BS.hPutStrLn stderr l+  return l +debugBsGet :: BSStream -> Int -> IO BS.ByteString+debugBsGet s len = do+  hPutStr stderr $ "reading with bsGet "++show len++"..."+  hFlush stderr+  chunk <- bsGet s len+  BS.hPutStrLn stderr chunk+  return chunk -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-    bsIsOpen (DS h) = bsIsOpen h+debugBsPut :: BSStream -> BS.ByteString -> IO ()+debugBsPut s str = do+  hPutStr stderr "putting with bsPut ("+  BS.hPutStrLn stderr str+  hPutStr stderr (")...")+  hFlush stderr+  bsPut s str+  bsFlush s+  hPutStrLn stderr "done"+  return ()
src/Network/HaskellNet/IMAP.hs view
@@ -34,7 +34,6 @@ import Control.Applicative ((<$>)) import Control.Monad -import System.IO import System.Time  import Data.Maybe@@ -113,14 +112,15 @@ ---------------------------------------------------------------------- -- establish connection -connectIMAPPort :: String -> PortNumber -> IO (IMAPConnection Handle)+connectIMAPPort :: String -> PortNumber -> IO IMAPConnection connectIMAPPort hostname port =-    connectTo hostname (PortNumber port) >>= connectStream+    handleToStream <$> connectTo hostname (PortNumber port)+    >>= connectStream -connectIMAP :: String -> IO (IMAPConnection Handle)+connectIMAP :: String -> IO IMAPConnection connectIMAP hostname = connectIMAPPort hostname 143 -connectStream :: BSStream s => s -> IO (IMAPConnection s)+connectStream :: BSStream -> IO IMAPConnection connectStream s =     do msg <- bsGetLine s        unless (and $ BS.zipWith (==) msg (BS.pack "* OK")) $@@ -129,13 +129,14 @@  ---------------------------------------------------------------------- -- normal send commands-sendCommand' :: (BSStream s) => IMAPConnection s -> String -> IO (ByteString, Int)+sendCommand' :: IMAPConnection -> String -> IO (ByteString, Int) sendCommand' c cmdstr = do-  (_, num) <- withNextCommandNum c $ \num -> bsPutCrLf c $ BS.pack $ show6 num ++ " " ++ cmdstr-  resp <- getResponse c+  (_, num) <- withNextCommandNum c $ \num -> bsPutCrLf (stream c) $+              BS.pack $ show6 num ++ " " ++ cmdstr+  resp <- getResponse (stream c)   return (resp, num) -show6 :: (Ord a, Num a) => a -> String+show6 :: (Ord a, Num a, Show a) => a -> String show6 n | n > 100000 = show n         | n > 10000  = '0' : show n         | n > 1000   = "00" ++ show n@@ -143,7 +144,7 @@         | n > 10     = "0000" ++ show n         | otherwise  = "00000" ++ show n -sendCommand :: BSStream s => IMAPConnection s -> String+sendCommand :: IMAPConnection -> String             -> (RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, v))             -> IO v sendCommand imapc cmdstr pFunc =@@ -156,7 +157,7 @@          BAD _ msg     -> fail ("BAD: " ++ msg)          PREAUTH _ msg -> fail ("preauth: " ++ msg) -getResponse :: BSStream s => s -> IO ByteString+getResponse :: BSStream -> IO ByteString getResponse s = unlinesCRLF <$> getLs     where unlinesCRLF = BS.concat . concatMap (:[crlfStr])           getLs =@@ -180,7 +181,7 @@           getLitLen = read . BS.unpack . snd . BS.spanEnd isDigit . BS.init           isTagged l = BS.head l == '*' && BS.head (BS.tail l) == ' ' -mboxUpdate :: (BSStream s) => IMAPConnection s -> MboxUpdate -> IO ()+mboxUpdate :: IMAPConnection -> MboxUpdate -> IO () mboxUpdate conn (MboxUpdate exists' recent') = do   when (isJust exists') $        modifyMailboxInfo conn $ \mbox -> mbox { _exists = fromJust exists' }@@ -192,28 +193,28 @@ -- IMAP commands -- -noop :: BSStream s => IMAPConnection s -> IO ()+noop :: IMAPConnection -> IO () noop conn = sendCommand conn "NOOP" pNone -capability :: BSStream s => IMAPConnection s -> IO [String]+capability :: IMAPConnection -> IO [String] capability conn = sendCommand conn "CAPABILITY" pCapability -logout :: (BSStream s) => IMAPConnection s -> IO ()-logout c = do bsPutCrLf c $ BS.pack "a0001 LOGOUT"-              bsClose c+logout :: IMAPConnection -> IO ()+logout c = do bsPutCrLf (stream c) $ BS.pack "a0001 LOGOUT"+              bsClose (stream c) -login :: BSStream s => IMAPConnection s -> A.UserName -> A.Password -> IO ()+login :: IMAPConnection -> A.UserName -> A.Password -> IO () login conn username password = sendCommand conn ("LOGIN " ++ username ++ " " ++ password)                                pNone -authenticate :: (BSStream s) => IMAPConnection s -> A.AuthType+authenticate :: IMAPConnection -> A.AuthType              -> A.UserName -> A.Password -> IO () authenticate conn A.LOGIN username password =     do (_, num) <- sendCommand' conn "AUTHENTICATE LOGIN"-       bsPutCrLf conn $ BS.pack userB64-       bsGetLine conn-       bsPutCrLf conn $ BS.pack passB64-       buf <- getResponse conn+       bsPutCrLf (stream conn) $ BS.pack userB64+       bsGetLine (stream conn)+       bsPutCrLf (stream conn) $ BS.pack passB64+       buf <- getResponse $ stream conn        let (resp, mboxUp, value) = eval pNone (show6 num) buf        case resp of          OK _ _        -> do mboxUpdate conn $ mboxUp@@ -229,8 +230,9 @@                then A.b64Decode $ BS.unpack $ head $                     dropWhile (isSpace . BS.last) $ BS.inits $ BS.drop 2 c                else ""-       bsPutCrLf conn $ BS.pack $ A.auth at challenge username password-       buf <- getResponse conn+       bsPutCrLf (stream conn) $ BS.pack $+                 A.auth at challenge username password+       buf <- getResponse $ stream conn        let (resp, mboxUp, value) = eval pNone (show6 num) buf        case resp of          OK _ _        -> do mboxUpdate conn $ mboxUp@@ -239,57 +241,57 @@          BAD _ msg     -> fail ("BAD: " ++ msg)          PREAUTH _ msg -> fail ("preauth: " ++ msg) -_select :: (BSStream s) => String -> IMAPConnection s -> String -> IO ()+_select :: String -> IMAPConnection -> String -> IO () _select cmd conn mboxName =     do mbox' <- sendCommand conn (cmd ++ mboxName) pSelect        setMailboxInfo conn $ mbox' { _mailbox = mboxName } -select :: BSStream s => IMAPConnection s -> MailboxName -> IO ()+select :: IMAPConnection -> MailboxName -> IO () select = _select "SELECT " -examine :: BSStream s => IMAPConnection s -> MailboxName -> IO ()+examine :: IMAPConnection -> MailboxName -> IO () examine = _select "EXAMINE " -create :: BSStream s => IMAPConnection s -> MailboxName -> IO ()+create :: IMAPConnection -> MailboxName -> IO () create conn mboxname = sendCommand conn ("CREATE " ++ mboxname) pNone -delete :: BSStream s => IMAPConnection s -> MailboxName -> IO ()+delete :: IMAPConnection -> MailboxName -> IO () delete conn mboxname = sendCommand conn ("DELETE " ++ mboxname) pNone -rename :: BSStream s => IMAPConnection s -> MailboxName -> MailboxName -> IO ()+rename :: IMAPConnection -> MailboxName -> MailboxName -> IO () rename conn mboxorg mboxnew =     sendCommand conn ("RENAME " ++ mboxorg ++ " " ++ mboxnew) pNone -subscribe :: BSStream s => IMAPConnection s -> MailboxName -> IO ()+subscribe :: IMAPConnection -> MailboxName -> IO () subscribe conn mboxname = sendCommand conn ("SUBSCRIBE " ++ mboxname) pNone -unsubscribe :: BSStream s => IMAPConnection s -> MailboxName -> IO ()+unsubscribe :: IMAPConnection -> MailboxName -> IO () unsubscribe conn mboxname = sendCommand conn ("UNSUBSCRIBE " ++ mboxname) pNone -list :: BSStream s => IMAPConnection s -> IO [([Attribute], MailboxName)]+list :: IMAPConnection -> IO [([Attribute], MailboxName)] list conn = (map (\(a, _, m) -> (a, m))) <$> listFull conn "\"\"" "*" -lsub :: BSStream s => IMAPConnection s -> IO [([Attribute], MailboxName)]+lsub :: IMAPConnection -> IO [([Attribute], MailboxName)] lsub conn = (map (\(a, _, m) -> (a, m))) <$> lsubFull conn "\"\"" "*" -listFull :: BSStream s => IMAPConnection s -> String -> String+listFull :: IMAPConnection -> String -> String          -> IO [([Attribute], String, MailboxName)] listFull conn ref pat = sendCommand conn (unwords ["LIST", ref, pat]) pList -lsubFull :: BSStream s => IMAPConnection s -> String -> String+lsubFull :: IMAPConnection -> String -> String          -> IO [([Attribute], String, MailboxName)] lsubFull conn ref pat = sendCommand conn (unwords ["LSUB", ref, pat]) pLsub -status :: BSStream s => IMAPConnection s -> MailboxName -> [MailboxStatus]+status :: IMAPConnection -> MailboxName -> [MailboxStatus]        -> IO [(MailboxStatus, Integer)] status conn mbox stats =     let cmd = "STATUS " ++ mbox ++ " (" ++ (unwords $ map show stats) ++ ")"     in sendCommand conn cmd pStatus -append :: BSStream s => IMAPConnection s -> MailboxName -> ByteString -> IO ()+append :: IMAPConnection -> MailboxName -> ByteString -> IO () append conn mbox mailData = appendFull conn mbox mailData [] Nothing -appendFull :: BSStream s => IMAPConnection s -> MailboxName -> ByteString+appendFull :: IMAPConnection -> MailboxName -> ByteString            -> [Flag] -> Maybe CalendarTime -> IO () appendFull conn mbox mailData flags' time =     do (buf, num) <- sendCommand' conn@@ -297,8 +299,8 @@                          , fstr, tstr,  "{" ++ show len ++ "}"])        unless (BS.null buf || (BS.head buf /= '+')) $               fail "illegal server response"-       mapM_ (bsPutCrLf conn) mailLines-       buf2 <- getResponse conn+       mapM_ (bsPutCrLf $ stream conn) mailLines+       buf2 <- getResponse $ stream conn        let (resp, mboxUp, ()) = eval pNone (show6 num) buf2        case resp of          OK _ _ -> mboxUpdate conn mboxUp@@ -310,21 +312,21 @@           tstr      = maybe "" show time           fstr      = unwords $ map show flags' -check :: BSStream s => IMAPConnection s -> IO ()+check :: IMAPConnection -> IO () check conn = sendCommand conn "CHECK" pNone -close :: BSStream s => IMAPConnection s -> IO ()+close :: IMAPConnection -> IO () close conn =     do sendCommand conn "CLOSE" pNone        setMailboxInfo conn emptyMboxInfo -expunge :: BSStream s => IMAPConnection s -> IO [Integer]+expunge :: IMAPConnection -> IO [Integer] expunge conn = sendCommand conn "EXPUNGE" pExpunge -search :: BSStream s => IMAPConnection s -> [SearchQuery] -> IO [UID]+search :: IMAPConnection -> [SearchQuery] -> IO [UID] search conn queries = searchCharset conn "" queries -searchCharset :: BSStream s => IMAPConnection s -> Charset -> [SearchQuery]+searchCharset :: IMAPConnection -> Charset -> [SearchQuery]               -> IO [UID] searchCharset conn charset queries =     sendCommand conn ("UID SEARCH "@@ -333,67 +335,67 @@                            else "")                     ++ unwords (map show queries)) pSearch -fetch :: BSStream s => IMAPConnection s -> UID -> IO ByteString+fetch :: IMAPConnection -> UID -> IO ByteString fetch conn uid =     do lst <- fetchByString conn uid "BODY[]"        return $ maybe BS.empty BS.pack $ lookup "BODY[]" lst -fetchHeader :: BSStream s => IMAPConnection s -> UID -> IO ByteString+fetchHeader :: IMAPConnection -> UID -> IO ByteString fetchHeader conn uid =     do lst <- fetchByString conn uid "BODY[HEADER]"        return $ maybe BS.empty BS.pack $ lookup "BODY[HEADER]" lst -fetchSize :: BSStream s => IMAPConnection s -> UID -> IO Int+fetchSize :: IMAPConnection -> UID -> IO Int fetchSize conn uid =     do lst <- fetchByString conn uid "RFC822.SIZE"        return $ maybe 0 read $ lookup "RFC822.SIZE" lst -fetchHeaderFields :: BSStream s => IMAPConnection s+fetchHeaderFields :: IMAPConnection                   -> UID -> [String] -> IO ByteString fetchHeaderFields conn uid hs =     do lst <- fetchByString conn uid ("BODY[HEADER.FIELDS "++unwords hs++"]")        return $ maybe BS.empty BS.pack $               lookup ("BODY[HEADER.FIELDS "++unwords hs++"]") lst -fetchHeaderFieldsNot :: BSStream s => IMAPConnection s+fetchHeaderFieldsNot :: IMAPConnection                      -> UID -> [String] -> IO ByteString fetchHeaderFieldsNot conn uid hs =     do let fetchCmd = "BODY[HEADER.FIELDS.NOT "++unwords hs++"]"        lst <- fetchByString conn uid fetchCmd        return $ maybe BS.empty BS.pack $ lookup fetchCmd lst -fetchFlags :: BSStream s => IMAPConnection s -> UID -> IO [Flag]+fetchFlags :: IMAPConnection -> UID -> IO [Flag] fetchFlags conn uid =     do lst <- fetchByString conn uid "FLAGS"        return $ getFlags $ lookup "FLAGS" lst     where getFlags Nothing  = []           getFlags (Just s) = eval' dvFlags "" s -fetchR :: BSStream s => IMAPConnection s -> (UID, UID)+fetchR :: IMAPConnection -> (UID, UID)        -> IO [(UID, ByteString)] fetchR conn r =     do lst <- fetchByStringR conn r "BODY[]"        return $ map (\(uid, vs) -> (uid, maybe BS.empty BS.pack $                                        lookup "BODY[]" vs)) lst-fetchByString :: BSStream s => IMAPConnection s -> UID -> String+fetchByString :: IMAPConnection -> UID -> String               -> IO [(String, String)] fetchByString conn uid command =     do lst <- fetchCommand conn ("UID FETCH "++show uid++" "++command) id        return $ snd $ head lst -fetchByStringR :: BSStream s => IMAPConnection s -> (UID, UID) -> String+fetchByStringR :: IMAPConnection -> (UID, UID) -> String                -> IO [(UID, [(String, String)])] fetchByStringR conn (s, e) command =     fetchCommand conn ("UID FETCH "++show s++":"++show e++" "++command) proc     where proc (n, ps) =               (maybe (toEnum (fromIntegral n)) read (lookup "UID" ps), ps) -fetchCommand :: (BSStream s) => IMAPConnection s -> String+fetchCommand :: IMAPConnection -> String              -> ((Integer, [(String, String)]) -> b) -> IO [b] fetchCommand conn command proc =     (map proc) <$> sendCommand conn command pFetch -storeFull :: BSStream s => IMAPConnection s -> String -> FlagsQuery -> Bool+storeFull :: IMAPConnection -> String -> FlagsQuery -> Bool           -> IO [(UID, [Flag])] storeFull conn uidstr query isSilent =     fetchCommand conn ("UID STORE " ++ uidstr ++ flgs query) procStore@@ -408,14 +410,14 @@                               ,maybe [] (eval' dvFlags "") (lookup "FLAG" ps))  -store :: BSStream s => IMAPConnection s -> UID -> FlagsQuery -> IO ()-store conn i q       = storeFull conn (show i) q True >> return ()+store :: IMAPConnection -> UID -> FlagsQuery -> IO ()+store conn i q = storeFull conn (show i) q True >> return () -copyFull :: (BSStream s) => IMAPConnection s -> String -> String -> IO ()+copyFull :: IMAPConnection -> String -> String -> IO () copyFull conn uidStr mbox =     sendCommand conn ("UID COPY " ++ uidStr ++ " " ++ mbox) pNone -copy :: BSStream s => IMAPConnection s -> UID -> MailboxName -> IO ()+copy :: IMAPConnection -> UID -> MailboxName -> IO () copy conn uid mbox     = copyFull conn (show uid) mbox  ----------------------------------------------------------------------@@ -442,3 +444,9 @@  strip :: ByteString -> ByteString strip = fst . BS.spanEnd isSpace . BS.dropWhile isSpace++crlf :: BS.ByteString+crlf = BS.pack "\r\n"++bsPutCrLf :: BSStream -> ByteString -> IO ()+bsPutCrLf h s = bsPut h s >> bsPut h crlf >> bsFlush h
src/Network/HaskellNet/IMAP/Connection.hs view
@@ -38,56 +38,46 @@     , UID     ) -data BSStream s => IMAPConnection s =-    IMAPC { stream :: s+data IMAPConnection =+    IMAPC { stream :: BSStream           , mboxInfo :: IORef MailboxInfo           , nextCommandNum :: IORef Int           } -instance BSStream s => BSStream (IMAPConnection s) where-    bsGetLine = bsGetLine . stream-    bsGet = bsGet . stream-    bsPut h s = bsPut (stream h) s-    bsPutStrLn h s = bsPutStrLn (stream h) s-    bsPutNoFlush = bsPutNoFlush . stream-    bsFlush = bsFlush . stream-    bsClose = bsClose . stream-    bsIsOpen = bsIsOpen . stream--newConnection :: (BSStream s) => s -> IO (IMAPConnection s)+newConnection :: BSStream -> IO IMAPConnection newConnection s = IMAPC s <$> (newIORef emptyMboxInfo) <*> (newIORef 0) -getMailboxInfo :: (BSStream s) => IMAPConnection s -> IO MailboxInfo+getMailboxInfo :: IMAPConnection -> IO MailboxInfo getMailboxInfo c = readIORef $ mboxInfo c -mailbox :: (BSStream s) => IMAPConnection s -> IO MailboxName+mailbox :: IMAPConnection -> IO MailboxName mailbox c = _mailbox <$> getMailboxInfo c -exists :: (BSStream s) => IMAPConnection s -> IO Integer+exists :: IMAPConnection -> IO Integer exists c = _exists <$> getMailboxInfo c -recent :: (BSStream s) => IMAPConnection s -> IO Integer+recent :: IMAPConnection -> IO Integer recent c = _recent <$> getMailboxInfo c -flags :: (BSStream s) => IMAPConnection s -> IO [Flag]+flags :: IMAPConnection -> IO [Flag] flags c = _flags <$> getMailboxInfo c -permanentFlags :: (BSStream s) => IMAPConnection s -> IO [Flag]+permanentFlags :: IMAPConnection -> IO [Flag] permanentFlags c = _permanentFlags <$> getMailboxInfo c -isWritable :: (BSStream s) => IMAPConnection s -> IO Bool+isWritable :: IMAPConnection -> IO Bool isWritable c = _isWritable <$> getMailboxInfo c -isFlagWritable :: (BSStream s) => IMAPConnection s -> IO Bool+isFlagWritable :: IMAPConnection -> IO Bool isFlagWritable c = _isFlagWritable <$> getMailboxInfo c -uidNext :: (BSStream s) => IMAPConnection s -> IO UID+uidNext :: IMAPConnection -> IO UID uidNext c = _uidNext <$> getMailboxInfo c -uidValidity :: (BSStream s) => IMAPConnection s -> IO UID+uidValidity :: IMAPConnection -> IO UID uidValidity c = _uidValidity <$> getMailboxInfo c -withNextCommandNum :: (BSStream s) => IMAPConnection s -> (Int -> IO a) -> IO (a, Int)+withNextCommandNum :: IMAPConnection -> (Int -> IO a) -> IO (a, Int) withNextCommandNum c act = do   let ref = nextCommandNum c   num <- readIORef ref@@ -95,8 +85,8 @@   modifyIORef ref (+1)   return (result, num) -setMailboxInfo :: (BSStream s) => IMAPConnection s -> MailboxInfo -> IO ()+setMailboxInfo :: IMAPConnection -> MailboxInfo -> IO () setMailboxInfo c = writeIORef (mboxInfo c) -modifyMailboxInfo :: (BSStream s) => IMAPConnection s -> (MailboxInfo -> MailboxInfo) -> IO ()+modifyMailboxInfo :: IMAPConnection -> (MailboxInfo -> MailboxInfo) -> IO () modifyMailboxInfo c f = modifyIORef (mboxInfo c) f
src/Network/HaskellNet/POP3.hs view
@@ -30,7 +30,6 @@  import Network.HaskellNet.BSStream import Network-import Network.HaskellNet.Auth hiding (auth, login) import qualified Network.HaskellNet.Auth as A  import Data.ByteString (ByteString)@@ -66,17 +65,18 @@  -- | connecting to the pop3 server specified by the hostname and port -- number-connectPop3Port :: String -> PortNumber -> IO (POP3Connection Handle)+connectPop3Port :: String -> PortNumber -> IO POP3Connection connectPop3Port hostname port =-    connectTo hostname (PortNumber port) >>= connectStream+    handleToStream <$> (connectTo hostname (PortNumber port))+    >>= connectStream  -- | connecting to the pop3 server specified by the hostname. 110 is -- used for the port number.-connectPop3 :: String -> IO (POP3Connection Handle)+connectPop3 :: String -> IO POP3Connection connectPop3 = flip connectPop3Port 110  -- | connecting to the pop3 server via a stream-connectStream :: BSStream s => s -> IO (POP3Connection s)+connectStream :: BSStream -> IO POP3Connection connectStream st =     do (resp, msg) <- response st        when (resp == Err) $ fail "cannot connect"@@ -85,7 +85,7 @@          then return $ newConnection st (BS.unpack code)          else return $ newConnection st "" -response :: BSStream s => s -> IO (Response, ByteString)+response :: BSStream -> IO (Response, ByteString) response st =     do reply <- strip <$> bsGetLine st        if (BS.pack "+OK") `BS.isPrefixOf` reply@@ -93,51 +93,51 @@          else return (Err, BS.drop 5 reply)  -- | parse mutiline of response-responseML :: BSStream s => s -> IO (Response, ByteString)-responseML st =+responseML :: POP3Connection -> IO (Response, ByteString)+responseML conn =     do reply <- strip <$> bsGetLine st        if (BS.pack "+OK") `BS.isPrefixOf` reply          then do rest <- getRest                  return (Ok, BS.unlines (BS.drop 4 reply : rest))          else return (Err, BS.drop 5 reply)-    where getRest = do l <- strip <$> bsGetLine st+    where st = stream conn+          getRest = do l <- strip <$> bsGetLine st                        if l == BS.singleton '.'                          then return []                          else (l:) <$> getRest  -- | sendCommand sends a pop3 command via a pop3 connection.  This -- action is too generic. Use more specific actions-sendCommand :: BSStream s => POP3Connection s -> Command-            -> IO (Response, ByteString)+sendCommand :: POP3Connection -> Command -> IO (Response, ByteString) sendCommand conn (LIST Nothing) =-    bsPutCrLf conn (BS.pack "LIST") >> responseML conn+    bsPutCrLf (stream conn) (BS.pack "LIST") >> responseML conn sendCommand conn (UIDL Nothing) =-    bsPutCrLf conn (BS.pack "UIDL") >> responseML conn+    bsPutCrLf (stream conn) (BS.pack "UIDL") >> responseML conn sendCommand conn (RETR msg) =-    bsPutCrLf conn (BS.pack $ "RETR " ++ show msg) >> responseML conn+    bsPutCrLf (stream conn) (BS.pack $ "RETR " ++ show msg) >> responseML conn sendCommand conn (TOP msg n) =-    bsPutCrLf conn (BS.pack $ "TOP " ++ show msg ++ " " ++ show n) >>+    bsPutCrLf (stream conn) (BS.pack $ "TOP " ++ show msg ++ " " ++ show n) >>     responseML conn-sendCommand conn (AUTH LOGIN username password) =-    do bsPutCrLf conn $ BS.pack "AUTH LOGIN"-       bsGetLine conn-       bsPutCrLf conn $ BS.pack userB64-       bsGetLine conn-       bsPutCrLf conn $ BS.pack passB64-       response conn+sendCommand conn (AUTH A.LOGIN username password) =+    do bsPutCrLf (stream conn) $ BS.pack "AUTH LOGIN"+       bsGetLine (stream conn)+       bsPutCrLf (stream conn) $ BS.pack userB64+       bsGetLine (stream conn)+       bsPutCrLf (stream conn) $ BS.pack passB64+       response (stream conn)     where (userB64, passB64) = A.login username password sendCommand conn (AUTH at username password) =-    do bsPutCrLf conn $ BS.pack $ unwords ["AUTH", show at]-       c <- bsGetLine conn+    do bsPutCrLf (stream conn) $ BS.pack $ unwords ["AUTH", show at]+       c <- bsGetLine (stream conn)        let challenge =                if BS.take 2 c == BS.pack "+ "-               then b64Decode $ BS.unpack $ head $+               then A.b64Decode $ BS.unpack $ head $                     dropWhile (isSpace . BS.last) $ BS.inits $ BS.drop 2 c                else ""-       bsPutCrLf conn $ BS.pack $ A.auth at challenge username password-       response conn+       bsPutCrLf (stream conn) $ BS.pack $ A.auth at challenge username password+       response (stream conn) sendCommand conn command =-    bsPutCrLf conn (BS.pack commandStr) >> response conn+    bsPutCrLf (stream conn) (BS.pack commandStr) >> response (stream conn)     where commandStr = case command of                          (USER name)  -> "USER " ++ name                          (PASS passw) -> "PASS " ++ passw@@ -154,86 +154,92 @@                          (RETR _) -> error "BUG: RETR should not get matched here"                          (TOP _ _) -> error "BUG: TOP should not get matched here" -user :: BSStream s => POP3Connection s -> String -> IO ()+user :: POP3Connection -> String -> IO () user conn name = do (resp, _) <- sendCommand conn (USER name)                     when (resp == Err) $ fail "cannot send user name" -pass :: BSStream s => POP3Connection s -> String -> IO ()+pass :: POP3Connection -> String -> IO () pass conn pwd = do (resp, _) <- sendCommand conn (PASS pwd)                    when (resp == Err) $ fail "cannot send password" -userPass :: BSStream s => POP3Connection s -> UserName -> Password -> IO ()+userPass :: POP3Connection -> A.UserName -> A.Password -> IO () userPass conn name pwd = user conn name >> pass conn pwd -auth :: BSStream s => POP3Connection s -> AuthType -> UserName -> Password+auth :: POP3Connection -> A.AuthType -> A.UserName -> A.Password      -> IO () auth conn at username password =     do (resp, msg) <- sendCommand conn (AUTH at username password)        unless (resp == Ok) $ fail $ "authentication failed: " ++ BS.unpack msg -apop :: BSStream s => POP3Connection s -> String -> String -> IO ()+apop :: POP3Connection -> String -> String -> IO () apop conn name pwd =     do (resp, msg) <- sendCommand conn (APOP name pwd)        when (resp == Err) $ fail $ "authentication failed: " ++ BS.unpack msg -stat :: BSStream s => POP3Connection s -> IO (Int, Int)+stat :: POP3Connection -> IO (Int, Int) stat conn = do (resp, msg) <- sendCommand conn STAT                when (resp == Err) $ fail "cannot get stat info"                let (nn, mm) = BS.span (/=' ') msg                return (read $ BS.unpack nn, read $ BS.unpack $ BS.tail mm) -dele :: BSStream s => POP3Connection s -> Int -> IO ()+dele :: POP3Connection -> Int -> IO () dele conn n = do (resp, _) <- sendCommand conn (DELE n)                  when (resp == Err) $ fail "cannot delete" -retr :: BSStream s => POP3Connection s -> Int -> IO ByteString+retr :: POP3Connection -> Int -> IO ByteString retr conn n = do (resp, msg) <- sendCommand conn (RETR n)                  when (resp == Err) $ fail "cannot retrieve"                  return $ BS.tail $ BS.dropWhile (/='\n') msg -top :: BSStream s => POP3Connection s -> Int -> Int -> IO ByteString+top :: POP3Connection -> Int -> Int -> IO ByteString top conn n m = do (resp, msg) <- sendCommand conn (TOP n m)                   when (resp == Err) $ fail "cannot retrieve"                   return $ BS.tail $ BS.dropWhile (/='\n') msg -rset :: BSStream s => POP3Connection s -> IO ()+rset :: POP3Connection -> IO () rset conn = do (resp, _) <- sendCommand conn RSET                when (resp == Err) $ fail "cannot reset" -allList :: BSStream s => POP3Connection s -> IO [(Int, Int)]+allList :: POP3Connection -> IO [(Int, Int)] allList conn = do (resp, lst) <- sendCommand conn (LIST Nothing)                   when (resp == Err) $ fail "cannot retrieve the list"                   return $ map f $ tail $ BS.lines lst     where f s = let (n1, n2) = BS.span (/=' ') s                 in (read $ BS.unpack n1, read $ BS.unpack $ BS.tail n2) -list :: BSStream s => POP3Connection s -> Int -> IO Int+list :: POP3Connection -> Int -> IO Int list conn n = do (resp, lst) <- sendCommand conn (LIST (Just n))                  when (resp == Err) $ fail "cannot retrieve the list"                  let (_, n2) = BS.span (/=' ') lst                  return $ read $ BS.unpack $ BS.tail n2 -allUIDLs :: BSStream s => POP3Connection s -> IO [(Int, ByteString)]+allUIDLs :: POP3Connection -> IO [(Int, ByteString)] allUIDLs conn = do (resp, lst) <- sendCommand conn (UIDL Nothing)                    when (resp == Err) $ fail "cannot retrieve the uidl list"                    return $ map f $ tail $ BS.lines lst     where f s = let (n1, n2) = BS.span (/=' ') s in (read $ BS.unpack n1, n2) -uidl :: BSStream s => POP3Connection s -> Int -> IO ByteString+uidl :: POP3Connection -> Int -> IO ByteString uidl conn n = do (resp, msg) <- sendCommand conn (UIDL (Just n))                  when (resp == Err) $ fail "cannot retrieve the uidl data"                  return $ BS.tail $ BS.dropWhile (/=' ') msg -closePop3 :: BSStream s => POP3Connection s -> IO ()+closePop3 :: POP3Connection -> IO () closePop3 c = do sendCommand c QUIT-                 bsClose c+                 bsClose (stream c) -doPop3Port :: String -> PortNumber -> (POP3Connection Handle -> IO a) -> IO a+doPop3Port :: String -> PortNumber -> (POP3Connection -> IO a) -> IO a doPop3Port host port execution =     bracket (connectPop3Port host port) closePop3 execution -doPop3 :: String -> (POP3Connection Handle -> IO a) -> IO a+doPop3 :: String -> (POP3Connection -> IO a) -> IO a doPop3 host execution = doPop3Port host 110 execution -doPop3Stream :: BSStream s => s -> (POP3Connection s -> IO b) -> IO b+doPop3Stream :: BSStream -> (POP3Connection -> IO b) -> IO b doPop3Stream conn execution = bracket (connectStream conn) closePop3 execution++crlf :: BS.ByteString+crlf = BS.pack "\r\n"++bsPutCrLf :: BSStream -> ByteString -> IO ()+bsPutCrLf h s = bsPut h s >> bsPut h crlf >> bsFlush h
src/Network/HaskellNet/POP3/Connection.hs view
@@ -1,5 +1,6 @@ module Network.HaskellNet.POP3.Connection     ( POP3Connection+    , stream     , newConnection     , apopKey     )@@ -7,20 +8,10 @@  import Network.HaskellNet.BSStream -data BSStream s => POP3Connection s =-    POP3C { stream :: !s+data POP3Connection =+    POP3C { stream :: !BSStream           , apopKey :: !String -- ^ APOP key           } -newConnection :: BSStream s => s -> String -> POP3Connection s+newConnection :: BSStream -> String -> POP3Connection newConnection = POP3C--instance BSStream s => BSStream (POP3Connection s) where-    bsGetLine = bsGetLine . stream-    bsGet = bsGet . stream-    bsPut h s = bsPut (stream h) s-    bsPutStrLn h s = bsPutStrLn (stream h) s-    bsPutNoFlush = bsPutNoFlush . stream-    bsFlush = bsFlush . stream-    bsClose = bsClose . stream-    bsIsOpen = bsIsOpen . stream
src/Network/HaskellNet/SMTP.hs view
@@ -26,6 +26,7 @@ import Network.BSD (getHostName) import Network +import Control.Applicative ((<$>)) import Control.Exception import Control.Monad (unless) @@ -44,7 +45,7 @@  import Prelude hiding (catch) -data (BSStream s) => SMTPConnection s = SMTPC !s ![ByteString]+data SMTPConnection = SMTPC !BSStream ![ByteString]  data Command = HELO String              | EHLO String@@ -89,16 +90,17 @@ -- | connecting SMTP server with the specified name and port number. connectSMTPPort :: String     -- ^ name of the server                 -> PortNumber -- ^ port number-                -> IO (SMTPConnection Handle)+                -> IO SMTPConnection connectSMTPPort hostname port =-    connectTo hostname (PortNumber port) >>= connectStream+    (handleToStream <$> connectTo hostname (PortNumber port))+    >>= connectStream  -- | connecting SMTP server with the specified name and port 25. connectSMTP :: String     -- ^ name of the server-            -> IO (SMTPConnection Handle)+            -> IO SMTPConnection connectSMTP = flip connectSMTPPort 25 -tryCommand :: BSStream s => s -> Command -> Int -> ReplyCode+tryCommand :: BSStream -> Command -> Int -> ReplyCode            -> IO ByteString tryCommand st cmd tries expectedReply | tries <= 0 = do   bsClose st@@ -111,7 +113,7 @@       tryCommand st cmd (tries - 1) expectedReply  -- | create SMTPConnection from already connected Stream-connectStream :: BSStream s => s -> IO (SMTPConnection s)+connectStream :: BSStream -> IO SMTPConnection connectStream st =     do (code1, _) <- parseResponse st        unless (code1 == 220) $@@ -121,7 +123,7 @@        msg <- tryCommand st (EHLO senderHost) 3 250        return (SMTPC st (tail $ BS.lines msg)) -parseResponse :: BSStream s => s -> IO (ReplyCode, ByteString)+parseResponse :: BSStream -> IO (ReplyCode, ByteString) parseResponse st =     do (code, bdy) <- readLines        return (read $ BS.unpack code, BS.unlines bdy)@@ -135,8 +137,7 @@   -- | send a method to a server-sendCommand :: BSStream s => SMTPConnection s -> Command-            -> IO (ReplyCode, ByteString)+sendCommand :: SMTPConnection -> Command -> IO (ReplyCode, ByteString) sendCommand (SMTPC conn _) (DATA dat) =     do bsPutCrLf conn $ BS.pack "DATA"        (code, _) <- parseResponse conn@@ -183,7 +184,7 @@  -- | close the connection.  This function send the QUIT method, so you -- do not have to QUIT method explicitly.-closeSMTP :: BSStream s => SMTPConnection s -> IO ()+closeSMTP :: SMTPConnection -> IO () closeSMTP (SMTPC conn _) = bsClose conn  {-@@ -201,11 +202,10 @@  -- | sending a mail to a server. This is achieved by sendMessage.  If -- something is wrong, it raises an IOexception.-sendMail :: BSStream s =>-            String     -- ^ sender mail+sendMail :: String     -- ^ sender mail          -> [String]   -- ^ receivers          -> ByteString -- ^ data-         -> SMTPConnection s+         -> SMTPConnection          -> IO () sendMail sender receivers dat conn =     catcher `handle` mainProc@@ -219,25 +219,26 @@  -- | doSMTPPort open a connection, and do an IO action with the -- connection, and then close it.-doSMTPPort :: String -> PortNumber -> (SMTPConnection Handle -> IO a) -> IO a+doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a doSMTPPort host port execution =     bracket (connectSMTPPort host port) closeSMTP execution  -- | doSMTP is similar to doSMTPPort, except that it does not require -- port number but connects to the server with port 25.-doSMTP :: String -> (SMTPConnection Handle -> IO a) -> IO a+doSMTP :: String -> (SMTPConnection -> IO a) -> IO a doSMTP host execution = doSMTPPort host 25 execution  -- | doSMTPStream is similar to doSMTPPort, except that its argument -- is a Stream data instead of hostname and port number.-doSMTPStream :: BSStream s => s -> (SMTPConnection s -> IO a) -> IO a+doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a doSMTPStream s execution = bracket (connectStream s) closeSMTP execution -sendMimeMail :: BSStream s => String -> String -> String -> LT.Text-             -> LT.Text -> [(T.Text, FilePath)] -> SMTPConnection s -> IO ()+sendMimeMail :: String -> String -> String -> LT.Text+             -> LT.Text -> [(T.Text, FilePath)] -> SMTPConnection -> IO () sendMimeMail to from subject plainBody htmlBody attachments con = do-  myMail <- simpleMail (T.pack to) (T.pack from) (T.pack subject)-            plainBody htmlBody attachments+  myMail <- simpleMail (Address Nothing $ T.pack to) (Address Nothing+                                                      $ T.pack from)+            (T.pack subject) plainBody htmlBody attachments   renderedMail <- renderMail' myMail   sendMail from [to] (lazyToStrict renderedMail) con   closeSMTP con@@ -247,3 +248,8 @@ lazyToStrict :: B.ByteString -> S.ByteString lazyToStrict = S.concat . B.toChunks +crlf :: BS.ByteString+crlf = BS.pack "\r\n"++bsPutCrLf :: BSStream -> ByteString -> IO ()+bsPutCrLf h s = bsPut h s >> bsPut h crlf >> bsFlush h
src/Text/Packrat/Parse.hs view
@@ -5,8 +5,8 @@  import Prelude hiding (exp, rem) -import Char-import List+import Data.Char+import Data.List  import Text.Packrat.Pos