on master help sign in
Started an alternative design
commit871df7c522bc3f3cff60ac98c962dbe0ef184a1c authormrkkrp <markkarpov@opmbx.org> dateSat 22 Oct 2016, 17:48 (10 years ago) parent8726d0e
2 files changed+366−62
Network/HTTP/Req.hs+355−56 req.cabal+11−6
Network/HTTP/Req.hs+355−56
@@ -7,94 +7,393 @@
77-- Stability : experimental
88-- Portability : portable
99--
10−-- Library for safe construction of HTTP requests.
10+-- This is an easy-to-use, type-safe, expandable, high-level HTTP library
11+-- that just works without any fooling around.
12+--
13+-- The documentation below is structured in such a way that most important
14+-- information goes first: you learn how to do HTTP requests, then how to
15+-- embed them any monad you have, then it goes on giving you details about
16+-- less-common things you may want to know about. The documentation is
17+-- written with sufficient coverage of details and with examples, it's
18+-- designed to be a complete tutorial on its own.
19+--
20+-- The library uses the following well-known and mature packages under the
21+-- hood to guarantee you best experience without bugs or other funny
22+-- business:
23+--
24+-- * <https://hackage.haskell.org/package/http-client> — low level HTTP
25+-- client used everywhere in Haskell.
26+-- * <https://hackage.haskell.org/package/http-client-tls> — TLS (HTTPS)
27+-- support.
28+-- * <https://hackage.haskell.org/package/http-conduit> — conduit
29+-- interface to @http-client@.
30+--
31+-- You generally won't need low-level interface of @http-client@ at all
32+-- because this package covers /everything/, so don't import it or import
33+-- qualified because it has naming conflicts with @req@.
1134
1235{-# LANGUAGE DataKinds #-}
1336{-# LANGUAGE FlexibleInstances #-}
14−{-# LANGUAGE FunctionalDependencies #-}
1537{-# LANGUAGE GADTs #-}
1638{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1739{-# LANGUAGE KindSignatures #-}
1840{-# LANGUAGE MultiParamTypeClasses #-}
1941{-# LANGUAGE OverloadedStrings #-}
42+{-# LANGUAGE ScopedTypeVariables #-}
43+{-# LANGUAGE TypeFamilies #-}
44+{-# LANGUAGE UndecidableInstances #-}
2045
2146module Network.HTTP.Req
22− ( HasBody (..)
47+ ( -- * Making a request
48+ req
49+ -- * Embedding requests into your monad
50+ , MonadHttp (..)
51+ , HttpConfig (..)
52+ , httpConfig
53+ , httpsConfig
54+ -- * Request
55+ -- ** Methods
56+ -- $request-methods
57+ , GET (..)
58+ , POST (..)
59+ , HEAD (..)
60+ , PUT (..)
61+ , DELETE (..)
62+ , TRACE (..)
63+ , CONNECT (..)
64+ , OPTIONS (..)
65+ , PATCH (..)
2366 , HttpMethod (..)
24− , Scheme (..)
25− , Endpoint (..)
26− , ReqBody (..)
27− , req )
67+ -- ** URL
68+ , http
69+ , https
70+ , (/:)
71+ , Endpoint
72+ -- ** Body
73+ , HttpBody (..) -- TODO more stuff here
74+ -- ** Optional parameters
75+ , Option
76+ -- *** Query parameters
77+ , (=:)
78+ , queryFlag
79+ , QueryParam (..)
80+ -- *** Headers
81+ , header
82+ -- *** Authorization
83+ -- *** Other
84+ , port
85+ , redirectCount
86+ -- * Response
87+ , HttpResponse (..)
88+ -- * Other
89+ , CanHaveBody (..)
90+ , Scheme (..) )
2891where
2992
3093import Control.Monad.IO.Class
3194import Control.Monad.Reader
3295import Data.Aeson
33−import Data.Binary.Builder (Builder)
96+import Data.ByteString
97+import Data.Proxy
3498import Data.Semigroup hiding (Option)
3599import Data.Text (Text)
36−import Network.HTTP.Client
37−import qualified Data.ByteString as B
100+import GHC.TypeLits
101+import Numeric.Natural
102+import qualified Data.ByteString as B
38103import qualified Data.ByteString.Lazy as BL
104+import qualified Network.HTTP.Client as L
105+import qualified Network.HTTP.Types as Y
39106
40−data HasBody = HasBody | NoBody
107+----------------------------------------------------------------------------
108+-- Making a request
41109
42−data HttpMethod (b :: HasBody) where
43− GET :: HttpMethod 'NoBody
44− HEAD :: HttpMethod 'NoBody
45− OPTIONS :: HttpMethod 'NoBody
46− DELETE :: HttpMethod 'NoBody
47− POST :: HttpMethod 'HasBody
48− PUT :: HttpMethod 'HasBody
49− PATCH :: HttpMethod 'HasBody
110+-- | Perform an HTTP request.
50111
51−data Scheme = Http | Https
112+req
113+ :: ( MonadHttp m
114+ , HttpMethod method
115+ , HttpBody body
116+ , HttpResponse response
117+ , AllowsBody method ~ ProvidesBody body
118+ , ProvidesConnection m ~ scheme )
119+ => method
120+ -> Endpoint scheme
121+ -> body
122+ -> Option
123+ -> m response
124+req = undefined
52125
53−data Endpoint (s :: Scheme) where
54− Http' :: Text -> Endpoint 'Http
55− Https' :: Text -> Endpoint 'Https
56− (:/) :: Endpoint s -> Text -> Endpoint s
126+-- TODO We need to catch exceptions here, only relevant ones and only
127+-- synchronous to give user a chance to work with pure, explicit exceptions
128+-- if he wants to do so.
57129
58−http = Http' -- don't export the constructors
130+-- TODO How to specify return type here?
131+-- TODO It needs a way to signal errors.
59132
60−https = Https'
133+----------------------------------------------------------------------------
134+-- Embedding requests into your monad
61135
62−infixl 5 :/
136+class MonadIO m => MonadHttp m where
137+ type ProvidesConnection m :: Scheme
138+ getHttpConfig :: m (HttpConfig (ProvidesConnection m))
63139
64−data ReqBody (b :: HasBody) where
65− NoReqBody :: ReqBody 'NoBody
66− ReqBodyLBS :: BL.ByteString -> ReqBody 'HasBody
67− ReqBodyBS :: B.ByteString -> ReqBody 'HasBody
68− ReqBodyBuilder :: Builder -> ReqBody 'HasBody
69− ReqBodyUrlEncoded :: [(Text,Text)] -> ReqBody 'HasBody
70− -- ↑ use something nicer than tuples? (:=) pairs perhaps?
71− ReqBodyJSON :: Value -> ReqBody 'HasBody
72− -- TODO add more?
140+-- | 'HttpConfig' contains general and default settings to be used when
141+-- making HTTP requests.
73142
74−newtype Options = Options [Option] deriving (Semigroup, Monoid)
143+data HttpConfig (scheme :: Scheme) = HttpConfig
144+ { httpConfigManager :: L.Manager
145+ }
75146
76−data Option
77− = QP Text Text -- ^ Query param
78− -- TODO add much more, headers, cookies, all the optional stuff
147+httpConfig :: MonadIO m => m (HttpConfig 'Http)
148+httpConfig = undefined -- FIXME not final, need to pass params in
79149
80−data ReqConfig (s :: Scheme) = ReqConfig Manager
150+httpsConfig :: MonadIO m => m (HttpConfig 'Https)
151+httpsConfig = undefined -- FIXME
81152
82−class HasReqConfig a s | a -> s where
83− reqConfig :: a -> ReqConfig s
153+----------------------------------------------------------------------------
154+-- Request — Methods
84155
85−instance HasReqConfig (ReqConfig s) s where
86− reqConfig = id
156+-- $request-methods
157+--
158+-- The package provides all methods as defined by RFC 2616, and 'PATCH'
159+-- which is defined by RFC 5789 — that should be enough to talk to RESTful
160+-- APIs. In some cases however, you may want to add more methods (e.g. you
161+-- work with WebDAV <https://en.wikipedia.org/wiki/WebDAV>); no need to
162+-- compromise on type safety and hack, it only takes a couple of seconds to
163+-- define a new method that will works seamlessly, see 'HttpMethod'.
87164
88−req
89− :: (MonadIO m, MonadReader r m, HasReqConfig r s)
90− => HttpMethod b
91− -> Endpoint s
92− -> ReqBody b
93− -> Options
94− -> m ()
95−req = undefined
165+-- | 'GET' method.
166+
167+data GET = GET
168+
169+instance HttpMethod GET where
170+ type AllowsBody GET = 'NoBody
171+ httpMethodName Proxy = Y.methodGet
172+
173+-- | 'POST' method.
174+
175+data POST = POST
176+
177+instance HttpMethod POST where
178+ type AllowsBody POST = 'CanHaveBody
179+ httpMethodName Proxy = Y.methodPost
180+
181+-- | 'HEAD' method.
182+
183+data HEAD = HEAD
184+
185+instance HttpMethod HEAD where
186+ type AllowsBody HEAD = 'NoBody
187+ httpMethodName Proxy = Y.methodHead
188+
189+-- | 'PUT' method.
190+
191+data PUT = PUT
192+
193+instance HttpMethod PUT where
194+ type AllowsBody PUT = 'CanHaveBody
195+ httpMethodName Proxy = Y.methodPut
196+
197+-- | 'DELETE' method.
198+
199+data DELETE = DELETE
200+
201+instance HttpMethod DELETE where
202+ type AllowsBody DELETE = 'NoBody
203+ httpMethodName Proxy = Y.methodDelete
204+
205+-- | 'TRACE' method.
206+
207+data TRACE = TRACE
208+
209+instance HttpMethod TRACE where
210+ type AllowsBody TRACE = 'CanHaveBody
211+ httpMethodName Proxy = Y.methodTrace
212+
213+-- | 'CONNECT' method.
214+
215+data CONNECT = CONNECT
216+
217+instance HttpMethod CONNECT where
218+ type AllowsBody CONNECT = 'CanHaveBody
219+ httpMethodName Proxy = Y.methodConnect
220+
221+-- | 'OPTIONS' method.
222+
223+data OPTIONS = OPTIONS
224+
225+instance HttpMethod OPTIONS where
226+ type AllowsBody OPTIONS = 'NoBody
227+ httpMethodName Proxy = Y.methodOptions
228+
229+-- | 'PATCH' method.
230+
231+data PATCH = PATCH
232+
233+instance HttpMethod PATCH where
234+ type AllowsBody PATCH = 'CanHaveBody
235+ httpMethodName Proxy = Y.methodPatch
236+
237+-- | A type class for types that can be used as an HTTP method. To define a
238+-- non-standard method, follow this example that defines COPY:
239+--
240+-- > data COPY = COPY
241+-- >
242+-- > instance HttpMethod COPY where
243+-- > type AllowsMody COPY = 'CanHaveBody
244+-- > httpMethodName Proxy = "COPY"
245+
246+class HttpMethod a where
247+
248+ -- | Type function 'AllowsBody' returns type of kind 'CanHaveBody' which
249+ -- tells the rest of the library whether the method can have a body or
250+ -- not. We use the special type 'CanHaveBody' “lifted” into kind instead
251+ -- of 'Bool' to get more user-friendly compiler messages.
252+
253+ type AllowsBody a :: CanHaveBody
254+
255+ -- | Return name of the method as a 'ByteString'.
256+
257+ httpMethodName :: Proxy a -> Y.Method
258+
259+-- NOTE Now we state how to get an endomorphism on 'Request's that changes
260+-- given 'Request' so it has the specified method.
261+
262+instance HttpMethod method => RequestComponent (Womb "method" method) where
263+ getRequestMod _ = Endo $ \x ->
264+ x { L.method = httpMethodName (Proxy :: Proxy method) }
96265
97−-- | Example of request.
266+----------------------------------------------------------------------------
267+-- Request — URL
268+
269+newtype Endpoint (scheme :: Scheme) = Endpoint { unEndpoint :: Text }
270+
271+-- data Endpoint (s :: Scheme) where
272+-- Http' :: Text -> Endpoint 'Http
273+-- Https' :: Text -> Endpoint 'Https
274+-- (:/) :: Endpoint s -> Text -> Endpoint s
275+
276+http :: Text -> Endpoint 'Http
277+http = Endpoint . percentEncode
278+
279+https :: Text -> Endpoint 'Https
280+https = Endpoint . percentEncode
281+
282+infixr 5 /:
283+
284+(/:) :: Endpoint scheme -> Text -> Endpoint scheme
285+(/:) = undefined -- TODO
286+
287+-- TODO Escape things in endpoint and query parameters, only :/ should work
288+-- as real /
289+
290+parseUrlHttp :: Text -> Endpoint 'Http
291+parseUrlHttp = undefined
292+
293+parseUrlHttps :: Text -> Endpoint 'Https
294+parseUrlHttps = undefined
295+
296+----------------------------------------------------------------------------
297+-- Request body
298+
299+class HttpBody b where
300+ type ProvidesBody b :: CanHaveBody
301+ getReqestBody :: b -> ByteString -- FIXME should use a conduit here
302+
303+data UrlEncodedParam = UrlEncodedParam Text (Maybe Text)
304+
305+instance QueryParam UrlEncodedParam where
306+ queryParam = UrlEncodedParam
307+
308+instance HttpBody b => RequestComponent (Womb "body" b) where
309+ getRequestMod = undefined -- FIXME
310+
311+-- data ReqBody (b :: HasBody) where
312+-- NoReqBody :: ReqBody 'NoBody
313+-- ReqBodyLBS :: BL.ByteString -> ReqBody 'HasBody
314+-- ReqBodyBS :: B.ByteString -> ReqBody 'HasBody
315+-- ReqBodyBuilder :: Builder -> ReqBody 'HasBody
316+-- ReqBodyUrlEncoded :: [(Text,Text)] -> ReqBody 'HasBody
317+-- -- ↑ use something nicer than tuples? (:=) pairs perhaps? The pairs
318+-- -- should represent query parameters and body of url encoded stuff at the
319+-- -- same time.
320+-- ReqBodyJSON :: Value -> ReqBody 'HasBody
321+-- -- TODO add more? add conduit support and depend on http-conduit
322+
323+----------------------------------------------------------------------------
324+-- Request — Optional parameters
325+
326+-- | Opaque 'Option' type is a 'Monoid' you can use to pack collection of
327+-- optional parameters like query parameters and headers. We also provide
328+-- authorization helpers out-of-the-box which are also of this type.
329+
330+newtype Option = Option { unOption :: Endo L.Request }
331+ deriving (Semigroup, Monoid)
332+
333+instance RequestComponent Option where
334+ getRequestMod = unOption
335+
336+----------------------------------------------------------------------------
337+-- Request — Optional parameters — Query Parameters
338+
339+-- | Synonym of '(=:)' in form of function, not operator.
340+
341+infix 7 =:
342+(=:) :: QueryParam a => Text -> Text -> a
343+name =: value = queryParam name (pure value)
344+
345+-- |
346+
347+queryFlag :: QueryParam a => Text -> a
348+queryFlag name = queryParam name Nothing
349+
350+class QueryParam a where
351+ queryParam :: Text -> Maybe Text -> a
352+
353+instance QueryParam Option where
354+ queryParam = undefined -- TODO
355+
356+----------------------------------------------------------------------------
357+-- Request — Optional parameters — Headers
358+
359+header :: Text -> Text -> Option
360+header = undefined
361+
362+----------------------------------------------------------------------------
363+-- Request — Optional parameters — Authorization
364+
365+-- Hmm, need to take a look at wreq first…
366+
367+----------------------------------------------------------------------------
368+-- Request — Optional parameters — Other
369+
370+port :: Natural -> Option
371+port = undefined -- TODO
372+
373+redirectCount :: Natural -> Option
374+redirectCount = undefined -- TODO
375+
376+-- etc.
377+
378+----------------------------------------------------------------------------
379+-- Response
380+
381+-- Here we need to provide various options how to consume responses.
382+
383+class HttpResponse response where
384+ interpretResponse :: ByteString -> response -- FIXME use conduit
385+
386+----------------------------------------------------------------------------
387+-- Other
388+
389+newtype Womb (tag :: Symbol) a = Womb { unWomb :: a }
390+
391+class RequestComponent a where
392+ getRequestMod :: a -> Endo L.Request
393+
394+data CanHaveBody = CanHaveBody | NoBody
395+
396+data Scheme = Http | Https
98397
99−myReq :: ReaderT (ReqConfig 'Http) IO ()
100−myReq = req GET (http "example.org" :/ "v1" :/ "items") NoReqBody mempty
398+percentEncode :: Text -> Text
399+percentEncode = undefined
req.cabal+11−6
@@ -56,13 +56,18 @@ flag dev
5656 default: False
5757
5858library
59− build-depends: aeson >= 0.11 && < 1.1
60− , base >= 4.7 && < 5.0
61− , binary >= 0.7.5 && < 0.9
62− , bytestring >= 0.2 && < 0.11
63− , http-client >= 0.4 && < 0.6
64− , text >= 0.2 && < 1.3
59+ build-depends: aeson >= 0.11 && < 1.1
60+ , base >= 4.7 && < 5.0
61+ , bytestring >= 0.2 && < 0.11
62+ , http-client >= 0.4 && < 0.6
63+ , http-client-tls >= 0.2.4.1 && < 0.4
64+ , http-conduit >= 2.1.11 && < 3.0
65+ , http-types >= 0.8 && < 10.0
66+ , mtl >= 2.0 && < 3.0
67+ , text >= 0.2 && < 1.3
6568 , transformers >= 0.4 && < 0.6
69+ if !impl(ghc >= 8.0)
70+ build-depends: semigroups == 0.18.*
6671 exposed-modules: Network.HTTP.Req
6772 if flag(dev)
6873 ghc-options: -Wall -Werror