Consolidate APIs (#104)

* Consolidate APIs

* Use partial function approach instead of Streamable typeclass

* Clean up
This commit is contained in:
Connor Prussin 2018-08-26 21:54:04 -07:00 committed by GitHub
parent 2673bd4b0b
commit 1bde8b4b1d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
13 changed files with 212 additions and 224 deletions

View File

@ -20,8 +20,7 @@ filePath = "./docs/Examples/Image/circle.png"
-- | Respond with image data when run -- | Respond with image data when run
image :: HTTPure.Request -> HTTPure.ResponseM image :: HTTPure.Request -> HTTPure.ResponseM
image _ = image _ = FS.readFile filePath >>= HTTPure.ok' headers
FS.readFile filePath >>= HTTPure.binaryResponse' 200 headers
where where
headers = HTTPure.header "Content-Type" "image/png" headers = HTTPure.header "Content-Type" "image/png"

View File

@ -20,7 +20,6 @@ import HTTPure.Response
( Response ( Response
, ResponseM , ResponseM
, response, response' , response, response'
, binaryResponse, binaryResponse'
, emptyResponse, emptyResponse' , emptyResponse, emptyResponse'
-- 1xx -- 1xx

View File

@ -1,13 +1,14 @@
module HTTPure.Body module HTTPure.Body
( Body(..) ( class Body
, read , read
, write
, size , size
, write
) where ) where
import Prelude import Prelude
import Data.Either as Either import Data.Either as Either
import Data.Maybe as Maybe
import Effect as Effect import Effect as Effect
import Effect.Aff as Aff import Effect.Aff as Aff
import Effect.Ref as Ref import Effect.Ref as Ref
@ -16,11 +17,44 @@ import Node.Encoding as Encoding
import Node.HTTP as HTTP import Node.HTTP as HTTP
import Node.Stream as Stream import Node.Stream as Stream
-- | The `Body` type is just sugar for a `String`, that will be sent or received -- | Types that implement the `Body` class can be used as a body to an HTTPure
-- | in the HTTP body. -- | response, and can be used with all the response helpers.
data Body class Body b where
= StringBody String
| BinaryBody Buffer.Buffer -- | Given a body value, return an effect that maybe calculates a size.
-- | TODO: This is a `Maybe` to support chunked transfer encoding. We still
-- | need to add code to send the body using chunking if the effect resolves a
-- | `Maybe.Nothing`.
size :: b -> Effect.Effect (Maybe.Maybe Int)
-- | Given a body value and a Node HTTP `Response` value, write the body value
-- | to the Node response.
write :: b -> HTTP.Response -> Aff.Aff Unit
-- | The instance for `String` will convert the string to a buffer first in
-- | order to determine it's size. This is to properly handle UTF-8 characters
-- | in the string. Writing is simply implemented by writing the string to the
-- | response stream and closing the response stream.
instance bodyString :: Body String where
size body = Buffer.fromString body Encoding.UTF8 >>= size
write body response = Aff.makeAff \done -> do
let stream = HTTP.responseAsStream response
_ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
_ <- Stream.end stream $ pure unit
done $ Either.Right unit
pure Aff.nonCanceler
-- | The instance for `Buffer` is trivial--to calculate size, we use
-- | `Buffer.size`, and to send the response, we just write the buffer to the
-- | stream and end the stream.
instance bodyBuffer :: Body Buffer.Buffer where
size = Buffer.size >>> map Maybe.Just
write body response = Aff.makeAff \done -> do
let stream = HTTP.responseAsStream response
_ <- Stream.write stream body $ pure unit
_ <- Stream.end stream $ pure unit
done $ Either.Right unit
pure Aff.nonCanceler
-- | Extract the contents of the body of the HTTP `Request`. -- | Extract the contents of the body of the HTTP `Request`.
read :: HTTP.Request -> Aff.Aff String read :: HTTP.Request -> Aff.Aff String
@ -30,21 +64,4 @@ read request = Aff.makeAff \done -> do
Stream.onDataString stream Encoding.UTF8 \str -> Stream.onDataString stream Encoding.UTF8 \str ->
void $ Ref.modify ((<>) str) buf void $ Ref.modify ((<>) str) buf
Stream.onEnd stream $ Ref.read buf >>= Either.Right >>> done Stream.onEnd stream $ Ref.read buf >>= Either.Right >>> done
pure $ Aff.nonCanceler pure Aff.nonCanceler
-- | Write a `Body` to the given HTTP `Response` and close it.
write :: HTTP.Response -> Body -> Effect.Effect Unit
write response body = void do
_ <- writeToStream $ pure unit
Stream.end stream $ pure unit
where
stream = HTTP.responseAsStream response
writeToStream =
case body of
StringBody str -> Stream.writeString stream Encoding.UTF8 str
BinaryBody buf -> Stream.write stream buf
-- | Get the size of the body in bytes
size :: Body -> Effect.Effect Int
size (StringBody body) = Buffer.fromString body Encoding.UTF8 >>= Buffer.size
size (BinaryBody body) = Buffer.size body

View File

@ -1,5 +1,5 @@
module HTTPure.Headers module HTTPure.Headers
( Headers ( Headers(..)
, empty , empty
, headers , headers
, header , header
@ -11,6 +11,7 @@ import Prelude
import Effect as Effect import Effect as Effect
import Foreign.Object as Object import Foreign.Object as Object
import Data.Newtype as Newtype
import Data.String as String import Data.String as String
import Data.TraversableWithIndex as TraversableWithIndex import Data.TraversableWithIndex as TraversableWithIndex
import Data.Tuple as Tuple import Data.Tuple as Tuple
@ -22,6 +23,7 @@ import HTTPure.Lookup ((!!))
-- | The `Headers` type is just sugar for a `Object` of `Strings` -- | The `Headers` type is just sugar for a `Object` of `Strings`
-- | that represents the set of headers in an HTTP request or response. -- | that represents the set of headers in an HTTP request or response.
newtype Headers = Headers (Object.Object String) newtype Headers = Headers (Object.Object String)
derive instance newtypeHeaders :: Newtype.Newtype Headers _
-- | Given a string, return a `Maybe` containing the value of the matching -- | Given a string, return a `Maybe` containing the value of the matching
-- | header, if there is any. -- | header, if there is any.
@ -50,9 +52,7 @@ read = HTTP.requestHeaders >>> Headers
-- | Given an HTTP `Response` and a `Headers` object, return an effect that will -- | Given an HTTP `Response` and a `Headers` object, return an effect that will
-- | write the `Headers` to the `Response`. -- | write the `Headers` to the `Response`.
write :: HTTP.Response -> write :: HTTP.Response -> Headers -> Effect.Effect Unit
Headers ->
Effect.Effect Unit
write response (Headers headers') = void $ write response (Headers headers') = void $
TraversableWithIndex.traverseWithIndex (HTTP.setHeader response) headers' TraversableWithIndex.traverseWithIndex (HTTP.setHeader response) headers'

View File

@ -16,7 +16,7 @@ import Foreign.Object as Object
-- | retrieve some value. For instance, you could have an implementation for -- | retrieve some value. For instance, you could have an implementation for
-- | `String Int String` where `lookup s i` returns `Just` a `String` containing -- | `String Int String` where `lookup s i` returns `Just` a `String` containing
-- | the character in `s` at `i`, or `Nothing` if `i` is out of bounds. -- | the character in `s` at `i`, or `Nothing` if `i` is out of bounds.
class Lookup c k r where class Lookup c k r | c -> r where
-- | Given some type and a key on that type, extract some value that -- | Given some type and a key on that type, extract some value that
-- | corresponds to that key. -- | corresponds to that key.

View File

@ -3,7 +3,6 @@ module HTTPure.Response
, ResponseM , ResponseM
, send , send
, response, response' , response, response'
, binaryResponse, binaryResponse'
, emptyResponse, emptyResponse' , emptyResponse, emptyResponse'
-- 1xx -- 1xx
@ -79,9 +78,9 @@ module HTTPure.Response
import Prelude import Prelude
import Effect as Effect import Data.Maybe as Maybe
import Effect.Aff as Aff import Effect.Aff as Aff
import Node.Buffer as Buffer import Effect.Class as EffectClass
import Node.HTTP as HTTP import Node.HTTP as HTTP
import HTTPure.Body as Body import HTTPure.Body as Body
@ -97,45 +96,37 @@ type ResponseM = Aff.Aff Response
type Response = type Response =
{ status :: Status.Status { status :: Status.Status
, headers :: Headers.Headers , headers :: Headers.Headers
, body :: Body.Body , writeBody :: HTTP.Response -> Aff.Aff Unit
, size :: Maybe.Maybe Int
} }
-- | Given an HTTP `Response` and a HTTPure `Response`, this method will return -- | Given an HTTP `Response` and a HTTPure `Response`, this method will return
-- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response` -- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response`
-- | and closing the HTTP `Response`. -- | and closing the HTTP `Response`.
send :: HTTP.Response -> Response -> Effect.Effect Unit send :: HTTP.Response -> Response -> Aff.Aff Unit
send httpresponse { status, headers, body } = do send httpresponse { status, headers, writeBody, size } = do
Status.write httpresponse $ status EffectClass.liftEffect $ Status.write httpresponse status
size <- Body.size body EffectClass.liftEffect $ Headers.write httpresponse finalHeaders
Headers.write httpresponse $ headers <> contentLength size writeBody httpresponse
Body.write httpresponse $ body
where where
contentLength size = Headers.header "Content-Length" $ show size finalHeaders = headers <> contentLength size
contentLength (Maybe.Just s) = Headers.header "Content-Length" $ show s
contentLength Maybe.Nothing = Headers.empty
-- | For custom response statuses or providing a body for response codes that -- | For custom response statuses or providing a body for response codes that
-- | don't typically send one. -- | don't typically send one.
response :: Status.Status -> String -> ResponseM response :: forall b. Body.Body b => Status.Status -> b -> ResponseM
response status = response' status Headers.empty response status = response' status Headers.empty
-- | The same as `response` but with headers. -- | The same as `response` but with headers.
response' :: Status.Status -> response' :: forall b. Body.Body b =>
Status.Status ->
Headers.Headers -> Headers.Headers ->
String -> b ->
ResponseM ResponseM
response' status headers body = response' status headers body = do
pure $ { status, headers, body: Body.StringBody body } size <- EffectClass.liftEffect $ Body.size body
pure $ { status, headers, size, writeBody: Body.write body }
-- | Like `response`, but the response body is binary data.
binaryResponse :: Status.Status -> Buffer.Buffer -> Aff.Aff Response
binaryResponse status = binaryResponse' status Headers.empty
-- | The same as `binaryResponse` but with headers.
binaryResponse' :: Status.Status ->
Headers.Headers ->
Buffer.Buffer ->
Aff.Aff Response
binaryResponse' status headers body
= pure $ { status, headers, body: Body.BinaryBody body }
-- | The same as `response` but without a body. -- | The same as `response` but without a body.
emptyResponse :: Status.Status -> ResponseM emptyResponse :: Status.Status -> ResponseM
@ -178,11 +169,11 @@ processing' = emptyResponse' Status.processing
--------- ---------
-- | 200 -- | 200
ok :: String -> ResponseM ok :: forall b. Body.Body b => b -> ResponseM
ok = ok' Headers.empty ok = ok' Headers.empty
-- | 200 with headers -- | 200 with headers
ok' :: Headers.Headers -> String -> ResponseM ok' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
ok' = response' Status.ok ok' = response' Status.ok
-- | 201 -- | 201
@ -202,12 +193,13 @@ accepted' :: Headers.Headers -> ResponseM
accepted' = emptyResponse' Status.accepted accepted' = emptyResponse' Status.accepted
-- | 203 -- | 203
nonAuthoritativeInformation :: String -> ResponseM nonAuthoritativeInformation :: forall b. Body.Body b => b -> ResponseM
nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty
-- | 203 with headers -- | 203 with headers
nonAuthoritativeInformation' :: Headers.Headers -> nonAuthoritativeInformation' :: forall b. Body.Body b =>
String -> Headers.Headers ->
b ->
ResponseM ResponseM
nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation
@ -228,19 +220,19 @@ resetContent' :: Headers.Headers -> ResponseM
resetContent' = emptyResponse' Status.resetContent resetContent' = emptyResponse' Status.resetContent
-- | 206 -- | 206
partialContent :: String -> ResponseM partialContent :: forall b. Body.Body b => b -> ResponseM
partialContent = partialContent' Headers.empty partialContent = partialContent' Headers.empty
-- | 206 with headers -- | 206 with headers
partialContent' :: Headers.Headers -> String -> ResponseM partialContent' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
partialContent' = response' Status.partialContent partialContent' = response' Status.partialContent
-- | 207 -- | 207
multiStatus :: String -> ResponseM multiStatus :: forall b. Body.Body b => b -> ResponseM
multiStatus = multiStatus' Headers.empty multiStatus = multiStatus' Headers.empty
-- | 207 with headers -- | 207 with headers
multiStatus' :: Headers.Headers -> String -> ResponseM multiStatus' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
multiStatus' = response' Status.multiStatus multiStatus' = response' Status.multiStatus
-- | 208 -- | 208
@ -252,11 +244,11 @@ alreadyReported' :: Headers.Headers -> ResponseM
alreadyReported' = emptyResponse' Status.alreadyReported alreadyReported' = emptyResponse' Status.alreadyReported
-- | 226 -- | 226
iMUsed :: String -> ResponseM iMUsed :: forall b. Body.Body b => b -> ResponseM
iMUsed = iMUsed' Headers.empty iMUsed = iMUsed' Headers.empty
-- | 226 with headers -- | 226 with headers
iMUsed' :: Headers.Headers -> String -> ResponseM iMUsed' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
iMUsed' = response' Status.iMUsed iMUsed' = response' Status.iMUsed
--------- ---------
@ -264,35 +256,35 @@ iMUsed' = response' Status.iMUsed
--------- ---------
-- | 300 -- | 300
multipleChoices :: String -> ResponseM multipleChoices :: forall b. Body.Body b => b -> ResponseM
multipleChoices = multipleChoices' Headers.empty multipleChoices = multipleChoices' Headers.empty
-- | 300 with headers -- | 300 with headers
multipleChoices' :: Headers.Headers -> String -> ResponseM multipleChoices' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
multipleChoices' = response' Status.multipleChoices multipleChoices' = response' Status.multipleChoices
-- | 301 -- | 301
movedPermanently :: String -> ResponseM movedPermanently :: forall b. Body.Body b => b -> ResponseM
movedPermanently = movedPermanently' Headers.empty movedPermanently = movedPermanently' Headers.empty
-- | 301 with headers -- | 301 with headers
movedPermanently' :: Headers.Headers -> String -> ResponseM movedPermanently' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
movedPermanently' = response' Status.movedPermanently movedPermanently' = response' Status.movedPermanently
-- | 302 -- | 302
found :: String -> ResponseM found :: forall b. Body.Body b => b -> ResponseM
found = found' Headers.empty found = found' Headers.empty
-- | 302 with headers -- | 302 with headers
found' :: Headers.Headers -> String -> ResponseM found' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
found' = response' Status.found found' = response' Status.found
-- | 303 -- | 303
seeOther :: String -> ResponseM seeOther :: forall b. Body.Body b => b -> ResponseM
seeOther = seeOther' Headers.empty seeOther = seeOther' Headers.empty
-- | 303 with headers -- | 303 with headers
seeOther' :: Headers.Headers -> String -> ResponseM seeOther' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
seeOther' = response' Status.seeOther seeOther' = response' Status.seeOther
-- | 304 -- | 304
@ -304,27 +296,27 @@ notModified' :: Headers.Headers -> ResponseM
notModified' = emptyResponse' Status.notModified notModified' = emptyResponse' Status.notModified
-- | 305 -- | 305
useProxy :: String -> ResponseM useProxy :: forall b. Body.Body b => b -> ResponseM
useProxy = useProxy' Headers.empty useProxy = useProxy' Headers.empty
-- | 305 with headers -- | 305 with headers
useProxy' :: Headers.Headers -> String -> ResponseM useProxy' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
useProxy' = response' Status.useProxy useProxy' = response' Status.useProxy
-- | 307 -- | 307
temporaryRedirect :: String -> ResponseM temporaryRedirect :: forall b. Body.Body b => b -> ResponseM
temporaryRedirect = temporaryRedirect' Headers.empty temporaryRedirect = temporaryRedirect' Headers.empty
-- | 307 with headers -- | 307 with headers
temporaryRedirect' :: Headers.Headers -> String -> ResponseM temporaryRedirect' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
temporaryRedirect' = response' Status.temporaryRedirect temporaryRedirect' = response' Status.temporaryRedirect
-- | 308 -- | 308
permanentRedirect :: String -> ResponseM permanentRedirect :: forall b. Body.Body b => b -> ResponseM
permanentRedirect = permanentRedirect' Headers.empty permanentRedirect = permanentRedirect' Headers.empty
-- | 308 with headers -- | 308 with headers
permanentRedirect' :: Headers.Headers -> String -> ResponseM permanentRedirect' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
permanentRedirect' = response' Status.permanentRedirect permanentRedirect' = response' Status.permanentRedirect
@ -333,11 +325,11 @@ permanentRedirect' = response' Status.permanentRedirect
--------- ---------
-- | 400 -- | 400
badRequest :: String -> ResponseM badRequest :: forall b. Body.Body b => b -> ResponseM
badRequest = badRequest' Headers.empty badRequest = badRequest' Headers.empty
-- | 400 with headers -- | 400 with headers
badRequest' :: Headers.Headers -> String -> ResponseM badRequest' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
badRequest' = response' Status.badRequest badRequest' = response' Status.badRequest
-- | 401 -- | 401
@ -405,11 +397,11 @@ requestTimeout' :: Headers.Headers -> ResponseM
requestTimeout' = emptyResponse' Status.requestTimeout requestTimeout' = emptyResponse' Status.requestTimeout
-- | 409 -- | 409
conflict :: String -> ResponseM conflict :: forall b. Body.Body b => b -> ResponseM
conflict = conflict' Headers.empty conflict = conflict' Headers.empty
-- | 409 with headers -- | 409 with headers
conflict' :: Headers.Headers -> String -> ResponseM conflict' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
conflict' = response' Status.conflict conflict' = response' Status.conflict
-- | 410 -- | 410
@ -561,11 +553,14 @@ unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons
--------- ---------
-- | 500 -- | 500
internalServerError :: String -> ResponseM internalServerError :: forall b. Body.Body b => b -> ResponseM
internalServerError = internalServerError' Headers.empty internalServerError = internalServerError' Headers.empty
-- | 500 with headers -- | 500 with headers
internalServerError' :: Headers.Headers -> String -> ResponseM internalServerError' :: forall b. Body.Body b =>
Headers.Headers ->
b ->
ResponseM
internalServerError' = response' Status.internalServerError internalServerError' = response' Status.internalServerError
-- | 501 -- | 501

View File

@ -10,7 +10,6 @@ import Prelude
import Effect as Effect import Effect as Effect
import Effect.Aff as Aff import Effect.Aff as Aff
import Effect.Class as EffectClass
import Data.Maybe as Maybe import Data.Maybe as Maybe
import Data.Options ((:=), Options) import Data.Options ((:=), Options)
import Node.Encoding as Encoding import Node.Encoding as Encoding
@ -37,7 +36,7 @@ handleRequest :: (Request.Request -> Response.ResponseM) ->
handleRequest router request response = handleRequest router request response =
void $ Aff.runAff (\_ -> pure unit) do void $ Aff.runAff (\_ -> pure unit) do
req <- Request.fromHTTPRequest request req <- Request.fromHTTPRequest request
router req >>= Response.send response >>> EffectClass.liftEffect router req >>= Response.send response
-- | Given a `ListenOptions` object, a function mapping `Request` to -- | Given a `ListenOptions` object, a function mapping `Request` to
-- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and -- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and

View File

@ -2,6 +2,7 @@ module Test.HTTPure.BodySpec where
import Prelude import Prelude
import Data.Maybe as Maybe
import Effect.Class as EffectClass import Effect.Class as EffectClass
import Node.Buffer as Buffer import Node.Buffer as Buffer
import Node.Encoding as Encoding import Node.Encoding as Encoding
@ -21,28 +22,37 @@ readSpec = Spec.describe "read" do
sizeSpec :: TestHelpers.Test sizeSpec :: TestHelpers.Test
sizeSpec = Spec.describe "size" do sizeSpec = Spec.describe "size" do
Spec.it "returns the correct size for ASCII string body" do Spec.describe "String" do
size <- EffectClass.liftEffect $ Body.size $ Body.StringBody "ascii" Spec.it "returns the correct size for ASCII string body" do
size ?= 5 size <- EffectClass.liftEffect $ Body.size "ascii"
size ?= Maybe.Just 5
Spec.it "returns the correct size for UTF-8 string body" do Spec.it "returns the correct size for UTF-8 string body" do
size <- EffectClass.liftEffect $ Body.size $ Body.StringBody "\x2603" -- snowman size <- EffectClass.liftEffect $ Body.size "\x2603" -- snowman
size ?= 3 size ?= Maybe.Just 3
Spec.describe "Buffer" do
Spec.it "returns the correct size for binary body" do Spec.it "returns the correct size for binary body" do
size <- EffectClass.liftEffect do size <- EffectClass.liftEffect do
buf <- Buffer.fromString "foobar" Encoding.UTF8 buf <- Buffer.fromString "foobar" Encoding.UTF8
Body.size $ Body.BinaryBody buf Body.size buf
size ?= 6 size ?= Maybe.Just 6
writeSpec :: TestHelpers.Test writeSpec :: TestHelpers.Test
writeSpec = Spec.describe "write" do writeSpec = Spec.describe "write" do
Spec.it "writes the string to the Response body" do Spec.describe "String" do
body <- EffectClass.liftEffect do Spec.it "writes the String to the Response body" do
resp <- TestHelpers.mockResponse body <- do
Body.write resp $ Body.StringBody "test" resp <- EffectClass.liftEffect TestHelpers.mockResponse
pure $ TestHelpers.getResponseBody resp Body.write "test" resp
body ?= "test" pure $ TestHelpers.getResponseBody resp
body ?= "test"
Spec.describe "Buffer" do
Spec.it "writes the Buffer to the Response body" do
body <- do
resp <- EffectClass.liftEffect TestHelpers.mockResponse
buf <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
Body.write buf resp
pure $ TestHelpers.getResponseBody resp
body ?= "test"
bodySpec :: TestHelpers.Test bodySpec :: TestHelpers.Test
bodySpec = Spec.describe "Body" do bodySpec = Spec.describe "Body" do

View File

@ -1,11 +0,0 @@
module Test.HTTPure.HTTPureEffectsSpec where
import Prelude
import Test.Spec as Spec
import Test.HTTPure.TestHelpers as TestHelpers
httpureEffectsSpec :: TestHelpers.Test
httpureEffectsSpec = Spec.describe "HTTPureEffects" do
pure unit

View File

@ -30,23 +30,22 @@ hasSpec = Spec.describe "has" do
Spec.it "is false" do Spec.it "is false" do
[ "one", "two", "three" ] !? 4 ?= false [ "one", "two", "three" ] !? 4 ?= false
lookupArraySpec :: TestHelpers.Test lookupFunctionSpec :: TestHelpers.Test
lookupArraySpec = Spec.describe "lookupArray" do lookupFunctionSpec = Spec.describe "lookup" do
Spec.describe "when the index is in bounds" do Spec.describe "Array" do
Spec.it "is Just the value at the index" do Spec.describe "when the index is in bounds" do
[ "one", "two", "three" ] !! 1 ?= Maybe.Just "two" Spec.it "is Just the value at the index" do
Spec.describe "when the index is out of bounds" do [ "one", "two", "three" ] !! 1 ?= Maybe.Just "two"
Spec.it "is Nothing" do Spec.describe "when the index is out of bounds" do
(([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing Spec.it "is Nothing" do
(([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing
lookupMapSpec :: TestHelpers.Test Spec.describe "Map" do
lookupMapSpec = Spec.describe "lookupMap" do Spec.describe "when the key is in the Map" do
Spec.describe "when the key is in the Map" do Spec.it "is Just the value at the given key" do
Spec.it "is Just the value at the given key" do mockMap !! "foo" ?= Maybe.Just "bar"
mockMap !! "foo" ?= Maybe.Just "bar" Spec.describe "when the key is not in the Map" do
Spec.describe "when the key is not in the Map" do Spec.it "is Nothing" do
Spec.it "is Nothing" do ((mockMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing
((mockMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing
where where
mockMap = Object.singleton "foo" "bar" mockMap = Object.singleton "foo" "bar"
@ -54,5 +53,4 @@ lookupSpec :: TestHelpers.Test
lookupSpec = Spec.describe "Lookup" do lookupSpec = Spec.describe "Lookup" do
atSpec atSpec
hasSpec hasSpec
lookupArraySpec lookupFunctionSpec
lookupMapSpec

View File

@ -2,13 +2,15 @@ module Test.HTTPure.ResponseSpec where
import Prelude import Prelude
import Data.Either as Either
import Data.Maybe as Maybe
import Effect.Aff as Aff
import Effect.Class as EffectClass import Effect.Class as EffectClass
import Node.Buffer as Buffer
import Node.Encoding as Encoding import Node.Encoding as Encoding
import Node.HTTP as HTTP
import Node.Stream as Stream
import Test.Spec as Spec import Test.Spec as Spec
import Test.Spec.Assertions as Assertions
import HTTPure.Body as Body
import HTTPure.Headers as Headers import HTTPure.Headers as Headers
import HTTPure.Response as Response import HTTPure.Response as Response
@ -18,35 +20,41 @@ import Test.HTTPure.TestHelpers ((?=))
sendSpec :: TestHelpers.Test sendSpec :: TestHelpers.Test
sendSpec = Spec.describe "send" do sendSpec = Spec.describe "send" do
Spec.it "writes the headers" do Spec.it "writes the headers" do
header <- EffectClass.liftEffect do header <- do
httpResponse <- TestHelpers.mockResponse httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse mockResponse Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseHeader "Test" httpResponse pure $ TestHelpers.getResponseHeader "Test" httpResponse
header ?= "test" header ?= "test"
Spec.it "sets the Content-Length header" do Spec.it "sets the Content-Length header" do
header <- EffectClass.liftEffect do header <- do
httpResponse <- TestHelpers.mockResponse httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse mockResponse Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseHeader "Content-Length" httpResponse pure $ TestHelpers.getResponseHeader "Content-Length" httpResponse
header ?= "4" header ?= "4"
Spec.it "writes the status" do Spec.it "writes the status" do
status <- EffectClass.liftEffect do status <- do
httpResponse <- TestHelpers.mockResponse httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse mockResponse Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseStatus httpResponse pure $ TestHelpers.getResponseStatus httpResponse
status ?= 123 status ?= 123
Spec.it "writes the body" do Spec.it "writes the body" do
body <- EffectClass.liftEffect do body <- do
httpResponse <- TestHelpers.mockResponse httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse mockResponse Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseBody httpResponse pure $ TestHelpers.getResponseBody httpResponse
body ?= "test" body ?= "test"
where where
mockHeaders = Headers.header "Test" "test" mockHeaders = Headers.header "Test" "test"
mockResponse = mockResponse _ =
{ status: 123 { status: 123
, headers: mockHeaders , headers: mockHeaders
, body: Body.StringBody "test" , writeBody: \response -> Aff.makeAff \done -> do
stream <- pure $ HTTP.responseAsStream response
_ <- Stream.writeString stream Encoding.UTF8 "test" $ pure unit
_ <- Stream.end stream $ pure unit
done $ Either.Right unit
pure Aff.nonCanceler
, size: Maybe.Just 4
} }
responseFunctionSpec :: TestHelpers.Test responseFunctionSpec :: TestHelpers.Test
@ -57,11 +65,16 @@ responseFunctionSpec = Spec.describe "response" do
Spec.it "has empty headers" do Spec.it "has empty headers" do
resp <- Response.response 123 "test" resp <- Response.response 123 "test"
resp.headers ?= Headers.empty resp.headers ?= Headers.empty
Spec.it "has the right body" do Spec.it "has the right size" do
resp <- Response.response 123 "test" resp <- Response.response 123 "test"
case resp.body of resp.size ?= Maybe.Just 4
Body.StringBody str -> str ?= "test" Spec.it "has the right writeBody function" do
_ -> Assertions.fail "String body expected" body <- do
resp <- Response.response 123 "test"
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= "test"
response'Spec :: TestHelpers.Test response'Spec :: TestHelpers.Test
response'Spec = Spec.describe "response'" do response'Spec = Spec.describe "response'" do
@ -71,56 +84,20 @@ response'Spec = Spec.describe "response'" do
Spec.it "has the right headers" do Spec.it "has the right headers" do
resp <- mockResponse resp <- mockResponse
resp.headers ?= mockHeaders resp.headers ?= mockHeaders
Spec.it "has the right body" do Spec.it "has the right size" do
resp <- mockResponse resp <- mockResponse
case resp.body of resp.size ?= Maybe.Just 4
Body.StringBody str -> str ?= "test" Spec.it "has the right writeBody function" do
_ -> Assertions.fail "String body expected" body <- do
resp <- mockResponse
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= "test"
where where
mockHeaders = Headers.header "Test" "test" mockHeaders = Headers.header "Test" "test"
mockResponse = Response.response' 123 mockHeaders "test" mockResponse = Response.response' 123 mockHeaders "test"
binaryResponseSpec :: TestHelpers.Test
binaryResponseSpec = Spec.describe "binaryResponse" do
Spec.it "has the right status" do
body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
resp <- Response.binaryResponse 123 body
resp.status ?= 123
Spec.it "has empty headers" do
body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
resp <- Response.binaryResponse 123 body
resp.headers ?= Headers.empty
Spec.it "has the right body" do
body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
resp <- Response.binaryResponse 123 body
case resp.body of
Body.BinaryBody bin -> do
str <- EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 bin
str ?= "test"
_ -> Assertions.fail "Binary body expected"
binaryResponse'Spec :: TestHelpers.Test
binaryResponse'Spec = Spec.describe "binaryResponse'" do
Spec.it "has the right status" do
body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
resp <- mockResponse body
resp.status ?= 123
Spec.it "has the right headers" do
body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
resp <- mockResponse body
resp.headers ?= mockHeaders
Spec.it "has the right body" do
body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
resp <- mockResponse body
case resp.body of
Body.BinaryBody bin -> do
str <- EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 bin
str ?= "test"
_ -> Assertions.fail "Binary body expected"
where
mockHeaders = Headers.header "Test" "test"
mockResponse = Response.binaryResponse' 123 mockHeaders
emptyResponseSpec :: TestHelpers.Test emptyResponseSpec :: TestHelpers.Test
emptyResponseSpec = Spec.describe "emptyResponse" do emptyResponseSpec = Spec.describe "emptyResponse" do
Spec.it "has the right status" do Spec.it "has the right status" do
@ -129,11 +106,16 @@ emptyResponseSpec = Spec.describe "emptyResponse" do
Spec.it "has empty headers" do Spec.it "has empty headers" do
resp <- Response.emptyResponse 123 resp <- Response.emptyResponse 123
resp.headers ?= Headers.empty resp.headers ?= Headers.empty
Spec.it "has an empty body" do Spec.it "has the right size" do
resp <- Response.emptyResponse 123 resp <- Response.emptyResponse 123
case resp.body of resp.size ?= Maybe.Just 0
Body.StringBody str -> str ?= "" Spec.it "has the right writeBody function" do
_ -> Assertions.fail "String body expected" body <- do
resp <- Response.emptyResponse 123
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= ""
emptyResponse'Spec :: TestHelpers.Test emptyResponse'Spec :: TestHelpers.Test
emptyResponse'Spec = Spec.describe "emptyResponse'" do emptyResponse'Spec = Spec.describe "emptyResponse'" do
@ -143,11 +125,16 @@ emptyResponse'Spec = Spec.describe "emptyResponse'" do
Spec.it "has the right headers" do Spec.it "has the right headers" do
resp <- mockResponse resp <- mockResponse
resp.headers ?= mockHeaders resp.headers ?= mockHeaders
Spec.it "has an empty body" do Spec.it "has the right size" do
resp <- mockResponse resp <- mockResponse
case resp.body of resp.size ?= Maybe.Just 0
Body.StringBody str -> str ?= "" Spec.it "has the right writeBody function" do
_ -> Assertions.fail "String body expected" body <- do
resp <- mockResponse
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= ""
where where
mockHeaders = Headers.header "Test" "test" mockHeaders = Headers.header "Test" "test"
mockResponse = Response.emptyResponse' 123 mockHeaders mockResponse = Response.emptyResponse' 123 mockHeaders
@ -157,7 +144,5 @@ responseSpec = Spec.describe "Response" do
sendSpec sendSpec
responseFunctionSpec responseFunctionSpec
response'Spec response'Spec
binaryResponseSpec
binaryResponse'Spec
emptyResponseSpec emptyResponseSpec
emptyResponse'Spec emptyResponse'Spec

View File

@ -66,7 +66,7 @@ toBuffer response = Aff.makeAff \done -> do
Ref.read chunks Ref.read chunks
>>= List.reverse >>> Array.fromFoldable >>> Buffer.concat >>= List.reverse >>> Array.fromFoldable >>> Buffer.concat
>>= Either.Right >>> done >>= Either.Right >>> done
pure $ Aff.nonCanceler pure Aff.nonCanceler
-- | Convert a request to an Aff containing the string with the response body. -- | Convert a request to an Aff containing the string with the response body.
toString :: HTTPClient.Response -> Aff.Aff String toString :: HTTPClient.Response -> Aff.Aff String
@ -143,8 +143,7 @@ mockRequest method url body =
EffectClass.liftEffect <<< mockRequestImpl method url body <<< Object.fromFoldable EffectClass.liftEffect <<< mockRequestImpl method url body <<< Object.fromFoldable
-- | Mock an HTTP Response object -- | Mock an HTTP Response object
foreign import mockResponse :: foreign import mockResponse :: Effect.Effect HTTP.Response
Effect.Effect HTTP.Response
-- | Get the current body from an HTTP Response object (note this will only work -- | Get the current body from an HTTP Response object (note this will only work
-- | with an object returned from mockResponse). -- | with an object returned from mockResponse).

View File

@ -8,7 +8,6 @@ import Test.Spec.Runner as Runner
import Test.HTTPure.BodySpec as BodySpec import Test.HTTPure.BodySpec as BodySpec
import Test.HTTPure.HeadersSpec as HeadersSpec import Test.HTTPure.HeadersSpec as HeadersSpec
import Test.HTTPure.HTTPureEffectsSpec as HTTPureEffectsSpec
import Test.HTTPure.LookupSpec as LookupSpec import Test.HTTPure.LookupSpec as LookupSpec
import Test.HTTPure.MethodSpec as MethodSpec import Test.HTTPure.MethodSpec as MethodSpec
import Test.HTTPure.PathSpec as PathSpec import Test.HTTPure.PathSpec as PathSpec
@ -25,7 +24,6 @@ main :: TestHelpers.TestSuite
main = Runner.run [ Reporter.specReporter ] $ Spec.describe "HTTPure" do main = Runner.run [ Reporter.specReporter ] $ Spec.describe "HTTPure" do
BodySpec.bodySpec BodySpec.bodySpec
HeadersSpec.headersSpec HeadersSpec.headersSpec
HTTPureEffectsSpec.httpureEffectsSpec
LookupSpec.lookupSpec LookupSpec.lookupSpec
MethodSpec.methodSpec MethodSpec.methodSpec
PathSpec.pathSpec PathSpec.pathSpec