/
Body.hs
226 lines (189 loc) · 7.7 KB
/
Body.hs
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-- |
-- Module : Network.AWS.Data.Body
-- Copyright : (c) 2013-2018 Brendan Hay
-- License : Mozilla Public License, v. 2.0.
-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability : provisional
-- Portability : non-portable (GHC extensions)
--
module Network.AWS.Data.Body where
import Control.Monad.Trans.Resource
import Data.Aeson
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS8
import Data.Conduit
import Data.HashMap.Strict (HashMap)
import Data.Monoid
import Data.String
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Encoding as LText
import Network.AWS.Data.ByteString
import Network.AWS.Data.Crypto
import Network.AWS.Data.Log
import Network.AWS.Data.Query (QueryString)
import Network.AWS.Data.XML (encodeXML)
import Network.AWS.Lens (AReview, Lens', lens, to, un)
import Network.HTTP.Conduit
import Text.XML (Element)
default (Builder)
-- | A streaming, exception safe response body.
newtype RsBody = RsBody
{ _streamBody :: ConduitM () ByteString (ResourceT IO) ()
} -- newtype for show/orhpan instance purposes.
instance Show RsBody where
show = const "RsBody { ConduitM () ByteString (ResourceT IO) () }"
fuseStream :: RsBody
-> ConduitM ByteString ByteString (ResourceT IO) ()
-> RsBody
fuseStream b f = b { _streamBody = _streamBody b .| f }
-- | Specifies the transmitted size of the 'Transfer-Encoding' chunks.
--
-- /See:/ 'defaultChunk'.
newtype ChunkSize = ChunkSize Int
deriving (Eq, Ord, Show, Enum, Num, Real, Integral)
instance ToLog ChunkSize where
build = build . show
-- | The default chunk size of 128 KB. The minimum chunk size accepted by
-- AWS is 8 KB, unless the entirety of the request is below this threshold.
--
-- A chunk size of 64 KB or higher is recommended for performance reasons.
defaultChunkSize :: ChunkSize
defaultChunkSize = 128 * 1024
-- | An opaque request body which will be transmitted via
-- @Transfer-Encoding: chunked@.
--
-- /Invariant:/ Only services that support chunked encoding can
-- accept a 'ChunkedBody'. (Currently S3.) This is enforced by the type
-- signatures emitted by the generator.
data ChunkedBody = ChunkedBody
{ _chunkedSize :: !ChunkSize
, _chunkedLength :: !Integer
, _chunkedBody :: ConduitM () ByteString (ResourceT IO) ()
}
chunkedLength :: Lens' ChunkedBody Integer
chunkedLength = lens _chunkedLength (\s a -> s { _chunkedLength = a })
-- Maybe revert to using Source's, and then enforce the chunk size
-- during conversion from HashedBody -> ChunkedBody
instance Show ChunkedBody where
show c = BS8.unpack . toBS $ build
"ChunkedBody { chunkSize = "
<> build (_chunkedSize c)
<> "<> originalLength = "
<> build (_chunkedLength c)
<> "<> fullChunks = "
<> build (fullChunks c)
<> "<> remainderBytes = "
<> build (remainderBytes c)
<> "}"
fuseChunks :: ChunkedBody
-> ConduitM ByteString ByteString (ResourceT IO) ()
-> ChunkedBody
fuseChunks c f = c { _chunkedBody = _chunkedBody c .| f }
fullChunks :: ChunkedBody -> Integer
fullChunks c = _chunkedLength c `div` fromIntegral (_chunkedSize c)
remainderBytes :: ChunkedBody -> Maybe Integer
remainderBytes c =
case _chunkedLength c `mod` toInteger (_chunkedSize c) of
0 -> Nothing
n -> Just n
-- | An opaque request body containing a 'SHA256' hash.
data HashedBody
= HashedStream (Digest SHA256) !Integer (ConduitM () ByteString (ResourceT IO) ())
| HashedBytes (Digest SHA256) ByteString
instance Show HashedBody where
show = \case
HashedStream h n _ -> str "HashedStream" h n
HashedBytes h x -> str "HashedBody" h (BS.length x)
where
str c h n = BS8.unpack . toBS $
c <> " { sha256 = "
<> build (digestToBase Base16 h)
<> ", length = "
<> build n
instance IsString HashedBody where
fromString = toHashed
sha256Base16 :: HashedBody -> ByteString
sha256Base16 = digestToBase Base16 . \case
HashedStream h _ _ -> h
HashedBytes h _ -> h
-- | Invariant: only services that support _both_ standard and
-- chunked signing expose 'RqBody' as a parameter.
data RqBody
= Chunked ChunkedBody
| Hashed HashedBody
deriving (Show)
instance IsString RqBody where
fromString = Hashed . fromString
md5Base64 :: RqBody -> Maybe ByteString
md5Base64 = \case
Hashed (HashedBytes _ x) -> Just . digestToBase Base64 $ hashMD5 x
_ -> Nothing
isStreaming :: RqBody -> Bool
isStreaming = \case
Hashed (HashedStream {}) -> True
_ -> False
toRequestBody :: RqBody -> RequestBody
toRequestBody = \case
Chunked x -> requestBodySourceChunked (_chunkedBody x)
Hashed x -> case x of
HashedStream _ n f -> requestBodySource (fromIntegral n) f
HashedBytes _ b -> RequestBodyBS b
contentLength :: RqBody -> Integer
contentLength = \case
Chunked x -> _chunkedLength x
Hashed x -> case x of
HashedStream _ n _ -> n
HashedBytes _ b -> fromIntegral (BS.length b)
-- | Anything that can be safely converted to a 'HashedBody'.
class ToHashedBody a where
-- | Convert a value to a hashed request body.
toHashed :: a -> HashedBody
instance ToHashedBody ByteString where
toHashed x = HashedBytes (hash x) x
instance ToHashedBody HashedBody where toHashed = id
instance ToHashedBody String where toHashed = toHashed . LBS8.pack
instance ToHashedBody LBS.ByteString where toHashed = toHashed . toBS
instance ToHashedBody Text where toHashed = toHashed . Text.encodeUtf8
instance ToHashedBody LText.Text where toHashed = toHashed . LText.encodeUtf8
instance ToHashedBody Value where toHashed = toHashed . encode
instance ToHashedBody Element where toHashed = toHashed . encodeXML
instance ToHashedBody QueryString where toHashed = toHashed . toBS
instance ToHashedBody (HashMap Text Value) where
toHashed = toHashed . Object
-- | Anything that can be converted to a streaming request 'Body'.
class ToBody a where
-- | Convert a value to a request body.
toBody :: a -> RqBody
default toBody :: ToHashedBody a => a -> RqBody
toBody = Hashed . toHashed
instance ToBody RqBody where toBody = id
instance ToBody HashedBody where toBody = Hashed
instance ToBody ChunkedBody where toBody = Chunked
instance ToHashedBody a => ToBody (Maybe a) where
toBody = Hashed . maybe (toHashed BS.empty) toHashed
instance ToBody String
instance ToBody LBS.ByteString
instance ToBody ByteString
instance ToBody Text
instance ToBody LText.Text
instance ToBody (HashMap Text Value)
instance ToBody Value
instance ToBody Element
instance ToBody QueryString
_Body :: ToBody a => AReview RqBody a
_Body = un (to toBody)