@@ -107,10 +107,10 @@ module Network.HTTP.Req
107 , PATCH (..)
107 , PATCH (..)
108 , HttpMethod (..)
108 , HttpMethod (..)
109 -- ** URL
109 -- ** URL
114 -- ** Body
114 -- ** Body
115 , HttpBody (..) -- TODO more stuff here
115 , HttpBody (..) -- TODO more stuff here
116 -- ** Optional parameters
116 -- ** Optional parameters
@@ -138,6 +138,7 @@ import Data.ByteString
138import Data.Data (Data)
138import Data.Data (Data)
139import Data.Default.Class
139import Data.Default.Class
140import Data.IORef
140import Data.IORef
141+import Data.List.NonEmpty (NonEmpty (..))
141import Data.Proxy
142import Data.Proxy
142import Data.Semigroup hiding (Option)
143import Data.Semigroup hiding (Option)
143import Data.Text (Text)
144import Data.Text (Text)
@@ -145,8 +146,11 @@ import Data.Typeable (Typeable)
145import GHC.Generics
146import GHC.Generics
146import GHC.TypeLits
147import GHC.TypeLits
147import System.IO.Unsafe (unsafePerformIO)
148import System.IO.Unsafe (unsafePerformIO)
149+import qualified Data.Binary.Builder as R
148import qualified Data.ByteString as B
150import qualified Data.ByteString as B
149import qualified Data.ByteString.Lazy as BL
151import qualified Data.ByteString.Lazy as BL
152+import qualified Data.List.NonEmpty as NE
153+import qualified Data.Text.Encoding as T
150import qualified Network.Connection as NC
154import qualified Network.Connection as NC
151import qualified Network.HTTP.Client as L
155import qualified Network.HTTP.Client as L
152import qualified Network.HTTP.Client.Internal as LI
156import qualified Network.HTTP.Client.Internal as LI
@@ -172,7 +176,7 @@ req
172 , HttpResponse response
176 , HttpResponse response
173 , AllowsBody method ~ ProvidesBody body )
177 , AllowsBody method ~ ProvidesBody body )
174 => method -- ^ HTTP method
178 => method -- ^ HTTP method
175− -> Endpoint -- ^ Endpoint to make the request against
179+ -> Url -- ^ 'Url' — location of resource
176 -> body -- ^ Body of the request
180 -> body -- ^ Body of the request
177 -> Option -- ^ Collection of optional parameters
181 -> Option -- ^ Collection of optional parameters
178 -> m response -- ^ Response
182 -> m response -- ^ Response
@@ -384,32 +388,60 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
384----------------------------------------------------------------------------
388----------------------------------------------------------------------------
385-- Request — URL
389-- Request — URL
387−newtype Endpoint = Endpoint { unEndpoint :: Text }
391+-- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'
388−
392+-- specifying the scheme and host at the same time. Then use the @('/:')@
389−instance RequestComponent Endpoint where
393+-- constructor to grow path one piece at a time. Every single piece of path
390− getRequestMod _ = undefined -- TODO
394+-- will be url(percent)-encoded, so @('/:')@ is the only way to have forward
395+-- slashes between path segments. This approach makes working with dynamic
396+-- path segments easy and safe. See examples below how to represent various
397+-- 'Url's (make sure the @OverloadedStrings@ language extension is enabled).
401+-- > -- http://httpbin.org
402+-- > http "httpbin.org"
404+-- > -- https://httpbin.org
405+-- > https "httpbin.org"
407+-- > -- https://httpbin.org/encoding/utf8
408+-- > https "httpbin.org" /: "encoding" /: "utf8"
410+-- > -- https://юникод.рф
411+-- > https "юникод.рф"
392−-- data Endpoint (s :: Scheme) where
413+data Url = Url Bool (NonEmpty Text)
393−-- Http' :: Text -> Endpoint 'Http
414+ -- NOTE The first 'Bool' value specifies if the 'Url' has “https” as its
394−-- Https' :: Text -> Endpoint 'Https
415+ -- scheme (otherwise “http” is assumed). The second value is path segments
395−-- (:/) :: Endpoint s -> Text -> Endpoint s
416+ -- in reversed order.
417+ deriving (Eq, Ord, Data, Typeable, Generic)
397−http :: Text -> Endpoint
419+-- | Given host name, produce a 'Url' which have “http” as its scheme and
398−http = Endpoint . percentEncode
420+-- empty path. This also sets port to @80@.
400−https :: Text -> Endpoint
422+http :: Text -> Url
401−https = Endpoint . percentEncode
423+http = Url False . pure
403−infixl 5 /:
425+-- | Given host name, produce a 'Url' which have “https” as its scheme and
426+-- empty path. This also sets port to @443@.
405−(/:) :: Endpoint -> Text -> Endpoint
428+https :: Text -> Url
406−(/:) = undefined -- TODO
429+https = Url True . pure
408−-- TODO Escape things in endpoint and query parameters, only :/ should work
431+-- | Grow given 'Url' appending a single path segment to it.
411−parseUrl :: Text -> Endpoint
433+infixl 5 /:
412−parseUrl = undefined
434+(/:) :: Url -> Text -> Url
435+Url secure path /: segment = Url secure (NE.cons segment path)
437+instance RequestComponent Url where
438+ getRequestMod (Url secure segments) = Endo $ \x ->
439+ let (host :| path) = NE.reverse segments in
440+ x { L.secure = secure
441+ , L.port = if secure then 443 else 80
442+ , L.host = Y.urlEncode False (T.encodeUtf8 host)
444+ (BL.toStrict . R.toLazyByteString . Y.encodePathSegments) path }
414----------------------------------------------------------------------------
446----------------------------------------------------------------------------
415-- Request — Body
447-- Request — Body
@@ -418,10 +450,10 @@ class HttpBody b where
418 type ProvidesBody b :: CanHaveBody
450 type ProvidesBody b :: CanHaveBody
419 getReqestBody :: b -> ByteString -- FIXME should use a conduit here
451 getReqestBody :: b -> ByteString -- FIXME should use a conduit here
421−data UrlEncodedParam = UrlEncodedParam Text (Maybe Text)
453+data FormUrlEncodedParam = FormUrlEncodedParam Text (Maybe Text)
423−instance QueryParam UrlEncodedParam where
455+instance QueryParam FormUrlEncodedParam where
424− queryParam = UrlEncodedParam
456+ queryParam = FormUrlEncodedParam
426instance HttpBody b => RequestComponent (Womb "body" b) where
458instance HttpBody b => RequestComponent (Womb "body" b) where
427 getRequestMod = undefined -- FIXME
459 getRequestMod = undefined -- FIXME
@@ -511,12 +543,37 @@ class HttpResponse response where
511----------------------------------------------------------------------------
543----------------------------------------------------------------------------
514−newtype Womb (tag :: Symbol) a = Womb { unWomb :: a }
546+-- | The main class for things that are “parts” of 'L.Request' in the sense
547+-- that if we have a 'L.Request', then we know how to apply an instance of
548+-- 'RequestComponent' changing\/overwriting something in it. 'Endo' is
549+-- endomorphism of functions under composition, it's used to chain different
550+-- request component easier using @('<>')@.
516class RequestComponent a where
552class RequestComponent a where
554+ -- | Get a function that takes a 'L.Request' and changes it somehow
555+ -- returning another 'L.Request'. For example HTTP method instance of
556+ -- 'RequestComponent' just overwrites method. The function is wrapped in
557+ -- 'Endo' so it's easier to chain such “modifying applications” together
558+ -- building bigger and bigger 'RequestComponent's.
517 getRequestMod :: a -> Endo L.Request
560 getRequestMod :: a -> Endo L.Request
519−data CanHaveBody = CanHaveBody | NoBody
562+-- | This wrapper is only used to attach a type-level tag to given type.
563+-- This is necessary to define instances of 'RequestComponent' for any thing
564+-- that implements 'HttpMethod' or 'HttpBody'. Without the tag, GHC is not
565+-- able to see difference between @'HttpMethod' method => 'RequestComponent'
566+-- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides
567+-- which instance to use (i.e. constraints are taken into account later,
568+-- when instance is already chosen).
570+newtype Womb (tag :: Symbol) a = Womb a
572+-- | A simple 'Bool'-like type we only have for better error messages. We
573+-- use it as a kind and its data constructors as type-level tags.
575+-- See also: 'HttpMethod' and 'HttpBody'.
521−percentEncode :: Text -> Text
577+data CanHaveBody
522−percentEncode = undefined
578+ = CanHaveBody -- ^ Indeed can have a body
579+ | NoBody -- ^ Should not have a body