From 8badd62b3e7b9c4c782e07bc3fba30c88063e85f Mon Sep 17 00:00:00 2001 From: Petri Lehtinen Date: Mon, 9 Jul 2018 02:16:48 +0300 Subject: [PATCH] PureScript 0.12 support (#89) - Upgrade all dependencies - Use Effect instead of Eff - Use Foreign.Object instead of StrMap - Use Effect.Ref instead of Control.Monad.ST - Drop SecureServerM, it's the same as ServerM now --- bower.json | 20 +- docs/Examples/AsyncResponse/Main.purs | 7 +- docs/Examples/Headers/Main.purs | 6 +- docs/Examples/HelloWorld/Main.purs | 6 +- docs/Examples/Middleware/Main.purs | 28 ++- docs/Examples/MultiRoute/Main.purs | 6 +- docs/Examples/PathSegments/Main.purs | 6 +- docs/Examples/Post/Main.purs | 6 +- docs/Examples/QueryParameters/Main.purs | 6 +- docs/Examples/SSL/Main.purs | 6 +- src/HTTPure.purs | 3 +- src/HTTPure/Body.purs | 18 +- src/HTTPure/HTTPureEffects.purs | 15 -- src/HTTPure/Headers.purs | 31 ++- src/HTTPure/Lookup.purs | 10 +- src/HTTPure/Method.purs | 10 +- src/HTTPure/Query.purs | 18 +- src/HTTPure/Request.purs | 13 +- src/HTTPure/Response.purs | 266 ++++++++++++------------ src/HTTPure/Server.purs | 60 +++--- src/HTTPure/Status.purs | 7 +- test/Test/HTTPure/BodySpec.purs | 4 +- test/Test/HTTPure/HeadersSpec.purs | 10 +- test/Test/HTTPure/IntegrationSpec.purs | 58 +++--- test/Test/HTTPure/LookupSpec.purs | 18 +- test/Test/HTTPure/QuerySpec.purs | 24 +-- test/Test/HTTPure/RequestSpec.purs | 4 +- test/Test/HTTPure/ResponseSpec.purs | 8 +- test/Test/HTTPure/ServerSpec.purs | 26 +-- test/Test/HTTPure/StatusSpec.purs | 4 +- test/Test/HTTPure/TestHelpers.purs | 108 ++++------ 31 files changed, 362 insertions(+), 450 deletions(-) delete mode 100644 src/HTTPure/HTTPureEffects.purs diff --git a/bower.json b/bower.json index 5d5e407..05faaf3 100644 --- a/bower.json +++ b/bower.json @@ -17,17 +17,17 @@ "*.md" ], "dependencies": { - "purescript-prelude": "^3.1.1", - "purescript-aff": "^4.0.2", - "purescript-node-fs": "^4.0.0", - "purescript-node-http": "^4.2.0", - "purescript-strings": "^3.5.0", - "purescript-foldable-traversable": "^3.7.1" + "purescript-prelude": "^4.0.1", + "purescript-aff": "^5.0.0", + "purescript-node-fs": "^5.0.0", + "purescript-node-http": "^5.0.0", + "purescript-strings": "^4.0.0", + "purescript-foldable-traversable": "^4.0.0" }, "devDependencies": { - "purescript-psci-support": "^3.0.0", - "purescript-spec": "^2.0.0", - "purescript-unsafe-coerce": "^3.0.0", - "purescript-node-fs-aff": "^5.0.0" + "purescript-psci-support": "^4.0.0", + "purescript-spec": "^3.0.0", + "purescript-unsafe-coerce": "^4.0.0", + "purescript-node-fs-aff": "^6.0.0" } } diff --git a/docs/Examples/AsyncResponse/Main.purs b/docs/Examples/AsyncResponse/Main.purs index fa68427..d228660 100644 --- a/docs/Examples/AsyncResponse/Main.purs +++ b/docs/Examples/AsyncResponse/Main.purs @@ -2,10 +2,9 @@ module Examples.AsyncResponse.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure import Node.Encoding as Encoding -import Node.FS as FS import Node.FS.Aff as FSAff -- | Serve the example server on this port @@ -21,11 +20,11 @@ filePath :: String filePath = "./docs/Examples/AsyncResponse/Hello" -- | Say 'hello world!' when run -sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM (fs :: FS.FS | e) +sayHello :: HTTPure.Request -> HTTPure.ResponseM sayHello _ = FSAff.readTextFile Encoding.UTF8 filePath >>= HTTPure.ok -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE, fs :: FS.FS | e) +main :: HTTPure.ServerM main = HTTPure.serve port sayHello do Console.log $ " ┌────────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/Headers/Main.purs b/docs/Examples/Headers/Main.purs index c803a1c..6e4b12c 100644 --- a/docs/Examples/Headers/Main.purs +++ b/docs/Examples/Headers/Main.purs @@ -2,7 +2,7 @@ module Examples.Headers.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure import HTTPure ((!@)) @@ -19,11 +19,11 @@ responseHeaders :: HTTPure.Headers responseHeaders = HTTPure.header "X-Example" "hello world!" -- | Route to the correct handler -router :: forall e. HTTPure.Request -> HTTPure.ResponseM e +router :: HTTPure.Request -> HTTPure.ResponseM router { headers } = HTTPure.ok' responseHeaders $ headers !@ "X-Input" -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serve port router do Console.log $ " ┌──────────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/HelloWorld/Main.purs b/docs/Examples/HelloWorld/Main.purs index c3b0734..ebd535c 100644 --- a/docs/Examples/HelloWorld/Main.purs +++ b/docs/Examples/HelloWorld/Main.purs @@ -2,7 +2,7 @@ module Examples.HelloWorld.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure -- | Serve the example server on this port @@ -14,11 +14,11 @@ portS :: String portS = show port -- | Say 'hello world!' when run -sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e +sayHello :: HTTPure.Request -> HTTPure.ResponseM sayHello _ = HTTPure.ok "hello world!" -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serve port sayHello do Console.log $ " ┌────────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/Middleware/Main.purs b/docs/Examples/Middleware/Main.purs index ff6245c..e163298 100644 --- a/docs/Examples/Middleware/Main.purs +++ b/docs/Examples/Middleware/Main.purs @@ -2,8 +2,8 @@ module Examples.Middleware.Main where import Prelude -import Control.Monad.Eff.Class as EffClass -import Control.Monad.Eff.Console as Console +import Effect.Class as EffectClass +import Effect.Console as Console import HTTPure as HTTPure -- | Serve the example server on this port @@ -15,25 +15,22 @@ portS :: String portS = show port -- | A middleware that logs at the beginning and end of each request -loggingMiddleware :: forall e. - (HTTPure.Request -> - HTTPure.ResponseM (console :: Console.CONSOLE | e)) -> +loggingMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) -> HTTPure.Request -> - HTTPure.ResponseM (console :: Console.CONSOLE | e) + HTTPure.ResponseM loggingMiddleware router request = do - EffClass.liftEff $ Console.log $ "Request starting for " <> path + EffectClass.liftEffect $ Console.log $ "Request starting for " <> path response <- router request - EffClass.liftEff $ Console.log $ "Request ending for " <> path + EffectClass.liftEffect $ Console.log $ "Request ending for " <> path pure response where path = HTTPure.fullPath request -- | A middleware that adds the X-Middleware header to the response, if it -- | wasn't already in the response -headerMiddleware :: forall e. - (HTTPure.Request -> HTTPure.ResponseM e) -> +headerMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) -> HTTPure.Request -> - HTTPure.ResponseM e + HTTPure.ResponseM headerMiddleware router request = do response <- router request HTTPure.response' response.status (header <> response.headers) response.body @@ -42,19 +39,18 @@ headerMiddleware router request = do -- | A middleware that sends the body "Middleware!" instead of running the -- | router when requesting /middleware -pathMiddleware :: forall e. - (HTTPure.Request -> HTTPure.ResponseM e) -> +pathMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) -> HTTPure.Request -> - HTTPure.ResponseM e + HTTPure.ResponseM pathMiddleware _ { path: [ "middleware" ] } = HTTPure.ok "Middleware!" pathMiddleware router request = router request -- | Say 'hello' when run, and add a default value to the X-Middleware header -sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e +sayHello :: HTTPure.Request -> HTTPure.ResponseM sayHello _ = HTTPure.ok' (HTTPure.header "X-Middleware" "router") "hello" -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serve port (middlewares sayHello) do Console.log $ " ┌───────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/MultiRoute/Main.purs b/docs/Examples/MultiRoute/Main.purs index 75d68f1..278dac2 100644 --- a/docs/Examples/MultiRoute/Main.purs +++ b/docs/Examples/MultiRoute/Main.purs @@ -2,7 +2,7 @@ module Examples.MultiRoute.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure -- | Serve the example server on this port @@ -14,13 +14,13 @@ portS :: String portS = show port -- | Specify the routes -router :: forall e. HTTPure.Request -> HTTPure.ResponseM e +router :: HTTPure.Request -> HTTPure.ResponseM router { path: [ "hello" ] } = HTTPure.ok "hello" router { path: [ "goodbye" ] } = HTTPure.ok "goodbye" router _ = HTTPure.notFound -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serve port router do Console.log $ " ┌───────────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/PathSegments/Main.purs b/docs/Examples/PathSegments/Main.purs index 98b0fa2..dd3e6b9 100644 --- a/docs/Examples/PathSegments/Main.purs +++ b/docs/Examples/PathSegments/Main.purs @@ -2,7 +2,7 @@ module Examples.PathSegments.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure import HTTPure ((!@)) @@ -15,13 +15,13 @@ portS :: String portS = show port -- | Specify the routes -router :: forall e. HTTPure.Request -> HTTPure.ResponseM e +router :: HTTPure.Request -> HTTPure.ResponseM router { path } | path !@ 0 == "segment" = HTTPure.ok $ path !@ 1 | otherwise = HTTPure.ok $ show path -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serve port router do Console.log $ " ┌───────────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/Post/Main.purs b/docs/Examples/Post/Main.purs index 9d559bf..2c6be22 100644 --- a/docs/Examples/Post/Main.purs +++ b/docs/Examples/Post/Main.purs @@ -2,7 +2,7 @@ module Examples.Post.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure -- | Serve the example server on this port @@ -14,12 +14,12 @@ portS :: String portS = show port -- | Route to the correct handler -router :: forall e. HTTPure.Request -> HTTPure.ResponseM e +router :: HTTPure.Request -> HTTPure.ResponseM router { body, method: HTTPure.Post } = HTTPure.ok body router _ = HTTPure.notFound -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serve port router do Console.log $ " ┌───────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/QueryParameters/Main.purs b/docs/Examples/QueryParameters/Main.purs index 887e77f..d1fa567 100644 --- a/docs/Examples/QueryParameters/Main.purs +++ b/docs/Examples/QueryParameters/Main.purs @@ -2,7 +2,7 @@ module Examples.QueryParameters.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure import HTTPure ((!@), (!?)) @@ -15,14 +15,14 @@ portS :: String portS = show port -- | Specify the routes -router :: forall e. HTTPure.Request -> HTTPure.ResponseM e +router :: HTTPure.Request -> HTTPure.ResponseM router { query } | query !? "foo" = HTTPure.ok "foo" | query !@ "bar" == "test" = HTTPure.ok "bar" | otherwise = HTTPure.ok $ query !@ "baz" -- | Boot up the server -main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serve port router do Console.log $ " ┌────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/docs/Examples/SSL/Main.purs b/docs/Examples/SSL/Main.purs index 62f705a..8a5d85c 100644 --- a/docs/Examples/SSL/Main.purs +++ b/docs/Examples/SSL/Main.purs @@ -2,7 +2,7 @@ module Examples.SSL.Main where import Prelude -import Control.Monad.Eff.Console as Console +import Effect.Console as Console import HTTPure as HTTPure -- | Serve the example server on this port @@ -22,11 +22,11 @@ key :: String key = "./docs/Examples/SSL/Key.key" -- | Say 'hello world!' when run -sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e +sayHello :: HTTPure.Request -> HTTPure.ResponseM sayHello _ = HTTPure.ok "hello world!" -- | Boot up the server -main :: forall e. HTTPure.SecureServerM (console :: Console.CONSOLE | e) +main :: HTTPure.ServerM main = HTTPure.serveSecure port cert key sayHello do Console.log $ " ┌───────────────────────────────────────────┐" Console.log $ " │ Server now up on port " <> portS <> " │" diff --git a/src/HTTPure.purs b/src/HTTPure.purs index aa85ebd..1ac65e7 100644 --- a/src/HTTPure.purs +++ b/src/HTTPure.purs @@ -89,8 +89,7 @@ import HTTPure.Response , networkAuthenticationRequired, networkAuthenticationRequired' ) import HTTPure.Server - ( SecureServerM - , ServerM + ( ServerM , serve , serve' , serveSecure diff --git a/src/HTTPure/Body.purs b/src/HTTPure/Body.purs index 2ff8364..686752e 100644 --- a/src/HTTPure/Body.purs +++ b/src/HTTPure/Body.purs @@ -7,31 +7,29 @@ module HTTPure.Body import Prelude import Data.Either as Either -import Control.Monad.Aff as Aff -import Control.Monad.Eff as Eff -import Control.Monad.ST as ST +import Effect as Effect +import Effect.Aff as Aff +import Effect.Ref as Ref import Node.Encoding as Encoding import Node.HTTP as HTTP import Node.Stream as Stream -import HTTPure.HTTPureEffects as HTTPureEffects - -- | The `Body` type is just sugar for a `String`, that will be sent or received -- | in the HTTP body. type Body = String -- | Extract the contents of the body of the HTTP `Request`. -read :: forall e. HTTP.Request -> Aff.Aff (HTTPureEffects.HTTPureEffects e) Body +read :: HTTP.Request -> Aff.Aff Body read request = Aff.makeAff \done -> do let stream = HTTP.requestAsStream request - buf <- ST.newSTRef "" + buf <- Ref.new "" Stream.onDataString stream Encoding.UTF8 \str -> - void $ ST.modifySTRef buf ((<>) str) - Stream.onEnd stream $ ST.readSTRef buf >>= Either.Right >>> done + void $ Ref.modify ((<>) str) buf + Stream.onEnd stream $ Ref.read buf >>= Either.Right >>> done pure $ Aff.nonCanceler -- | Write a `Body` to the given HTTP `Response` and close it. -write :: forall e. HTTP.Response -> Body -> Eff.Eff (http :: HTTP.HTTP | e) Unit +write :: HTTP.Response -> Body -> Effect.Effect Unit write response body = void do _ <- Stream.writeString stream Encoding.UTF8 body $ pure unit Stream.end stream $ pure unit diff --git a/src/HTTPure/HTTPureEffects.purs b/src/HTTPure/HTTPureEffects.purs deleted file mode 100644 index ced8f09..0000000 --- a/src/HTTPure/HTTPureEffects.purs +++ /dev/null @@ -1,15 +0,0 @@ -module HTTPure.HTTPureEffects - ( HTTPureEffects - ) where - -import Control.Monad.Eff.Exception as Exception -import Control.Monad.ST as ST -import Node.HTTP as HTTP - --- | A row of types that are used by an HTTPure server. -type HTTPureEffects e = - ( http :: HTTP.HTTP - , st :: ST.ST String - , exception :: Exception.EXCEPTION - | e - ) diff --git a/src/HTTPure/Headers.purs b/src/HTTPure/Headers.purs index bc5caa7..9e48bed 100644 --- a/src/HTTPure/Headers.purs +++ b/src/HTTPure/Headers.purs @@ -9,9 +9,9 @@ module HTTPure.Headers import Prelude -import Control.Monad.Eff as Eff -import Data.String as StringUtil -import Data.StrMap as StrMap +import Effect as Effect +import Foreign.Object as Object +import Data.String as String import Data.TraversableWithIndex as TraversableWithIndex import Data.Tuple as Tuple import Node.HTTP as HTTP @@ -19,30 +19,30 @@ import Node.HTTP as HTTP import HTTPure.Lookup as Lookup import HTTPure.Lookup ((!!)) --- | The `Headers` type is just sugar for a `StrMap` of `Strings` that --- | represents the set of headers in an HTTP request or response. -newtype Headers = Headers (StrMap.StrMap String) +-- | The `Headers` type is just sugar for a `Object` of `Strings` +-- | that represents the set of headers in an HTTP request or response. +newtype Headers = Headers (Object.Object String) -- | Given a string, return a `Maybe` containing the value of the matching -- | header, if there is any. instance lookup :: Lookup.Lookup Headers String String where - lookup (Headers headers') key = headers' !! StringUtil.toLower key + lookup (Headers headers') key = headers' !! String.toLower key -- | Allow a `Headers` to be represented as a string. This string is formatted -- | in HTTP headers format. instance show :: Show Headers where show (Headers headers') = - StrMap.foldMap showField headers' <> "\n" + Object.foldMap showField headers' <> "\n" where showField key value = key <> ": " <> value <> "\n" --- | Compare two `Headers` objects by comparing the underlying `StrMaps`. +-- | Compare two `Headers` objects by comparing the underlying `Objects`. instance eq :: Eq Headers where eq (Headers a) (Headers b) = eq a b -- | Allow one `Headers` objects to be appended to another. instance semigroup :: Semigroup Headers where - append (Headers a) (Headers b) = Headers $ StrMap.union b a + append (Headers a) (Headers b) = Headers $ Object.union b a -- | Get the headers out of a HTTP `Request` object. read :: HTTP.Request -> Headers @@ -50,21 +50,20 @@ read = HTTP.requestHeaders >>> Headers -- | Given an HTTP `Response` and a `Headers` object, return an effect that will -- | write the `Headers` to the `Response`. -write :: forall e. - HTTP.Response -> +write :: HTTP.Response -> Headers -> - Eff.Eff (http :: HTTP.HTTP | e) Unit + Effect.Effect Unit write response (Headers headers') = void $ TraversableWithIndex.traverseWithIndex (HTTP.setHeader response) headers' -- | Return a `Headers` containing nothing. empty :: Headers -empty = Headers StrMap.empty +empty = Headers Object.empty -- | Convert an `Array` of `Tuples` of 2 `Strings` to a `Headers` object. headers :: Array (Tuple.Tuple String String) -> Headers -headers = StrMap.fromFoldable >>> Headers +headers = Object.fromFoldable >>> Headers -- | Create a singleton header from a key-value pair. header :: String -> String -> Headers -header key = StrMap.singleton key >>> Headers +header key = Object.singleton key >>> Headers diff --git a/src/HTTPure/Lookup.purs b/src/HTTPure/Lookup.purs index 34e2d04..a9ac71e 100644 --- a/src/HTTPure/Lookup.purs +++ b/src/HTTPure/Lookup.purs @@ -10,7 +10,7 @@ import Prelude import Data.Array as Array import Data.Maybe as Maybe import Data.Monoid as Monoid -import Data.StrMap as StrMap +import Foreign.Object as Object -- | Types that implement the `Lookup` class can be looked up by some key to -- | retrieve some value. For instance, you could have an implementation for @@ -32,11 +32,11 @@ infixl 8 lookup as !! instance lookupArray :: Lookup (Array t) Int t where lookup = Array.index --- | The instance of `Lookup` for a `StrMap` just uses `StrMap.lookup` (but --- | flipped, because `StrMap.lookup` expects the key first, which would end up +-- | The instance of `Lookup` for a `Object` just uses `Object.lookup` (but +-- | flipped, because `Object.lookup` expects the key first, which would end up -- | with a really weird API for `!!`). -instance lookupStrMap :: Lookup (StrMap.StrMap t) String t where - lookup = flip StrMap.lookup +instance lookupObject :: Lookup (Object.Object t) String t where + lookup = flip Object.lookup -- | This simple helper works on any `Lookup` instance where the return type is -- | a `Monoid`, and is the same as `lookup` except that it returns a `t` diff --git a/src/HTTPure/Method.purs b/src/HTTPure/Method.purs index f2cd362..efb55ff 100644 --- a/src/HTTPure/Method.purs +++ b/src/HTTPure/Method.purs @@ -3,10 +3,8 @@ module HTTPure.Method , read ) where -import Data.Eq as Eq -import Data.Generic as Generic +import Prelude import Node.HTTP as HTTP -import Data.Show as Show -- | These are the HTTP methods that HTTPure understands. data Method @@ -21,12 +19,10 @@ data Method | Patch -- | If two `Methods` are the same constructor, they are equal. -derive instance generic :: Generic.Generic Method -instance eq :: Eq.Eq Method where - eq = Generic.gEq +derive instance eqMethod :: Eq Method -- | Convert a constructor to a `String`. -instance show :: Show.Show Method where +instance showMethod :: Show Method where show Get = "Get" show Post = "Post" show Put = "Put" diff --git a/src/HTTPure/Query.purs b/src/HTTPure/Query.purs index a2d539e..80c62ca 100644 --- a/src/HTTPure/Query.purs +++ b/src/HTTPure/Query.purs @@ -8,26 +8,26 @@ import Prelude import Data.Array as Array import Data.Maybe as Maybe import Data.String as String -import Data.StrMap as StrMap import Data.Tuple as Tuple +import Foreign.Object as Object import Node.HTTP as HTTP --- | The `Query` type is a `StrMap` of `Strings`, with one entry per query +-- | The `Query` type is a `Object` of `Strings`, with one entry per query -- | parameter in the request. For any query parameters that don't have values --- | (`/some/path?query`), the value in the `StrMap` for that parameter will be +-- | (`/some/path?query`), the value in the `Object` for that parameter will be -- | the string `"true"`. Note that this type has an implementation of `Lookup` --- | for `String` keys defined by `lookpStrMap` in [Lookup.purs](./Lookup.purs) --- | because `lookupStrMap` is defined for any `StrMap` of `Monoids`. So you can +-- | for `String` keys defined by `lookupObject` in [Lookup.purs](./Lookup.purs) +-- | because `lookupObject` is defined for any `Object` of `Monoids`. So you can -- | do something like `query !! "foo"` to get the value of the query parameter -- | "foo". -type Query = StrMap.StrMap String +type Query = Object.Object String --- | The `StrMap` of query segments in the given HTTP `Request`. +-- | The `Map` of query segments in the given HTTP `Request`. read :: HTTP.Request -> Query read = - HTTP.requestURL >>> split "?" >>> last >>> split "&" >>> nonempty >>> toStrMap + HTTP.requestURL >>> split "?" >>> last >>> split "&" >>> nonempty >>> toObject where - toStrMap = map toTuple >>> StrMap.fromFoldable + toObject = map toTuple >>> Object.fromFoldable nonempty = Array.filter ((/=) "") split = String.Pattern >>> String.split first = Array.head >>> Maybe.fromMaybe "" diff --git a/src/HTTPure/Request.purs b/src/HTTPure/Request.purs index 6a2ce93..8e07888 100644 --- a/src/HTTPure/Request.purs +++ b/src/HTTPure/Request.purs @@ -6,14 +6,13 @@ module HTTPure.Request import Prelude -import Control.Monad.Aff as Aff +import Effect.Aff as Aff import Data.String as String -import Data.StrMap as StrMap +import Foreign.Object as Object import Node.HTTP as HTTP import HTTPure.Body as Body import HTTPure.Headers as Headers -import HTTPure.HTTPureEffects as HTTPureEffects import HTTPure.Method as Method import HTTPure.Path as Path import HTTPure.Query as Query @@ -35,16 +34,14 @@ fullPath :: Request -> String fullPath request = "/" <> path <> questionMark <> queryParams where path = String.joinWith "/" request.path - questionMark = if StrMap.isEmpty request.query then "" else "?" + questionMark = if Object.isEmpty request.query then "" else "?" queryParams = String.joinWith "&" queryParamsArr - queryParamsArr = StrMap.toArrayWithKey stringifyQueryParam request.query + queryParamsArr = Object.toArrayWithKey stringifyQueryParam request.query stringifyQueryParam key value = key <> "=" <> value -- | Given an HTTP `Request` object, this method will convert it to an HTTPure -- | `Request` object. -fromHTTPRequest :: forall e. - HTTP.Request -> - Aff.Aff (HTTPureEffects.HTTPureEffects e) Request +fromHTTPRequest :: HTTP.Request -> Aff.Aff Request fromHTTPRequest request = do body <- Body.read request pure $ diff --git a/src/HTTPure/Response.purs b/src/HTTPure/Response.purs index 1fc77c7..68b4fd2 100644 --- a/src/HTTPure/Response.purs +++ b/src/HTTPure/Response.purs @@ -78,19 +78,18 @@ module HTTPure.Response import Prelude -import Control.Monad.Eff as Eff -import Control.Monad.Aff as Aff +import Effect as Effect +import Effect.Aff as Aff import Node.HTTP as HTTP import HTTPure.Body as Body import HTTPure.Headers as Headers -import HTTPure.HTTPureEffects as HTTPureEffects import HTTPure.Status as Status -- | The `ResponseM` type simply conveniently wraps up an HTTPure monad that -- | returns a response. This type is the return type of all router/route -- | methods. -type ResponseM e = Aff.Aff (HTTPureEffects.HTTPureEffects e) Response +type ResponseM = Aff.Aff Response -- | A `Response` is a status code, headers, and a body. type Response = @@ -102,10 +101,7 @@ type Response = -- | Given an HTTP `Response` and a HTTPure `Response`, this method will return -- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response` -- | and closing the HTTP `Response`. -send :: forall e. - HTTP.Response -> - Response -> - Eff.Eff (HTTPureEffects.HTTPureEffects e) Unit +send :: HTTP.Response -> Response -> Effect.Effect Unit send httpresponse { status, headers, body } = do Status.write httpresponse $ status Headers.write httpresponse $ headers @@ -113,23 +109,22 @@ send httpresponse { status, headers, body } = do -- | For custom response statuses or providing a body for response codes that -- | don't typically send one. -response :: forall e. Status.Status -> Body.Body -> ResponseM e +response :: Status.Status -> Body.Body -> ResponseM response status = response' status Headers.empty -- | The same as `response` but with headers. -response' :: forall e. - Status.Status -> +response' :: Status.Status -> Headers.Headers -> Body.Body -> - ResponseM e + ResponseM response' status headers body = pure $ { status, headers, body } -- | The same as `response` but without a body. -emptyResponse :: forall e. Status.Status -> ResponseM e +emptyResponse :: Status.Status -> ResponseM emptyResponse status = emptyResponse' status Headers.empty -- | The same as `emptyResponse` but with headers. -emptyResponse' :: forall e. Status.Status -> Headers.Headers -> ResponseM e +emptyResponse' :: Status.Status -> Headers.Headers -> ResponseM emptyResponse' status headers = response' status headers "" --------- @@ -137,27 +132,27 @@ emptyResponse' status headers = response' status headers "" --------- -- | 100 -continue :: forall e. ResponseM e +continue :: ResponseM continue = continue' Headers.empty -- | 100 with headers -continue' :: forall e. Headers.Headers -> ResponseM e +continue' :: Headers.Headers -> ResponseM continue' = emptyResponse' Status.continue -- | 101 -switchingProtocols :: forall e. ResponseM e +switchingProtocols :: ResponseM switchingProtocols = switchingProtocols' Headers.empty -- | 101 with headers -switchingProtocols' :: forall e. Headers.Headers -> ResponseM e +switchingProtocols' :: Headers.Headers -> ResponseM switchingProtocols' = emptyResponse' Status.switchingProtocols -- | 102 -processing :: forall e. ResponseM e +processing :: ResponseM processing = processing' Headers.empty -- | 102 with headers -processing' :: forall e. Headers.Headers -> ResponseM e +processing' :: Headers.Headers -> ResponseM processing' = emptyResponse' Status.processing --------- @@ -165,86 +160,85 @@ processing' = emptyResponse' Status.processing --------- -- | 200 -ok :: forall e. Body.Body -> ResponseM e +ok :: Body.Body -> ResponseM ok = ok' Headers.empty -- | 200 with headers -ok' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +ok' :: Headers.Headers -> Body.Body -> ResponseM ok' = response' Status.ok -- | 201 -created :: forall e. ResponseM e +created :: ResponseM created = created' Headers.empty -- | 201 with headers -created' :: forall e. Headers.Headers -> ResponseM e +created' :: Headers.Headers -> ResponseM created' = emptyResponse' Status.created -- | 202 -accepted :: forall e. ResponseM e +accepted :: ResponseM accepted = accepted' Headers.empty -- | 202 with headers -accepted' :: forall e. Headers.Headers -> ResponseM e +accepted' :: Headers.Headers -> ResponseM accepted' = emptyResponse' Status.accepted -- | 203 -nonAuthoritativeInformation :: forall e. Body.Body -> ResponseM e +nonAuthoritativeInformation :: Body.Body -> ResponseM nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty -- | 203 with headers -nonAuthoritativeInformation' :: forall e. - Headers.Headers -> +nonAuthoritativeInformation' :: Headers.Headers -> Body.Body -> - ResponseM e + ResponseM nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation -- | 204 -noContent :: forall e. ResponseM e +noContent :: ResponseM noContent = noContent' Headers.empty -- | 204 with headers -noContent' :: forall e. Headers.Headers -> ResponseM e +noContent' :: Headers.Headers -> ResponseM noContent' = emptyResponse' Status.noContent -- | 205 -resetContent :: forall e. ResponseM e +resetContent :: ResponseM resetContent = resetContent' Headers.empty -- | 205 with headers -resetContent' :: forall e. Headers.Headers -> ResponseM e +resetContent' :: Headers.Headers -> ResponseM resetContent' = emptyResponse' Status.resetContent -- | 206 -partialContent :: forall e. Body.Body -> ResponseM e +partialContent :: Body.Body -> ResponseM partialContent = partialContent' Headers.empty -- | 206 with headers -partialContent' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +partialContent' :: Headers.Headers -> Body.Body -> ResponseM partialContent' = response' Status.partialContent -- | 207 -multiStatus :: forall e. Body.Body -> ResponseM e +multiStatus :: Body.Body -> ResponseM multiStatus = multiStatus' Headers.empty -- | 207 with headers -multiStatus' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +multiStatus' :: Headers.Headers -> Body.Body -> ResponseM multiStatus' = response' Status.multiStatus -- | 208 -alreadyReported :: forall e. ResponseM e +alreadyReported :: ResponseM alreadyReported = alreadyReported' Headers.empty -- | 208 with headers -alreadyReported' :: forall e. Headers.Headers -> ResponseM e +alreadyReported' :: Headers.Headers -> ResponseM alreadyReported' = emptyResponse' Status.alreadyReported -- | 226 -iMUsed :: forall e. Body.Body -> ResponseM e +iMUsed :: Body.Body -> ResponseM iMUsed = iMUsed' Headers.empty -- | 226 with headers -iMUsed' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +iMUsed' :: Headers.Headers -> Body.Body -> ResponseM iMUsed' = response' Status.iMUsed --------- @@ -252,67 +246,67 @@ iMUsed' = response' Status.iMUsed --------- -- | 300 -multipleChoices :: forall e. Body.Body -> ResponseM e +multipleChoices :: Body.Body -> ResponseM multipleChoices = multipleChoices' Headers.empty -- | 300 with headers -multipleChoices' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +multipleChoices' :: Headers.Headers -> Body.Body -> ResponseM multipleChoices' = response' Status.multipleChoices -- | 301 -movedPermanently :: forall e. Body.Body -> ResponseM e +movedPermanently :: Body.Body -> ResponseM movedPermanently = movedPermanently' Headers.empty -- | 301 with headers -movedPermanently' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +movedPermanently' :: Headers.Headers -> Body.Body -> ResponseM movedPermanently' = response' Status.movedPermanently -- | 302 -found :: forall e. Body.Body -> ResponseM e +found :: Body.Body -> ResponseM found = found' Headers.empty -- | 302 with headers -found' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +found' :: Headers.Headers -> Body.Body -> ResponseM found' = response' Status.found -- | 303 -seeOther :: forall e. Body.Body -> ResponseM e +seeOther :: Body.Body -> ResponseM seeOther = seeOther' Headers.empty -- | 303 with headers -seeOther' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +seeOther' :: Headers.Headers -> Body.Body -> ResponseM seeOther' = response' Status.seeOther -- | 304 -notModified :: forall e. ResponseM e +notModified :: ResponseM notModified = notModified' Headers.empty -- | 304 with headers -notModified' :: forall e. Headers.Headers -> ResponseM e +notModified' :: Headers.Headers -> ResponseM notModified' = emptyResponse' Status.notModified -- | 305 -useProxy :: forall e. Body.Body -> ResponseM e +useProxy :: Body.Body -> ResponseM useProxy = useProxy' Headers.empty -- | 305 with headers -useProxy' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +useProxy' :: Headers.Headers -> Body.Body -> ResponseM useProxy' = response' Status.useProxy -- | 307 -temporaryRedirect :: forall e. Body.Body -> ResponseM e +temporaryRedirect :: Body.Body -> ResponseM temporaryRedirect = temporaryRedirect' Headers.empty -- | 307 with headers -temporaryRedirect' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +temporaryRedirect' :: Headers.Headers -> Body.Body -> ResponseM temporaryRedirect' = response' Status.temporaryRedirect -- | 308 -permanentRedirect :: forall e. Body.Body -> ResponseM e +permanentRedirect :: Body.Body -> ResponseM permanentRedirect = permanentRedirect' Headers.empty -- | 308 with headers -permanentRedirect' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +permanentRedirect' :: Headers.Headers -> Body.Body -> ResponseM permanentRedirect' = response' Status.permanentRedirect @@ -321,227 +315,227 @@ permanentRedirect' = response' Status.permanentRedirect --------- -- | 400 -badRequest :: forall e. Body.Body -> ResponseM e +badRequest :: Body.Body -> ResponseM badRequest = badRequest' Headers.empty -- | 400 with headers -badRequest' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +badRequest' :: Headers.Headers -> Body.Body -> ResponseM badRequest' = response' Status.badRequest -- | 401 -unauthorized :: forall e. ResponseM e +unauthorized :: ResponseM unauthorized = unauthorized' Headers.empty -- | 401 with headers -unauthorized' :: forall e. Headers.Headers -> ResponseM e +unauthorized' :: Headers.Headers -> ResponseM unauthorized' = emptyResponse' Status.unauthorized -- | 402 -paymentRequired :: forall e. ResponseM e +paymentRequired :: ResponseM paymentRequired = paymentRequired' Headers.empty -- | 402 with headers -paymentRequired' :: forall e. Headers.Headers -> ResponseM e +paymentRequired' :: Headers.Headers -> ResponseM paymentRequired' = emptyResponse' Status.paymentRequired -- | 403 -forbidden :: forall e. ResponseM e +forbidden :: ResponseM forbidden = forbidden' Headers.empty -- | 403 with headers -forbidden' :: forall e. Headers.Headers -> ResponseM e +forbidden' :: Headers.Headers -> ResponseM forbidden' = emptyResponse' Status.forbidden -- | 404 -notFound :: forall e. ResponseM e +notFound :: ResponseM notFound = notFound' Headers.empty -- | 404 with headers -notFound' :: forall e. Headers.Headers -> ResponseM e +notFound' :: Headers.Headers -> ResponseM notFound' = emptyResponse' Status.notFound -- | 405 -methodNotAllowed :: forall e. ResponseM e +methodNotAllowed :: ResponseM methodNotAllowed = methodNotAllowed' Headers.empty -- | 405 with headers -methodNotAllowed' :: forall e. Headers.Headers -> ResponseM e +methodNotAllowed' :: Headers.Headers -> ResponseM methodNotAllowed' = emptyResponse' Status.methodNotAllowed -- | 406 -notAcceptable :: forall e. ResponseM e +notAcceptable :: ResponseM notAcceptable = notAcceptable' Headers.empty -- | 406 with headers -notAcceptable' :: forall e. Headers.Headers -> ResponseM e +notAcceptable' :: Headers.Headers -> ResponseM notAcceptable' = emptyResponse' Status.notAcceptable -- | 407 -proxyAuthenticationRequired :: forall e. ResponseM e +proxyAuthenticationRequired :: ResponseM proxyAuthenticationRequired = proxyAuthenticationRequired' Headers.empty -- | 407 with headers -proxyAuthenticationRequired' :: forall e. Headers.Headers -> ResponseM e +proxyAuthenticationRequired' :: Headers.Headers -> ResponseM proxyAuthenticationRequired' = emptyResponse' Status.proxyAuthenticationRequired -- | 408 -requestTimeout :: forall e. ResponseM e +requestTimeout :: ResponseM requestTimeout = requestTimeout' Headers.empty -- | 408 with headers -requestTimeout' :: forall e. Headers.Headers -> ResponseM e +requestTimeout' :: Headers.Headers -> ResponseM requestTimeout' = emptyResponse' Status.requestTimeout -- | 409 -conflict :: forall e. Body.Body -> ResponseM e +conflict :: Body.Body -> ResponseM conflict = conflict' Headers.empty -- | 409 with headers -conflict' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +conflict' :: Headers.Headers -> Body.Body -> ResponseM conflict' = response' Status.conflict -- | 410 -gone :: forall e. ResponseM e +gone :: ResponseM gone = gone' Headers.empty -- | 410 with headers -gone' :: forall e. Headers.Headers -> ResponseM e +gone' :: Headers.Headers -> ResponseM gone' = emptyResponse' Status.gone -- | 411 -lengthRequired :: forall e. ResponseM e +lengthRequired :: ResponseM lengthRequired = lengthRequired' Headers.empty -- | 411 with headers -lengthRequired' :: forall e. Headers.Headers -> ResponseM e +lengthRequired' :: Headers.Headers -> ResponseM lengthRequired' = emptyResponse' Status.lengthRequired -- | 412 -preconditionFailed :: forall e. ResponseM e +preconditionFailed :: ResponseM preconditionFailed = preconditionFailed' Headers.empty -- | 412 with headers -preconditionFailed' :: forall e. Headers.Headers -> ResponseM e +preconditionFailed' :: Headers.Headers -> ResponseM preconditionFailed' = emptyResponse' Status.preconditionFailed -- | 413 -payloadTooLarge :: forall e. ResponseM e +payloadTooLarge :: ResponseM payloadTooLarge = payloadTooLarge' Headers.empty -- | 413 with headers -payloadTooLarge' :: forall e. Headers.Headers -> ResponseM e +payloadTooLarge' :: Headers.Headers -> ResponseM payloadTooLarge' = emptyResponse' Status.payloadTooLarge -- | 414 -uRITooLong :: forall e. ResponseM e +uRITooLong :: ResponseM uRITooLong = uRITooLong' Headers.empty -- | 414 with headers -uRITooLong' :: forall e. Headers.Headers -> ResponseM e +uRITooLong' :: Headers.Headers -> ResponseM uRITooLong' = emptyResponse' Status.uRITooLong -- | 415 -unsupportedMediaType :: forall e. ResponseM e +unsupportedMediaType :: ResponseM unsupportedMediaType = unsupportedMediaType' Headers.empty -- | 415 with headers -unsupportedMediaType' :: forall e. Headers.Headers -> ResponseM e +unsupportedMediaType' :: Headers.Headers -> ResponseM unsupportedMediaType' = emptyResponse' Status.unsupportedMediaType -- | 416 -rangeNotSatisfiable :: forall e. ResponseM e +rangeNotSatisfiable :: ResponseM rangeNotSatisfiable = rangeNotSatisfiable' Headers.empty -- | 416 with headers -rangeNotSatisfiable' :: forall e. Headers.Headers -> ResponseM e +rangeNotSatisfiable' :: Headers.Headers -> ResponseM rangeNotSatisfiable' = emptyResponse' Status.rangeNotSatisfiable -- | 417 -expectationFailed :: forall e. ResponseM e +expectationFailed :: ResponseM expectationFailed = expectationFailed' Headers.empty -- | 417 with headers -expectationFailed' :: forall e. Headers.Headers -> ResponseM e +expectationFailed' :: Headers.Headers -> ResponseM expectationFailed' = emptyResponse' Status.expectationFailed -- | 418 -imATeapot :: forall e. ResponseM e +imATeapot :: ResponseM imATeapot = imATeapot' Headers.empty -- | 418 with headers -imATeapot' :: forall e. Headers.Headers -> ResponseM e +imATeapot' :: Headers.Headers -> ResponseM imATeapot' = emptyResponse' Status.imATeapot -- | 421 -misdirectedRequest :: forall e. ResponseM e +misdirectedRequest :: ResponseM misdirectedRequest = misdirectedRequest' Headers.empty -- | 421 with headers -misdirectedRequest' :: forall e. Headers.Headers -> ResponseM e +misdirectedRequest' :: Headers.Headers -> ResponseM misdirectedRequest' = emptyResponse' Status.misdirectedRequest -- | 422 -unprocessableEntity :: forall e. ResponseM e +unprocessableEntity :: ResponseM unprocessableEntity = unprocessableEntity' Headers.empty -- | 422 with headers -unprocessableEntity' :: forall e. Headers.Headers -> ResponseM e +unprocessableEntity' :: Headers.Headers -> ResponseM unprocessableEntity' = emptyResponse' Status.unprocessableEntity -- | 423 -locked :: forall e. ResponseM e +locked :: ResponseM locked = locked' Headers.empty -- | 423 with headers -locked' :: forall e. Headers.Headers -> ResponseM e +locked' :: Headers.Headers -> ResponseM locked' = emptyResponse' Status.locked -- | 424 -failedDependency :: forall e. ResponseM e +failedDependency :: ResponseM failedDependency = failedDependency' Headers.empty -- | 424 with headers -failedDependency' :: forall e. Headers.Headers -> ResponseM e +failedDependency' :: Headers.Headers -> ResponseM failedDependency' = emptyResponse' Status.failedDependency -- | 426 -upgradeRequired :: forall e. ResponseM e +upgradeRequired :: ResponseM upgradeRequired = upgradeRequired' Headers.empty -- | 426 with headers -upgradeRequired' :: forall e. Headers.Headers -> ResponseM e +upgradeRequired' :: Headers.Headers -> ResponseM upgradeRequired' = emptyResponse' Status.upgradeRequired -- | 428 -preconditionRequired :: forall e. ResponseM e +preconditionRequired :: ResponseM preconditionRequired = preconditionRequired' Headers.empty -- | 428 with headers -preconditionRequired' :: forall e. Headers.Headers -> ResponseM e +preconditionRequired' :: Headers.Headers -> ResponseM preconditionRequired' = emptyResponse' Status.preconditionRequired -- | 429 -tooManyRequests :: forall e. ResponseM e +tooManyRequests :: ResponseM tooManyRequests = tooManyRequests' Headers.empty -- | 429 with headers -tooManyRequests' :: forall e. Headers.Headers -> ResponseM e +tooManyRequests' :: Headers.Headers -> ResponseM tooManyRequests' = emptyResponse' Status.tooManyRequests -- | 431 -requestHeaderFieldsTooLarge :: forall e. ResponseM e +requestHeaderFieldsTooLarge :: ResponseM requestHeaderFieldsTooLarge = requestHeaderFieldsTooLarge' Headers.empty -- | 431 with headers -requestHeaderFieldsTooLarge' :: forall e. Headers.Headers -> ResponseM e +requestHeaderFieldsTooLarge' :: Headers.Headers -> ResponseM requestHeaderFieldsTooLarge' = emptyResponse' Status.requestHeaderFieldsTooLarge -- | 451 -unavailableForLegalReasons :: forall e. ResponseM e +unavailableForLegalReasons :: ResponseM unavailableForLegalReasons = unavailableForLegalReasons' Headers.empty -- | 451 with headers -unavailableForLegalReasons' :: forall e. Headers.Headers -> ResponseM e +unavailableForLegalReasons' :: Headers.Headers -> ResponseM unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons --------- @@ -549,90 +543,90 @@ unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons --------- -- | 500 -internalServerError :: forall e. Body.Body -> ResponseM e +internalServerError :: Body.Body -> ResponseM internalServerError = internalServerError' Headers.empty -- | 500 with headers -internalServerError' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +internalServerError' :: Headers.Headers -> Body.Body -> ResponseM internalServerError' = response' Status.internalServerError -- | 501 -notImplemented :: forall e. ResponseM e +notImplemented :: ResponseM notImplemented = notImplemented' Headers.empty -- | 501 with headers -notImplemented' :: forall e. Headers.Headers -> ResponseM e +notImplemented' :: Headers.Headers -> ResponseM notImplemented' = emptyResponse' Status.notImplemented -- | 502 -badGateway :: forall e. ResponseM e +badGateway :: ResponseM badGateway = badGateway' Headers.empty -- | 502 with headers -badGateway' :: forall e. Headers.Headers -> ResponseM e +badGateway' :: Headers.Headers -> ResponseM badGateway' = emptyResponse' Status.badGateway -- | 503 -serviceUnavailable :: forall e. ResponseM e +serviceUnavailable :: ResponseM serviceUnavailable = serviceUnavailable' Headers.empty -- | 503 with headers -serviceUnavailable' :: forall e. Headers.Headers -> ResponseM e +serviceUnavailable' :: Headers.Headers -> ResponseM serviceUnavailable' = emptyResponse' Status.serviceUnavailable -- | 504 -gatewayTimeout :: forall e. ResponseM e +gatewayTimeout :: ResponseM gatewayTimeout = gatewayTimeout' Headers.empty -- | 504 with headers -gatewayTimeout' :: forall e. Headers.Headers -> ResponseM e +gatewayTimeout' :: Headers.Headers -> ResponseM gatewayTimeout' = emptyResponse' Status.gatewayTimeout -- | 505 -hTTPVersionNotSupported :: forall e. ResponseM e +hTTPVersionNotSupported :: ResponseM hTTPVersionNotSupported = hTTPVersionNotSupported' Headers.empty -- | 505 with headers -hTTPVersionNotSupported' :: forall e. Headers.Headers -> ResponseM e +hTTPVersionNotSupported' :: Headers.Headers -> ResponseM hTTPVersionNotSupported' = emptyResponse' Status.hTTPVersionNotSupported -- | 506 -variantAlsoNegotiates :: forall e. ResponseM e +variantAlsoNegotiates :: ResponseM variantAlsoNegotiates = variantAlsoNegotiates' Headers.empty -- | 506 with headers -variantAlsoNegotiates' :: forall e. Headers.Headers -> ResponseM e +variantAlsoNegotiates' :: Headers.Headers -> ResponseM variantAlsoNegotiates' = emptyResponse' Status.variantAlsoNegotiates -- | 507 -insufficientStorage :: forall e. ResponseM e +insufficientStorage :: ResponseM insufficientStorage = insufficientStorage' Headers.empty -- | 507 with headers -insufficientStorage' :: forall e. Headers.Headers -> ResponseM e +insufficientStorage' :: Headers.Headers -> ResponseM insufficientStorage' = emptyResponse' Status.insufficientStorage -- | 508 -loopDetected :: forall e. ResponseM e +loopDetected :: ResponseM loopDetected = loopDetected' Headers.empty -- | 508 with headers -loopDetected' :: forall e. Headers.Headers -> ResponseM e +loopDetected' :: Headers.Headers -> ResponseM loopDetected' = emptyResponse' Status.loopDetected -- | 510 -notExtended :: forall e. ResponseM e +notExtended :: ResponseM notExtended = notExtended' Headers.empty -- | 510 with headers -notExtended' :: forall e. Headers.Headers -> ResponseM e +notExtended' :: Headers.Headers -> ResponseM notExtended' = emptyResponse' Status.notExtended -- | 511 -networkAuthenticationRequired :: forall e. ResponseM e +networkAuthenticationRequired :: ResponseM networkAuthenticationRequired = networkAuthenticationRequired' Headers.empty -- | 511 with headers -networkAuthenticationRequired' :: forall e. Headers.Headers -> ResponseM e +networkAuthenticationRequired' :: Headers.Headers -> ResponseM networkAuthenticationRequired' = emptyResponse' Status.networkAuthenticationRequired diff --git a/src/HTTPure/Server.purs b/src/HTTPure/Server.purs index ed94227..a75334e 100644 --- a/src/HTTPure/Server.purs +++ b/src/HTTPure/Server.purs @@ -1,6 +1,5 @@ module HTTPure.Server ( ServerM - , SecureServerM , serve , serve' , serveSecure @@ -9,66 +8,57 @@ module HTTPure.Server import Prelude -import Control.Monad.Aff as Aff -import Control.Monad.Eff as Eff -import Control.Monad.Eff.Class as EffClass +import Effect as Effect +import Effect.Aff as Aff +import Effect.Class as EffectClass import Data.Maybe as Maybe import Data.Options ((:=), Options) import Node.Encoding as Encoding -import Node.FS as FS import Node.FS.Sync as FSSync import Node.HTTP as HTTP import Node.HTTP.Secure as HTTPS -import HTTPure.HTTPureEffects as HTTPureEffects import HTTPure.Request as Request import HTTPure.Response as Response -- | The `ServerM` type simply conveniently wraps up an HTTPure monad that -- | returns a `Unit`. This type is the return type of the HTTPure serve and -- | related methods. -type ServerM e = Eff.Eff (HTTPureEffects.HTTPureEffects e) Unit - --- | The `SecureServerM` type is the same as the `ServerM` type, but it includes --- | effects for working with the filesystem (to load the key and certificate). -type SecureServerM e = ServerM (fs :: FS.FS | e) +type ServerM = Effect.Effect Unit -- | This function takes a method which takes a `Request` and returns a -- | `ResponseM`, an HTTP `Request`, and an HTTP `Response`. It runs the -- | request, extracts the `Response` from the `ResponseM`, and sends the -- | `Response` to the HTTP `Response`. -handleRequest :: forall e. - (Request.Request -> Response.ResponseM e) -> +handleRequest :: (Request.Request -> Response.ResponseM) -> HTTP.Request -> HTTP.Response -> - ServerM e + ServerM handleRequest router request response = void $ Aff.runAff (\_ -> pure unit) do req <- Request.fromHTTPRequest request - router req >>= Response.send response >>> EffClass.liftEff + router req >>= Response.send response >>> EffectClass.liftEffect -- | Given a `ListenOptions` object, a function mapping `Request` to -- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and -- | runs a HTTPure server without SSL. -serve' :: forall e. - HTTP.ListenOptions -> - (Request.Request -> Response.ResponseM e) -> - ServerM e -> - ServerM e +serve' :: HTTP.ListenOptions -> + (Request.Request -> Response.ResponseM) -> + ServerM -> + ServerM serve' options router onStarted = HTTP.createServer (handleRequest router) >>= \server -> HTTP.listen server options onStarted -- | Given a `Options HTTPS.SSLOptions` object and a `HTTP.ListenOptions` --- | object, a function mapping `Request` to `ResponseM`, and a `SecureServerM` +-- | object, a function mapping `Request` to `ResponseM`, and a `ServerM` -- | containing effects to run on boot, creates and runs a HTTPure server with -- | SSL. -serveSecure' :: forall e. - Options HTTPS.SSLOptions -> +serveSecure' :: Options HTTPS.SSLOptions -> HTTP.ListenOptions -> - (Request.Request -> Response.ResponseM (fs :: FS.FS | e)) -> - SecureServerM e -> - SecureServerM e + (Request.Request -> Response.ResponseM) -> + ServerM -> + ServerM serveSecure' sslOptions options router onStarted = HTTPS.createServer sslOptions (handleRequest router) >>= \server -> HTTP.listen server options onStarted @@ -86,11 +76,10 @@ listenOptions port = -- | `ResponseM`, and a `ServerM` containing effects to run after the server has -- | booted (usually logging). Returns an `ServerM` containing the server's -- | effects. -serve :: forall e. - Int -> - (Request.Request -> Response.ResponseM e) -> - ServerM e -> - ServerM e +serve :: Int -> + (Request.Request -> Response.ResponseM) -> + ServerM -> + ServerM serve = serve' <<< listenOptions -- | Create and start an SSL server. This method is the same as `serve`, but @@ -100,13 +89,12 @@ serve = serve' <<< listenOptions -- | 3. A path to a private key file -- | 4. A handler method which maps `Request` to `ResponseM` -- | 5. A callback to call when the server is up -serveSecure :: forall e. - Int -> +serveSecure :: Int -> String -> String -> - (Request.Request -> Response.ResponseM (fs :: FS.FS | e)) -> - SecureServerM e -> - SecureServerM e + (Request.Request -> Response.ResponseM) -> + ServerM -> + ServerM serveSecure port cert key router onStarted = do cert' <- FSSync.readTextFile Encoding.UTF8 cert key' <- FSSync.readTextFile Encoding.UTF8 key diff --git a/src/HTTPure/Status.purs b/src/HTTPure/Status.purs index 40dac73..ec11fdc 100644 --- a/src/HTTPure/Status.purs +++ b/src/HTTPure/Status.purs @@ -75,17 +75,14 @@ module HTTPure.Status import Prelude -import Control.Monad.Eff as Eff +import Effect as Effect import Node.HTTP as HTTP -- | The `Status` type enumerates all valid HTTP response status codes. type Status = Int -- | Write a status to a given HTTP `Response`. -write :: forall e. - HTTP.Response -> - Status -> - Eff.Eff (http :: HTTP.HTTP | e) Unit +write :: HTTP.Response -> Status -> Effect.Effect Unit write = HTTP.setStatusCode --------- diff --git a/test/Test/HTTPure/BodySpec.purs b/test/Test/HTTPure/BodySpec.purs index 95c36e7..3d8d633 100644 --- a/test/Test/HTTPure/BodySpec.purs +++ b/test/Test/HTTPure/BodySpec.purs @@ -2,7 +2,7 @@ module Test.HTTPure.BodySpec where import Prelude -import Control.Monad.Eff.Class as EffClass +import Effect.Class as EffectClass import Test.Spec as Spec import HTTPure.Body as Body @@ -20,7 +20,7 @@ readSpec = Spec.describe "read" do writeSpec :: TestHelpers.Test writeSpec = Spec.describe "write" do Spec.it "writes the string to the Response body" do - body <- EffClass.liftEff do + body <- EffectClass.liftEffect do resp <- TestHelpers.mockResponse Body.write resp "test" pure $ TestHelpers.getResponseBody resp diff --git a/test/Test/HTTPure/HeadersSpec.purs b/test/Test/HTTPure/HeadersSpec.purs index 8405620..5cc9b69 100644 --- a/test/Test/HTTPure/HeadersSpec.purs +++ b/test/Test/HTTPure/HeadersSpec.purs @@ -2,7 +2,7 @@ module Test.HTTPure.HeadersSpec where import Prelude -import Control.Monad.Eff.Class as EffClass +import Effect.Class as EffectClass import Data.Maybe as Maybe import Data.Tuple as Tuple import Test.Spec as Spec @@ -69,11 +69,11 @@ appendSpec = Spec.describe "append" do readSpec :: TestHelpers.Test readSpec = Spec.describe "read" do Spec.describe "with no headers" do - Spec.it "is an empty StrMap" do + Spec.it "is an empty Map" do request <- TestHelpers.mockRequest "" "" "" [] Headers.read request ?= Headers.empty Spec.describe "with headers" do - Spec.it "is an StrMap with the contents of the headers" do + Spec.it "is a Map with the contents of the headers" do let testHeader = [Tuple.Tuple "X-Test" "test"] request <- TestHelpers.mockRequest "" "" "" testHeader Headers.read request ?= Headers.headers testHeader @@ -81,7 +81,7 @@ readSpec = Spec.describe "read" do writeSpec :: TestHelpers.Test writeSpec = Spec.describe "write" do Spec.it "writes the headers to the response" do - header <- EffClass.liftEff do + header <- EffectClass.liftEffect do mock <- TestHelpers.mockResponse Headers.write mock $ Headers.header "X-Test" "test" pure $ TestHelpers.getResponseHeader "X-Test" mock @@ -89,7 +89,7 @@ writeSpec = Spec.describe "write" do emptySpec :: TestHelpers.Test emptySpec = Spec.describe "empty" do - Spec.it "is a empty StrMap in an empty Headers" do + Spec.it "is an empty Map in an empty Headers" do show Headers.empty ?= "\n" headerSpec :: TestHelpers.Test diff --git a/test/Test/HTTPure/IntegrationSpec.purs b/test/Test/HTTPure/IntegrationSpec.purs index 8dfd084..8d9c152 100644 --- a/test/Test/HTTPure/IntegrationSpec.purs +++ b/test/Test/HTTPure/IntegrationSpec.purs @@ -2,8 +2,8 @@ module Test.HTTPure.IntegrationSpec where import Prelude -import Control.Monad.Eff.Class as EffClass -import Data.StrMap as StrMap +import Effect.Class as EffectClass +import Foreign.Object as Object import Test.Spec as Spec import Test.HTTPure.TestHelpers as TestHelpers @@ -21,82 +21,82 @@ import Examples.SSL.Main as SSL asyncResponseSpec :: TestHelpers.Test asyncResponseSpec = Spec.it "runs the async response example" do - EffClass.liftEff AsyncResponse.main - response <- TestHelpers.get port StrMap.empty "/" + EffectClass.liftEffect AsyncResponse.main + response <- TestHelpers.get port Object.empty "/" response ?= "hello world!" where port = AsyncResponse.port headersSpec :: TestHelpers.Test headersSpec = Spec.it "runs the headers example" do - EffClass.liftEff Headers.main - header <- TestHelpers.getHeader port StrMap.empty "/" "X-Example" + EffectClass.liftEffect Headers.main + header <- TestHelpers.getHeader port Object.empty "/" "X-Example" header ?= "hello world!" - response <- TestHelpers.get port (StrMap.singleton "X-Input" "test") "/" + response <- TestHelpers.get port (Object.singleton "X-Input" "test") "/" response ?= "test" where port = Headers.port helloWorldSpec :: TestHelpers.Test helloWorldSpec = Spec.it "runs the hello world example" do - EffClass.liftEff HelloWorld.main - response <- TestHelpers.get port StrMap.empty "/" + EffectClass.liftEffect HelloWorld.main + response <- TestHelpers.get port Object.empty "/" response ?= "hello world!" where port = HelloWorld.port middlewareSpec :: TestHelpers.Test middlewareSpec = Spec.it "runs the middleware example" do - EffClass.liftEff Middleware.main - header <- TestHelpers.getHeader port StrMap.empty "/" "X-Middleware" + EffectClass.liftEffect Middleware.main + header <- TestHelpers.getHeader port Object.empty "/" "X-Middleware" header ?= "router" - body <- TestHelpers.get port StrMap.empty "/" + body <- TestHelpers.get port Object.empty "/" body ?= "hello" - header' <- TestHelpers.getHeader port StrMap.empty "/middleware" "X-Middleware" + header' <- TestHelpers.getHeader port Object.empty "/middleware" "X-Middleware" header' ?= "middleware" - body' <- TestHelpers.get port StrMap.empty "/middleware" + body' <- TestHelpers.get port Object.empty "/middleware" body' ?= "Middleware!" where port = Middleware.port multiRouteSpec :: TestHelpers.Test multiRouteSpec = Spec.it "runs the multi route example" do - EffClass.liftEff MultiRoute.main - hello <- TestHelpers.get port StrMap.empty "/hello" + EffectClass.liftEffect MultiRoute.main + hello <- TestHelpers.get port Object.empty "/hello" hello ?= "hello" - goodbye <- TestHelpers.get port StrMap.empty "/goodbye" + goodbye <- TestHelpers.get port Object.empty "/goodbye" goodbye ?= "goodbye" where port = MultiRoute.port pathSegmentsSpec :: TestHelpers.Test pathSegmentsSpec = Spec.it "runs the path segments example" do - EffClass.liftEff PathSegments.main - foo <- TestHelpers.get port StrMap.empty "/segment/foo" + EffectClass.liftEffect PathSegments.main + foo <- TestHelpers.get port Object.empty "/segment/foo" foo ?= "foo" - somebars <- TestHelpers.get port StrMap.empty "/some/bars" + somebars <- TestHelpers.get port Object.empty "/some/bars" somebars ?= "[\"some\",\"bars\"]" where port = PathSegments.port queryParametersSpec :: TestHelpers.Test queryParametersSpec = Spec.it "runs the query parameters example" do - EffClass.liftEff QueryParameters.main - foo <- TestHelpers.get port StrMap.empty "/?foo" + EffectClass.liftEffect QueryParameters.main + foo <- TestHelpers.get port Object.empty "/?foo" foo ?= "foo" - bar <- TestHelpers.get port StrMap.empty "/?bar=test" + bar <- TestHelpers.get port Object.empty "/?bar=test" bar ?= "bar" - notbar <- TestHelpers.get port StrMap.empty "/?bar=nottest" + notbar <- TestHelpers.get port Object.empty "/?bar=nottest" notbar ?= "" - baz <- TestHelpers.get port StrMap.empty "/?baz=test" + baz <- TestHelpers.get port Object.empty "/?baz=test" baz ?= "test" where port = QueryParameters.port postSpec :: TestHelpers.Test postSpec = Spec.it "runs the post example" do - EffClass.liftEff Post.main - response <- TestHelpers.post port StrMap.empty "/" "test" + EffectClass.liftEffect Post.main + response <- TestHelpers.post port Object.empty "/" "test" response ?= "test" where port = Post.port sslSpec :: TestHelpers.Test sslSpec = Spec.it "runs the ssl example" do - EffClass.liftEff SSL.main - response <- TestHelpers.get' port StrMap.empty "/" + EffectClass.liftEffect SSL.main + response <- TestHelpers.get' port Object.empty "/" response ?= "hello world!" where port = SSL.port diff --git a/test/Test/HTTPure/LookupSpec.purs b/test/Test/HTTPure/LookupSpec.purs index 8e70d22..1cdb157 100644 --- a/test/Test/HTTPure/LookupSpec.purs +++ b/test/Test/HTTPure/LookupSpec.purs @@ -3,7 +3,7 @@ module Test.HTTPure.LookupSpec where import Prelude import Data.Maybe as Maybe -import Data.StrMap as StrMap +import Foreign.Object as Object import Test.Spec as Spec @@ -39,20 +39,20 @@ lookupArraySpec = Spec.describe "lookupArray" do Spec.it "is Nothing" do (([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing -lookupStrMapSpec :: TestHelpers.Test -lookupStrMapSpec = Spec.describe "lookupStrMap" do - Spec.describe "when the key is in the StrMap" do +lookupMapSpec :: TestHelpers.Test +lookupMapSpec = Spec.describe "lookupMap" do + Spec.describe "when the key is in the Map" do Spec.it "is Just the value at the given key" do - mockStrMap !! "foo" ?= Maybe.Just "bar" - Spec.describe "when the key is not in the StrMap" do + mockMap !! "foo" ?= Maybe.Just "bar" + Spec.describe "when the key is not in the Map" do Spec.it "is Nothing" do - ((mockStrMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing + ((mockMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing where - mockStrMap = StrMap.singleton "foo" "bar" + mockMap = Object.singleton "foo" "bar" lookupSpec :: TestHelpers.Test lookupSpec = Spec.describe "Lookup" do atSpec hasSpec lookupArraySpec - lookupStrMapSpec + lookupMapSpec diff --git a/test/Test/HTTPure/QuerySpec.purs b/test/Test/HTTPure/QuerySpec.purs index fc7a507..830f71a 100644 --- a/test/Test/HTTPure/QuerySpec.purs +++ b/test/Test/HTTPure/QuerySpec.purs @@ -2,8 +2,8 @@ module Test.HTTPure.QuerySpec where import Prelude -import Data.StrMap as StrMap import Data.Tuple as Tuple +import Foreign.Object as Object import Test.Spec as Spec import HTTPure.Query as Query @@ -14,36 +14,36 @@ import Test.HTTPure.TestHelpers ((?=)) readSpec :: TestHelpers.Test readSpec = Spec.describe "read" do Spec.describe "with no query string" do - Spec.it "is an empty StrMap" do + Spec.it "is an empty Map" do req <- TestHelpers.mockRequest "" "/test" "" [] - Query.read req ?= StrMap.empty + Query.read req ?= Object.empty Spec.describe "with an empty query string" do - Spec.it "is an empty StrMap" do + Spec.it "is an empty Map" do req <- TestHelpers.mockRequest "" "/test?" "" [] - Query.read req ?= StrMap.empty + Query.read req ?= Object.empty Spec.describe "with a query parameter in the query string" do - Spec.it "is a correct StrMap" do + Spec.it "is a correct Map" do req <- TestHelpers.mockRequest "" "/test?a=b" "" [] - Query.read req ?= StrMap.singleton "a" "b" + Query.read req ?= Object.singleton "a" "b" Spec.describe "with empty fields in the query string" do Spec.it "ignores the empty fields" do req <- TestHelpers.mockRequest "" "/test?&&a=b&&" "" [] - Query.read req ?= StrMap.singleton "a" "b" + Query.read req ?= Object.singleton "a" "b" Spec.describe "with duplicated params" do Spec.it "takes the last param value" do req <- TestHelpers.mockRequest "" "/test?a=b&a=c" "" [] - Query.read req ?= StrMap.singleton "a" "c" + Query.read req ?= Object.singleton "a" "c" Spec.describe "with empty params" do Spec.it "uses 'true' as the value" do req <- TestHelpers.mockRequest "" "/test?a" "" [] - Query.read req ?= StrMap.singleton "a" "true" + Query.read req ?= Object.singleton "a" "true" Spec.describe "with complex params" do - Spec.it "is the correct StrMap" do + Spec.it "is the correct Map" do req <- TestHelpers.mockRequest "" "/test?&&a&b=c&b=d&&&e=f&g=&" "" [] Query.read req ?= expectedComplexResult where expectedComplexResult = - StrMap.fromFoldable + Object.fromFoldable [ Tuple.Tuple "a" "true" , Tuple.Tuple "b" "d" , Tuple.Tuple "e" "f" diff --git a/test/Test/HTTPure/RequestSpec.purs b/test/Test/HTTPure/RequestSpec.purs index 44e8fd8..9d19d8f 100644 --- a/test/Test/HTTPure/RequestSpec.purs +++ b/test/Test/HTTPure/RequestSpec.purs @@ -3,7 +3,7 @@ module Test.HTTPure.RequestSpec where import Prelude import Data.Tuple as Tuple -import Data.StrMap as StrMap +import Foreign.Object as Object import Test.Spec as Spec import HTTPure.Headers as Headers @@ -23,7 +23,7 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do mock.path ?= [ "test" ] Spec.it "contains the correct query" do mock <- mockRequest - mock.query ?= StrMap.singleton "a" "b" + mock.query ?= Object.singleton "a" "b" Spec.it "contains the correct headers" do mock <- mockRequest mock.headers ?= Headers.headers mockHeaders diff --git a/test/Test/HTTPure/ResponseSpec.purs b/test/Test/HTTPure/ResponseSpec.purs index e6ec551..29ba0aa 100644 --- a/test/Test/HTTPure/ResponseSpec.purs +++ b/test/Test/HTTPure/ResponseSpec.purs @@ -2,7 +2,7 @@ module Test.HTTPure.ResponseSpec where import Prelude -import Control.Monad.Eff.Class as EffClass +import Effect.Class as EffectClass import Test.Spec as Spec import HTTPure.Headers as Headers @@ -14,19 +14,19 @@ import Test.HTTPure.TestHelpers ((?=)) sendSpec :: TestHelpers.Test sendSpec = Spec.describe "send" do Spec.it "writes the headers" do - header <- EffClass.liftEff do + header <- EffectClass.liftEffect do httpResponse <- TestHelpers.mockResponse Response.send httpResponse mockResponse pure $ TestHelpers.getResponseHeader "Test" httpResponse header ?= "test" Spec.it "writes the status" do - status <- EffClass.liftEff do + status <- EffectClass.liftEffect do httpResponse <- TestHelpers.mockResponse Response.send httpResponse mockResponse pure $ TestHelpers.getResponseStatus httpResponse status ?= 123 Spec.it "writes the body" do - body <- EffClass.liftEff do + body <- EffectClass.liftEffect do httpResponse <- TestHelpers.mockResponse Response.send httpResponse mockResponse pure $ TestHelpers.getResponseBody httpResponse diff --git a/test/Test/HTTPure/ServerSpec.purs b/test/Test/HTTPure/ServerSpec.purs index 269cdf0..26b95d5 100644 --- a/test/Test/HTTPure/ServerSpec.purs +++ b/test/Test/HTTPure/ServerSpec.purs @@ -2,11 +2,11 @@ module Test.HTTPure.ServerSpec where import Prelude -import Control.Monad.Eff.Class as EffClass +import Effect.Class as EffectClass import Data.Maybe as Maybe import Data.Options ((:=)) import Data.String as String -import Data.StrMap as StrMap +import Foreign.Object as Object import Node.Encoding as Encoding import Node.HTTP.Secure as HTTPS import Node.FS.Sync as FSSync @@ -20,21 +20,21 @@ import HTTPure.Server as Server import Test.HTTPure.TestHelpers as TestHelpers import Test.HTTPure.TestHelpers ((?=)) -mockRouter :: forall e. Request.Request -> Response.ResponseM e +mockRouter :: Request.Request -> Response.ResponseM mockRouter { path } = Response.ok $ "/" <> String.joinWith "/" path serveSpec :: TestHelpers.Test serveSpec = Spec.describe "serve" do Spec.it "boots a server on the given port" do - EffClass.liftEff $ Server.serve 7901 mockRouter $ pure unit - out <- TestHelpers.get 7901 StrMap.empty "/test" + EffectClass.liftEffect $ Server.serve 7901 mockRouter $ pure unit + out <- TestHelpers.get 7901 Object.empty "/test" out ?= "/test" serve'Spec :: TestHelpers.Test serve'Spec = Spec.describe "serve'" do Spec.it "boots a server with the given options" do - EffClass.liftEff $ Server.serve' options mockRouter $ pure unit - out <- TestHelpers.get 7902 StrMap.empty "/test" + EffectClass.liftEffect $ Server.serve' options mockRouter $ pure unit + out <- TestHelpers.get 7902 Object.empty "/test" out ?= "/test" where options = { hostname: "localhost", port: 7902, backlog: Maybe.Nothing } @@ -43,13 +43,13 @@ serveSecureSpec :: TestHelpers.Test serveSecureSpec = Spec.describe "serveSecure" do Spec.describe "with valid key and cert files" do Spec.it "boots a server on the given port" do - EffClass.liftEff $ Server.serveSecure 7903 cert key mockRouter $ pure unit - out <- TestHelpers.get' 7903 StrMap.empty "/test" + EffectClass.liftEffect $ Server.serveSecure 7903 cert key mockRouter $ pure unit + out <- TestHelpers.get' 7903 Object.empty "/test" out ?= "/test" Spec.describe "with invalid key and cert files" do Spec.it "throws" do AffAssertions.expectError do - EffClass.liftEff $ Server.serveSecure 7904 "" "" mockRouter $ pure unit + EffectClass.liftEffect $ Server.serveSecure 7904 "" "" mockRouter $ pure unit where cert = "./test/Mocks/Certificate.cer" key = "./test/Mocks/Key.key" @@ -58,10 +58,10 @@ serveSecure'Spec :: TestHelpers.Test serveSecure'Spec = Spec.describe "serveSecure'" do Spec.describe "with valid key and cert files" do Spec.it "boots a server on the given port" do - sslOpts <- EffClass.liftEff $ sslOptions - EffClass.liftEff $ + sslOpts <- EffectClass.liftEffect $ sslOptions + EffectClass.liftEffect $ Server.serveSecure' sslOpts (options 7905) mockRouter $ pure unit - out <- TestHelpers.get' 7905 StrMap.empty "/test" + out <- TestHelpers.get' 7905 Object.empty "/test" out ?= "/test" where options port = { hostname: "localhost", port, backlog: Maybe.Nothing } diff --git a/test/Test/HTTPure/StatusSpec.purs b/test/Test/HTTPure/StatusSpec.purs index 207aa9d..7a097ca 100644 --- a/test/Test/HTTPure/StatusSpec.purs +++ b/test/Test/HTTPure/StatusSpec.purs @@ -2,7 +2,7 @@ module Test.HTTPure.StatusSpec where import Prelude -import Control.Monad.Eff.Class as EffClass +import Effect.Class as EffectClass import Test.Spec as Spec import HTTPure.Status as Status @@ -13,7 +13,7 @@ import Test.HTTPure.TestHelpers ((?=)) writeSpec :: TestHelpers.Test writeSpec = Spec.describe "write" do Spec.it "writes the given status code" do - status <- EffClass.liftEff do + status <- EffectClass.liftEffect do mock <- TestHelpers.mockResponse Status.write mock 123 pure $ TestHelpers.getResponseStatus mock diff --git a/test/Test/HTTPure/TestHelpers.purs b/test/Test/HTTPure/TestHelpers.purs index 4b2b6d7..ba83911 100644 --- a/test/Test/HTTPure/TestHelpers.purs +++ b/test/Test/HTTPure/TestHelpers.purs @@ -2,63 +2,41 @@ module Test.HTTPure.TestHelpers where import Prelude -import Control.Monad.Aff as Aff -import Control.Monad.Eff as Eff -import Control.Monad.Eff.Class as EffClass -import Control.Monad.Eff.Exception as Exception -import Control.Monad.ST as ST +import Effect as Effect +import Effect.Aff as Aff +import Effect.Class as EffectClass +import Effect.Ref as Ref import Data.Either as Either import Data.Maybe as Maybe import Data.Options ((:=)) import Data.String as StringUtil -import Data.StrMap as StrMap import Data.Tuple as Tuple +import Foreign.Object as Object import Node.Encoding as Encoding -import Node.FS as FS import Node.HTTP as HTTP import Node.HTTP.Client as HTTPClient import Node.Stream as Stream import Test.Spec as Spec -import Test.Spec.Runner as Runner import Test.Spec.Assertions as Assertions import Unsafe.Coerce as Coerce infix 1 Assertions.shouldEqual as ?= --- | A type alias encapsulating all effect types used in making a mock request. -type HTTPRequestEffects e = - ( st :: ST.ST String - , exception :: Exception.EXCEPTION - , http :: HTTP.HTTP - | e - ) - --- | A type alias encapsulating all effect types used in tests. -type TestEffects = - Runner.RunnerEffects ( - HTTPRequestEffects - ( mockResponse :: MOCK_RESPONSE - , mockRequest :: MOCK_REQUEST - , fs :: FS.FS - ) - ) - -- | The type for integration tests. -type Test = Spec.Spec TestEffects Unit +type Test = Spec.Spec Unit -- | The type for the entire test suite. -type TestSuite = Eff.Eff TestEffects Unit +type TestSuite = Effect.Effect Unit -- | Given a URL, a failure handler, and a success handler, create an HTTP -- | client request. -request :: forall e. - Boolean -> +request :: Boolean -> Int -> String -> - StrMap.StrMap String -> + Object.Object String -> String -> String -> - Aff.Aff (http :: HTTP.HTTP | e) HTTPClient.Response + Aff.Aff HTTPClient.Response request secure port method headers path body = Aff.makeAff \done -> do req <- HTTPClient.request options $ Either.Right >>> done let stream = HTTPClient.requestAsStream req @@ -77,46 +55,41 @@ request secure port method headers path body = Aff.makeAff \done -> do -- | Given an ST String buffer and a new string, concatenate that new string -- | onto the ST buffer. -concat :: forall e s. - ST.STRef s String -> String -> Eff.Eff (st :: ST.ST s | e) Unit -concat buf new = void $ ST.modifySTRef buf ((<>) new) +concat :: Ref.Ref String -> String -> Effect.Effect Unit +concat buf new = void $ Ref.modify ((<>) new) buf -- | Convert a request to an Aff containing the string with the response body. -toString :: forall e. - HTTPClient.Response -> Aff.Aff (HTTPRequestEffects e) String +toString :: HTTPClient.Response -> Aff.Aff String toString response = Aff.makeAff \done -> do let stream = HTTPClient.responseAsStream response - buf <- ST.newSTRef "" + buf <- Ref.new "" Stream.onDataString stream Encoding.UTF8 $ concat buf - Stream.onEnd stream $ ST.readSTRef buf >>= Either.Right >>> done + Stream.onEnd stream $ Ref.read buf >>= Either.Right >>> done pure $ Aff.nonCanceler -- | Run an HTTP GET with the given url and return an Aff that contains the -- | string with the response body. -get :: forall e. - Int -> - StrMap.StrMap String -> +get :: Int -> + Object.Object String -> String -> - Aff.Aff (HTTPRequestEffects e) String + Aff.Aff String get port headers path = request false port "GET" headers path "" >>= toString -- | Run an HTTPS GET with the given url and return an Aff that contains the -- | string with the response body. -get' :: forall e. - Int -> - StrMap.StrMap String -> +get' :: Int -> + Object.Object String -> String -> - Aff.Aff (HTTPRequestEffects e) String + Aff.Aff String get' port headers path = request true port "GET" headers path "" >>= toString -- | Run an HTTP POST with the given url and body and return an Aff that -- | contains the string with the response body. -post :: forall e. - Int -> - StrMap.StrMap String -> +post :: Int -> + Object.Object String -> String -> String -> - Aff.Aff (HTTPRequestEffects e) String + Aff.Aff String post port headers path = request false port "POST" headers path >=> toString -- | Convert a request to an Aff containing the string with the given header @@ -125,47 +98,38 @@ extractHeader :: String -> HTTPClient.Response -> String extractHeader header = unmaybe <<< lookup <<< HTTPClient.responseHeaders where unmaybe = Maybe.fromMaybe "" - lookup = StrMap.lookup $ StringUtil.toLower header + lookup = Object.lookup $ StringUtil.toLower header -- | Run an HTTP GET with the given url and return an Aff that contains the -- | string with the header value for the given header. -getHeader :: forall e. - Int -> - StrMap.StrMap String -> +getHeader :: Int -> + Object.Object String -> String -> String -> - Aff.Aff (HTTPRequestEffects e) String + Aff.Aff String getHeader port headers path header = extractHeader header <$> request false port "GET" headers path "" --- | An effect encapsulating creating a mock request object -foreign import data MOCK_REQUEST :: Eff.Effect - -- | Mock an HTTP Request object foreign import mockRequestImpl :: - forall e. String -> String -> String -> - StrMap.StrMap String -> - Eff.Eff (mockRequest :: MOCK_REQUEST | e) HTTP.Request + Object.Object String -> + Effect.Effect HTTP.Request -- | Mock an HTTP Request object -mockRequest :: forall e. - String -> +mockRequest :: String -> String -> String -> Array (Tuple.Tuple String String) -> - Aff.Aff (mockRequest :: MOCK_REQUEST | e) HTTP.Request + Aff.Aff HTTP.Request mockRequest method url body = - EffClass.liftEff <<< mockRequestImpl method url body <<< StrMap.fromFoldable - --- | An effect encapsulating creating a mock response object -foreign import data MOCK_RESPONSE :: Eff.Effect + EffectClass.liftEffect <<< mockRequestImpl method url body <<< Object.fromFoldable -- | Mock an HTTP Response object foreign import mockResponse :: - forall e. Eff.Eff (mockResponse :: MOCK_RESPONSE | e) HTTP.Response + Effect.Effect HTTP.Response -- | Get the current body from an HTTP Response object (note this will only work -- | with an object returned from mockResponse). @@ -177,10 +141,10 @@ getResponseStatus :: HTTP.Response -> Int getResponseStatus = _.statusCode <<< Coerce.unsafeCoerce -- | Get all current headers on the HTTP Response object. -getResponseHeaders :: HTTP.Response -> StrMap.StrMap String +getResponseHeaders :: HTTP.Response -> Object.Object String getResponseHeaders = Coerce.unsafeCoerce <<< _.headers <<< Coerce.unsafeCoerce -- | Get the current value for the header on the HTTP Response object. getResponseHeader :: String -> HTTP.Response -> String getResponseHeader header = - Maybe.fromMaybe "" <<< StrMap.lookup header <<< getResponseHeaders + Maybe.fromMaybe "" <<< Object.lookup header <<< getResponseHeaders