{-# LANGUAGE JavaScriptFFI #-} {-# LANGUAGE OverloadedStrings #-} import Control.Exception (catch, finally) import Data.Aeson (Value(..), Object) import qualified Data.HashMap.Lazy as HashMap import qualified Data.JSString as JSString import Data.Text (Text) import GHCJS.Fetch import GHCJS.Marshal import GHCJS.Types import Network.HTTP.Types import Test.Hspec import Test.Hspec.Core.Runner (Config(..), hspecWith, defaultConfig, ColorMode(..)) import Test.QuickCheck main :: IO () main = do flip finally seleniumAsync $ hspecWith defaultConfig {configColorMode = ColorNever} $ do describe "fetch" $ do it "can GET" $ do resp <- fetch (Request "https://httpbin.org/get" defaultRequestOptions) val <- responseJSON resp withObject val $ \obj -> HashMap.lookup "url" obj `shouldBe` Just (String "https://httpbin.org/get") it "should throw on nonexisting URL" $ fetch (Request "https://nonexistent.AA" defaultRequestOptions) `shouldThrow` (\(JSPromiseException _) -> True) it "can’t POST using GET" $ do resp <- fetch (Request "https://httpbin.org/post" defaultRequestOptions) responseText resp `shouldReturn` JSString.unlines [ "" , "405 Method Not Allowed" , "

Method Not Allowed

" , "

The method is not allowed for the requested URL.

" ] it "can POST" $ do resp <- fetch (Request "https://httpbin.org/post" defaultRequestOptions {reqOptMethod = methodPost}) val <- responseJSON resp withObject val $ \obj -> HashMap.lookup "url" obj `shouldBe` Just (String "https://httpbin.org/post") it "can POST text/plain" $ do resp <- fetch (Request "https://httpbin.org/post" defaultRequestOptions { reqOptMethod = methodPost , reqOptBody = Just (jsval ("my-text" :: JSString)) }) val <- responseJSON resp withObject val $ \obj -> do (lookupKey "Content-Type" =<< HashMap.lookup "headers" obj) `shouldBe` Just (String "text/plain;charset=UTF-8") HashMap.lookup "data" obj `shouldBe` Just (String "my-text") it "can set HEADERS" $ do resp <- fetch (Request "https://httpbin.org/get" defaultRequestOptions {reqOptHeaders = [("My-Header-Name", "my-header-value")]}) val <- responseJSON resp withObject val $ \obj -> (lookupKey "My-Header-Name" =<< HashMap.lookup "headers" obj) `shouldBe` Just (String "my-header-value") withObject :: Value -> (Object -> Expectation) -> Expectation withObject (Object obj) f = f obj withObject val _ = expectationFailure ("Expected Object but got: " ++ show val) lookupKey :: Text -> Value -> Maybe Value lookupKey k (Object obj) = HashMap.lookup k obj lookupKey _ _ = Nothing foreign import javascript safe "console.log($1);" consoleLog :: JSVal -> IO () foreign import javascript safe "window.seleniumCallback();" seleniumAsync :: IO ()