@@ -81,6 +81,7 @@
81{-# LANGUAGE FlexibleInstances #-}
81{-# LANGUAGE FlexibleInstances #-}
82{-# LANGUAGE GeneralizedNewtypeDeriving #-}
82{-# LANGUAGE GeneralizedNewtypeDeriving #-}
83{-# LANGUAGE KindSignatures #-}
83{-# LANGUAGE KindSignatures #-}
84+{-# LANGUAGE OverloadedStrings #-}
84{-# LANGUAGE RecordWildCards #-}
85{-# LANGUAGE RecordWildCards #-}
85{-# LANGUAGE ScopedTypeVariables #-}
86{-# LANGUAGE ScopedTypeVariables #-}
86{-# LANGUAGE TypeFamilies #-}
87{-# LANGUAGE TypeFamilies #-}
@@ -125,12 +126,19 @@ module Network.HTTP.Req
126 -- *** Cookies
127 -- *** Cookies
127 -- *** Authentication
128 -- *** Authentication
129+ -- $request-optional-parameters-authentication
128 -- *** Other
135 -- *** Other
130 -- * Response
137 -- * Response
131 , HttpResponse (..)
138 , HttpResponse (..)
132 -- * Other
139 -- * Other
133− , CanHaveBody (..) )
140+ , CanHaveBody (..)
136import Control.Arrow (first, second)
144import Control.Arrow (first, second)
@@ -173,16 +181,16 @@ import qualified Network.HTTP.Types as Y
173-- TODO Finish docs of this function when the package is more developed.
181-- TODO Finish docs of this function when the package is more developed.
176− :: forall m method body response.
184+ :: forall m method body response scheme.
177 ( MonadHttp m
185 ( MonadHttp m
178 , HttpMethod method
186 , HttpMethod method
179 , HttpBody body
187 , HttpBody body
180 , HttpResponse response
188 , HttpResponse response
181 , AllowsBody method ~ ProvidesBody body )
189 , AllowsBody method ~ ProvidesBody body )
182 => method -- ^ HTTP method
190 => method -- ^ HTTP method
183− -> Url -- ^ 'Url' — location of resource
191+ -> Url scheme -- ^ 'Url' — location of resource
184 -> body -- ^ Body of the request
192 -> body -- ^ Body of the request
185− -> Option -- ^ Collection of optional parameters
193+ -> Option scheme -- ^ Collection of optional parameters
186 -> m response -- ^ Response
194 -> m response -- ^ Response
187req method url body options = do
195req method url body options = do
188 config <- getHttpConfig
196 config <- getHttpConfig
@@ -422,7 +430,7 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
422-- > https "юникод.рф"
430-- > https "юникод.рф"
423-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
431-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
425−data Url = Url Bool (NonEmpty Text)
433+data Url (scheme :: Scheme) = Url Bool (NonEmpty Text)
426 -- NOTE The first 'Bool' value specifies if the 'Url' has “https” as its
434 -- NOTE The first 'Bool' value specifies if the 'Url' has “https” as its
427 -- scheme (otherwise “http” is assumed). The second value is path segments
435 -- scheme (otherwise “http” is assumed). The second value is path segments
428 -- in reversed order.
436 -- in reversed order.
@@ -431,22 +439,22 @@ data Url = Url Bool (NonEmpty Text)
431-- | Given host name, produce a 'Url' which have “http” as its scheme and
439-- | Given host name, produce a 'Url' which have “http” as its scheme and
432-- empty path. This also sets port to @80@.
440-- empty path. This also sets port to @80@.
434−http :: Text -> Url
442+http :: Text -> Url 'Http
435http = Url False . pure
443http = Url False . pure
437-- | Given host name, produce a 'Url' which have “https” as its scheme and
445-- | Given host name, produce a 'Url' which have “https” as its scheme and
438-- empty path. This also sets port to @443@.
446-- empty path. This also sets port to @443@.
440−https :: Text -> Url
448+https :: Text -> Url 'Https
441https = Url True . pure
449https = Url True . pure
443-- | Grow given 'Url' appending a single path segment to it.
451-- | Grow given 'Url' appending a single path segment to it.
445infixl 5 /:
453infixl 5 /:
446−(/:) :: Url -> Text -> Url
454+(/:) :: Url scheme -> Text -> Url scheme
447Url secure path /: segment = Url secure (NE.cons segment path)
455Url secure path /: segment = Url secure (NE.cons segment path)
449−instance RequestComponent Url where
457+instance RequestComponent (Url scheme) where
450 getRequestMod (Url secure segments) = Endo $ \x ->
458 getRequestMod (Url secure segments) = Endo $ \x ->
451 let (host :| path) = NE.reverse segments in
459 let (host :| path) = NE.reverse segments in
452 x { L.secure = secure
460 x { L.secure = secure
@@ -487,7 +495,7 @@ instance HttpBody b => RequestComponent (Womb "body" b) where
488-- TODO We need examples here.
496-- TODO We need examples here.
490−newtype Option = Option (Endo (Y.QueryText, L.Request))
498+newtype Option (scheme :: Scheme) = Option (Endo (Y.QueryText, L.Request))
491 -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
499 -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
492 -- Request to avoid appending to existing query string in request every
500 -- Request to avoid appending to existing query string in request every
493 -- time new parameter is added.
501 -- time new parameter is added.
@@ -496,16 +504,16 @@ newtype Option = Option (Endo (Y.QueryText, L.Request))
496-- | A helper to create an 'Option' that modifies only collection of query
504-- | A helper to create an 'Option' that modifies only collection of query
497-- parameters. This helper is not a part of public API.
505-- parameters. This helper is not a part of public API.
499−withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option
507+withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
500withQueryParams = Option . Endo . first
508withQueryParams = Option . Endo . first
502-- | A helper to create an 'Option' that modifies only 'L.Request'. This
510-- | A helper to create an 'Option' that modifies only 'L.Request'. This
503-- helper is not a part of public API.
511-- helper is not a part of public API.
505−withRequest :: (L.Request -> L.Request) -> Option
513+withRequest :: (L.Request -> L.Request) -> Option scheme
506withRequest = Option . Endo . second
514withRequest = Option . Endo . second
508−instance RequestComponent Option where
516+instance RequestComponent (Option scheme) where
509 getRequestMod (Option f) = Endo $ \x ->
517 getRequestMod (Option f) = Endo $ \x ->
510 let (qparams, x') = appEndo f ([], x)
518 let (qparams, x') = appEndo f ([], x)
511 query = Y.renderQuery True (Y.queryTextToQuery qparams)
519 query = Y.renderQuery True (Y.queryTextToQuery qparams)
@@ -552,23 +560,20 @@ class QueryParam a where
553 queryParam :: Text -> Maybe Text -> a
561 queryParam :: Text -> Maybe Text -> a
555−instance QueryParam Option where
563+instance QueryParam (Option scheme) where
556 queryParam name mvalue = withQueryParams ((:) (name, mvalue))
564 queryParam name mvalue = withQueryParams ((:) (name, mvalue))
558----------------------------------------------------------------------------
566----------------------------------------------------------------------------
559-- Request — Optional parameters — Headers
567-- Request — Optional parameters — Headers
561−-- | Create an 'Option' that adds a header. The 'Text' values will be
569+-- | Create an 'Option' that adds a header.
562−-- inserted in UTF-8 encoding.
565− :: Text -- ^ Header name
572+ :: ByteString -- ^ Header name
566− -> Text -- ^ Header value
573+ -> ByteString -- ^ Header value
567− -> Option
574+ -> Option scheme
568header name value = withRequest $ \x ->
575header name value = withRequest $ \x ->
569− let name' = T.encodeUtf8 name
570− value' = T.encodeUtf8 value
571− in x { L.requestHeaders = (CI.mk name', value') : L.requestHeaders x }
576+ x { L.requestHeaders = (CI.mk name, value) : L.requestHeaders x }
573----------------------------------------------------------------------------
578----------------------------------------------------------------------------
574-- Request — Optional parameters — Cookies
579-- Request — Optional parameters — Cookies
@@ -578,11 +583,64 @@ header name value = withRequest $ \x ->
578----------------------------------------------------------------------------
583----------------------------------------------------------------------------
579-- Request — Optional parameters — Authentication
584-- Request — Optional parameters — Authentication
581−-- TODO basicAuth
586+-- $request-optional-parameters-authentication
588+-- TODO Something. You should always prefer authentication 'Option's to
589+-- manual construction of headers, etc., because it's a better style and
590+-- provides additional type safety that prevents leaking of credentials.
582−-- TODO oAuth1
592+oAuth1
583−-- TODO oAuth2Bearer
593+ :: ByteString -- ^ Consumer token
584−-- TODO oAuth2Token
594+ -> ByteString -- ^ Consumer secret
595+ -> ByteString -- ^ OAuth token
596+ -> ByteString -- ^ OAuth token secret
598+oAuth1 = undefined -- TODO
600+-- | The 'Option' adds basic authentication. The 'Text' values will be UTF-8
603+-- See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>
606+ :: ByteString -- ^ Username
607+ -> ByteString -- ^ Password
608+ -> Option 'Https -- ^ Auth 'Option'
609+basicAuth username password = withRequest
610+ (L.applyBasicAuth username password)
612+-- | The 'Option' adds an OAuth2 bearer token. This is treated by many
613+-- services as the equivalent of a username and password.
615+-- The 'Option' is defined as:
617+-- > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
620+ :: ByteString -- ^ Token
621+ -> Option 'Https -- ^ Auth 'Option'
622+oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
624+-- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems
625+-- to be used only by GitHub). This will be treated by whatever services
626+-- accept it as the equivalent of a username and password.
628+-- The 'Option' is defined as:
630+-- > oAuth2Token token = header "Authorization" ("token" <> token)
633+ :: ByteString -- ^ Token
634+ -> Option 'Https -- ^ Auth 'Option'
635+oAuth2Token token = header "Authorization" ("token" <> token)
637+-- | The 'Option' adds AWS v4 request signature.
585−-- TODO awsAuth
639+awsAuth
640+ :: ByteString -- ^ AWS access key
641+ -> ByteString -- ^ AWS secret access key
642+ -> Option 'Https -- ^ Auth 'Option'
643+awsAuth accessKey secretKey = undefined -- TODO
587----------------------------------------------------------------------------
645----------------------------------------------------------------------------
588-- Request — Optional parameters — Other
646-- Request — Optional parameters — Other
@@ -591,7 +649,7 @@ header name value = withRequest $ \x ->
591-- determines default port, @80@ for HTTP and @443@ for HTTPS, this 'Option'
649-- determines default port, @80@ for HTTP and @443@ for HTTPS, this 'Option'
592-- allows to choose arbitrary port overwriting the defaults.
650-- allows to choose arbitrary port overwriting the defaults.
594−port :: Word -> Option
652+port :: Word -> Option scheme
595port n = withRequest $ \x ->
653port n = withRequest $ \x ->
596 x { L.port = fromIntegral n }
654 x { L.port = fromIntegral n }
@@ -646,3 +704,11 @@ newtype Womb (tag :: Symbol) a = Womb a
646data CanHaveBody
704data CanHaveBody
647 = CanHaveBody -- ^ Indeed can have a body
705 = CanHaveBody -- ^ Indeed can have a body
648 | NoBody -- ^ Should not have a body
706 | NoBody -- ^ Should not have a body
708+-- | A type-level tag that specifies URL scheme used (and thus if TLS is
709+-- enabled). This is used to force TLS requirement for some authentication
713+ = Http -- ^ HTTP, no TLS