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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module JSON (
Test (..),
Case (..),
HeaderList,
) where
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative
#endif
import Control.Monad (mzero)
import Data.Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as H
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector ((!))
import qualified Data.Vector as V
import Network.HPACK
{-
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy as BL
main :: IO ()
main = do
bs <- BL.getContents
let Right x = eitherDecode bs :: Either String Test
BL.putStr $ encodePretty x
-}
data Test = Test
{ description :: String
, cases :: [Case]
}
deriving (Show)
data Case = Case
{ size :: Maybe Int
, wire :: ByteString
, headers :: HeaderList
, seqno :: Maybe Int
}
deriving (Show)
instance FromJSON Test where
parseJSON (Object o) =
Test
<$> o .: "description"
<*> o .: "cases"
parseJSON _ = mzero
instance ToJSON Test where
toJSON (Test desc cs) =
object
[ "description" .= desc
, "cases" .= cs
]
instance FromJSON Case where
parseJSON (Object o) =
Case
<$> o .:? "header_table_size"
<*> (textToByteString <$> (o .: "wire"))
<*> o .: "headers"
<*> o .:? "seqno"
parseJSON _ = mzero
instance ToJSON Case where
toJSON (Case (Just siz) w hs no) =
object
[ "header_table_size" .= siz
, "wire" .= byteStringToText w
, "headers" .= hs
, "seqno" .= no
]
toJSON (Case Nothing w hs no) =
object
[ "wire" .= byteStringToText w
, "headers" .= hs
, "seqno" .= no
]
instance {-# OVERLAPPING #-} FromJSON HeaderList where
parseJSON (Array a) = mapM parseJSON $ V.toList a
parseJSON _ = mzero
instance {-# OVERLAPPING #-} ToJSON HeaderList where
toJSON hs = toJSON $ map toJSON hs
instance {-# OVERLAPPING #-} FromJSON Header where
parseJSON (Array a) = pure (toKey (a ! 0), toValue (a ! 1)) -- old
where
toKey = toValue
parseJSON (Object o) = pure (textToByteString (Key.toText k), toValue v) -- new
where
(k, v) = head $ H.toList o
parseJSON _ = mzero
instance {-# OVERLAPPING #-} ToJSON Header where
toJSON (k, v) = object [Key.fromText (byteStringToText k) .= byteStringToText v]
textToByteString :: Text -> ByteString
textToByteString = B8.pack . T.unpack
byteStringToText :: ByteString -> Text
byteStringToText = T.pack . B8.unpack
toValue :: Value -> ByteString
toValue (String s) = textToByteString s
toValue _ = error "toValue"
|
