From 0a4f73cddec1120ae601453fce94be14b9614149 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Thu, 19 Aug 2021 23:49:07 +0800
Subject: [PATCH 01/13] parser fixed; remove redundant imports
---
Z/Data/HTTP/Request.hs | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/Z/Data/HTTP/Request.hs b/Z/Data/HTTP/Request.hs
index f0bbe89..0769a83 100644
--- a/Z/Data/HTTP/Request.hs
+++ b/Z/Data/HTTP/Request.hs
@@ -5,7 +5,6 @@ import Data.IORef
import qualified Data.CaseInsensitive as CI
import qualified Z.Data.Builder as B
import qualified Z.Data.Parser as P
-import qualified Z.Data.Parser as P
import qualified Z.Data.Text as T
import qualified Z.Data.Vector as V
import qualified Z.Data.Vector.Base as V
@@ -102,10 +101,10 @@ requestLineParser = do
-- version
vbs <- P.bytes "HTTP/"
- majv <- P.satisfy isDigit
+ majv <- P.digit
P.word8 DOT
- minv <- P.satisfy isDigit
- let !version = Version (fromIntegral $ majv - DIGIT_0) (fromIntegral $ minv - DIGIT_0)
+ minv <- P.digit
+ let !version = Version majv minv
-- request line end
P.word8 CARRIAGE_RETURN
From a838d3c6f42f035f742e286c9c1c45e2bfd0cb2c Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Thu, 19 Aug 2021 23:49:44 +0800
Subject: [PATCH 02/13] WIP Z.Data.Client.Request for request builder
---
Z/Data/HTTP/Client/Request.hs | 24 ++++++++++++++++++++++++
1 file changed, 24 insertions(+)
create mode 100644 Z/Data/HTTP/Client/Request.hs
diff --git a/Z/Data/HTTP/Client/Request.hs b/Z/Data/HTTP/Client/Request.hs
new file mode 100644
index 0000000..596305d
--- /dev/null
+++ b/Z/Data/HTTP/Client/Request.hs
@@ -0,0 +1,24 @@
+module Z.Data.HTTP.Client.Request where
+
+import Z.Data.HTTP.Request
+import qualified Z.Data.Vector as V
+import Z.IO (Source)
+import Z.IO.Network
+
+type Host = (HostName, Maybe PortNumber)
+
+initialRequest :: Request
+initialRequest = Request
+ { requestHost = V.empty
+ , requestSecure = False
+ , requestRemote = SocketAddrIPv4 ipv4Any 80 -- default http port number
+
+ , requestMethod = GET
+ , requestVersion = Version 1 0
+ , requestPathRaw = V.empty
+ , requestPathQuery = ([], V.empty)
+
+ , requestHeaders = V.empty
+
+ , requestBody = Left V.empty
+ }
From 1e9b2b3f36dc721a88cfe974c332d415b24ccb69 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Fri, 20 Aug 2021 00:39:26 +0800
Subject: [PATCH 03/13] WIP host parser
---
Z/HTTP/Client.hs | 27 +++++++++++++++++++++++++++
z-http.cabal | 1 +
2 files changed, 28 insertions(+)
create mode 100644 Z/HTTP/Client.hs
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
new file mode 100644
index 0000000..beba853
--- /dev/null
+++ b/Z/HTTP/Client.hs
@@ -0,0 +1,27 @@
+module Z.HTTP.Client where
+
+import Z.Data.HTTP.Request
+import Z.Data.HTTP.Client.Request
+import Z.IO.Network
+
+import Z.Data.Text (Text)
+import Z.Data.Parser (Parser)
+import Z.Data.CBytes
+
+import qualified Z.Data.Parser as P
+import qualified Z.Data.ASCII as C
+
+fromUrl :: Text -> Request
+fromUrl = undefined
+
+-- fromHost :: Text -> Either P.ParseError Host
+-- fromHost host = P.parse' parseHost (T)
+
+-- This should parse "www.google.com:80" but not "http://www.google.com:80"
+parseHost :: Parser Host
+parseHost = do
+ hostName <- P.takeTill (== C.COLON)
+ w <- P.peek
+ if w == C.COLON
+ then P.skipWord8 >> ((,) (fromBytes hostName) <$> (Just . PortNumber <$> P.int))
+ else pure (fromBytes hostName, Nothing)
diff --git a/z-http.cabal b/z-http.cabal
index 41ef6b0..961e0e3 100644
--- a/z-http.cabal
+++ b/z-http.cabal
@@ -22,6 +22,7 @@ extra-source-files: CHANGELOG.md
library
exposed-modules: Z.Data.HTTP.Request
Z.HTTP.Server
+ Z.HTTP.Client
-- Modules included in this library but not exported.
-- other-modules:
From ea537345e084e1988226abd4bc11f6856b5fc9fa Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Sun, 22 Aug 2021 15:27:36 +0800
Subject: [PATCH 04/13] bump version
---
z-http.cabal | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/z-http.cabal b/z-http.cabal
index 961e0e3..ae50ac5 100644
--- a/z-http.cabal
+++ b/z-http.cabal
@@ -29,8 +29,8 @@ library
build-depends: base >=4.14
, case-insensitive == 1.*
- , Z-Data == 0.7.*
- , Z-IO == 0.7.*
+ , Z-Data == 1.0.*
+ , Z-IO == 1.0.*
-- Directories containing source files.
hs-source-dirs: .
From 630cbe3a395d7574e0d4bcd770fe6ed71d944d12 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Sun, 22 Aug 2021 15:27:58 +0800
Subject: [PATCH 05/13] delete unused file
---
Z/Data/HTTP/Client/Request.hs | 24 ------------------------
1 file changed, 24 deletions(-)
delete mode 100644 Z/Data/HTTP/Client/Request.hs
diff --git a/Z/Data/HTTP/Client/Request.hs b/Z/Data/HTTP/Client/Request.hs
deleted file mode 100644
index 596305d..0000000
--- a/Z/Data/HTTP/Client/Request.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Z.Data.HTTP.Client.Request where
-
-import Z.Data.HTTP.Request
-import qualified Z.Data.Vector as V
-import Z.IO (Source)
-import Z.IO.Network
-
-type Host = (HostName, Maybe PortNumber)
-
-initialRequest :: Request
-initialRequest = Request
- { requestHost = V.empty
- , requestSecure = False
- , requestRemote = SocketAddrIPv4 ipv4Any 80 -- default http port number
-
- , requestMethod = GET
- , requestVersion = Version 1 0
- , requestPathRaw = V.empty
- , requestPathQuery = ([], V.empty)
-
- , requestHeaders = V.empty
-
- , requestBody = Left V.empty
- }
From 73dc010a7de16d23e5c093fd2bfdee46c551d08d Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Sun, 22 Aug 2021 15:28:12 +0800
Subject: [PATCH 06/13] sendRequest
---
Z/Data/HTTP/Request.hs | 6 +--
Z/HTTP/Client.hs | 111 +++++++++++++++++++++++++++++++++++++----
2 files changed, 103 insertions(+), 14 deletions(-)
diff --git a/Z/Data/HTTP/Request.hs b/Z/Data/HTTP/Request.hs
index 0769a83..de618e6 100644
--- a/Z/Data/HTTP/Request.hs
+++ b/Z/Data/HTTP/Request.hs
@@ -13,7 +13,7 @@ import Z.Data.ASCII
import Z.Data.PrimRef
import Z.IO
import Z.IO.Network
-
+import Z.IO.BIO (Source)
data HTTPException
= BadHeaderLine V.Bytes
@@ -132,7 +132,7 @@ readRequest remoteAddr secure bi = do
host <- readIORef hostRef
when (V.null host) $ throwIO NoHostHeader
- contentLen <- readPrimIORef contentLenRef
+ contentLen <- readPrimRef contentLenRef
transferEncoding <- readIORef transferEncodingRef
keepAlive <- readIORef connectionRef
@@ -170,7 +170,7 @@ readRequest remoteAddr secure bi = do
when (hdrK == "content-length") $
case P.parse' P.uint hdrV of
- Right l -> writePrimIORef contentLenRef l
+ Right l -> writePrimRef contentLenRef l
_ -> throwIO (BadHeaderLine hdr)
when (hdrK == "transfer-encoding") $
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
index beba853..6d1c1bb 100644
--- a/Z/HTTP/Client.hs
+++ b/Z/HTTP/Client.hs
@@ -1,27 +1,116 @@
module Z.HTTP.Client where
-import Z.Data.HTTP.Request
-import Z.Data.HTTP.Client.Request
import Z.IO.Network
-
+import Z.IO.Buffered
+import Z.IO (withResource)
+import Z.Data.HTTP.Request (Method (..))
import Z.Data.Text (Text)
import Z.Data.Parser (Parser)
-import Z.Data.CBytes
-
+import Z.Data.CBytes (fromBytes, buildCBytes)
+import GHC.Word
import qualified Z.Data.Parser as P
import qualified Z.Data.ASCII as C
+import qualified Z.Data.Vector as V
+import qualified Z.Data.Builder as B
+
+type Path = V.Bytes
+
+data Request = Request
+ { reqMethod :: !Method
+ , reqPath :: !Path
+ , reqHost :: V.Bytes
+ , reqHeaders :: [(V.Bytes, V.Bytes)]
+ }
-fromUrl :: Text -> Request
-fromUrl = undefined
+defaultRequest :: Request
+defaultRequest = Request
+ { reqMethod = GET
+ , reqPath = V.empty
+ , reqHost = V.empty
+ , reqHeaders = []
+ }
--- fromHost :: Text -> Either P.ParseError Host
--- fromHost host = P.parse' parseHost (T)
+type Host = (HostName, Maybe PortNumber)
-- This should parse "www.google.com:80" but not "http://www.google.com:80"
-parseHost :: Parser Host
-parseHost = do
+parseHost' :: Parser Host
+parseHost' = do
hostName <- P.takeTill (== C.COLON)
w <- P.peek
if w == C.COLON
then P.skipWord8 >> ((,) (fromBytes hostName) <$> (Just . PortNumber <$> P.int))
else pure (fromBytes hostName, Nothing)
+
+----------------------------
+
+-- http-client
+-- Builder model
+-- https://github.com/snoyberg/http-client/blob/master/TUTORIAL.md#request-building
+
+-- * Record
+-- Simple
+-- https://hackage.haskell.org/package/http-conduit-2.3.8/docs/Network-HTTP-Conduit.html
+
+resolveDNS :: Host -> IO AddrInfo
+resolveDNS (hostName, Just portNumber) = head <$> getAddrInfo Nothing hostName (buildCBytes . B.int $ portNumber)
+resolveDNS (hostName, Nothing) = head <$> getAddrInfo Nothing hostName "http"
+
+pattern CRLF :: V.Bytes
+pattern CRLF = "\r\n"
+
+requestToBytes :: Request -> V.Bytes
+requestToBytes req = mconcat [method, " ", path, " ", version, CRLF, headers, CRLF]
+ where
+ method :: V.Bytes = "GET" -- TODO: find a way to serialise HTTP method from enum
+ path :: V.Bytes = reqPath req
+ version :: V.Bytes = "HTTP/1.1"
+ headers :: V.Bytes = ""
+
+data Response = Response
+ { responseVersion :: HttpVersion
+ , responseCode :: Word16 -- smallest unit that can contain 3 digits int
+ , responseMessage :: V.Bytes
+ , responseHeaders :: [(V.Bytes, V.Bytes)]
+ } deriving (Show)
+
+-- TODO: user defined chunksize?
+sendRequest :: Request -> IO V.Bytes
+sendRequest req = do
+ addr <- resolveDNS (fromBytes $ reqHost req, Nothing)
+ withResource (initTCPClient defaultTCPClientConfig { tcpRemoteAddr = addrAddress addr }) $ \tcp -> do
+ (i, o) <- newBufferedIO tcp
+ writeBuffer' o (requestToBytes req)
+ readBuffer i
+
+data HttpVersion = HttpVersion Int Int deriving (Show)
+
+httpParser :: Parser Response
+httpParser = do
+ P.bytes "HTTP/"
+ maj <- P.digit
+ P.word8 C.DOT
+ min <- P.digit
+ P.skipSpaces
+ httpCode <- P.uint
+ P.skipSpaces
+ httpMsg <- P.takeWhile (/= C.CARRIAGE_RETURN)
+ P.bytes CRLF
+ !headers <- headersLoop []
+ return $ Response (HttpVersion maj min) httpCode httpMsg (reverse headers)
+
+ where
+ headersLoop :: [(V.Bytes, V.Bytes)] -> Parser [(V.Bytes, V.Bytes)]
+ headersLoop acc = do
+ w <- P.peek
+ case w of
+ C.CARRIAGE_RETURN -> do
+ P.bytes CRLF
+ return acc
+ _ -> do
+ headerKey <- P.takeWhile (/= C.COLON)
+ P.word8 C.COLON
+ P.skipSpaces
+ headerVal <- P.takeWhile (/= C.CARRIAGE_RETURN)
+ P.bytes CRLF
+ headersLoop $ (headerKey, headerVal) : acc -- Don't forget to reverse
+
From 0a4fecc398d1056784544b01e7c15a64d0900992 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Sun, 22 Aug 2021 17:34:01 +0800
Subject: [PATCH 07/13] Using FlatMap as http header IR
---
Z/Data/HTTP/Request.hs | 4 ++--
Z/HTTP/Client.hs | 45 +++++++++++++++++++++++++-----------------
2 files changed, 29 insertions(+), 20 deletions(-)
diff --git a/Z/Data/HTTP/Request.hs b/Z/Data/HTTP/Request.hs
index de618e6..db989e6 100644
--- a/Z/Data/HTTP/Request.hs
+++ b/Z/Data/HTTP/Request.hs
@@ -37,7 +37,7 @@ data Method
| OPTIONS
| PATCH
| CUSTOM_METHOD V.Bytes
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Show)
instance T.Print Method where
toUTF8BuilderP _ GET = "GET"
@@ -53,7 +53,7 @@ instance T.Print Method where
data Version = Version {-# UNPACK #-} !Int {-# UNPACK #-} !Int
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Show)
instance T.Print Version where
toUTF8BuilderP _ (Version maj min) = do
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
index 6d1c1bb..f633fdd 100644
--- a/Z/HTTP/Client.hs
+++ b/Z/HTTP/Client.hs
@@ -1,17 +1,21 @@
module Z.HTTP.Client where
import Z.IO.Network
-import Z.IO.Buffered
+import Z.IO.Buffered (newBufferedIO, readBuffer, writeBuffer')
import Z.IO (withResource)
-import Z.Data.HTTP.Request (Method (..))
+import Z.Data.HTTP.Request (Method (..), Version(..))
import Z.Data.Text (Text)
import Z.Data.Parser (Parser)
import Z.Data.CBytes (fromBytes, buildCBytes)
-import GHC.Word
+import GHC.Word (Word16)
import qualified Z.Data.Parser as P
import qualified Z.Data.ASCII as C
import qualified Z.Data.Vector as V
import qualified Z.Data.Builder as B
+import qualified Z.Data.Text as T
+
+import Z.Data.Vector.FlatMap (FlatMap)
+import qualified Z.Data.Vector.FlatMap as FlatMap
type Path = V.Bytes
@@ -64,25 +68,31 @@ requestToBytes req = mconcat [method, " ", path, " ", version, CRLF, headers, CR
method :: V.Bytes = "GET" -- TODO: find a way to serialise HTTP method from enum
path :: V.Bytes = reqPath req
version :: V.Bytes = "HTTP/1.1"
- headers :: V.Bytes = ""
+ headers :: V.Bytes = "" -- TODO: find a way to serialise Flatmap to V.Bytes
+
+type Headers = FlatMap V.Bytes V.Bytes
+
+emptyHeaders :: Headers
+emptyHeaders = FlatMap.empty
data Response = Response
- { responseVersion :: HttpVersion
+ { responseVersion :: Version
, responseCode :: Word16 -- smallest unit that can contain 3 digits int
, responseMessage :: V.Bytes
- , responseHeaders :: [(V.Bytes, V.Bytes)]
- } deriving (Show)
+ , responseHeaders :: Headers
+ } deriving Show
-- TODO: user defined chunksize?
-sendRequest :: Request -> IO V.Bytes
+sendRequest :: Request -> IO Response
sendRequest req = do
addr <- resolveDNS (fromBytes $ reqHost req, Nothing)
withResource (initTCPClient defaultTCPClientConfig { tcpRemoteAddr = addrAddress addr }) $ \tcp -> do
(i, o) <- newBufferedIO tcp
writeBuffer' o (requestToBytes req)
- readBuffer i
-
-data HttpVersion = HttpVersion Int Int deriving (Show)
+ buf <- readBuffer i
+ case P.parse' httpParser buf of
+ Left _ -> undefined
+ Right res -> pure res
httpParser :: Parser Response
httpParser = do
@@ -95,11 +105,11 @@ httpParser = do
P.skipSpaces
httpMsg <- P.takeWhile (/= C.CARRIAGE_RETURN)
P.bytes CRLF
- !headers <- headersLoop []
- return $ Response (HttpVersion maj min) httpCode httpMsg (reverse headers)
+ !headers <- headersLoop emptyHeaders
+ return $ Response (Version maj min) httpCode httpMsg headers
where
- headersLoop :: [(V.Bytes, V.Bytes)] -> Parser [(V.Bytes, V.Bytes)]
+ headersLoop :: Headers -> Parser Headers
headersLoop acc = do
w <- P.peek
case w of
@@ -107,10 +117,9 @@ httpParser = do
P.bytes CRLF
return acc
_ -> do
- headerKey <- P.takeWhile (/= C.COLON)
+ key <- P.takeWhile (/= C.COLON)
P.word8 C.COLON
P.skipSpaces
- headerVal <- P.takeWhile (/= C.CARRIAGE_RETURN)
+ val <- P.takeWhile (/= C.CARRIAGE_RETURN)
P.bytes CRLF
- headersLoop $ (headerKey, headerVal) : acc -- Don't forget to reverse
-
+ headersLoop $ FlatMap.insert key val acc
From fd073016ce37ef6c011da00966cb37a9756fc752 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Wed, 25 Aug 2021 20:07:12 +0800
Subject: [PATCH 08/13] HTTP/major.minor version defined
https://datatracker.ietf.org/doc/html/rfc2616#section-3.1
---
Z/Data/HTTP/Request.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Z/Data/HTTP/Request.hs b/Z/Data/HTTP/Request.hs
index db989e6..8060f05 100644
--- a/Z/Data/HTTP/Request.hs
+++ b/Z/Data/HTTP/Request.hs
@@ -37,7 +37,7 @@ data Method
| OPTIONS
| PATCH
| CUSTOM_METHOD V.Bytes
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord)
instance T.Print Method where
toUTF8BuilderP _ GET = "GET"
@@ -57,7 +57,7 @@ data Version = Version {-# UNPACK #-} !Int {-# UNPACK #-} !Int
instance T.Print Version where
toUTF8BuilderP _ (Version maj min) = do
- "HTTP"
+ "HTTP/"
B.int maj
B.encodePrim DOT
B.int min
From b3b819c08080263469d2141c86ca5f7db87652d9 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Wed, 25 Aug 2021 20:08:05 +0800
Subject: [PATCH 09/13] Bytes request builder
---
Z/HTTP/Client.hs | 38 ++++++++++++++++++++++++++++++--------
1 file changed, 30 insertions(+), 8 deletions(-)
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
index f633fdd..fc7c921 100644
--- a/Z/HTTP/Client.hs
+++ b/Z/HTTP/Client.hs
@@ -20,17 +20,19 @@ import qualified Z.Data.Vector.FlatMap as FlatMap
type Path = V.Bytes
data Request = Request
- { reqMethod :: !Method
- , reqPath :: !Path
+ { reqMethod :: Method
+ , reqPath :: Path
, reqHost :: V.Bytes
+ , reqVersion :: Version
, reqHeaders :: [(V.Bytes, V.Bytes)]
}
defaultRequest :: Request
defaultRequest = Request
{ reqMethod = GET
- , reqPath = V.empty
+ , reqPath = "/"
, reqHost = V.empty
+ , reqVersion = Version 1 1
, reqHeaders = []
}
@@ -62,13 +64,33 @@ resolveDNS (hostName, Nothing) = head <$> getAddrInfo Nothing hostName "http"
pattern CRLF :: V.Bytes
pattern CRLF = "\r\n"
+-- build lazily
+buildHeaders :: [(V.Bytes, V.Bytes)] -> B.Builder ()
+buildHeaders = foldl buildHeader ""
+ where
+ buildHeader :: B.Builder () -> (V.Bytes, V.Bytes) -> B.Builder ()
+ buildHeader b (headerKey, headerVal) = B.append b $ do
+ B.bytes headerKey
+ B.word8 C.COLON
+ B.word8 C.SPACE
+ B.bytes headerVal
+ B.bytes CRLF
+
requestToBytes :: Request -> V.Bytes
-requestToBytes req = mconcat [method, " ", path, " ", version, CRLF, headers, CRLF]
+requestToBytes req = B.build $ do
+ B.bytes method
+ B.encodePrim C.SPACE
+ B.bytes path
+ B.encodePrim C.SPACE
+ B.bytes version
+ B.bytes CRLF
+ headers
+ B.bytes CRLF
where
- method :: V.Bytes = "GET" -- TODO: find a way to serialise HTTP method from enum
- path :: V.Bytes = reqPath req
- version :: V.Bytes = "HTTP/1.1"
- headers :: V.Bytes = "" -- TODO: find a way to serialise Flatmap to V.Bytes
+ method :: V.Bytes = T.toUTF8Bytes (reqMethod req)
+ path :: V.Bytes = reqPath req
+ version :: V.Bytes = T.toUTF8Bytes (reqVersion req)
+ headers = buildHeaders $ ("Host", reqHost req) : reqHeaders req
type Headers = FlatMap V.Bytes V.Bytes
From a9a0f84a8353204b6fdd0b2ec9cee6fe62642818 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Wed, 25 Aug 2021 21:02:46 +0800
Subject: [PATCH 10/13] add some strictness in buildHeaders function
---
Z/HTTP/Client.hs | 21 +++++++++++++++------
1 file changed, 15 insertions(+), 6 deletions(-)
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
index fc7c921..5f367bc 100644
--- a/Z/HTTP/Client.hs
+++ b/Z/HTTP/Client.hs
@@ -1,18 +1,27 @@
module Z.HTTP.Client where
+import GHC.Word (Word16)
+import Data.Foldable (foldl')
import Z.IO.Network
+ ( getAddrInfo
+ , defaultTCPClientConfig
+ , initTCPClient
+ , AddrInfo(addrAddress)
+ , HostName
+ , PortNumber(..)
+ , TCPClientConfig(tcpRemoteAddr)
+ )
import Z.IO.Buffered (newBufferedIO, readBuffer, writeBuffer')
import Z.IO (withResource)
import Z.Data.HTTP.Request (Method (..), Version(..))
import Z.Data.Text (Text)
import Z.Data.Parser (Parser)
import Z.Data.CBytes (fromBytes, buildCBytes)
-import GHC.Word (Word16)
-import qualified Z.Data.Parser as P
-import qualified Z.Data.ASCII as C
-import qualified Z.Data.Vector as V
+import qualified Z.Data.Parser as P
+import qualified Z.Data.ASCII as C
+import qualified Z.Data.Vector as V
import qualified Z.Data.Builder as B
-import qualified Z.Data.Text as T
+import qualified Z.Data.Text as T
import Z.Data.Vector.FlatMap (FlatMap)
import qualified Z.Data.Vector.FlatMap as FlatMap
@@ -66,7 +75,7 @@ pattern CRLF = "\r\n"
-- build lazily
buildHeaders :: [(V.Bytes, V.Bytes)] -> B.Builder ()
-buildHeaders = foldl buildHeader ""
+buildHeaders = foldl' buildHeader ""
where
buildHeader :: B.Builder () -> (V.Bytes, V.Bytes) -> B.Builder ()
buildHeader b (headerKey, headerVal) = B.append b $ do
From f33388f2aedb460a1ef72e9b85ac922d22798102 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Mon, 30 Aug 2021 17:53:01 +0800
Subject: [PATCH 11/13] builder pattern
---
Z/HTTP/Client.hs | 99 ++++++++++++++++++++++++++++++------------------
1 file changed, 62 insertions(+), 37 deletions(-)
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
index 5f367bc..89f88af 100644
--- a/Z/HTTP/Client.hs
+++ b/Z/HTTP/Client.hs
@@ -1,7 +1,13 @@
+{-# LANGUAGE StrictData #-} -- Give an error instead of warnings in case
+ -- user forgets to initialize some fields
+{-# LANGUAGE RecordWildCards #-}
+
module Z.HTTP.Client where
import GHC.Word (Word16)
-import Data.Foldable (foldl')
+import Data.Foldable (foldr)
+import Data.Functor.Identity (Identity)
+import Data.Function ((&))
import Z.IO.Network
( getAddrInfo
, defaultTCPClientConfig
@@ -16,7 +22,7 @@ import Z.IO (withResource)
import Z.Data.HTTP.Request (Method (..), Version(..))
import Z.Data.Text (Text)
import Z.Data.Parser (Parser)
-import Z.Data.CBytes (fromBytes, buildCBytes)
+import Z.Data.CBytes (fromBytes, buildCBytes, toBytes)
import qualified Z.Data.Parser as P
import qualified Z.Data.ASCII as C
import qualified Z.Data.Vector as V
@@ -36,6 +42,18 @@ data Request = Request
, reqHeaders :: [(V.Bytes, V.Bytes)]
}
+type Headers = FlatMap V.Bytes V.Bytes
+
+emptyHeaders :: Headers
+emptyHeaders = FlatMap.empty
+
+data Response = Response
+ { responseVersion :: Version
+ , responseCode :: Word16 -- smallest unit that can contain 3 digits int
+ , responseMessage :: V.Bytes
+ , responseHeaders :: Headers
+ } deriving Show
+
defaultRequest :: Request
defaultRequest = Request
{ reqMethod = GET
@@ -47,25 +65,6 @@ defaultRequest = Request
type Host = (HostName, Maybe PortNumber)
--- This should parse "www.google.com:80" but not "http://www.google.com:80"
-parseHost' :: Parser Host
-parseHost' = do
- hostName <- P.takeTill (== C.COLON)
- w <- P.peek
- if w == C.COLON
- then P.skipWord8 >> ((,) (fromBytes hostName) <$> (Just . PortNumber <$> P.int))
- else pure (fromBytes hostName, Nothing)
-
-----------------------------
-
--- http-client
--- Builder model
--- https://github.com/snoyberg/http-client/blob/master/TUTORIAL.md#request-building
-
--- * Record
--- Simple
--- https://hackage.haskell.org/package/http-conduit-2.3.8/docs/Network-HTTP-Conduit.html
-
resolveDNS :: Host -> IO AddrInfo
resolveDNS (hostName, Just portNumber) = head <$> getAddrInfo Nothing hostName (buildCBytes . B.int $ portNumber)
resolveDNS (hostName, Nothing) = head <$> getAddrInfo Nothing hostName "http"
@@ -75,13 +74,12 @@ pattern CRLF = "\r\n"
-- build lazily
buildHeaders :: [(V.Bytes, V.Bytes)] -> B.Builder ()
-buildHeaders = foldl' buildHeader ""
+buildHeaders = foldr buildHeader ""
where
- buildHeader :: B.Builder () -> (V.Bytes, V.Bytes) -> B.Builder ()
- buildHeader b (headerKey, headerVal) = B.append b $ do
+ buildHeader :: (V.Bytes, V.Bytes) -> B.Builder () -> B.Builder ()
+ buildHeader (headerKey, headerVal) b = B.append b $ do
B.bytes headerKey
B.word8 C.COLON
- B.word8 C.SPACE
B.bytes headerVal
B.bytes CRLF
@@ -101,18 +99,6 @@ requestToBytes req = B.build $ do
version :: V.Bytes = T.toUTF8Bytes (reqVersion req)
headers = buildHeaders $ ("Host", reqHost req) : reqHeaders req
-type Headers = FlatMap V.Bytes V.Bytes
-
-emptyHeaders :: Headers
-emptyHeaders = FlatMap.empty
-
-data Response = Response
- { responseVersion :: Version
- , responseCode :: Word16 -- smallest unit that can contain 3 digits int
- , responseMessage :: V.Bytes
- , responseHeaders :: Headers
- } deriving Show
-
-- TODO: user defined chunksize?
sendRequest :: Request -> IO Response
sendRequest req = do
@@ -154,3 +140,42 @@ httpParser = do
val <- P.takeWhile (/= C.CARRIAGE_RETURN)
P.bytes CRLF
headersLoop $ FlatMap.insert key val acc
+
+-- This should parse "www.google.com:80" but not "http://www.google.com:80"
+parseHost :: Parser Host
+parseHost = do
+ hostName <- P.takeTill (== C.COLON)
+ w <- P.peek
+ if w == C.COLON
+ then P.skipWord8 >> ((,) (fromBytes hostName) <$> (Just . PortNumber <$> P.int))
+ else pure (fromBytes hostName, Nothing)
+
+fromHost :: Text -> Request
+fromHost host = let host' = T.toUTF8Bytes host in
+ case P.parse' parseHost (T.toUTF8Bytes host) of
+ Left err -> error (show err)
+ Right (hostName, Nothing) -> defaultRequest { reqHost = toBytes hostName }
+ Right (hostName, Just port) -> defaultRequest { reqHost = toBytes hostName <> ":" <> T.toUTF8Bytes port }
+
+fromIpAddr :: Text -> Request
+fromIpAddr = undefined
+
+f :: Request
+f = fromHost "www.google.com"
+ & setPath "/url"
+ & setHeadears [("X-Powered-By", "Z-HTTP-Client")]
+
+setMethod :: Method -> Request -> Request
+setMethod method req@Request{..} = req { reqMethod = method }
+
+setPath :: V.Bytes -> Request -> Request
+setPath path req@Request{..} = req { reqPath = path }
+
+-- setHost :: V.Bytes -> Request -> Request
+-- setHost host req@Request{..} = req { reqHost = host }
+
+setVersion :: Version -> Request -> Request
+setVersion version req@Request{..} = req { reqVersion = version }
+
+setHeadears :: [(V.Bytes, V.Bytes)] -> Request -> Request
+setHeadears headers req@Request{..} = req { reqHeaders = headers }
From 61253a9edc4f7c5749d6f38d3715d845ff14c4bb Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Mon, 6 Sep 2021 10:22:32 +0800
Subject: [PATCH 12/13] misc changes
---
Z/HTTP/Client.hs | 11 ++++-------
1 file changed, 4 insertions(+), 7 deletions(-)
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
index 89f88af..b61e4ca 100644
--- a/Z/HTTP/Client.hs
+++ b/Z/HTTP/Client.hs
@@ -160,10 +160,10 @@ fromHost host = let host' = T.toUTF8Bytes host in
fromIpAddr :: Text -> Request
fromIpAddr = undefined
-f :: Request
-f = fromHost "www.google.com"
- & setPath "/url"
- & setHeadears [("X-Powered-By", "Z-HTTP-Client")]
+-- | f :: Request
+-- | f = fromHost "www.google.com"
+-- | & setPath "/url"
+-- | & setHeadears [("X-Powered-By", "Z-HTTP-Client")]
setMethod :: Method -> Request -> Request
setMethod method req@Request{..} = req { reqMethod = method }
@@ -171,9 +171,6 @@ setMethod method req@Request{..} = req { reqMethod = method }
setPath :: V.Bytes -> Request -> Request
setPath path req@Request{..} = req { reqPath = path }
--- setHost :: V.Bytes -> Request -> Request
--- setHost host req@Request{..} = req { reqHost = host }
-
setVersion :: Version -> Request -> Request
setVersion version req@Request{..} = req { reqVersion = version }
From efad1716b2a6b8d6ef3ae40dfc374ca9958aebd8 Mon Sep 17 00:00:00 2001
From: zypeh <zypeh.geek@gmail.com>
Date: Sat, 18 Sep 2021 01:13:58 +0800
Subject: [PATCH 13/13] parseUri
---
Z/HTTP/Client.hs | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/Z/HTTP/Client.hs b/Z/HTTP/Client.hs
index b61e4ca..a9744a3 100644
--- a/Z/HTTP/Client.hs
+++ b/Z/HTTP/Client.hs
@@ -42,6 +42,8 @@ data Request = Request
, reqHeaders :: [(V.Bytes, V.Bytes)]
}
+data Protocol = HTTP | HTTPS deriving Show
+
type Headers = FlatMap V.Bytes V.Bytes
emptyHeaders :: Headers
@@ -141,6 +143,14 @@ httpParser = do
P.bytes CRLF
headersLoop $ FlatMap.insert key val acc
+parseUri :: Parser (Protocol, Host)
+parseUri = do
+ P.bytes "http"
+ proto <- P.peek
+ if proto == C.LETTER_S
+ then P.skipWord8 >> P.bytes "://" >> ((,) HTTPS <$> parseHost)
+ else P.bytes "://" >> ((,) HTTP <$> parseHost)
+
-- This should parse "www.google.com:80" but not "http://www.google.com:80"
parseHost :: Parser Host
parseHost = do