wip

servant-client/servant-client.cabal

@@ -80,6 +80,8 @@ test-suite spec
       Servant.ClientSpec
     , Servant.Client.PerformRequest.GHCJSSpec
     , Servant.Client.TestServer
+    , Servant.Client.TestServer.Types
+    , Servant.Common.BaseUrl
     , Servant.Common.BaseUrlSpec
     , Spec
   if impl(ghcjs)

servant-client/src/Servant/Common/Req.hs

@@ -18,7 +18,6 @@ import Data.String.Conversions
 import Data.Proxy
 import Data.Text (Text)
 import Data.Text.Encoding
-import Data.Typeable
 import Network.HTTP.Client hiding (Proxy, path)
 import Network.HTTP.Media
 import Network.HTTP.Types
@@ -31,8 +30,6 @@ import Web.HttpApiData
 
 import qualified Network.HTTP.Client as Client
 
-import Web.HttpApiData
-
 data Req = Req
   { reqPath   :: String
   , qs        :: QueryText

servant-client/test/Servant/Client/TestServer/GHCJS.hs

@@ -27,7 +27,7 @@ withServer (TestServer testServerName _) action = do
       }
       line <- hGetLine stdout
       case readMay line :: Maybe Int of
-        Nothing -> error ("unparseable port: " ++ show line)
+        Nothing -> die ("unparseable port: " ++ show line)
         Just port -> return (port, process)
     stop (_, process) = do
       terminateProcess process

servant-client/test/Servant/ClientSpec.hs

@@ -34,8 +34,9 @@ import           GHC.Generics               (Generic)
 import qualified Network.HTTP.Client        as C
 import           Network.HTTP.Media
 import qualified Network.HTTP.Types as HTTP
-import           Network.Wai                (Application, responseLBS)
+import           Network.Wai                (responseLBS)
 import qualified Network.Wai as Wai
+import           System.Exit
 import           System.IO.Unsafe           (unsafePerformIO)
 import           Test.HUnit
 import           Test.Hspec
@@ -77,12 +78,14 @@ spec = describe "Servant.Client" $ do
 -- This rather cumbersome approach is taken because it's not easy to run a wai
 -- Application as a http server when using ghcjs.
 withTestServer :: String -> (BaseUrl -> IO a) -> IO a
-withTestServer = withServer . lookupTestServer
+withTestServer name action = do
+  server <- lookupTestServer name
+  withServer server action
 
-lookupTestServer :: String -> TestServer
+lookupTestServer :: String -> IO TestServer
 lookupTestServer name = case lookup name mapping of
-  Nothing -> error ("test server not found: " ++ name)
+  Nothing -> die ("test server not found: " ++ name)
-  Just testServer -> testServer
+  Just testServer -> return testServer
   where
     mapping :: [(String, TestServer)]
     mapping = map (\ server -> (testServerName server, server)) allTestServers
@@ -93,6 +96,8 @@ allTestServers =
   server :
   errorServer :
   failServer :
+  basicAuthServer :
+  genAuthServer :
   []
 
 -- * test data types
@@ -227,8 +232,9 @@ basicAuthHandler =
 basicServerContext :: Context '[ BasicAuthCheck () ]
 basicServerContext = basicAuthHandler :. EmptyContext
 
-basicAuthServer :: Application
+basicAuthServer :: TestServer
-basicAuthServer = serveWithContext basicAuthAPI basicServerContext (const (return alice))
+basicAuthServer = TestServer "basicAuthServer" $
+  serveWithContext basicAuthAPI basicServerContext (const (return alice))
 
 -- * general auth stuff
 
@@ -251,8 +257,9 @@ genAuthHandler =
 genAuthServerContext :: Context '[ AuthHandler Wai.Request () ]
 genAuthServerContext = genAuthHandler :. EmptyContext
 
-genAuthServer :: Application
+genAuthServer :: TestServer
-genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
+genAuthServer = TestServer "genAuthServer" $
+  serveWithContext genAuthAPI genAuthServerContext (const (return alice))
 
 {-# NOINLINE manager #-}
 manager :: C.Manager

servant-client/test/ghcjs/package.yaml

@@ -20,6 +20,7 @@ executables:
       - wai
       - transformers
       - network
+      - bytestring
     source-dirs:
       - ./
       - ../

servant-client/test/ghcjs/stack-ghc.yaml

@@ -9,7 +9,4 @@ packages:
       - servant-server
     extra-dep: true
 
-resolver: nightly-2015-10-08
+resolver: nightly-2016-04-01
-
-extra-deps:
-  - http-api-data-0.1.1.1

servant-client/test/ghcjs/testServer.cabal

@@ -1,4 +1,4 @@
--- This file has been generated from package.yaml by hpack version 0.8.0.
+-- This file has been generated from package.yaml by hpack version 0.10.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -29,6 +29,7 @@ executable testServer
     , wai
     , transformers
     , network
+    , bytestring
   other-modules:
       Servant.Client.PerformRequest.GHCJSSpec
       Servant.Client.TestServer

servant-client/test/ghcjs/testServer.hs

@@ -17,8 +17,9 @@ main = do
         setBeforeMainLoop (print port >> hFlush stdout) $
         defaultSettings
   runSettingsSocket settings socket $
-    serve testServerApi $ \ testServerName ->
+    serve testServerApi $ \ testServerName request respond -> do
-      testServerApp $ lookupTestServer testServerName
+      app <- testServerApp <$> lookupTestServer testServerName
+      app request respond
 
 type TestServerApi =
   Capture "testServerName" String :> Raw