diff --git a/README.rst b/README.rst
--- a/README.rst
+++ b/README.rst
@@ -1,1 +1,1 @@
-Email handling library.  Groks RFC 5322 and MIME.
+Email handling library.  RFC 5322, MIME and more.
diff --git a/purebred-email.cabal b/purebred-email.cabal
--- a/purebred-email.cabal
+++ b/purebred-email.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                purebred-email
-version:             0.2.0.0
+version:             0.3.0.0
 synopsis:            types and parser for email messages (including MIME)
 description:
   The purebred email library.  RFC 5322, MIME, etc.
@@ -10,16 +10,15 @@
   Things that are currently implemented:
   .
   - RFC 5322 message parsing and serialisation
-  - MIME multipart parsing (RFC 2046)
+  - MIME multipart parsing (RFC 2046) and serialisation
   - MIME message header extensions for non-ASCII text (RFC 2047)
   - MIME parameter value and encoded word extensions (RFC 2231)
   - Content-Disposition header field (RFC 2183)
+  - Message encapsulation (forward/bounce)
   .
   Things that are not yet implemented / need improvement:
   .
-  - Support for more charsets
   - Improve handling of dates
-  - Sensible heuristics for choosing a content transfer encoding
   - Probably lots of other things
 
 license:             AGPL-3
