blob: 46384d43603bfdfca128fddc6e80f931985ed3b0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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")
|
