2 files changed, 101 insertions, 0 deletions
diff --git a/src/Data/ByteString/Extended.hs b/src/Data/ByteString/Extended.hs
new file mode 100644
index 0000000..144c933
--- /dev/null
+++ b/src/Data/ByteString/Extended.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Data.ByteString.Extended
+    (
+    ) where
+
+import Data.Aeson
+import Data.ByteString
+import qualified Data.CaseInsensitive
+import Data.Text.Encoding
+import qualified Data.Text.Encoding.Error
+
+
+instance FromJSON ByteString where
+    parseJSON =
+        withText "ByteString" $
+          pure . Data.Text.Encoding.encodeUtf8
+
+instance ToJSON Data.ByteString.ByteString where
+    toJSON =
+        String .
+        Data.Text.Encoding.decodeUtf8With
+          Data.Text.Encoding.Error.lenientDecode
+
+
+instance ToJSON (Data.CaseInsensitive.CI Data.ByteString.ByteString) where
+    toJSON =
+        toJSON . Data.CaseInsensitive.foldedCase
+
+instance FromJSON (Data.CaseInsensitive.CI Data.ByteString.ByteString) where
+    parseJSON =
+        withText "CI ByteString" $
+          pure . Data.CaseInsensitive.mk . Data.Text.Encoding.encodeUtf8
diff --git a/src/Data/MIME/Extended.hs b/src/Data/MIME/Extended.hs
new file mode 100644
index 0000000..46384d4
--- /dev/null
+++ b/src/Data/MIME/Extended.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Data.MIME.Extended
+    ( module Data.MIME
+    ) where
+
+import Control.Lens hiding ((.=))
+import Data.Aeson
+import Data.ByteString.Extended ()
+import Data.MIME
+import Data.MIME.EncodedWord
+import qualified Data.Vector
+
+
+
+instance ToJSON (Message s MIME) where
+    toJSON (Message h b) =
+      object
+          [ "headers" .= toJSON h
+          , "body" .=
+            case b of
+              Part b' -> toJSON b'
+              Encapsulated b' -> toJSON b'
+              Multipart b' -> toJSON b'
+              FailedParse _ msg -> toJSON msg
+          ]
+
+instance FromJSON (Message s MIME) where
+    parseJSON =
+        withObject "MIMEMessage" $ \v -> do
+          h <- v .: "headers"
+          b <-
+            case h ^. contentType of
+              ContentType "message" "rfc822" _ ->
+                Encapsulated <$> v .: "body"
+
+              ContentType "multipart" _ _ ->
+                Multipart <$> v .: "body"
+
+              _ ->
+                Part <$> v .: "body"
+          pure $ Message h b
+
+
+instance ToJSON Headers where
+    toJSON (Headers h) =
+        Array . Data.Vector.fromList . map toJSON' $ h
+      where
+        toJSON' (k, v) =
+          object
+            [ "key" .= toJSON k
+            , "value" .= toJSON (decodeEncodedWords defaultCharsets v)
+            ]
+
+instance FromJSON Headers where
+    parseJSON =
+        withArray "Headers" $ \v -> do
+          x <- mapM parseJSON' $ Data.Vector.toList v
+          pure $ Headers x
+      where
+        parseJSON' =
+            withObject "Header" $ \v ->
+              (,) <$> v .: "key"
+                  <*> encodeEncodedWords `fmap` (v .: "value")