@@ -35,7 +34,7 @@
   tests/golden/*.golden
 cabal-version:       >=1.10
 tested-with:
-  GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
+  GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
 
 homepage:            https://github.com/purebred-mua/purebred-email
 bug-reports:         https://github.com/purebred-mua/purebred-email/issues
@@ -52,6 +51,7 @@
     Data.RFC5322
     , Data.RFC5322.Address.Text
     , Data.RFC5322.Address.Types
+    , Data.RFC5322.Internal
     , Data.MIME
     , Data.MIME.Error
     , Data.MIME.Charset
@@ -62,11 +62,10 @@
     , Data.MIME.Base64
     , Data.MIME.QuotedPrintable
   other-modules:
-    Data.RFC5322.Internal
-    , Data.MIME.Internal
+    Data.MIME.Internal
   -- other-extensions:    
   build-depends:
-    base >= 4.8 && < 5
+    base >= 4.11 && < 5
     , attoparsec >= 0.13 && < 0.14
     , base64-bytestring >= 1 && < 2
     , bytestring >= 0.10 && < 0.11
@@ -93,6 +92,8 @@
     , Headers
     , MIME
     , Generator
+    , Parser
+    , Message
   build-depends:
     base
     , bytestring
diff --git a/src/Data/MIME.hs b/src/Data/MIME.hs
--- a/src/Data/MIME.hs
+++ b/src/Data/MIME.hs
@@ -9,17 +9,28 @@
 
 {- |
 
-MIME messages (RFC 2045, RFC 2046 and friends).
+MIME messages (RFC 2045, RFC 2046, RFC 2183 and friends).
 
+This module extends "Data.RFC5322" with types for handling MIME
+messages.  It provides the 'mime' parsing helper function for
+use with 'message'.
+
 -}
 module Data.MIME
   (
-  -- * Overview
-  -- $overview
+  -- * Overview / HOWTO
+  -- ** Creating and serialising mail
+  -- $create
 
-  -- * Examples / HOWTO
-  -- $examples
+  -- ** Parsing mail
+  -- $parse
 
+  -- ** Inspecting messages
+  -- $inspect
+
+  -- ** Unicode support
+  -- $unicode
+
   -- * API
 
   -- ** MIME data type
@@ -38,6 +49,7 @@
   , attachments
   , isAttachment
   , transferDecoded
+  , transferDecoded'
   , charsetDecoded
 
   -- ** Header processing
@@ -73,16 +85,19 @@
   , buildMessage
 
   -- ** Mail creation
+  -- *** Common use cases
+  , createTextPlainMessage
+  , createAttachment
+  , createAttachmentFromFile
+  , createMultipartMixedMessage
+  , encapsulate
+  -- *** Setting headers
   , headerFrom
   , headerTo
   , headerCC
   , headerBCC
   , headerDate
   , replyHeaderReferences
-  , createAttachmentFromFile
-  , createAttachment
-  , createTextPlainMessage
-  , createMultipartMixedMessage
 
   -- * Re-exports
   , CharsetLookup
@@ -93,9 +108,10 @@
   ) where
 
 import Control.Applicative
-import Control.Monad (void)
+import Data.List.NonEmpty (NonEmpty, fromList)
 import Data.Maybe (fromMaybe, catMaybes)
 import Data.Semigroup ((<>))
+import Data.String (IsString(fromString))
 import GHC.Generics (Generic)
 
 import Control.DeepSeq (NFData)
@@ -119,102 +135,186 @@
 import Data.MIME.EncodedWord
 import Data.MIME.Parameter
 import Data.MIME.TransferEncoding
-import Data.MIME.Types (Encoding(..))
 
-{- $overview
+{- $create
 
-This module extends 'Data.RFC5322' with types for handling MIME
-messages.  It provides the 'mime' parsing helper function for
-use with 'message'.
+Create an inline, plain text message and render it:
 
 @
-'mime' :: Headers -> Parser MIME
-message mime :: Parser (Message ctx MIME)
+λ> import Data.MIME
+λ> msg = 'createTextPlainMessage' "Hello, world!"
+λ> s = 'renderMessage' msg
+λ> B.putStrLn s
+MIME-Version: 1.0
+Content-Transfer-Encoding: 7bit
+Content-Type: text/plain; charset=us-ascii
+Content-Disposition: inline
+
+Hello, world!
 @
 
-The 'Message' data type has a phantom type parameter for context.
-In this module we use it to track whether the body has
-/content transfer encoding/ or /charset encoding/ applied.  Type
-aliases are provided for convenince.
+__TODO__ show how to set From,To,Cc,etc.
 
-@
-data 'Message' ctx a = Message Headers a
-data 'EncStateWire'
-data 'EncStateByte'
+Create a multipart message with attachment:
 
-type 'MIMEMessage' = Message EncStateWire MIME
-type 'WireEntity' = Message EncStateWire B.ByteString
-type 'ByteEntity' = Message EncStateByte B.ByteString
-type 'TextEntity' = Message () T.Text
 @
+λ> attachment = 'createAttachment' "application/json" (Just "data.json") "{\"foo\":42}"
+λ> msg2 = 'createMultipartMixedMessage' "boundary" [msg, attachment]
+λ> s2 = 'renderMessage' msg2
+λ> B.putStrLn s2
+MIME-Version: 1.0
+Content-Type: multipart/mixed; boundary=boundary
 
-Folds are provided over all leaf /entities/, and entities that are
-identified as attachments:
+--boundary
+Content-Transfer-Encoding: 7bit
+Content-Disposition: inline
+Content-Type: text/plain; charset=us-ascii
 
-@
-'entities' :: Fold MIMEMessage WireEntity
-'attachments' :: Fold MIMEMessage WireEntity
-@
+Hello, world!
+--boundary
+Content-Transfer-Encoding: 7bit
+Content-Disposition: attachment; filename=data.json
+Content-Type: application/json
 
-Content transfer decoding is performed using the 'transferDecoded'
-optic.  This will convert /Quoted-Printable/ or /Base64/ encoded
-entities into their decoded form.
+{"foo":42}
+--boundary--
 
 @
-'transferDecoded' :: Getter WireEntity (Either 'TransferEncodingError' ByteEntity)
-transferDecoded :: Getter WireEntity (Either 'EncodingError' ByteEntity)
-transferDecoded :: (HasTransferEncoding a, AsTransferEncodingError e) => Getter a (Either e (TransferDecoded a))
-@
 
-Charset decoding is performed using the 'charsetDecoded' optic:
+-}
 
+{- $parse
+
+Most often you will parse a message like this:
+
 @
-'charsetDecoded' :: Getter ByteEntity (Either 'CharsetError' TextEntity)
-charsetDecoded :: Getter ByteEntity (Either 'EncodingError' TextEntity)
-charsetDecoded :: (HasCharset a, AsCharsetError e) => Getter a (Either e (Decoded a))
+λ> parsedMessage = 'parse' ('message' 'mime') s2
+λ> :t parsedMessage
+parsedMessage :: Either String 'MIMEMessage'
+λ> parsedMessage == Right msg2
+True
 @
 
+The 'message' function builds a parser for a message.  It is
+abstracted over the body type; the argument is a function that can
+inspect headers and return a parser for the body.  If you are
+parsing MIME messages (or plain RFC 5322 messages), the 'mime'
+function is the right one to use.
+
 -}
 
-{- $examples
+{- $inspect
 
-__Parse__ a MIME message:
+Parsing an email is nice, but your normally want to get at the
+content inside.  One of the most important tasks is finding entities
+of interest, e.g. attachments, plain text or HTML bodies.  The
+'entities' optic is a fold over all /leaf/ entities in the message.
+That is, all the non-multipart bodies.  You can use 'filtered' to
+refine the query.
 
+For example, let's say you want to find the first @text/plain@
+entity in a message.  Define a predicate with the help of the
+'matchContentType' function:
+
 @
-'parse' (message mime) :: ByteString -> Either String MIMEMessage
+λ> isTextPlain = 'matchContentType' "text" (Just "plain") . view 'contentType'
+λ> :t isTextPlain
+isTextPlain :: HasHeaders s => s -> Bool
+λ> isTextPlain msg
+True
+λ> isTextPlain msg2
+False
 @
 
-Find the first entity with the @text/plain@ __content type__:
+Now we can use the predicate to construct a fold and retrieve the
+body.  If there is no matching entity the result would be @Nothing@.
 
 @
-getTextPlain :: 'MIMEMessage' -> Maybe 'WireEntity'
-getTextPlain = firstOf ('entities' . filtered f)
-  where
-  f = 'matchContentType' "text" (Just "plain") . view ('headers' . 'contentType')
+λ> firstOf ('entities' . filtered isTextPlain . 'body') msg2
+Just "Hello, world!"
 @
 
-Perform __content transfer decoding__ /and/ __charset__ decoding
-while preserving decode errors:
+For __attachments__ you are normally interested in the binary data
+and possibly the filename (if specified).  In the following example we retrieve all attachments, and their filenames, as a list of tuples (although there is only one in the message).  Note that
 
+Get the (optional) filenames and (decoded) body of all attachments,
+as a list of tuples.  The 'attachments' optic selects non-multipart
+entities with @Content-Disposition: attachment@.  The 'attachments'
+fold targets all entities with @Content-Disposition: attachment@.
+The 'transferDecoded'' optic undoes the @Content-Transfer-Encoding@
+of the entity.
+
 @
-view 'transferDecoded' >=> view 'charsetDecoded' :: WireEntity -> Either EncodingError TextEntity
+λ> getFilename = preview ('contentDisposition' . _Just . 'filename' 'defaultCharsets')
+λ> getBody = preview ('transferDecoded'' . _Right . 'body')
+λ> getAttachment = liftA2 (,) getFilename getBody
+λ> toListOf ('attachments' . to getAttachment) msg2
+[(Just "data.json",Just "{\"foo\":42}")]
 @
 
-Get all __attachments__ (transfer decoded) and their __filenames__ (if specified):
+Finally, note that the 'filename' optic takes an argument: it is a
+function for looking up a character set.  Supporting every possible
+character encoding is a bit tricky so we let the user supply a map
+of supported charsets, and provide 'defaultCharsets' which supports
+ASCII, UTF-8 and ISO-8859-1.
 
 @
-getAttachments :: 'MIMEMessage' -> [(Either 'TransferEncodingError' B.ByteString, Maybe T.Text)]
-getAttachments = toListOf ('attachments' . to (liftA2 (,) content name)
-  where
-  content = view 'transferDecodedBytes'
-  name = preview ('headers' . 'contentDisposition' . 'filename')
+λ> :t 'filename'
+filename
+  :: ('HasParameters' a, Applicative f) =>
+     'CharsetLookup' -> (T.Text -> f T.Text) -> a -> f a
+λ> :t 'defaultCharsets'
+defaultCharsets :: CharsetLookup
+λ> :i CharsetLookup
+type CharsetLookup = CI Char8.ByteString -> Maybe Data.MIME.Charset.Charset
 @
 
-Create an inline, plain text message and render it:
+-}
 
+{- $unicode
+
+In Australia we say "Hello world" upside down:
+
 @
-renderMessage $ createTextPlainMessage "This is a test body"
+λ> msg3 = createTextPlainMessage "ɥǝןןo ʍoɹןp"
+λ> B.putStrLn $ renderMessage msg3
+MIME-Version: 1.0
+Content-Transfer-Encoding: base64
+Content-Disposition: inline
+Content-Type: text/plain; charset=utf-8
+
+yaXHndef159vIMqNb8m5159w
+
 @
+
+Charset set and transfer encoding are handled automatically.  If the
+message only includes characters representable in ASCII, the charset
+will be @us-ascii@, otherwise @utf-8@.
+
+To read the message as @Text@ you must perform transfer decoding and
+charset decoding.  The 'transferDecoded' optic performs transfer
+decoding, as does its sibling 'transferDecoded'' which is
+monomorphic in the error type.  Similarly, 'charsetText' and
+'charsetText'' perform text decoding according to the character set.
+
+If you don't mind throwing away decoding errors, the simplest way to
+get the text of a message is:
+
+@
+λ> Just ent = firstOf ('entities' . filtered isTextPlain) msg3
+λ> :t ent
+ent :: 'WireEntity'
+λ> text = preview ('transferDecoded'' . _Right . 'charsetText'' 'defaultCharsets' . _Right) ent
+λ> :t text
+text :: Maybe T.Text
+λ> traverse_ T.putStrLn text
+ɥǝןןo ʍoɹןp
+@
+
+As mentioned earlier, functions that perform text decoding take a
+'CharsetLookup' parameter, and we provide 'defaultCharsets' for
+convenience.
+
 -}
 
 
@@ -238,28 +338,40 @@
 --
 data MIME
   = Part B.ByteString
-  | Multipart [MIMEMessage]
+  | Encapsulated MIMEMessage
+  | Multipart (NonEmpty MIMEMessage)
+  | FailedParse MIMEParseError B.ByteString
   deriving (Eq, Show)
 
--- | Get all leaf entities from the MIME message
+-- | Ignores the presence/absense of @MIME-Version@ header
+instance EqMessage MIME where
+  Message h1 b1 `eqMessage` Message h2 b2 =
+    stripVer h1 == stripVer h2 && b1 == b2
+    where
+    stripVer = set (headers . at "MIME-Version") Nothing
+
+-- | Get all leaf entities from the MIME message.
+-- Entities that failed to parse are skipped.
 --
 entities :: Traversal' MIMEMessage WireEntity
 entities f (Message h a) = case a of
   Part b ->
     (\(Message h' b') -> Message h' (Part b')) <$> f (Message h b)
+  Encapsulated msg -> Message h . Encapsulated <$> entities f msg
   Multipart bs ->
     Message h . Multipart <$> sequenceA (entities f <$> bs)
+  FailedParse _ _ -> pure (Message h a)
 
 -- | Leaf entities with @Content-Disposition: attachment@
 attachments :: Traversal' MIMEMessage WireEntity
-attachments = entities . filtered (notNullOf l) where
-  l = headers . contentDisposition . dispositionType . filtered (== Attachment)
+attachments = entities . filtered isAttachment
 
 -- | MIMEMessage content disposition is an 'Attachment'
-isAttachment :: MIMEMessage -> Bool
-isAttachment = has (headers . contentDisposition . dispositionType . filtered (== Attachment))
+isAttachment :: HasHeaders a => a -> Bool
+isAttachment = has (contentDisposition . _Just . dispositionType . filtered (== Attachment))
 
-contentTransferEncoding :: Getter Headers TransferEncodingName
+contentTransferEncoding
+  :: (Profunctor p, Contravariant f) => Optic' p f Headers TransferEncodingName
 contentTransferEncoding = to $
   fromMaybe "7bit"
   . preview (header "content-transfer-encoding" . caseInsensitive)
@@ -270,9 +382,14 @@
   transferEncodedData = body
   transferDecoded = to $ \a -> (\t -> set body t a) <$> view transferDecodedBytes a
 
-printContentTransferEncoding :: Encoding -> B.ByteString
-printContentTransferEncoding Base64 = "base64"
-printContentTransferEncoding None = "7bit"
+  transferEncode (Message h s) =
+    let
+      (cteName, cte) = chooseTransferEncoding s
+      s' = review (clonePrism cte) s
+      cteName' = CI.original cteName
+      h' = set (headers . at "Content-Transfer-Encoding") (Just cteName') h
+    in
+      Message h' s'
 
 caseInsensitive :: CI.FoldCase s => Iso' s (CI s)
 caseInsensitive = iso CI.mk CI.original
@@ -284,9 +401,12 @@
 -- Example:
 --
 -- @
--- ContentType "text" "plain" [("charset", "utf-8")]
+-- ContentType "text" "plain" (Parameters [("charset", "utf-8")])
 -- @
 --
+-- You can also use @-XOverloadedStrings@ but be aware the conversion
+-- is non-total (throws an error if it cannot parse the string).
+--
 data ContentType = ContentType (CI B.ByteString) (CI B.ByteString) Parameters
   deriving (Show, Generic, NFData)
 
@@ -298,6 +418,14 @@
 instance Eq ContentType where
   ContentType a b c == ContentType a' b' c' = a == a' && b == b' && c == c'
 
+-- | __NON-TOTAL__ parses the Content-Type (including parameters)
+-- and throws an error if the parse fails
+--
+instance IsString ContentType where
+  fromString = either err id . parseOnly parseContentType . C8.pack
+    where
+    err msg = error $ "failed to parse Content-Type: " <> msg
+
 -- | Match content type.  If @Nothing@ is given for subtype, any
 -- subtype is accepted.
 --
@@ -394,7 +522,7 @@
     let
       b = T.encodeUtf8 a
       charset = if B.all (< 0x80) b then "us-ascii" else "utf-8"
-    in Message (set (contentType . rawParameter "charset") charset h) b
+    in Message (set (contentType . parameter "charset") (Just charset) h) b
 
 -- | RFC 6657 provides for different media types having different
 -- ways to determine the charset.  This data type defines how a
@@ -405,10 +533,10 @@
   -- ^ Charset should be declared within payload (e.g. xml, rtf).
   --   The given function reads it from the payload.
   | InParameter (Maybe CharsetName)
-  -- ^ Charset should be declared in the 'charset' parameter,
+  -- ^ Charset should be declared in the @charset@ parameter,
   --   with optional fallback to the given default.
   | InBandOrParameter (B.ByteString -> Maybe CharsetName) (Maybe CharsetName)
-  -- ^ Check in-band first, fall back to 'charset' parameter,
+  -- ^ Check in-band first, fall back to @charset@ parameter,
   --   and further optionally fall back to a default.
 
 -- | Charset sources for text/* media types.  IANA registry:
@@ -439,18 +567,18 @@
 
 -- | @text/plain@
 contentTypeTextPlain :: ContentType
-contentTypeTextPlain = ContentType "text" "plain" (Parameters [])
+contentTypeTextPlain = ContentType "text" "plain" mempty
 
 -- | @application/octet-stream@
 contentTypeApplicationOctetStream :: ContentType
 contentTypeApplicationOctetStream =
-  ContentType "application" "octet-stream" (Parameters [])
+  ContentType "application" "octet-stream" mempty
 
 -- | @multipart/mixed; boundary=asdf@
 contentTypeMultipartMixed :: B.ByteString -> ContentType
 contentTypeMultipartMixed boundary =
-  over parameterList (("boundary", boundary):)
-  $ ContentType "multipart" "mixed" (Parameters [])
+  set (parameter "boundary") (Just (ParameterValue Nothing Nothing boundary))
+  $ ContentType "multipart" "mixed" mempty
 
 -- | Lens to the content-type header.  Probably not a lawful lens.
 --
@@ -467,8 +595,8 @@
 -- otherwise it is added.  Unrecognised Content-Transfer-Encoding
 -- is ignored when setting.
 --
-contentType :: Lens' Headers ContentType
-contentType = lens sa sbt where
+contentType :: HasHeaders a => Lens' a ContentType
+contentType = headers . lens sa sbt where
   sa s = case view cte s of
     Nothing -> contentTypeApplicationOctetStream
     Just _ ->
@@ -524,17 +652,19 @@
   where
     typStr = case typ of Inline -> "inline" ; Attachment -> "attachment"
 
--- | Get Content-Disposition header.
+-- | Access @Content-Disposition@ header.
+--
 -- Unrecognised disposition types are coerced to @Attachment@
 -- in accordance with RFC 2183 §2.8 which states:
--- /Unrecognized disposition types should be treated as/ attachment.
+-- /Unrecognized disposition types should be treated as attachment/.
 --
--- The fold may be empty, e.g. if the header is absent or unparseable.
+-- This optic does not distinguish between missing header or malformed
+-- value.
 --
-contentDisposition :: Traversal' Headers ContentDisposition
-contentDisposition =
-  header "content-disposition"
-  . parsePrint parseContentDisposition printContentDisposition
+contentDisposition :: HasHeaders a => Lens' a (Maybe ContentDisposition)
+contentDisposition = headers . at "Content-Disposition" . dimap
+  (>>= either (const Nothing) Just . Data.RFC5322.parse parseContentDisposition)
+  (fmap . fmap $ printContentDisposition)
 
 -- | Traverse the value of the filename parameter (if present).
 --
@@ -570,7 +700,7 @@
 --
 -- Preambles and epilogues are discarded.
 --
--- This parser accepts non-MIME messages, and unconditionally
+-- This parser accepts non-MIME messages, and
 -- treats them as a single part.
 --
 mime :: Headers -> Parser MIME
@@ -578,6 +708,8 @@
   | nullOf (header "MIME-Version") h = Part <$> takeByteString
   | otherwise = mime' takeByteString h
 
+type instance MessageContext MIME = EncStateWire
+
 mime'
   :: Parser B.ByteString
   -- ^ Parser FOR A TAKE to the part delimiter.  If this part is
@@ -588,21 +720,34 @@
 mime' takeTillEnd h = case view contentType h of
   ct | view ctType ct == "multipart" ->
     case preview (rawParameter "boundary") ct of
-      Nothing -> part
-      Just boundary -> Multipart <$> multipart takeTillEnd boundary
+      Nothing -> FailedParse MultipartBoundaryNotSpecified <$> takeTillEnd
+      Just boundary ->
+        (Multipart <$> multipart takeTillEnd boundary)
+        <|> (FailedParse MultipartParseFail <$> takeTillEnd)
+     | matchContentType "message" (Just "rfc822") ct ->
+        (Encapsulated <$> message (mime' takeTillEnd))
+        <|> (FailedParse EncapsulatedMessageParseFail <$> takeTillEnd)
   _ -> part
   where
     part = Part <$> takeTillEnd
 
+data MIMEParseError
+  = MultipartBoundaryNotSpecified
+  | MultipartParseFail
+  | EncapsulatedMessageParseFail
+  deriving (Eq, Show)
+
 -- | Parse a multipart MIME message.  Preambles and epilogues are
 -- discarded.
 --
 multipart
   :: Parser B.ByteString  -- ^ parser to the end of the part
   -> B.ByteString         -- ^ boundary, sans leading "--"
-  -> Parser [MIMEMessage]
+  -> Parser (NonEmpty MIMEMessage)
 multipart takeTillEnd boundary =
-  multipartBody
+  skipTillString dashBoundary *> crlf -- FIXME transport-padding
+  *> fmap fromList (part `sepBy1` crlf)
+  <* string "--" <* takeTillEnd
   where
     delimiter = "\n--" <> boundary
     dashBoundary = B.tail delimiter
@@ -612,59 +757,46 @@
       | C8.last s == '\r' = B.init s
       | otherwise = s
 
-    multipartBody =
-      skipTillString dashBoundary *> crlf -- FIXME transport-padding
-      *> part `sepBy` crlf
-      <* string "--" <* takeTillEnd
-
--- | Serialise a given `MIMEMessage` into a ByteString. The message is
--- serialised as is. No additional headers are set.
+-- | Serialise a given `MIMEMessage` into a ByteString.
+--
+-- Sets the @MIME-Version: 1.0@ header (on the top-level message only).
+-- No other headers are set.
+--
 renderMessage :: MIMEMessage -> B.ByteString
 renderMessage = toStrict . Builder.toLazyByteString . buildMessage
 
 -- | Serialise a given `MIMEMessage` using a `Builder`
+--
+-- Sets the @MIME-Version: 1.0@ header (on the top-level message only).
+-- No other headers are set.
+--
 buildMessage :: MIMEMessage -> Builder.Builder
-buildMessage (Message h (Part partbody)) =
-    buildFields h <> "\r\n" <> Builder.byteString partbody
-buildMessage (Message h (Multipart xs)) =
-    let b = firstOf (contentType . mimeBoundary) h
-        boundary = maybe mempty (\b' -> "\r\n--" <> Builder.byteString b') b
-        ents = foldMap (\part -> boundary <> "\r\n" <> buildMessage part) xs
-    in buildFields h <> ents <> boundary <> "--\r\n"
-
-
-mimeHeader :: (CI B.ByteString, B.ByteString)
-mimeHeader = (CI.mk "MIME-Version", "1.0")
-
--- | creates a new `MIMEMessage` and transfer encodes the given content with the
--- given Encoding
-createMessage
-    :: ContentType
-    -> ContentDisposition
-    -> Encoding
-    -> B.ByteString -- ^ content
-    -> MIMEMessage
-createMessage ct cd encoding content =
-  let m = Message (Headers [mimeHeader]) (Part $ transferEncodeData encoding content)
-  in m
-  & set (headers . at "Content-Type") (Just (printContentType ct))
-  . set (headers . at "Content-Disposition") (Just (printContentDisposition cd))
-  . set (headers . at "Content-Transfer-Encoding") (Just (printContentTransferEncoding encoding))
+buildMessage = go . set (headers . at "MIME-Version") (Just "1.0")
+  where
+  go (Message h z) = buildFields h <> case z of
+    Part partbody -> "\r\n" <> Builder.byteString partbody
+    Encapsulated msg -> "\r\n" <> buildMessage msg
+    Multipart xs ->
+      let b = firstOf (contentType . mimeBoundary) h
+          boundary = maybe mempty (\b' -> "\r\n--" <> Builder.byteString b') b
+          ents = foldMap (\part -> boundary <> "\r\n" <> go part) xs
+      in ents <> boundary <> "--\r\n"
+    FailedParse _ bs -> "\r\n" <> Builder.byteString bs
 
-headerFrom :: Lens' Headers [Mailbox]
-headerFrom = lens getter setter
+headerFrom :: HasHeaders a => Lens' a [Mailbox]
+headerFrom = headers . lens getter setter
   where
     getter = either (pure []) id . parseOnly mailboxList . view (header "from")
     setter = flip $ set (header "from") . renderMailboxes
 
-headerTo :: Lens' Headers [Address]
-headerTo = lens (headerGetter "to") (headerSetter "to")
+headerTo :: HasHeaders a => Lens' a [Address]
+headerTo = headers . lens (headerGetter "to") (headerSetter "to")
 
-headerCC :: Lens' Headers [Address]
-headerCC = lens (headerGetter "cc") (headerSetter "cc")
+headerCC :: HasHeaders a => Lens' a [Address]
+headerCC = headers . lens (headerGetter "cc") (headerSetter "cc")
 
-headerBCC :: Lens' Headers [Address]
-headerBCC = lens (headerGetter "bcc") (headerSetter "bcc")
+headerBCC :: HasHeaders a => Lens' a [Address]
+headerBCC = headers . lens (headerGetter "bcc") (headerSetter "bcc")
 
 headerSetter :: CI B.ByteString -> Headers -> [Address] -> Headers
 headerSetter fieldname = flip $ set (header fieldname) . renderAddresses
@@ -673,8 +805,8 @@
 headerGetter fieldname =
     either (pure []) id . parseOnly addressList . view (header fieldname)
 
-headerDate :: Lens' Headers UTCTime
-headerDate = lens getter setter
+headerDate :: HasHeaders a => Lens' a UTCTime
+headerDate = headers . lens getter setter
   where
     -- TODO for parseTimeOrError. See #16
     getter =
@@ -686,13 +818,15 @@
 -- fields from the parents message `Headers`. Rules to gather the values are in
 -- accordance to RFC5322 - 3.6.4 as follows sorted by priority (first has
 -- precedence):
--- * Values from 'References' and `Message-ID` (if any)
--- * Values from 'In-Reply-To' and 'Message-ID' (if any)
--- * Value from 'Message-ID' (in case it's the first reply to a parent mail)
--- * otherwise Nothing is returned indicating that the replying mail should not have a 'References' field.
 --
-replyHeaderReferences :: Getter Headers (Maybe C8.ByteString)
-replyHeaderReferences = to $ \hdrs ->
+-- * Values from @References@ and @Message-ID@ (if any)
+-- * Values from @In-Reply-To@ and @Message-ID@ (if any)
+-- * Value from @Message-ID@ (in case it's the first reply to a parent mail)
+-- * Otherwise @Nothing@ is returned indicating that the replying mail should
+--   not have a @References@ field.
+--
+replyHeaderReferences :: HasHeaders a => Getter a (Maybe C8.ByteString)
+replyHeaderReferences = (.) headers $ to $ \hdrs ->
   let xs = catMaybes
         [preview (header "references") hdrs
          <|> preview (header "in-reply-to") hdrs
@@ -703,7 +837,7 @@
 -- | Create a mixed `MIMEMessage` with an inline text/plain part and multiple
 -- `attachments`
 --
--- Additional headers can be set (e.g. 'cc') by using `At` and `Ixed`, for
+-- Additional headers can be set (e.g. @Cc@) by using `At` and `Ixed`, for
 -- example:
 --
 -- @
@@ -720,27 +854,23 @@
 -- @
 createMultipartMixedMessage
     :: B.ByteString -- ^ Boundary
-    -> [MIMEMessage] -- ^ attachments
+    -> NonEmpty MIMEMessage -- ^ parts
     -> MIMEMessage
 createMultipartMixedMessage b attachments' =
-    let hdrs =
-            set
-                (at "Content-Type")
-                (Just $ printContentType (contentTypeMultipartMixed b)) $
-            Headers [mimeHeader]
+    let hdrs = mempty &
+                set contentType (contentTypeMultipartMixed b)
     in Message hdrs (Multipart attachments')
 
 -- | Create an inline, text/plain, utf-8 encoded message
 --
-createTextPlainMessage
-    :: T.Text -- ^ message body
-    -> MIMEMessage
-createTextPlainMessage =
-    createMessage
-        contentTypeTextPlain
-        (ContentDisposition Inline $ Parameters [(CI.mk "charset", "utf-8")])
-        None
-    . T.encodeUtf8
+createTextPlainMessage :: T.Text -> MIMEMessage
+createTextPlainMessage s = fmap Part $ transferEncode $ charsetEncode msg
+  where
+  msg = Message hdrs s :: TextEntity
+  cd = ContentDisposition Inline mempty
+  hdrs = mempty
+          & set contentType contentTypeTextPlain
+          & set contentDisposition (Just cd)
 
 -- | Create an attachment from a given file path.
 -- Note: The filename content disposition is set to the given `FilePath`. For
@@ -749,12 +879,23 @@
 createAttachmentFromFile :: ContentType -> FilePath -> IO MIMEMessage
 createAttachmentFromFile ct fp = createAttachment ct (Just fp) <$> B.readFile fp
 
--- | Create an attachment from the given file contents. Optionally set the given
+-- | Create an attachment from the given file contents. Optionally set the
 -- filename parameter to the given file path.
 --
 createAttachment :: ContentType -> Maybe FilePath -> B.ByteString -> MIMEMessage
-createAttachment ct fp =
-    set
-        (headers . contentDisposition . filenameParameter)
-        (newParameter . T.pack <$> fp) .
-    createMessage ct (ContentDisposition Attachment $ Parameters []) Base64
+createAttachment ct fp s = Part <$> transferEncode msg
+  where
+  msg = Message hdrs s
+  cd = ContentDisposition Attachment cdParams
+  cdParams = mempty & set filenameParameter (newParameter <$> fp)
+  hdrs = mempty
+          & set contentType ct
+          & set contentDisposition (Just cd)
+
+-- | Encapsulate a message as a @message/rfc822@ message.
+-- You can use this in creating /forwarded/ or /bounce/ messages.
+--
+encapsulate :: MIMEMessage -> MIMEMessage
+encapsulate = Message hdrs . Encapsulated
+  where
+  hdrs = mempty & set contentType "message/rfc822"
diff --git a/src/Data/MIME/Charset.hs b/src/Data/MIME/Charset.hs
--- a/src/Data/MIME/Charset.hs
+++ b/src/Data/MIME/Charset.hs
@@ -14,6 +14,9 @@
 * @utf-8@
 * @iso-8859-1@
 
+See also the <https://github.com/purebred-mua/purebred-icu purebred-icu>
+plugin, which adds support for many character sets.
+
 -}
 module Data.MIME.Charset
   (
@@ -31,7 +34,7 @@
   , decodeLenient
   ) where
 
-import Control.Lens (Getter, Prism', prism', review, to, view)
+import Control.Lens
 import qualified Data.ByteString as B
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Text as T
@@ -80,7 +83,11 @@
   charsetData :: Getter a B.ByteString
 
   -- | Structure with the encoded data replaced with 'Text'
-  charsetDecoded :: AsCharsetError e => CharsetLookup -> Getter a (Either e (Decoded a))
+  charsetDecoded
+    :: AsCharsetError e
+    => CharsetLookup
+    -> ( forall p f. (Profunctor p, Contravariant f)
+        => Optic' p f a (Either e (Decoded a)) )
 
   -- | Encode the data
   charsetEncode :: Decoded a -> a
@@ -88,8 +95,8 @@
 
 -- | Decode the object according to the declared charset.
 charsetText
-  :: (HasCharset a, AsCharsetError e)
-  => CharsetLookup -> Getter a (Either e T.Text)
+  :: (HasCharset a, AsCharsetError e, Profunctor p, Contravariant f)
+  => CharsetLookup -> Optic' p f a (Either e T.Text)
 charsetText lookupCharset = to $ \a ->
   maybe (Left $ review _CharsetUnspecified ()) Right (view charsetName a)
   >>= \k -> maybe (Left $ review _CharsetUnsupported k) Right (lookupCharset k)
@@ -97,17 +104,17 @@
 
 -- | Monomorphic in error type
 charsetText'
-  :: (HasCharset a)
+  :: (HasCharset a, Profunctor p, Contravariant f)
   => CharsetLookup
-  -> Getter a (Either CharsetError T.Text)
+  -> Optic' p f a (Either CharsetError T.Text)
 charsetText' = charsetText
 
 -- | Prism for charset decoded/encoded data.
 -- Information about decoding failures is discarded.
 charsetPrism :: forall a. (HasCharset a) => CharsetLookup -> Prism' a (Decoded a)
-charsetPrism m = prism' charsetEncode (either (const Nothing) Just . view l)
+charsetPrism m = prism' charsetEncode (either err Just . view (charsetDecoded m))
   where
-  l = charsetDecoded m :: Getter a (Either CharsetError (Decoded a))
+  err = const Nothing :: CharsetError -> Maybe x
 
 charsets :: [(CI.CI B.ByteString, Charset)]
 charsets =
diff --git a/src/Data/MIME/EncodedWord.hs b/src/Data/MIME/EncodedWord.hs
--- a/src/Data/MIME/EncodedWord.hs
+++ b/src/Data/MIME/EncodedWord.hs
@@ -42,6 +42,7 @@
   transferEncodedData = to _encodedWordText
   transferDecoded = to $ \a@(EncodedWord charset lang _ _) ->
     TransferDecodedEncodedWord charset lang <$> view transferDecodedBytes a
+  transferEncode = transferEncodeEncodedWord
 
 
 data TransferDecodedEncodedWord = TransferDecodedEncodedWord
diff --git a/src/Data/MIME/Parameter.hs b/src/Data/MIME/Parameter.hs
--- a/src/Data/MIME/Parameter.hs
+++ b/src/Data/MIME/Parameter.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -39,6 +40,7 @@
 import Data.Foldable (fold)
 import Data.Functor (($>))
 import Data.Semigroup ((<>), Sum(..), Max(..))
+import Data.String (IsString(..))
 import Data.Word (Word8)
 import Data.Void (Void)
 import Foreign (withForeignPtr, plusPtr, minusPtr, peek, peekByteOff, poke)
@@ -47,6 +49,7 @@
 
 import Control.DeepSeq (NFData)
 import Control.Lens
+import Control.Lens.Cons.Extras (recons)
 import Data.Attoparsec.ByteString.Char8 hiding (take)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Internal as B
@@ -67,6 +70,12 @@
 newtype Parameters = Parameters [(CI B.ByteString, B.ByteString)]
   deriving (Eq, Show, Generic, NFData)
 
+instance Semigroup Parameters where
+  Parameters a <> Parameters b = Parameters (a <> b)
+
+instance Monoid Parameters where
+  mempty = Parameters []
+
 type instance Index Parameters = CI B.ByteString
 type instance IxValue Parameters = EncodedParameterValue
 
@@ -171,6 +180,15 @@
 type EncodedParameterValue = ParameterValue CharsetName B.ByteString
 type DecodedParameterValue = ParameterValue Void T.Text
 
+-- | Parameter value with no language.
+instance IsString DecodedParameterValue where
+  fromString = ParameterValue Nothing Nothing . T.pack
+
+-- | Parameter value with no language, encoded either in @us-ascii@
+-- or @utf-8.
+instance IsString EncodedParameterValue where
+  fromString = charsetEncode . fromString
+
 value :: Lens (ParameterValue cs a) (ParameterValue cs b) a b
 value f (ParameterValue a b c) = ParameterValue a b <$> f c
 
@@ -182,8 +200,8 @@
 -- If you need to to specify language, use the 'ParameterValue'
 -- constructor directly.
 --
-newParameter :: T.Text -> EncodedParameterValue
-newParameter = charsetEncode . ParameterValue Nothing Nothing
+newParameter :: Cons s s Char Char => s -> EncodedParameterValue
+newParameter = charsetEncode . ParameterValue Nothing Nothing . view recons
 
 
 -- | The default charset @us-ascii@ is implied by the abstract of
diff --git a/src/Data/MIME/QuotedPrintable.hs b/src/Data/MIME/QuotedPrintable.hs
--- a/src/Data/MIME/QuotedPrintable.hs
+++ b/src/Data/MIME/QuotedPrintable.hs
@@ -12,6 +12,9 @@
   (
     contentTransferEncodingQuotedPrintable
   , q
+  , QuotedPrintableMode(..)
+  , encodingRequiredEOL
+  , encodingRequiredNonEOL
   ) where
 
 import Control.Lens (APrism', prism')
diff --git a/src/Data/MIME/TransferEncoding.hs b/src/Data/MIME/TransferEncoding.hs
--- a/src/Data/MIME/TransferEncoding.hs
+++ b/src/Data/MIME/TransferEncoding.hs
@@ -13,20 +13,21 @@
   , TransferEncodingName
   , transferDecodedBytes
   , transferEncodings
-  , transferEncodeData
   , TransferEncodingError(..)
   , AsTransferEncodingError(..)
   , TransferEncoding
+  , chooseTransferEncoding
   ) where
 
+import Data.Monoid (Sum(Sum), Any(Any))
+
 import Control.Lens
-  ( APrism', Getter, Prism', clonePrism, preview, prism', review, to, view )
 import qualified Data.ByteString as B
+import Data.ByteString.Lens (bytes)
 import qualified Data.CaseInsensitive as CI
 
 import Data.MIME.Base64
 import Data.MIME.QuotedPrintable
-import Data.MIME.Types (Encoding(..))
 
 type TransferEncodingName = CI.CI B.ByteString
 type TransferEncoding = APrism' B.ByteString B.ByteString
@@ -52,6 +53,7 @@
       TransferDecodeError k -> Just k ; _ -> Nothing
 
 
+-- | Data types that can have /transfer encoding/.
 class HasTransferEncoding a where
   type TransferDecoded a
 
@@ -62,12 +64,23 @@
   transferEncodedData :: Getter a B.ByteString
 
   -- | Perform content transfer decoding.
-  transferDecoded :: AsTransferEncodingError e => Getter a (Either e (TransferDecoded a))
+  transferDecoded
+    :: (AsTransferEncodingError e, Profunctor p, Contravariant f)
+    => Optic' p f a (Either e (TransferDecoded a))
 
+  -- | Perform content transfer decoding (monomorphic error type).
+  transferDecoded'
+    :: (Profunctor p, Contravariant f)
+    => Optic' p f a (Either TransferEncodingError (TransferDecoded a))
+  transferDecoded' = transferDecoded
+
+  -- | Encode the data
+  transferEncode :: TransferDecoded a -> a
+
 -- | Decode the object according to the declared content transfer encoding.
 transferDecodedBytes
-  :: (HasTransferEncoding a, AsTransferEncodingError e)
-  => Getter a (Either e B.ByteString)
+  :: (HasTransferEncoding a, AsTransferEncodingError e, Profunctor p, Contravariant f)
+  => Optic' p f a (Either e B.ByteString)
 transferDecodedBytes = to $ \a -> do
   let encName = view transferEncodingName a
   enc <- maybe (Left $ review _TransferEncodingUnsupported encName) Right
@@ -93,6 +106,21 @@
   , ("b", contentTransferEncodingBase64)
   ]
 
-transferEncodeData :: Encoding -> B.ByteString -> B.ByteString
-transferEncodeData Base64 = contentTransferEncodeBase64
-transferEncodeData _ = id
+-- | Inspect the data and choose a transfer encoding to use: @7bit@
+-- if the data can be transmitted as-is, otherwise whichever of
+-- @quoted-printable@ or @base64@ should result in smaller output.
+--
+chooseTransferEncoding :: B.ByteString -> (TransferEncodingName, TransferEncoding)
+chooseTransferEncoding s
+  -- TODO: does not handle max line length of 998
+  | not doEnc = ("7bit", id)
+  | nQP < nB64 = ("quoted-printable", contentTransferEncodingQuotedPrintable)
+  | otherwise = ("base64", contentTransferEncodingBase64)
+  where
+    -- https://tools.ietf.org/html/rfc5322#section-3.5 'text'
+    needEnc c = c > 127 || c == 0
+    qpBytes c
+      | encodingRequiredNonEOL QuotedPrintable c = 3
+      | otherwise = 1
+    (Any doEnc, Sum nQP) = foldMapOf bytes (\c -> (Any (needEnc c), Sum (qpBytes c))) s
+    nB64 = ((B.length s + 2) `div` 3) * 4
diff --git a/src/Data/MIME/Types.hs b/src/Data/MIME/Types.hs
--- a/src/Data/MIME/Types.hs
+++ b/src/Data/MIME/Types.hs
@@ -4,13 +4,11 @@
   (
     ContentTransferEncoding
   , EncodedWordEncoding
-  , Encoding(..)
   ) where
 
 import Control.Lens (APrism')
 import qualified Data.ByteString as B
 
 type ContentTransferEncoding = APrism' B.ByteString B.ByteString
-data Encoding = None | Base64
 
 type EncodedWordEncoding = APrism' B.ByteString B.ByteString
diff --git a/src/Data/RFC5322.hs b/src/Data/RFC5322.hs
--- a/src/Data/RFC5322.hs
+++ b/src/Data/RFC5322.hs
@@ -60,12 +60,18 @@
   -- * Message types
     Message(..)
   , message
-  , headers
-  , headerList
+  , MessageContext
   , body
-  , Headers(..)
+  , EqMessage(..)
+
+  -- ** Headers
   , Header
+  , HasHeaders(..)
   , header
+  , headerList
+  , Headers(..)
+
+  -- ** Addresses
   , Address(..)
   , address
   , addressList
@@ -127,6 +133,18 @@
 newtype Headers = Headers [Header]
   deriving (Eq, Show, Generic, NFData)
 
+instance Semigroup Headers where
+  Headers a <> Headers b = Headers (a <> b)
+
+instance Monoid Headers where
+  mempty = Headers []
+
+class HasHeaders a where
+  headers :: Lens' a Headers
+
+instance HasHeaders Headers where
+  headers = id
+
 type instance Index Headers = CI B.ByteString
 type instance IxValue Headers = B.ByteString
 
@@ -151,9 +169,9 @@
         g <$> f (lookup k kv)
 
 
--- | Get all values of the given header
-header :: CI B.ByteString -> Traversal' Headers B.ByteString
-header k = hdriso . traversed . filtered ((k ==) . fst) . _2
+-- | Target all values of the given header
+header :: HasHeaders a => CI B.ByteString -> Traversal' a B.ByteString
+header k = headerList . traversed . filtered ((k ==) . fst) . _2
 
 -- | Message type, parameterised over context and body type.  The
 -- context type is not used in this module but is provided for uses
@@ -161,14 +179,28 @@
 -- messages.
 --
 data Message s a = Message Headers a
-  deriving (Eq, Show, Generic, NFData)
+  deriving (Show, Generic, NFData)
 
-headers :: Lens' (Message s a) Headers
-headers f (Message h b) = fmap (\h' -> Message h' b) (f h)
-{-# ANN headers ("HLint: ignore Avoid lambda" :: String) #-}
+instance HasHeaders (Message s a) where
+  headers f (Message h b) = fmap (`Message` b) (f h)
 
+instance Functor (Message s) where
+  fmap f (Message h a) = Message h (f a)
+
+-- | How to compare messages with this body type.
+--
+-- This class arises because we may want to tweak the headers,
+-- possibly in response to body data, or vice-versa, when
+-- comparing messages.
+--
+class EqMessage a where
+  eqMessage :: Message s a -> Message s a -> Bool
+
+instance EqMessage a => Eq (Message s a) where
+  (==) = eqMessage
+
 -- | Access headers as a list of key/value pairs.
-headerList :: Lens' (Message s a) [(CI B.ByteString, B.ByteString)]
+headerList :: HasHeaders a => Lens' a [(CI B.ByteString, B.ByteString)]
 headerList = headers . coerced
 
 body :: Lens (Message ctx a) (Message ctx' b) a b
@@ -273,8 +305,11 @@
 -- This parser does not handle the legitimate but obscure case
 -- of a message with no body (empty body is fine, though).
 --
-message :: (Headers -> Parser a) -> Parser (Message s a)
+message :: (Headers -> Parser a) -> Parser (Message (MessageContext a) a)
 message f = fields >>= \hdrs -> Message hdrs <$> (crlf *> f hdrs)
+
+type family MessageContext a = s
+
 
 fields :: Parser Headers
 fields = Headers <$> many field
diff --git a/src/Data/RFC5322/Internal.hs b/src/Data/RFC5322/Internal.hs
--- a/src/Data/RFC5322/Internal.hs
+++ b/src/Data/RFC5322/Internal.hs
@@ -167,9 +167,8 @@
 -- WSP."
 
 fws :: (Alternative (f s), CharParsing f s a) => (f s) s
-fws = optional (takeWhile isWsp *> crlf)
-      *> takeWhile1 isWsp
-      *> pure (singleton ' ')
+fws = ( optional (takeWhile isWsp *> crlf) *> takeWhile1 isWsp )
+      $> singleton ' '
 
 -- | FWS collapsed to a single SPACE character, or empty string
 --
@@ -192,7 +191,7 @@
 
 cfws :: (Alternative (f s), CharParsing f s a, SM s) => (f s) s
 cfws =
-  foldMany1 (optionalFWS <<>> comment) *> optionalFWS *> pure (singleton ' ')
+  ((foldMany1 (optionalFWS <<>> comment) *> optionalFWS) $> singleton ' ')
   <|> fws
 
 -- | CFWS collapsed to a single SPACE character, or empty string
@@ -329,20 +328,20 @@
 spanTillString :: B.ByteString -> A.Parser Int
 spanTillString pat
   | B.null pat = position
-  | otherwise = go
+  | otherwise = position >>= go
   where
   search = indices pat
-  go = do
-    start <- position
+  go start = do
+    pos <- position
     buf <- takeBuffer
     case search buf of
       (offset:_) ->
         -- Pattern was found.  Seek to end of pattern and return the span
-        seek (start + offset + B.length pat) $> offset
+        seek (pos + offset + B.length pat) $> pos + offset - start
       _ ->
         -- We hit the end of the buffer without a match.  Seek to
-        -- (length buf - length pat + 1), demand more input and go again.
-        seek (B.length buf - B.length pat + 1) *> A.demandInput *> go
+        -- (length buf - length pat), demand more input and go again.
+        seek (max start (B.length buf - B.length pat)) *> A.demandInput *> go start
 
 -- | Efficient skip, using Boyer-Moore to locate the pattern.
 --
diff --git a/tests/Generator.hs b/tests/Generator.hs
--- a/tests/Generator.hs
+++ b/tests/Generator.hs
@@ -3,6 +3,8 @@
 
 module Generator where
 
+import Data.List.NonEmpty (fromList)
+
 import Test.Tasty
 import Test.QuickCheck.Instances ()
 import Test.Tasty.HUnit ((@=?), testCase)
@@ -75,7 +77,7 @@
                 (Just "foo.bin")
                 "fileContentsASDF"
         now = UTCTime (ModifiedJulianDay 123) (secondsToDiffTime 123)
-    in createMultipartMixedMessage "asdf" [p, a]
+    in createMultipartMixedMessage "asdf" (fromList [p, a])
        & set (headers . at "From") (Just $ renderMailboxes [from'])
        . set (headers . at "To") (Just $ renderAddresses [to'])
        . set (headers . at "Date") (Just $ renderRFC5422Date now)
diff --git a/tests/Headers.hs b/tests/Headers.hs
--- a/tests/Headers.hs
+++ b/tests/Headers.hs
@@ -81,27 +81,26 @@
 rendersAddressesToTextSuccessfully =
   testGroup "renders addresses to text" $
   (\(desc, address, expected) ->
-     testCase desc $ expected @=? (AddressText.renderAddress address)) <$>
+     testCase desc $ expected @=? AddressText.renderAddress address) <$>
   xs
   where
     xs =
       [ ( "single address"
-        , (Single
-             (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ pure "bar.com"))))
+        , Single
+            (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ pure "bar.com")))
         , "foo@bar.com")
       , ( "group of addresses"
-        , (Group
-             "Group"
+        , Group "Group"
              [ Mailbox
                  (Just "Mr Foo")
                  (AddrSpec "foo" (DomainDotAtom $ pure "bar.com"))
              , Mailbox
                  (Just "Mr Bar")
                  (AddrSpec "bar" (DomainDotAtom $ pure "bar.com"))
-             ])
+             ]
         , "Group:\"Mr Foo\" <foo@bar.com>, \"Mr Bar\" <bar@bar.com>;")
       , ( "group of undisclosed recipients"
-        , (Group "undisclosed-recipients" [])
+        , Group "undisclosed-recipients" []
         , "undisclosed-recipients:;")
       ]
 
@@ -257,11 +256,12 @@
         (Headers [("Content-Type", "application/x-stuff; title*0*=us-ascii'en'This%20is%20even%20more%20; title*1*=%2A%2A%2Afun%2A%2A%2A%20; title*2=\"isn't it!\"")])
       @?= Just (ParameterValue (Just "us-ascii") (Just "en") "This is even more ***fun*** isn't it!")
   , testCase "set filename parameter in Content-Disposition" $
-      set (contentDisposition . parameter "filename") (Just (ParameterValue Nothing Nothing "foo.pdf"))
+      set (contentDisposition . traversed . parameter "filename")
+        (Just (ParameterValue Nothing Nothing "foo.pdf"))
         (Headers [("Content-Disposition", "attachment")])
       @?= Headers [("Content-Disposition", "attachment; filename=foo.pdf")]
   , testCase "unset filename parameter in Content-Disposition" $
-      set (contentDisposition . parameter "filename") Nothing
+      set (contentDisposition . traversed . parameter "filename") Nothing
         (Headers [("Content-Disposition", "attachment; foo=bar; filename=foo.pdf")])
       @?= Headers [("Content-Disposition", "attachment; foo=bar")]
   ]
@@ -310,7 +310,7 @@
 
 -- | Generate headers
 genFieldItem :: Gen B.ByteString
-genFieldItem = resize 55 $ listOf1 (suchThat arbitrary isFtext) >>= pure . B.pack
+genFieldItem = resize 55 . B.pack <$> listOf1 (suchThat arbitrary isFtext)
 
 isFtext :: Word8 -> Bool
 isFtext c = (c >= 33 && c <= 57) || (c >= 59 && c <= 126)
diff --git a/tests/MIME.hs b/tests/MIME.hs
--- a/tests/MIME.hs
+++ b/tests/MIME.hs
@@ -19,24 +19,32 @@
 
 module MIME where
 
+import Control.Exception (ErrorCall, evaluate, try)
 import Control.Monad ((<=<), void)
+import Data.Bifunctor (first)
 import Data.Char (toUpper)
+import Data.Either (isLeft)
+import Data.List.NonEmpty (fromList)
+import Data.String (fromString)
 
 import Control.Lens
 import qualified Data.ByteString as B
 import qualified Data.Text as T
 
 import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit ((@?=), Assertion, assertFailure, testCase)
+import Test.Tasty.HUnit ((@?=), Assertion, assertBool, assertFailure, testCase)
 import Test.Tasty.QuickCheck
 import Test.QuickCheck.Instances ()
 
 import Data.MIME
+import Data.MIME.Charset
 
 unittests :: TestTree
 unittests = testGroup "MIME tests"
   [ testContentDisposition
   , testParse
+  , testParameterValueOverloadedStrings
+  , testContentTypeOverloadedStrings
   ]
 
 testContentDisposition :: TestTree
@@ -123,15 +131,17 @@
         (Message (Headers [("Content-Disposition", "attachment; filename=foo.pdf")]) (Part ""))
         == Just s
     , testCase "unset multiple filenames" $
-        set (attachments . headers . contentDisposition . filenameParameter) Nothing
-        (Message (Headers []) (Multipart
+        set
+          (attachments . headers . contentDisposition . traversed . filenameParameter)
+          Nothing
+        (Message (Headers []) (Multipart . fromList $
           [ Message (Headers [("Content-Disposition", "inline; filename=msg.txt")]) (Part "")
           , Message (Headers [("Content-Disposition", "attachment; filename=foo.pdf")]) (Part "")
           , Message (Headers [("Content-Disposition", "attachment; filename=bar.pdf")]) (Part "")
           ]
         ))
         @?=
-        Message (Headers []) (Multipart
+        Message (Headers []) (Multipart . fromList $
           [ Message (Headers [("Content-Disposition", "inline; filename=msg.txt")]) (Part "")
           , Message (Headers [("Content-Disposition", "attachment")]) (Part "")
           , Message (Headers [("Content-Disposition", "attachment")]) (Part "")
@@ -139,7 +149,7 @@
         )
     ]
   where
-    lFilename = headers . contentDisposition . filename defaultCharsets
+    lFilename = headers . contentDisposition . traversed . filename defaultCharsets
     stripPath = snd . T.breakOnEnd "/"
 
 testParse :: TestTree
@@ -151,3 +161,33 @@
 testParseFile :: FilePath -> Assertion
 testParseFile =
   either assertFailure (void . pure) . parse (message mime) <=< B.readFile
+
+testParameterValueOverloadedStrings :: TestTree
+testParameterValueOverloadedStrings = testGroup "ParameterValue IsString instances"
+  [ testCase "DecodedParameterValue" $
+      let
+        -- start with DecodedParameterValue, then round-trip it
+        v' = charsetEncode "hello世界" :: EncodedParameterValue
+      in
+        meh (view (charsetDecoded defaultCharsets) v')
+          @?= Right (ParameterValue Nothing Nothing "hello世界")
+  , testCase "EncodedParameterValue" $
+      let
+        -- start with EncodedParameterValue, then decode it
+        v = "hello世界" :: EncodedParameterValue
+      in
+        meh (view (charsetDecoded defaultCharsets) v)
+          @?= Right (ParameterValue Nothing Nothing "hello世界")
+  ]
+  where
+    meh :: Either CharsetError b -> Either () b
+    meh = first (const ())
+
+testContentTypeOverloadedStrings :: TestTree
+testContentTypeOverloadedStrings = testGroup "ContentType fromString"
+  [ testCase "no params" $ fromString "foo/bar" @?= ContentType "foo" "bar" mempty
+  , testCase "params" $ fromString "foo/bar; baz=quux" @?= ContentType "foo" "bar" (Parameters [("baz", "quux")])
+  , testCase "bogus" $
+      (isLeft <$> (try . evaluate $ fromString "foo/; baz=quux" :: IO (Either ErrorCall ContentType)))
+      >>= assertBool "bogus string throws error"
+  ]
diff --git a/tests/Message.hs b/tests/Message.hs
new file mode 100644
--- /dev/null
+++ b/tests/Message.hs
@@ -0,0 +1,90 @@
+-- This file is part of purebred-email
+-- Copyright (C) 2019  Fraser Tweedale
+--
+-- purebred-email is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{- |
+
+Generators and instances for messages and parts thereof.
+
+-}
+module Message where
+
+import Data.Char (isAscii, isPrint)
+import Data.List.NonEmpty (fromList)
+
+import qualified Data.ByteString.Char8 as B
+import qualified Data.Text as T
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+import Data.MIME
+
+tests :: TestTree
+tests = testGroup "message tests"
+  [ testProperty "message round trip" prop_messageRoundTrip
+  ]
+
+genPrintAsciiChar :: Gen Char
+genPrintAsciiChar = arbitraryPrintableChar `suchThat` isAscii
+
+genAscii1 :: Gen T.Text
+genAscii1 = T.pack <$> listOf1 genPrintAsciiChar
+
+genText1 :: Gen T.Text
+genText1 = T.pack <$> listOf1 arbitraryPrintableChar
+
+genTextPlain :: Gen MIMEMessage
+genTextPlain = createTextPlainMessage <$> oneof [genAscii1, genText1]
+
+-- Generate a 50 character multipart boundary.  These MUST be unique
+-- for all (nested) multipart messages.  Hopefully 50 chars is
+-- enough to have a low-enough probability of collision.
+genBoundary :: Gen B.ByteString
+genBoundary = B.pack <$> vectorOf 50 genPrintAsciiChar
+
+-- Multipart message with at least one part.
+genMultipart1 = depths >>= go
+  where
+  go :: Int -> Gen MIMEMessage
+  go 0 = genTextPlain
+  go n = do
+    len <- choose (1, 10) -- up to 10 subparts, minimum of 1
+    createMultipartMixedMessage
+      <$> genBoundary
+      <*> ( fromList <$>
+            -- 75% plain, 25% nested multipart
+            vectorOf len (maybeAp encapsulate 5 $ frequency [(3, genTextPlain), (1, go (n - 1))])
+          )
+
+  -- max depth of 4
+  depths = frequency
+    [ (1, pure 1)
+    , (5, pure 2)
+    , (3, pure 3)
+    , (1, pure 4)
+    ]
+
+-- | Apply the function to the generated value with probability 1-in-/n/.
+maybeAp :: (a -> a) -> Int -> Gen a -> Gen a
+maybeAp f n g = frequency [(n - 1, g), (1, f <$> g)]
+
+genMessage :: Gen MIMEMessage
+genMessage = oneof [ genTextPlain, genMultipart1, encapsulate <$> genMessage ]
+
+
+prop_messageRoundTrip :: Property
+prop_messageRoundTrip = forAll genMessage $ \msg ->
+  parse (message mime) (renderMessage msg) == Right msg
diff --git a/tests/Parser.hs b/tests/Parser.hs
new file mode 100644
--- /dev/null
+++ b/tests/Parser.hs
@@ -0,0 +1,39 @@
+-- This file is part of purebred-email
+-- Copyright (C) 2019  Fraser Tweedale
+--
+-- purebred-email is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+module Parser where
+
+import Data.Attoparsec.ByteString.Lazy as AL
+import Data.ByteString as B
+import Data.ByteString.Lazy as L
+import Test.QuickCheck.Instances ()
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+import Data.RFC5322.Internal (takeTillString)
+
+tests :: TestTree
+tests = testGroup "Parser tests"
+  [ testProperty "takeTillString" $ \h l c r ->
+      let
+        s = h <> l <> c <> r
+        s' = L.fromChunks $ B.foldr ((:) . B.singleton) [] s
+      in
+        not (c `B.isInfixOf` l) ==>
+          case AL.parse (AL.string h *> takeTillString c) s' of
+            AL.Done r' l' -> r' == L.fromStrict r && l' == l
+            _ -> False
+  ]
diff --git a/tests/Test.hs b/tests/Test.hs
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -5,6 +5,8 @@
 import MIME
 import Headers
 import Generator
+import Parser
+import Message
 
 main :: IO ()
 main =
@@ -13,4 +15,6 @@
     , Headers.unittests
     , Generator.properties
     , MIME.unittests
+    , Parser.tests
+    , Message.tests
     ]
diff --git a/tests/golden/multipart.golden b/tests/golden/multipart.golden
--- a/tests/golden/multipart.golden
+++ b/tests/golden/multipart.golden
@@ -1,23 +1,20 @@
+MIME-Version: 1.0
 From: "Roman Joost" <foo@bar.com>
 To: bar@bar.com
 Date: Sun, 20 Mar 1859 00:02:03 +0000
 Subject: Hello there
 Content-Type: multipart/mixed; boundary=asdf
-MIME-Version: 1.0
 
 --asdf
-Content-Type: text/plain
-Content-Disposition: inline; charset=utf-8
 Content-Transfer-Encoding: 7bit
-MIME-Version: 1.0
+Content-Disposition: inline
+Content-Type: text/plain; charset=us-ascii
 
 This is a simple mail.
 --asdf
-Content-Type: application/octet-stream
+Content-Transfer-Encoding: 7bit
 Content-Disposition: attachment; filename=foo.bin
-Content-Transfer-Encoding: base64
-MIME-Version: 1.0
-
-ZmlsZUNvbnRlbnRzQVNERg==
+Content-Type: application/octet-stream
 
+fileContentsASDF
 --asdf--
diff --git a/tests/golden/textplain7bit.golden b/tests/golden/textplain7bit.golden
--- a/tests/golden/textplain7bit.golden
+++ b/tests/golden/textplain7bit.golden
@@ -1,7 +1,7 @@
+MIME-Version: 1.0
 Subject: Hello there
-Content-Type: text/plain
-Content-Disposition: inline; charset=utf-8
 Content-Transfer-Encoding: 7bit
-MIME-Version: 1.0
+Content-Disposition: inline
+Content-Type: text/plain; charset=us-ascii
 
 This is a simple mail.