Closes #81 - in the spirit of withManager->newManger implemented newS…

…ession.
haskell · Dec 29, 2017 · 209e331 · 209e331
1 parent a8e0faf
commit 209e331
Show file tree

Hide file tree

Showing 2 changed files with 46 additions and 13 deletions.
diff --git a/Network/Wreq/Session.hs b/Network/Wreq/Session.hs
@@ -48,9 +48,12 @@ module Network.Wreq.Session
     (
     -- * Session creation
       Session
+    , newSession
+    , newAPISession
     , withSession
     , withAPISession
     -- ** More control-oriented session creation
+    , newSessionControl
     , withSessionWith
     , withSessionControl
     -- ** Get information about session state
@@ -96,21 +99,38 @@ import qualified Network.Wreq.Lens as Lens
 -- This session manages cookies and uses default session manager
 -- configuration.
 withSession :: (Session -> IO a) -> IO a
-withSession = withSessionWith defaultManagerSettings
+withSession act = newSession >>= act
+{-# DEPRECATED withSession "Use newSession instead." #-}
+
+-- | Create a 'Session'.
+--
+-- This session manages cookies and uses default session manager
+-- configuration.
+newSession :: IO Session
+newSession = newSessionControl (Just (HTTP.createCookieJar [])) defaultManagerSettings
 
 -- | Create a session.
 --
 -- This uses the default session manager settings, but does not manage
 -- cookies.  It is intended for use with REST-like HTTP-based APIs,
 -- which typically do not use cookies.
 withAPISession :: (Session -> IO a) -> IO a
-withAPISession = withSessionControl Nothing defaultManagerSettings
+withAPISession act = newAPISession >>= act
+{-# DEPRECATED withAPISession "Use newAPISession instead." #-}
+
+-- | Create a session.
+--
+-- This uses the default session manager settings, but does not manage
+-- cookies.  It is intended for use with REST-like HTTP-based APIs,
+-- which typically do not use cookies.
+newAPISession :: IO Session
+newAPISession = newSessionControl Nothing defaultManagerSettings
 
 -- | Create a session, using the given manager settings.  This session
 -- manages cookies.
 withSessionWith :: HTTP.ManagerSettings -> (Session -> IO a) -> IO a
 withSessionWith = withSessionControl (Just (HTTP.createCookieJar []))
-{-# DEPRECATED withSessionWith "Use withSessionControl instead." #-}
+{-# DEPRECATED withSessionWith "Use newSessionControl instead." #-}
 
 -- | Create a session, using the given cookie jar and manager settings.
 withSessionControl :: Maybe HTTP.CookieJar
@@ -119,12 +139,23 @@ withSessionControl :: Maybe HTTP.CookieJar
                -> HTTP.ManagerSettings
                -> (Session -> IO a) -> IO a
 withSessionControl mj settings act = do
-  mref <- maybe (return Nothing) (fmap Just . newIORef) mj
-  mgr <- HTTP.newManager settings
-  act Session { seshCookies = mref
-              , seshManager = mgr
-              , seshRun = runWith
-              }
+    sess <- newSessionControl mj settings
+    act sess
+{-# DEPRECATED withSessionControl "Use newSessionControl instead." #-}
+
+-- | Create a session, using the given cookie jar and manager settings.
+newSessionControl ::  Maybe HTTP.CookieJar
+                  -- ^ If 'Nothing' is specified, no cookie management
+                  -- will be performed.
+               -> HTTP.ManagerSettings
+               -> IO Session
+newSessionControl mj settings = do
+     mref <- maybe (return Nothing) (fmap Just . newIORef) mj
+     mgr <- HTTP.newManager settings
+     return Session { seshCookies = mref
+                     , seshManager = mgr
+                     , seshRun = runWith
+                     }
 
 -- | Extract current 'Network.HTTP.Client.CookieJar' from a 'Session'
 getSessionCookieJar :: Session -> IO (Maybe HTTP.CookieJar)

diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs
@@ -287,7 +287,8 @@ cookiesSet Verb{..} site = do
     (r ^? responseCookie "x" . cookieValue)
 
 
-cookieSession site = Session.withSession $ \s -> do
+cookieSession site = do
+  s <- Session.newSession
   r0 <- Session.get s (site "/cookies/set?foo=bar")
   assertEqual "after set foo, foo set" (Just "bar")
     (r0 ^? responseCookie "foo" . cookieValue)
@@ -366,7 +367,8 @@ commonTestsWith verb site = [
 -- Snap responds incorrectly to HEAD (by sending a response body),
 -- thereby killing http-client's ability to continue a session.
 -- https://github.com/snapframework/snap-core/issues/192
-snapHeadSessionBug site = Session.withSession $ \s -> do
+snapHeadSessionBug site = do
+  s <- Session.newSession
   basicHead (session s) site
   -- will crash with (InvalidStatusLine "0")
   basicGet (session s) site
@@ -402,8 +404,8 @@ startServer = do
 testWith :: [Test] -> IO ()
 testWith tests = do
   (tid, mserv) <- startServer
-  Session.withSession $ \s ->
-    flip E.finally (killThread tid) .
+  s <- Session.newSession
+  flip E.finally (killThread tid) .
     defaultMain $ tests <>
                   [ testGroup "plain" $ httpbinTests basic
                   , testGroup "session" $ httpbinTests (session s)] <>