@@ -81,6 +81,7 @@
8181{-# LANGUAGE FlexibleInstances #-}
8282{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8383{-# LANGUAGE KindSignatures #-}
84+{-# LANGUAGE OverloadedStrings #-}
8485{-# LANGUAGE RecordWildCards #-}
8586{-# LANGUAGE ScopedTypeVariables #-}
8687{-# LANGUAGE TypeFamilies #-}
@@ -125,12 +126,19 @@ module Network.HTTP.Req
125126 , header
126127 -- *** Cookies
127128 -- *** Authentication
129+ -- $request-optional-parameters-authentication
130+ , basicAuth
131+ , oAuth1
132+ , oAuth2Bearer
133+ , oAuth2Token
134+ , awsAuth
128135 -- *** Other
129136 , port
130137 -- * Response
131138 , HttpResponse (..)
132139 -- * Other
133− , CanHaveBody (..) )
140+ , CanHaveBody (..)
141+ , Scheme (..) )
134142where
135143
136144import Control.Arrow (first, second)
@@ -173,16 +181,16 @@ import qualified Network.HTTP.Types as Y
173181-- TODO Finish docs of this function when the package is more developed.
174182
175183req
176− :: forall m method body response.
184+ :: forall m method body response scheme.
177185 ( MonadHttp m
178186 , HttpMethod method
179187 , HttpBody body
180188 , HttpResponse response
181189 , AllowsBody method ~ ProvidesBody body )
182190 => method -- ^ HTTP method
183− -> Url -- ^ 'Url' — location of resource
191+ -> Url scheme -- ^ 'Url' — location of resource
184192 -> body -- ^ Body of the request
185− -> Option -- ^ Collection of optional parameters
193+ -> Option scheme -- ^ Collection of optional parameters
186194 -> m response -- ^ Response
187195req method url body options = do
188196 config <- getHttpConfig
@@ -422,7 +430,7 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
422430-- > https "юникод.рф"
423431-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
424432
425−data Url = Url Bool (NonEmpty Text)
433+data Url (scheme :: Scheme) = Url Bool (NonEmpty Text)
426434 -- NOTE The first 'Bool' value specifies if the 'Url' has “https” as its
427435 -- scheme (otherwise “http” is assumed). The second value is path segments
428436 -- in reversed order.
@@ -431,22 +439,22 @@ data Url = Url Bool (NonEmpty Text)
431439-- | Given host name, produce a 'Url' which have “http” as its scheme and
432440-- empty path. This also sets port to @80@.
433441
434−http :: Text -> Url
442+http :: Text -> Url 'Http
435443http = Url False . pure
436444
437445-- | Given host name, produce a 'Url' which have “https” as its scheme and
438446-- empty path. This also sets port to @443@.
439447
440−https :: Text -> Url
448+https :: Text -> Url 'Https
441449https = Url True . pure
442450
443451-- | Grow given 'Url' appending a single path segment to it.
444452
445453infixl 5 /:
446−(/:) :: Url -> Text -> Url
454+(/:) :: Url scheme -> Text -> Url scheme
447455Url secure path /: segment = Url secure (NE.cons segment path)
448456
449−instance RequestComponent Url where
457+instance RequestComponent (Url scheme) where
450458 getRequestMod (Url secure segments) = Endo $ \x ->
451459 let (host :| path) = NE.reverse segments in
452460 x { L.secure = secure
@@ -487,7 +495,7 @@ instance HttpBody b => RequestComponent (Womb "body" b) where
487495
488496-- TODO We need examples here.
489497
490−newtype Option = Option (Endo (Y.QueryText, L.Request))
498+newtype Option (scheme :: Scheme) = Option (Endo (Y.QueryText, L.Request))
491499 -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
492500 -- Request to avoid appending to existing query string in request every
493501 -- time new parameter is added.
@@ -496,16 +504,16 @@ newtype Option = Option (Endo (Y.QueryText, L.Request))
496504-- | A helper to create an 'Option' that modifies only collection of query
497505-- parameters. This helper is not a part of public API.
498506
499−withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option
507+withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
500508withQueryParams = Option . Endo . first
501509
502510-- | A helper to create an 'Option' that modifies only 'L.Request'. This
503511-- helper is not a part of public API.
504512
505−withRequest :: (L.Request -> L.Request) -> Option
513+withRequest :: (L.Request -> L.Request) -> Option scheme
506514withRequest = Option . Endo . second
507515
508−instance RequestComponent Option where
516+instance RequestComponent (Option scheme) where
509517 getRequestMod (Option f) = Endo $ \x ->
510518 let (qparams, x') = appEndo f ([], x)
511519 query = Y.renderQuery True (Y.queryTextToQuery qparams)
@@ -552,23 +560,20 @@ class QueryParam a where
552560
553561 queryParam :: Text -> Maybe Text -> a
554562
555−instance QueryParam Option where
563+instance QueryParam (Option scheme) where
556564 queryParam name mvalue = withQueryParams ((:) (name, mvalue))
557565
558566----------------------------------------------------------------------------
559567-- Request — Optional parameters — Headers
560568
561−-- | Create an 'Option' that adds a header. The 'Text' values will be
562−-- inserted in UTF-8 encoding.
569+-- | Create an 'Option' that adds a header.
563570
564571header
565− :: Text -- ^ Header name
566− -> Text -- ^ Header value
567− -> Option
572+ :: ByteString -- ^ Header name
573+ -> ByteString -- ^ Header value
574+ -> Option scheme
568575header 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 }
572577
573578----------------------------------------------------------------------------
574579-- Request — Optional parameters — Cookies
@@ -578,11 +583,64 @@ header name value = withRequest $ \x ->
578583----------------------------------------------------------------------------
579584-- Request — Optional parameters — Authentication
580585
581−-- TODO basicAuth
582−-- TODO oAuth1
583−-- TODO oAuth2Bearer
584−-- TODO oAuth2Token
585−-- TODO awsAuth
586+-- $request-optional-parameters-authentication
587+--
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.
591+
592+oAuth1
593+ :: ByteString -- ^ Consumer token
594+ -> ByteString -- ^ Consumer secret
595+ -> ByteString -- ^ OAuth token
596+ -> ByteString -- ^ OAuth token secret
597+ -> Option scheme
598+oAuth1 = undefined -- TODO
599+
600+-- | The 'Option' adds basic authentication. The 'Text' values will be UTF-8
601+-- encoded.
602+--
603+-- See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>
604+
605+basicAuth
606+ :: ByteString -- ^ Username
607+ -> ByteString -- ^ Password
608+ -> Option 'Https -- ^ Auth 'Option'
609+basicAuth username password = withRequest
610+ (L.applyBasicAuth username password)
611+
612+-- | The 'Option' adds an OAuth2 bearer token. This is treated by many
613+-- services as the equivalent of a username and password.
614+--
615+-- The 'Option' is defined as:
616+--
617+-- > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
618+
619+oAuth2Bearer
620+ :: ByteString -- ^ Token
621+ -> Option 'Https -- ^ Auth 'Option'
622+oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
623+
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.
627+--
628+-- The 'Option' is defined as:
629+--
630+-- > oAuth2Token token = header "Authorization" ("token" <> token)
631+
632+oAuth2Token
633+ :: ByteString -- ^ Token
634+ -> Option 'Https -- ^ Auth 'Option'
635+oAuth2Token token = header "Authorization" ("token" <> token)
636+
637+-- | The 'Option' adds AWS v4 request signature.
638+
639+awsAuth
640+ :: ByteString -- ^ AWS access key
641+ -> ByteString -- ^ AWS secret access key
642+ -> Option 'Https -- ^ Auth 'Option'
643+awsAuth accessKey secretKey = undefined -- TODO
586644
587645----------------------------------------------------------------------------
588646-- Request — Optional parameters — Other
@@ -591,7 +649,7 @@ header name value = withRequest $ \x ->
591649-- determines default port, @80@ for HTTP and @443@ for HTTPS, this 'Option'
592650-- allows to choose arbitrary port overwriting the defaults.
593651
594−port :: Word -> Option
652+port :: Word -> Option scheme
595653port n = withRequest $ \x ->
596654 x { L.port = fromIntegral n }
597655
@@ -646,3 +704,11 @@ newtype Womb (tag :: Symbol) a = Womb a
646704data CanHaveBody
647705 = CanHaveBody -- ^ Indeed can have a body
648706 | NoBody -- ^ Should not have a body
707+
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
710+-- 'Option's.
711+
712+data Scheme
713+ = Http -- ^ HTTP, no TLS
714+ | Https -- ^ HTTPS