@@ -3,36 +3,103 @@ module Test.Main where
33import Prelude
44
55import Control.Monad.Aff
6+ import Control.Bind
67import Control.Monad.Eff
78import Control.Monad.Eff.Class
8- import Control.Monad.Eff.Console (CONSOLE (), log )
9+ import Control.Monad.Eff.Console (CONSOLE (), log , print )
10+ import qualified Control.Monad.Aff.Console as A
911import Control.Monad.Eff.Exception
1012import Data.Either
13+ import Data.Maybe
1114import Data.Foreign
1215import Network.HTTP.Affjax
1316import Network.HTTP.Affjax.Response
1417import Network.HTTP.Affjax.Request
1518import Network.HTTP.Method
1619import Network.HTTP.MimeType.Common
1720import Network.HTTP.RequestHeader
21+ import Network.HTTP.StatusCode
1822
1923foreign import logAny
2024 :: forall e a . a -> Eff (console :: CONSOLE | e ) Unit
2125
22- main = launchAff $ do
26+ logAny' :: forall e a . a -> Assert e Unit
27+ logAny' = liftEff <<< logAny
2328
24- res <- attempt $ affjax $ defaultRequest { url = " /api" , method = POST }
25- liftEff $ either logAny (logAny :: AffjaxResponse String -> _ ) res
29+ type Assert e a = Aff (err :: EXCEPTION , console :: CONSOLE , ajax :: AJAX | e ) a
2630
27- res <- attempt $ post_ " /api" " test"
28- liftEff $ either logAny logAny res
31+ assertFail :: forall e a . String -> Assert e a
32+ assertFail msg = let e = error msg
33+ in makeAff \errback _ -> errback e
2934
30- res <- attempt $ get " /arrayview"
31- liftEff $ either logAny (logAny :: AffjaxResponse Foreign -> _ ) res
35+ assertMsg :: forall e . String -> Boolean -> Assert e Unit
36+ assertMsg _ true = return unit
37+ assertMsg msg false = assertFail msg
3238
33- res <- attempt $ get " ttp://www.google.com"
34- liftEff $ either logAny (logAny :: AffjaxResponse Foreign -> _ ) res
39+ assertRight :: forall e a b . Either a b -> Assert e b
40+ assertRight x = case x of
41+ Left y -> logAny' y >>= \_ -> assertFail " Expected a Right value"
42+ Right y -> return y
3543
36- canceler <- forkAff (post_ " /api" " do it now" )
44+ assertLeft :: forall e a b . Either a b -> Assert e a
45+ assertLeft x = case x of
46+ Right y -> logAny' y >>= \_ -> assertFail " Expected a Left value"
47+ Left y -> return y
48+
49+ assertEq :: forall e a . (Eq a , Show a ) => a -> a -> Assert e Unit
50+ assertEq x y = if x == y
51+ then return unit
52+ else assertFail $ " Expected " <> show x <> " , got " <> show y
53+
54+ -- | For helping type inference
55+ typeIs :: forall e a . a -> Assert e Unit
56+ typeIs = const (return unit)
57+
58+ main = runAff throwException (const $ log " affjax: All good!" ) $ do
59+ let ok200 = StatusCode 200
60+ let notFound404 = StatusCode 404
61+
62+ assertFail " lol"
63+
64+ A .log " GET /mirror: should be 200 OK"
65+ (attempt $ affjax $ defaultRequest { url = " /mirror" }) >>= assertRight >>= \res -> do
66+ typeIs (res :: AffjaxResponse Foreign )
67+ assertEq ok200 res.status
68+
69+ A .log " GET /does-not-exist: should be 404 Not found"
70+ (attempt $ affjax $ defaultRequest { url = " /does-not-exist" }) >>= assertRight >>= \res -> do
71+ typeIs (res :: AffjaxResponse String )
72+ assertEq notFound404 res.status
73+
74+ A .log " GET /not-json: invalid JSON with Foreign response should throw an error"
75+ assertLeft =<< attempt (get " /not-json" :: Affjax _ Foreign )
76+
77+ A .log " GET /not-json: invalid JSON with String response should be ok"
78+ (attempt $ get " /not-json" ) >>= assertRight >>= \res -> do
79+ typeIs (res :: AffjaxResponse String )
80+ assertEq ok200 res.status
81+
82+ A .log " POST /mirror: should use the POST method"
83+ (attempt $ post " /mirror" " test" ) >>= assertRight >>= \res -> do
84+ assertEq ok200 res.status
85+ assertEq " POST" (_.method $ unsafeFromForeign res.response)
86+
87+ A .log " PUT with a request body"
88+ let content = " the quick brown fox jumps over the lazy dog"
89+ (attempt $ put " /mirror" content) >>= assertRight >>= \res -> do
90+ typeIs (res :: AffjaxResponse Foreign )
91+ assertEq ok200 res.status
92+ let mirroredReq = unsafeFromForeign res.response
93+ assertEq " PUT" mirroredReq.method
94+ assertEq content mirroredReq.body
95+
96+ A .log " Testing CORS, HTTPS"
97+ (attempt $ get " https://cors-test.appspot.com/test" ) >>= assertRight >>= \res -> do
98+ typeIs (res :: AffjaxResponse Foreign )
99+ assertEq ok200 res.status
100+ -- assertEq (Just "test=test") (lookupHeader "Set-Cookie" res.headers)
101+
102+ A .log " Testing cancellation"
103+ canceler <- forkAff (post_ " /mirror" " do it now" )
37104 canceled <- canceler `cancel` error " Pull the cord!"
38- liftEff $ if canceled then (log " Canceled " ) else (log " Not Canceled " )
105+ assertMsg " Should have been canceled " canceled
0 commit comments