~singpolyma/cheogram-smtp

1de6f0cb7ee18c53a604433acbdd156f83e76618 — Stephen Paul Weber 2 years ago 5ae8ddb
Add a lens to get at the email message in an envelope
2 files changed, 33 insertions(+), 2 deletions(-)

M Email.hs
M test/EmailTest.hs
M Email.hs => Email.hs +6 -2
@@ 7,8 7,8 @@ import Data.Functor                              ((<&>))
import Control.Error                             (headZ, lastZ, justZ, hush)
import Data.Time.Clock                           (UTCTime)
import Data.Time.Format                          (formatTime, defaultTimeLocale)
import Control.Lens 
	(Const, Leftmost, filtered, firstOf, view, _Right, set, at)
import Control.Lens
	(Lens', Const, Leftmost, filtered, firstOf, view, _Right, set, at)
import qualified Data.ByteString.Char8           as C8
import qualified Data.Text                       as T
import qualified Data.Attoparsec.ByteString.Lazy as Atto


@@ 238,6 238,10 @@ data EmailWithEnvelope = EmailWithEnvelope {
	emailEnvelopeTo :: MIME.AddrSpec
}

emailMessage' :: Lens' EmailWithEnvelope MIME.MIMEMessage
emailMessage' f (EmailWithEnvelope msg from to) =
	fmap (\msg' -> EmailWithEnvelope msg' from to) (f msg)

sendEmail :: (MonadIO m) => EmailWithEnvelope -> m ()
sendEmail (EmailWithEnvelope mail from to) =
	liftIO $ Mail.sendmailCustom "/usr/sbin/sendmail" [

M test/EmailTest.hs => test/EmailTest.hs +27 -0
@@ 5,6 5,7 @@ import BasicPrelude
import Test.Tasty.HUnit
import Test.QuickCheck.Instances ()
import Control.Error (hush)
import Control.Lens (view, set)
import qualified Data.Time.Format as Time
import qualified Data.MIME as MIME
import qualified Data.XML.Types as XML


@@ 598,3 599,29 @@ unit_messageToEmailWithDeepCheoThread =
			]
		]
	}

unit_emailMessage' :: IO ()
unit_emailMessage' =
	view emailMessage' envelope @?= email
	where
	envelope = EmailWithEnvelope email undefined undefined
	Right email = MIME.parse (MIME.message MIME.mime) $ encodeUtf8 $
		s"To: to@example.com\n\
		\From: Human <f@example.com>\n\
		\Subject: subject\n\
		\Message-ID: <boop-id@ids.example.com>\n\
		\\n\
		\Hello\n"

unit_emailMessage'Set :: IO ()
unit_emailMessage'Set =
	view emailMessage' (set emailMessage' email envelope) @?= email
	where
	envelope = EmailWithEnvelope undefined undefined undefined
	Right email = MIME.parse (MIME.message MIME.mime) $ encodeUtf8 $
		s"To: to@example.com\n\
		\From: Human <f@example.com>\n\
		\Subject: subject\n\
		\Message-ID: <boop-id@ids.example.com>\n\
		\\n\
		\Hello\n"