From 8f11927ea74d6adb332c884502ebd9c486837523 Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Tue, 24 Nov 2020 20:07:37 +0100
Subject: initial commit

---
 src/Data/MIME/Extended.hs | 67 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 src/Data/MIME/Extended.hs

(limited to 'src/Data/MIME/Extended.hs')

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")
-- 
cgit v1.2.3