module Test.HTTPurple.TestHelpers where import Prelude import Data.Array (fromFoldable) as Array import Data.Either (Either(Right)) import Data.List (List(Nil, Cons), reverse) import Data.Maybe (fromMaybe) import Data.Options ((:=)) import Data.String (toLower) import Data.Tuple (Tuple) import Effect (Effect) import Effect.Aff (Aff, makeAff, nonCanceler) import Effect.Class (liftEffect) import Effect.Ref (modify_, new, read) import Foreign.Object (Object, lookup) import Foreign.Object (fromFoldable) as Object import Node.Buffer (Buffer, concat, create, fromString) import Node.Buffer (toString) as Buffer import Node.Encoding (Encoding(UTF8)) import Node.HTTP (Request) import Node.HTTP (Response) as HTTP import Node.HTTP.Client ( RequestHeaders(RequestHeaders) , headers , hostname , method , path , port , protocol , rejectUnauthorized , requestAsStream , responseAsStream , responseHeaders , statusCode ) import Node.HTTP.Client (Response, request) as HTTPClient import Node.Stream (Readable, end, onData, onEnd, write) import Test.Spec (Spec) import Test.Spec.Assertions (shouldEqual) import Unsafe.Coerce (unsafeCoerce) infix 1 shouldEqual as ?= -- | The type for integration tests. type Test = Spec Unit -- | The type for the entire test suite. type TestSuite = Effect Unit -- | Given a URL, a failure handler, and a success handler, create an HTTP -- | client request. request :: Boolean -> Int -> String -> Object String -> String -> Buffer -> Aff HTTPClient.Response request secure port' method' headers' path' body = makeAff \done -> do req <- HTTPClient.request options $ Right >>> done let stream = requestAsStream req void $ write stream body $ const $ end stream $ const $ pure unit pure nonCanceler where options = protocol := (if secure then "https:" else "http:") <> method := method' <> hostname := "localhost" <> port := port' <> path := path' <> headers := RequestHeaders headers' <> rejectUnauthorized := false -- | Same as `request` but without. request' :: Boolean -> Int -> String -> Object String -> String -> Aff HTTPClient.Response request' secure port method headers path = liftEffect (create 0) >>= request secure port method headers path -- | Same as `request` but with a `String` body. requestString :: Boolean -> Int -> String -> Object String -> String -> String -> Aff HTTPClient.Response requestString secure port method headers path body = do liftEffect (fromString body UTF8) >>= request secure port method headers path -- | Convert a request to an Aff containing the `Buffer with the response body. toBuffer :: HTTPClient.Response -> Aff Buffer toBuffer response = makeAff \done -> do let stream = responseAsStream response chunks <- new Nil onData stream $ \new -> modify_ (Cons new) chunks onEnd stream $ read chunks >>= reverse >>> Array.fromFoldable >>> concat >>= Right >>> done pure nonCanceler -- | Convert a request to an Aff containing the string with the response body. toString :: HTTPClient.Response -> Aff String toString resp = do buf <- toBuffer resp liftEffect $ Buffer.toString UTF8 buf -- | Run an HTTP GET with the given url and return an Aff that contains the -- | string with the response body. get :: Int -> Object String -> String -> Aff String get port headers path = request' false port "GET" headers path >>= toString -- | Like `get` but return a response body in a `Buffer` getBinary :: Int -> Object String -> String -> Aff Buffer getBinary port headers path = request' false port "GET" headers path >>= toBuffer -- | Run an HTTPS GET with the given url and return an Aff that contains the -- | string with the response body. get' :: Int -> Object String -> String -> 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 :: Int -> Object String -> String -> String -> Aff String post port headers path = requestString false port "POST" headers path >=> toString -- | Run an HTTP POST with the given url and binary buffer body and return an -- | Aff that contains the string with the response body. postBinary :: Int -> Object String -> String -> Buffer -> Aff String postBinary port headers path = request false port "POST" headers path >=> toString -- | Convert a request to an Aff containing the string with the given header -- | value. extractHeader :: String -> HTTPClient.Response -> String extractHeader header = unmaybe <<< lookup' <<< responseHeaders where unmaybe = fromMaybe "" lookup' = lookup $ 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 :: Int -> Object String -> String -> String -> Aff String getHeader port headers path header = extractHeader header <$> request' false port "GET" headers path getStatus :: Int -> Object String -> String -> Aff Int getStatus port headers path = statusCode <$> request' false port "GET" headers path -- | Mock an HTTP Request object foreign import mockRequestImpl :: String -> String -> String -> String -> Object String -> Effect Request -- | Mock an HTTP Request object mockRequest :: String -> String -> String -> String -> Array (Tuple String String) -> Aff Request mockRequest httpVersion method url body = liftEffect <<< mockRequestImpl httpVersion method url body <<< Object.fromFoldable -- | Mock an HTTP Response object foreign import mockResponse :: Effect HTTP.Response -- | Get the current body from an HTTP Response object (note this will only work -- | with an object returned from mockResponse). getResponseBody :: HTTP.Response -> String getResponseBody = _.body <<< unsafeCoerce -- | Get the currently set status from an HTTP Response object. getResponseStatus :: HTTP.Response -> Int getResponseStatus = _.statusCode <<< unsafeCoerce -- | Get all current headers on the HTTP Response object. getResponseHeaders :: HTTP.Response -> Object String getResponseHeaders = unsafeCoerce <<< _.headers <<< unsafeCoerce -- | Get the current value for the header on the HTTP Response object. getResponseHeader :: String -> HTTP.Response -> String getResponseHeader header = fromMaybe "" <<< lookup header <<< getResponseHeaders -- | Create a stream out of a string. foreign import stringToStream :: String -> Readable ()