packages feed

email (empty) → 0.1

raw patch · 14 files changed

+756/−0 lines, 14 filesdep +HaskellNetdep +arraydep +basesetup-changed

Dependencies added: HaskellNet, array, base, bytestring, encoding, hsemail, old-locale, old-time, parsec, process, time

Files

+ Data/Email.hs view
@@ -0,0 +1,31 @@+module Data.Email (sendSimpleEmail) where++----------------------------------------+---- STDLIB+----------------------------------------+import Data.Encoding (encodeStrictByteString)+import Data.Encoding.UTF8 (UTF8(..))++----------------------------------------+---- SITE-PACKAGES+----------------------------------------+import Network.EmailSend (sendMessage)+import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..))++----------------------------------------+---- LOCAL+----------------------------------------+import Data.EmailSerializer (serializeMessage)+import Data.EmailRepr (_EMPTY_EMAIL_, Email(..), email2message, Content(..))++sendSimpleEmail backend from to subject text =+    sendMessage backend from to (+        (serializeMessage . email2message)+            _EMPTY_EMAIL_ { em_from=[(NameAddr Nothing from)]+                          , em_to=[(NameAddr Nothing to)]+                          , em_subject=subject+                          , em_optionals=[("Content-Type",+                                           "text/plain; charset=utf-8")]+                          , em_body=ContentByte+                                      (encodeStrictByteString UTF8 text)+                          })
+ Data/EmailRepr.hs view
@@ -0,0 +1,114 @@+-- vim: set encoding=utf-8 :++module Data.EmailRepr(Email(..), Message, _EMPTY_EMAIL_, encodeHeaders+                     ,Headers, Content(..), MimePart(..), email2message) where+----------------------------------------+---- STDLIB+----------------------------------------+import Data.Time.Calendar (toGregorian)+import Data.Time.Format (formatTime)+import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), TimeZone(..), ZonedTime(..))++import System.Time (CalendarTime(..), Day(..), Month(..))+import System.Locale (defaultTimeLocale)++----------------------------------------+---- SITE-PACKAGES+----------------------------------------+import Text.ParserCombinators.Parsec.Rfc2822+       (Field(..), NameAddr(..), GenericMessage(..))+import qualified Data.ByteString as BS (ByteString, empty, concat)+import Data.EmailSerializer (Message, encodeHeader, _CRLF_)++----------------------------------------+---- LOCAL+----------------------------------------++data Email = Email { em_from :: [NameAddr]+                   , em_to :: [NameAddr]+                   , em_cc :: [NameAddr]+                   , em_bcc :: [NameAddr]+                   , em_subject :: String+                   , em_date :: Maybe ZonedTime+                   , em_optionals :: Headers+                   , em_body :: Content+                   } deriving Show++_EMPTY_EMAIL_ = Email [] [] [] [] "" Nothing [] (ContentByte BS.empty)+type Headers = [(String, String)]++data Content = ContentByte BS.ByteString | ContentMime MimePart deriving Show++data MimePart = MimePart+  { mp_mime_type :: Maybe String -- text/plain \+  , mp_filename :: Maybe String  -- test.txt    +--> Content-Type+  , mp_charset :: Maybe String   -- UTF-8      /+  , mp_inline :: Bool            -- True       ----> Content-Disposition+  , mp_optionals :: Headers      -- [("MIME-Version", "1.0)]+  , mp_content :: Content        -- "foo bar"+  } deriving Show++append2 ::  BS.ByteString -> BS.ByteString -> BS.ByteString+append2 a b = BS.concat [a, _CRLF_, b]++encodeHeaders :: Headers -> BS.ByteString+encodeHeaders hs = foldr append2 BS.empty $ map (uncurry encodeHeader) hs++dow2ltDow :: Int -> Day+dow2ltDow day =+            case day of+              0 -> Sunday+              1 -> Monday+              2 -> Tuesday+              3 -> Wednesday+              4 -> Thursday+              5 -> Friday+              6 -> Saturday++dtMonth2ltMonth :: Int -> Month+dtMonth2ltMonth dtMonth =+            case dtMonth of+              1 -> January+              2 -> February+              3 -> March+              4 -> April+              5 -> May+              6 -> June+              7 -> July+              8 -> August+              9 -> September+              10 -> October+              11 -> November+              12 -> December++zonedTimeToCalendarTime :: ZonedTime -> CalendarTime+zonedTimeToCalendarTime (ZonedTime (LocalTime day (TimeOfDay h min s)) (TimeZone tzMin tzDst tzName)) =+-- =+    CalendarTime y' m' d h min s' ps wd yd tzName tzSec tzDst+    where (y, m, d)  = toGregorian day+          y' = fromInteger y+          m' = dtMonth2ltMonth m+          s' = fromInteger (round s)+          tzSec = tzMin * 60+          wd = dow2ltDow (read $ formatTime defaultTimeLocale "%w" day)+          ps = 0+          yd = read $ formatTime defaultTimeLocale "%j" day+++email2message :: Email -> Message+email2message (Email ef et ecc ebcc es ed eo (ContentByte eb)) = +              Message fields' eb+              where fromField = From ef+                    toField = To et+                    ccField = Cc ecc+                    bccField = Bcc ebcc+                    subjectField = Subject es+                    optionalFields = map (uncurry OptionalField) eo+                    fields = [fromField] ++ [toField] ++ [ccField] ++ [bccField] +++                             [subjectField] ++ optionalFields+                    fields' = case ed of+                                   Just date -> +                                     fields ++ [dateField]+                                     where format = "%a, %d %b %Y %H:%M:%S %z"+                                           dateField = Date (zonedTimeToCalendarTime date)+                                   Nothing -> fields
+ Data/EmailSerializer.hs view
@@ -0,0 +1,114 @@+-- vim: set encoding=utf-8 :++module Data.EmailSerializer(_CRLF_, Message, encodeHeader, encodeAscii, serializeMessage) where+----------------------------------------+---- STDLIB+----------------------------------------+import Data.Encoding (encodeStrictByteString)+import System.Time (calendarTimeToString, CalendarTime)++----------------------------------------+---- SITE-PACKAGES+----------------------------------------+import Text.ParserCombinators.Parsec.Rfc2822 (GenericMessage(..), Field(..),+                                              NameAddr(..))+import qualified Data.ByteString as BS (ByteString, empty, concat)+import Data.Encoding (encodeStrictByteString)+import Data.Encoding.ASCII (ASCII(..))++----------------------------------------+---- LOCAL+----------------------------------------+import WashUtils.RFC2047 (encodeValueBS)++_EMPTY_MESSAGE_ = Message [] BS.empty+_CRLF_ = encodeAscii "\r\n"++encodeAscii ::  String -> BS.ByteString+encodeAscii s = encodeStrictByteString ASCII s++maybeEncodeValue ::  [Char] -> String -> BS.ByteString+maybeEncodeValue "Content-Type" v = encodeAscii v+maybeEncodeValue "Content-Disposition" v = encodeAscii v+maybeEncodeValue k v = encodeValueBS v++encodeHeaderBS :: String -> BS.ByteString -> BS.ByteString+encodeHeaderBS key value = BS.concat [encodeAscii (key++": "), value]++encodeHeader :: String -> String -> BS.ByteString+encodeHeader key value = encodeHeaderBS key (maybeEncodeValue key value)++type Message = GenericMessage BS.ByteString++serializeMessage :: Message -> BS.ByteString+serializeMessage (Message hs msg) = BS.concat [encodeHeaders hs+                                              ,_CRLF_+                                              ,msg+                                              ]++crlfAppend ::  BS.ByteString -> BS.ByteString -> BS.ByteString+crlfAppend l r = BS.concat [l, _CRLF_, r]++encodeHeaders :: [Field] -> BS.ByteString+encodeHeaders fs = foldr crlfAppend BS.empty $ map encodeField fs++encodeField :: Field -> BS.ByteString+encodeField (OptionalField k v) = BS.concat[encodeAscii k+                                           ,encodeAscii ": "+                                           ,maybeEncodeValue k v+                                           ]+encodeField (From ns) = encodeNameAddrs "From" ns+encodeField (Sender n) = encodeNameAddr "Sender" n+encodeField (ReturnPath r) = encodeHeader "Return-Path" r+encodeField (ReplyTo ns) = encodeNameAddrs "Reply-To" ns+encodeField (To ns) = encodeNameAddrs "To" ns+encodeField (Cc ns) = encodeNameAddrs "Cc" ns+encodeField (Bcc ns) = encodeNameAddrs "Bcc" ns+encodeField (MessageID id) = encodeHeader "Message-ID" id+encodeField (InReplyTo sl) = encodeStringList "In-Reply-To" sl+encodeField (References sl) = encodeStringList "References" sl+encodeField (Subject s) = encodeHeader "Subject" s+encodeField (Comments s) = encodeHeader "Comments" s+encodeField (Keywords dsl) = encodeDoubleStringList "Keywords" dsl+encodeField (Date ct) = encodeCalendarTime "Date" ct+encodeField (ResentDate ct) = encodeCalendarTime "Resent-Date" ct+encodeField (ResentFrom ns) = encodeNameAddrs "Resent-From" ns+encodeField (ResentSender n) = encodeNameAddr "Resent-Sender" n+encodeField (ResentTo ns) = encodeNameAddrs "Resent-To" ns+encodeField (ResentCc ns) = encodeNameAddrs "Resent-Cc" ns+encodeField (ResentBcc ns) = encodeNameAddrs "Resent-Bcc" ns+encodeField (ResentMessageID s) = encodeHeader "Resent-Message-ID" s+encodeField (ResentReplyTo ns) = encodeNameAddrs "Resent-Reply-To" ns+encodeField (Received rc) = encodeReceived "Received" rc+encodeField (ObsReceived orc) = encodeObsReceived "Obs-Received" orc++appendComma :: BS.ByteString -> BS.ByteString -> BS.ByteString+appendComma l r = BS.concat [l, encodeAscii ", ", r]++encodeNameAddrs :: String -> [NameAddr] -> BS.ByteString+encodeNameAddrs k vs = encodeHeaderBS k $+                       foldr appendComma BS.empty $ map encodeNameAddrValue vs++encodeNameAddr :: String -> NameAddr -> BS.ByteString+encodeNameAddr k v = encodeHeaderBS k $ encodeNameAddrValue v++encodeNameAddrValue :: NameAddr -> BS.ByteString+encodeNameAddrValue (NameAddr Nothing m) = encodeValueBS m+encodeNameAddrValue (NameAddr (Just n) m) = encodeValueBS (n++" <"++m++">")+++encodeStringList :: String -> [String] -> BS.ByteString+encodeStringList k vs = encodeHeaderBS k $ foldr appendComma BS.empty $+                                                 map encodeValueBS vs++encodeCalendarTime :: String -> System.Time.CalendarTime -> BS.ByteString+encodeCalendarTime k v = encodeHeader k (calendarTimeToString v)++encodeReceived ::  String -> ([(String, String)], CalendarTime) -> BS.ByteString+encodeReceived k v = encodeHeader k (show v)++encodeObsReceived :: String -> [(String, String)] -> BS.ByteString+encodeObsReceived k v = encodeHeader k (show v)++encodeDoubleStringList ::  String -> [[String]] -> BS.ByteString+encodeDoubleStringList k v = encodeHeader k (show v)
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Johannes Weiss, Dirk Spoeri, Gero Kriependorf 2010+Copyright 2001-2003, Peter Thiemann.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Johannes Weiss nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.
+ Network/EmailSend.hs view
@@ -0,0 +1,8 @@+module Network.EmailSend(MailBackend(..), SendingReceipt) where++import Data.ByteString (ByteString)++type SendingReceipt = Maybe String++class MailBackend a where+    sendMessage :: a -> String -> String -> ByteString -> IO SendingReceipt
+ Network/EmailSend/SMTP.hs view
@@ -0,0 +1,33 @@+module Network.EmailSend.SMTP(SMTPBackend(..)) where++----------------------------------------+---- STDLIB+----------------------------------------++----------------------------------------+---- SITE-PACKAGES+----------------------------------------+import Data.ByteString (ByteString)+import qualified Network.HaskellNet.SMTP as SMTP+import Network.EmailSend (MailBackend(..), SendingReceipt)++----------------------------------------+---- LOCAL+----------------------------------------++data SMTPBackend = SMTPBackend String String++instance MailBackend SMTPBackend where+    sendMessage = smtpSendMessage++smtpSendMessage :: SMTPBackend -> String -> String -> ByteString ->+                   IO SendingReceipt+smtpSendMessage (SMTPBackend server hostname) from to message = (do+    c <- SMTP.connectSMTP server+    SMTP.sendCommand c $ SMTP.EHLO hostname+    SMTP.sendCommand c $ SMTP.MAIL from+    SMTP.sendCommand c $ SMTP.RCPT to+    SMTP.sendCommand c $ SMTP.DATA message+    SMTP.sendCommand c SMTP.NOOP+    SMTP.sendCommand c SMTP.QUIT+    return Nothing) `catch` (\m -> return $ Just $ show m)
+ Network/EmailSend/SendMail.hs view
@@ -0,0 +1,43 @@+module Network.EmailSend.SendMail(sendMessageSendMail+                                 , SendMailBackend(..)) where++----------------------------------------+---- STDLIB+----------------------------------------+import qualified System.IO as Sio+import qualified System.Process as Spo+import qualified Data.ByteString as BS+import System.Exit (ExitCode(..))++----------------------------------------+---- SITE-PACKAGES+----------------------------------------+import Network.EmailSend (MailBackend(..), SendingReceipt)+import Data.Encoding.UTF8 (UTF8(..))+import Data.Encoding (decodeStrictByteString)++----------------------------------------+---- LOCAL+----------------------------------------++_SENDMAIL_BINARY_ = "/usr/sbin/sendmail"++data SendMailBackend = SendMailBackend String | StdSendMailBackend+instance MailBackend SendMailBackend where+    sendMessage = sendMessageSendMail++sendMessageSendMail :: SendMailBackend -> String -> String -> BS.ByteString -> IO SendingReceipt+sendMessageSendMail (SendMailBackend binary) = sendEmail binary+sendMessageSendMail StdSendMailBackend = sendEmail _SENDMAIL_BINARY_++sendEmail :: String -> String -> String -> BS.ByteString -> IO SendingReceipt+sendEmail binary from to message =+  do (inh, outh, errh, ph) <-+       Spo.runInteractiveProcess binary [to] Nothing Nothing+     Sio.hClose outh+     BS.hPutStr inh message+     Sio.hClose inh+     ret <- Spo.waitForProcess ph+     case ret of+       ExitSuccess -> return Nothing+       ExitFailure code -> return $ Just $ show code
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ WashUtils/Base64.hs view
@@ -0,0 +1,123 @@+-- © 2002 Peter Thiemann+-- |Implements RFC 2045 MIME coding.+module WashUtils.Base64+       (encode, encode', decode, decode'+       ,alphabet_list+       )+       where++import Data.Array+import Data.Char++--+-- |Yields encoded input cropped to lines of less than 76 characters. Directly+-- usable as email body.+encode :: String -> String+encode = encode_base64+-- |yields continuous stream of bytes.+encode' :: String -> String+encode' = encode_base64'+-- |Directly applicable to email body.+decode :: String -> String+decode = decode_base64+-- |Only applicable to stream of Base64 characters.+decode' :: String -> String+decode' = decode_base64'+-- |Applicable to list of lines.+decode_lines :: [String] -> String+decode_lines = decode_base64_lines++-- --------------------------------------------------------------------+-- |Base64 alphabet in encoding order.+alphabet_list :: String+alphabet_list =+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"++encode_base64_alphabet_index =+  zip [0 .. (63::Int)] alphabet_list++decode_base64_alphabet_index =+  zip alphabet_list [0 .. (63::Int)]++encode_base64_alphabet =+  array (0 :: Int, 63 :: Int) encode_base64_alphabet_index++decode_base64_alphabet =+  array (' ','z') decode_base64_alphabet_index++base64_character =+  array (chr 0, chr 255) [(c, c `elem` alphabet_list || c == '=') | c <- [chr 0 .. chr 255]]++encode_base64 = linebreak 76 . encode_base64'++linebreak m xs = lb m xs+  where+    lb n [] = "\r\n"+    lb 0 xs = '\r':'\n': lb m xs+    lb n (x:xs) = x: lb (n-1) xs++encode_base64' [] = []++encode_base64' [ch] =+  encode_base64_alphabet!b1 :+  encode_base64_alphabet!b2 :+  "=="+  where (b1, b2, _, _) = encode_base64_group (ch, chr 0, chr 0)++encode_base64' [ch1, ch2] =+  encode_base64_alphabet!b1 :+  encode_base64_alphabet!b2 :+  encode_base64_alphabet!b3 :+  "="+  where (b1, b2, b3, _) = encode_base64_group (ch1, ch2, chr 0)++encode_base64' (ch1: ch2: ch3: rest) =+  encode_base64_alphabet!b1 :+  encode_base64_alphabet!b2 :+  encode_base64_alphabet!b3 :+  encode_base64_alphabet!b4 :+  encode_base64' rest+  where (b1, b2, b3, b4) = encode_base64_group (ch1, ch2, ch3)++-- 111111 112222 222233 333333+encode_base64_group (ch1, ch2, ch3) = (b1, b2, b3, b4)+  where o1 = ord ch1+	o2 = ord ch2+	o3 = ord ch3+	b1 = o1 `div` 4+	b2 = (o1 `mod` 4) * 16 + o2 `div` 16+	b3 = (o2 `mod` 16) * 4 + o3 `div` 64+	b4 = o3 `mod` 64++decode_base64_group (b1, b2, b3, b4) = (ch1, ch2, ch3)+  where ch1 = chr (b1 * 4 + b2 `div` 16)+	ch2 = chr (b2 `mod` 16 * 16 + b3 `div` 4)+	ch3 = chr (b3 `mod` 4 * 64 + b4)++decode_base64' [] = []++decode_base64' [cin1, cin2, '=', '='] = [cout1]+  where (cout1, _, _) =+          decode_base64_group (decode_base64_alphabet!cin1+	  		      ,decode_base64_alphabet!cin2+			      ,0+			      ,0)++decode_base64' [cin1, cin2, cin3, '='] = [cout1, cout2]+  where (cout1, cout2, _) =+          decode_base64_group (decode_base64_alphabet!cin1+	  		      ,decode_base64_alphabet!cin2+			      ,decode_base64_alphabet!cin3+			      ,0)++decode_base64' (cin1: cin2: cin3: cin4: rest) =+  cout1: cout2: cout3: decode_base64' rest+  where (cout1, cout2, cout3) =+          decode_base64_group (decode_base64_alphabet!cin1+	  		      ,decode_base64_alphabet!cin2+			      ,decode_base64_alphabet!cin3+			      ,decode_base64_alphabet!cin4)++decode_base64 = decode_base64' . filter (base64_character!)++decode_base64_lines = decode_base64' . concat
+ WashUtils/Hex.hs view
@@ -0,0 +1,48 @@+-- © 2001, 2003 Peter Thiemann+module WashUtils.Hex where++import Data.Array+import Data.Char++hexdigit :: Int -> Char+hexdigit i = hexdigits ! i++hexdigits' = "0123456789ABCDEF"+alternative_digits = "abcdef"+alternative_indices :: [(Int, Char)]+alternative_indices = zip [10..15] alternative_digits+hexdigits'_indices :: [(Int, Char)]+hexdigits'_indices = [(i, hexdigits'!!i) | i <- [0..15]]++hexdigits = array (0, 15) hexdigits'_indices++fromHexdigits =+  array (chr 0, chr 127)+        (map (\ (x,y) -> (y, x)) (hexdigits'_indices ++ alternative_indices))++isHexdigitArray =+  array (chr 0, chr 127)+	(map (\ c -> (c, isHexdigit c)) [chr 0 .. chr 127])+  where+    isHexdigit :: Char -> Bool+    isHexdigit x =+      (x >= '0' && x <= '9') ||+      (x >= 'a' && x <= 'f') ||+      (x >= 'A' && x <= 'F')++isHexdigit :: Char -> Bool+isHexdigit x =+  x <= chr 127 && isHexdigitArray ! x++showHex2 :: Int -> String+showHex2 ox = showsHex 2 ox ""++showsHex :: Int -> Int -> ShowS+showsHex 0 x = id+showsHex i x = let (d,m) = x `divMod` 16 in showsHex (i-1) d . showChar (hexdigits ! m)++hexDigitVal :: Char -> Int+hexDigitVal x | isHexdigit x = fromHexdigits ! x+	      | otherwise    = 0++allDigits = hexdigits' ++ alternative_digits
+ WashUtils/QuotedPrintable.hs view
@@ -0,0 +1,49 @@+-- © 2003 Peter Thiemann+module WashUtils.QuotedPrintable+       (encode, encode', decode+       -- deprecated: encode_quoted, encode_quoted', decode_quoted+       ) where++import Data.Char+import WashUtils.Hex++encode, encode', decode :: String -> String+encode = encode_quoted+encode' = encode_quoted'+decode = decode_quoted+++encode_hexadecimal c = '=' : showHex2 c++quoted_printable x =+  ox >= 33 && ox <= 126 && ox /= 61 && ox /= 63+  where ox = ord x++end_of_line [] = False+end_of_line ('\r':'\n':_) = True+end_of_line _ = False++encode_quoted' (x:xs) | x `elem` "\t " =+                          encode_hexadecimal (ord x) ++ encode_quoted' xs+encode_quoted' (x:xs) | quoted_printable x = x : encode_quoted' xs+encode_quoted' ('\r':'\n':xs) = '\r':'\n': encode_quoted' xs+encode_quoted' (x:xs) = encode_hexadecimal (ord x) ++ encode_quoted' xs+encode_quoted' [] = ""++encode_quoted = softLineBreak 76 . encode_quoted'++softLineBreak n [] = []+softLineBreak 0 xs | not (end_of_line xs) = '=':'\r':'\n': softLineBreak 76 xs+softLineBreak n ('\r':'\n':xs) = '\r':'\n': softLineBreak 76 xs+softLineBreak n (xs@('=':_)) | n < 4 = '=':'\r':'\n': softLineBreak 76 xs+softLineBreak n (x:xs) = x : softLineBreak (n-1) xs++decode_quoted [] = []+decode_quoted ('=':'\r':'\n':xs) =+  decode_quoted xs+decode_quoted ('=':'\n':xs) =+  decode_quoted xs+decode_quoted ('=':upper:lower:xs) | isHexdigit upper && isHexdigit lower =+  chr (16 * hexDigitVal upper + hexDigitVal lower) : decode_quoted xs+decode_quoted (x:xs) =+  x : decode_quoted xs
+ WashUtils/RFC2047.hs view
@@ -0,0 +1,108 @@+-- © 2003 Peter Thiemann+module WashUtils.RFC2047 where+-- decoding of header fields+import qualified Data.ByteString as Bs+import qualified Data.ByteString.Char8 as BsChar8+import Data.Char+import qualified Data.Encoding as DataEnc+import Data.Encoding.ASCII (ASCII(..))+import Data.Encoding (encodeStrictByteString)+import Data.List++import qualified WashUtils.Base64 as Base64+import qualified WashUtils.QuotedPrintable as QuotedPrintable+import qualified WashUtils.Base64 as Base64+import WashUtils.Hex++import Text.ParserCombinators.Parsec++lineString =+  do initial <- many (noneOf "\n\r=")+     rest <- option "" (do xs <- try encoded_words <|> string "="+			   ys <- lineString+			   return (xs ++ ys))+     return (initial ++ rest)++especials = "()<>@,;:\\\"/[]?.="+tokenchar = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" \\ especials+p_token = many1 (oneOf tokenchar)+p_encoded_text = many1 $ oneOf "!\"#$%&'()*+,-./0123456789:;<=>@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"+allchar = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\a\b\t\n\v\f\r\SO\SI\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\EM\SUB\ESC\FS\GS\RS\US !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL"++-- supress linear white space between adjacent encoded_word+encoded_words =+  do ew <- encoded_word+     ws <- many space+     option (ew++ws) (encoded_words >>= \ews -> return (ew++ews))++encoded_word =+  do string "=?"+     charset <- p_token+     char '?'+     encoding <- p_token+     char '?'+     encoded_text <- p_encoded_text+     string "?="+     return $ decode charset (map toUpper encoding) encoded_text++decodeCharset charset text =+--encodeCharset charset text =+    DataEnc.decodeStrictByteString encoding (BsChar8.pack text)+        where encoding = DataEnc.encodingFromString (map toUpper charset)++decode charset "B" encoded_text =+    decodeCharset charset (Base64.decode' encoded_text)+decode charset "Q" encoded_text =+    decodeCharset charset (decode_quoted encoded_text)+decode charset encoding encoded_text =+  error ("Unknown encoding: " ++ encoding)++decode_quoted [] = []+decode_quoted ('=':upper:lower:xs) =+  chr (16 * hexDigitVal upper + hexDigitVal lower) : decode_quoted xs+--decode_quoted ('_':xs) = ' ' : decode_quoted xs+decode_quoted (x:xs) =+  x : decode_quoted xs++-- --------------------------------------------------------------------+-- RFC 2047: encoding of header fields++encodeCharset ::  String -> String -> [Char]+encodeCharset charset text =+    BsChar8.unpack (DataEnc.encodeStrictByteString encoder text)+           where encoder = DataEnc.encodingFromString charset++encodeWord ::  String -> [Char]+encodeWord w =+  "=?" ++ charset ++ "?" ++ encoding ++ "?" ++ encoded ++ "?="+  where encoding = "B"+	charset  = "UTF-8"+        --encoded = QuotedPrintable.encode' converted+        encoded = Base64.encode' converted+        converted = encodeCharset charset w++encodeValue ::  [Char] -> [Char]+encodeValue v =+  case span (not . flip elem "()<>@.!,?") v of+    ([], []) -> []+    (word, []) -> maybeEncode word+    (word, x:rest) -> maybeEncode word ++ x : encodeValue rest++maybeEncode ::  [Char] -> [Char]+maybeEncode word | all p word = word+                 | otherwise = encodeWord word+  where p x = x /= '?' && let ox = ord x in ox >= 33 && ox <= 126++encodeAscii = encodeStrictByteString ASCII++encodeCharsetBS ::  String -> String -> Bs.ByteString+encodeCharsetBS x = encodeAscii .  encodeCharset x++encodeWordBS ::  String -> Bs.ByteString+encodeWordBS = encodeAscii . encodeWord++encodeValueBS ::  [Char] -> Bs.ByteString+encodeValueBS = encodeAscii . encodeValue++maybeEncodeBS ::  [Char] -> Bs.ByteString+maybeEncodeBS = encodeAscii . maybeEncode
+ email.cabal view
@@ -0,0 +1,24 @@+Name:                   email+Version:                0.1+Author:                 Johannes Weiss <weiss@tux4u.de>, Dirk Spoeri,+                        Gero Kriependorf+License:                BSD3+License-File:           LICENSE+Maintainer:             Johannes Weiss <weiss@tux4u.de>+Category:               Network+Synopsis:               Sending eMail in Haskell made easy+Cabal-Version:          >=1.6+Build-Type:             Simple+Tested-With:            GHC == 6.12.1+Description:            A simple and small library for sending eMail.++Library+    Build-Depends:      base == 4.*, bytestring, HaskellNet, encoding, process,+                        hsemail >= 1.4, old-locale, old-time, time, parsec,+                        array+    Exposed-Modules:    Network.EmailSend+                        Network.EmailSend.SMTP+                        Network.EmailSend.SendMail+                        Data.Email+                        Data.EmailRepr+                        Data.EmailSerializer
+ testemail.hs view
@@ -0,0 +1,28 @@+{- vim: set encoding=utf-8 :+ -*- coding: utf-8 -*- -}+----------------------------------------+---- STDLIB+----------------------------------------++----------------------------------------+---- SITE-PACKAGES+----------------------------------------+import Network.EmailSend.SendMail (SendMailBackend(..))+import Data.Email (sendSimpleEmail)+import Network.EmailSend(sendMessage, MailBackend(..), SendingReceipt, )+import Network.EmailSend.SMTP (SMTPBackend(..))+import Network.EmailSend.SendMail (SendMailBackend(..))++----------------------------------------+---- LOCAL+----------------------------------------++main = do+    putStrLn "Sending Mail..."+    let smtp = SMTPBackend "localhost" "localhost"+    --sendSimpleEmail StdSendMailBackend "dirk" "weissi" "test ääööüü" "hallo ääüüöö"+    x <- sendSimpleEmail smtp "dirk" "weissi" "test ääööüü" "hallo ääüüöö"+    case x of+      Nothing -> putStrLn "done."+      Just m -> putStrLn $ "ERROR: "++m+    putStrLn "bye bye"