module Network.Wreq.Session
(
Session
, withSession
, withAPISession
, withSessionWith
, withSessionControl
, get
, post
, head_
, options
, put
, delete
, customMethod
, getWith
, postWith
, headWith
, optionsWith
, putWith
, deleteWith
, customMethodWith
, Lens.seshRun
) where
import Control.Lens ((&), (?~), (.~))
import Data.Foldable (forM_)
import Data.IORef (newIORef, readIORef, writeIORef)
import Network.Wreq (Options, Response)
import Network.Wreq.Internal
import Network.Wreq.Internal.Types (Body(..), Req(..), Session(..))
import Network.Wreq.Types (Postable, Putable, Run)
import Prelude hiding (head)
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as L
import qualified Network.HTTP.Client as HTTP
import qualified Network.Wreq.Internal.Lens as Lens
import qualified Network.Wreq.Lens as Lens
withSession :: (Session -> IO a) -> IO a
withSession = withSessionWith defaultManagerSettings
withAPISession :: (Session -> IO a) -> IO a
withAPISession = withSessionControl Nothing defaultManagerSettings
withSessionWith :: HTTP.ManagerSettings -> (Session -> IO a) -> IO a
withSessionWith = withSessionControl (Just (HTTP.createCookieJar []))
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
}
get :: Session -> String -> IO (Response L.ByteString)
get = getWith defaults
post :: Postable a => Session -> String -> a -> IO (Response L.ByteString)
post = postWith defaults
head_ :: Session -> String -> IO (Response ())
head_ = headWith (defaults & Lens.redirects .~ 0)
options :: Session -> String -> IO (Response ())
options = optionsWith defaults
put :: Putable a => Session -> String -> a -> IO (Response L.ByteString)
put = putWith defaults
delete :: Session -> String -> IO (Response L.ByteString)
delete = deleteWith defaults
customMethod :: String -> Session -> String -> IO (Response L.ByteString)
customMethod = flip customMethodWith defaults
getWith :: Options -> Session -> String -> IO (Response L.ByteString)
getWith opts sesh url = run string sesh =<< prepareGet opts url
postWith :: Postable a => Options -> Session -> String -> a
-> IO (Response L.ByteString)
postWith opts sesh url payload =
run string sesh =<< preparePost opts url payload
headWith :: Options -> Session -> String -> IO (Response ())
headWith opts sesh url = run ignore sesh =<< prepareHead opts url
optionsWith :: Options -> Session -> String -> IO (Response ())
optionsWith opts sesh url = run ignore sesh =<< prepareOptions opts url
putWith :: Putable a => Options -> Session -> String -> a
-> IO (Response L.ByteString)
putWith opts sesh url payload = run string sesh =<< preparePut opts url payload
deleteWith :: Options -> Session -> String -> IO (Response L.ByteString)
deleteWith opts sesh url = run string sesh =<< prepareDelete opts url
customMethodWith :: String -> Options -> Session -> String -> IO (Response L.ByteString)
customMethodWith method opts sesh url = run string sesh =<< prepareMethod methodBS opts url
where
methodBS = BC8.pack method
runWith :: Session -> Run Body -> Run Body
runWith Session{..} act (Req _ req) = do
req' <- case seshCookies of
Nothing -> return (req & Lens.cookieJar .~ Nothing)
Just ref -> (\s -> req & Lens.cookieJar ?~ s) `fmap` readIORef ref
resp <- act (Req (Right seshManager) req')
forM_ seshCookies $ \ref ->
writeIORef ref (HTTP.responseCookieJar resp)
return resp
type Mapping a = (Body -> a, a -> Body, Run a)
run :: Mapping a -> Session -> Run a
run (to,from,act) sesh =
fmap (fmap to) . seshRun sesh sesh (fmap (fmap from) . act)
string :: Mapping L.ByteString
string = (\(StringBody s) -> s, StringBody, runRead)
ignore :: Mapping ()
ignore = (\_ -> (), const NoBody, runIgnore)