{-# LANGUAGE RankNTypes, RecordWildCards #-}

-- |
-- Module      : Network.Wreq.Session
-- Copyright   : (c) 2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- The functions in this module use a 'Session' to handle the
-- following common needs:
--
-- * TCP connection reuse.  This is important for performance when
--   multiple requests go to a single server, particularly if TLS is
--   being used.
--
-- * Transparent cookie management.  Any cookies set by the server
--   persist from one request to the next.  (Bypass this overhead
--   using 'newAPISession'.)
--
--
-- This module is designed to be used alongside the "Network.Wreq"
-- module.  Typical usage will look like this:
--
-- @
-- import "Network.Wreq"
-- import qualified "Network.Wreq.Session" as Sess
--
-- main = do
--   sess <- Sess.'newSession'
--   Sess.'get' sess \"http:\/\/httpbin.org\/get\"
-- @
--
-- We create a 'Session' using 'newSession', then pass the session to
-- subsequent functions.  When talking to a REST-like service that does
-- not use cookies, it is more efficient to use 'newAPISession'.
--
-- Note the use of qualified import statements in the examples above,
-- so that we can refer unambiguously to the 'Session'-specific
-- implementation of HTTP GET.
--
-- One 'Network.HTTP.Client.Manager' (possibly set with 'newSessionControl') is used for all
-- session requests. The manager settings in the 'Options' parameter
-- for the 'getWith', 'postWith' and similar functions is ignored.

module Network.Wreq.Session
    (
    -- * Session creation
      Session
    , newSession
    , newAPISession
    , withSession
    , withAPISession
    -- ** More control-oriented session creation
    , newSessionControl
    , withSessionWith
    , withSessionControl
    -- ** Get information about session state
    , getSessionCookieJar
    -- * HTTP verbs
    , get
    , post
    , head_
    , options
    , put
    , delete
    , customMethod
    -- ** Configurable verbs
    , getWith
    , postWith
    , headWith
    , optionsWith
    , putWith
    , deleteWith
    , customMethodWith
    , customPayloadMethodWith
    , customHistoriedMethodWith
    , customHistoriedPayloadMethodWith
    -- * Extending a session
    , Lens.seshRun
    ) where

import Control.Lens ((&), (.~))
import Data.Foldable (forM_)
import Data.IORef (newIORef, readIORef, writeIORef)
import Network.Wreq (Options, Response, HistoriedResponse)
import Network.Wreq.Internal
import Network.Wreq.Internal.Types (Body(..), Req(..), Session(..), RunHistory)
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
import Data.Traversable as T

-- | Create a 'Session', passing it to the given function.  The
-- 'Session' will no longer be valid after that function returns.
--
-- This session manages cookies and uses default session manager
-- configuration.
withSession :: (Session -> IO a) -> IO a
withSession :: (Session -> IO a) -> IO a
withSession Session -> IO a
act = IO Session
newSession IO Session -> (Session -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Session -> IO a
act
{-# DEPRECATED withSession "Use newSession instead." #-}

-- | Create a 'Session'.
--
-- This session manages cookies and uses default session manager
-- configuration.
--
-- @since 0.5.2.0
newSession :: IO Session
newSession :: IO Session
newSession = Maybe CookieJar -> ManagerSettings -> IO Session
newSessionControl (CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just ([Cookie] -> CookieJar
HTTP.createCookieJar [])) ManagerSettings
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 :: (Session -> IO a) -> IO a
withAPISession Session -> IO a
act = IO Session
newAPISession IO Session -> (Session -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Session -> IO a
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.
--
-- @since 0.5.2.0
newAPISession :: IO Session
newAPISession :: IO Session
newAPISession = Maybe CookieJar -> ManagerSettings -> IO Session
newSessionControl Maybe CookieJar
forall a. Maybe a
Nothing ManagerSettings
defaultManagerSettings

-- | Create a session, using the given manager settings.  This session
-- manages cookies.
withSessionWith :: HTTP.ManagerSettings -> (Session -> IO a) -> IO a
withSessionWith :: ManagerSettings -> (Session -> IO a) -> IO a
withSessionWith = Maybe CookieJar -> ManagerSettings -> (Session -> IO a) -> IO a
forall a.
Maybe CookieJar -> ManagerSettings -> (Session -> IO a) -> IO a
withSessionControl (CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just ([Cookie] -> CookieJar
HTTP.createCookieJar []))
{-# DEPRECATED withSessionWith "Use newSessionControl instead." #-}

-- | Create a session, using the given cookie jar and manager settings.
withSessionControl :: Maybe HTTP.CookieJar
                  -- ^ If 'Nothing' is specified, no cookie management
                  -- will be performed.
               -> HTTP.ManagerSettings
               -> (Session -> IO a) -> IO a
withSessionControl :: Maybe CookieJar -> ManagerSettings -> (Session -> IO a) -> IO a
withSessionControl Maybe CookieJar
mj ManagerSettings
settings Session -> IO a
act = do
    Session
sess <- Maybe CookieJar -> ManagerSettings -> IO Session
newSessionControl Maybe CookieJar
mj ManagerSettings
settings
    Session -> IO a
act Session
sess
{-# DEPRECATED withSessionControl "Use newSessionControl instead." #-}

-- | Create a session, using the given cookie jar and manager settings.
--
-- @since 0.5.2.0
newSessionControl ::  Maybe HTTP.CookieJar
                  -- ^ If 'Nothing' is specified, no cookie management
                  -- will be performed.
               -> HTTP.ManagerSettings
               -> IO Session
newSessionControl :: Maybe CookieJar -> ManagerSettings -> IO Session
newSessionControl Maybe CookieJar
mj ManagerSettings
settings = do
     Maybe (IORef CookieJar)
mref <- IO (Maybe (IORef CookieJar))
-> (CookieJar -> IO (Maybe (IORef CookieJar)))
-> Maybe CookieJar
-> IO (Maybe (IORef CookieJar))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (IORef CookieJar) -> IO (Maybe (IORef CookieJar))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef CookieJar)
forall a. Maybe a
Nothing) ((IORef CookieJar -> Maybe (IORef CookieJar))
-> IO (IORef CookieJar) -> IO (Maybe (IORef CookieJar))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef CookieJar -> Maybe (IORef CookieJar)
forall a. a -> Maybe a
Just (IO (IORef CookieJar) -> IO (Maybe (IORef CookieJar)))
-> (CookieJar -> IO (IORef CookieJar))
-> CookieJar
-> IO (Maybe (IORef CookieJar))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CookieJar -> IO (IORef CookieJar)
forall a. a -> IO (IORef a)
newIORef) Maybe CookieJar
mj
     Manager
mgr <- ManagerSettings -> IO Manager
HTTP.newManager ManagerSettings
settings
     Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return Session :: Maybe (IORef CookieJar)
-> Manager
-> (Session -> Run Body -> Run Body)
-> (Session -> RunHistory Body -> RunHistory Body)
-> Session
Session { seshCookies :: Maybe (IORef CookieJar)
seshCookies = Maybe (IORef CookieJar)
mref
                     , seshManager :: Manager
seshManager = Manager
mgr
                     , seshRun :: Session -> Run Body -> Run Body
seshRun = Session -> Run Body -> Run Body
runWith
                     , seshRunHistory :: Session -> RunHistory Body -> RunHistory Body
seshRunHistory = Session -> RunHistory Body -> RunHistory Body
runWithHistory
                     }

-- | Extract current 'Network.HTTP.Client.CookieJar' from a 'Session'
--
-- @since 0.5.2.0
getSessionCookieJar :: Session -> IO (Maybe HTTP.CookieJar)
getSessionCookieJar :: Session -> IO (Maybe CookieJar)
getSessionCookieJar = (IORef CookieJar -> IO CookieJar)
-> Maybe (IORef CookieJar) -> IO (Maybe CookieJar)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse IORef CookieJar -> IO CookieJar
forall a. IORef a -> IO a
readIORef (Maybe (IORef CookieJar) -> IO (Maybe CookieJar))
-> (Session -> Maybe (IORef CookieJar))
-> Session
-> IO (Maybe CookieJar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> Maybe (IORef CookieJar)
seshCookies

-- | 'Session'-specific version of 'Network.Wreq.get'.
get :: Session -> String -> IO (Response L.ByteString)
get :: Session -> String -> IO (Response ByteString)
get = Options -> Session -> String -> IO (Response ByteString)
getWith Options
defaults

-- | 'Session'-specific version of 'Network.Wreq.post'.
post :: Postable a => Session -> String -> a -> IO (Response L.ByteString)
post :: Session -> String -> a -> IO (Response ByteString)
post = Options -> Session -> String -> a -> IO (Response ByteString)
forall a.
Postable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
postWith Options
defaults

-- | 'Session'-specific version of 'Network.Wreq.head_'.
head_ :: Session -> String -> IO (Response ())
head_ :: Session -> String -> IO (Response ())
head_ = Options -> Session -> String -> IO (Response ())
headWith (Options
defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Options -> Identity Options
Lens' Options Int
Lens.redirects ((Int -> Identity Int) -> Options -> Identity Options)
-> Int -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0)

-- | 'Session'-specific version of 'Network.Wreq.options'.
options :: Session -> String -> IO (Response ())
options :: Session -> String -> IO (Response ())
options = Options -> Session -> String -> IO (Response ())
optionsWith Options
defaults

-- | 'Session'-specific version of 'Network.Wreq.put'.
put :: Putable a => Session -> String -> a -> IO (Response L.ByteString)
put :: Session -> String -> a -> IO (Response ByteString)
put = Options -> Session -> String -> a -> IO (Response ByteString)
forall a.
Putable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
putWith Options
defaults

-- | 'Session'-specific version of 'Network.Wreq.delete'.
delete :: Session -> String -> IO (Response L.ByteString)
delete :: Session -> String -> IO (Response ByteString)
delete = Options -> Session -> String -> IO (Response ByteString)
deleteWith Options
defaults

-- | 'Session'-specific version of 'Network.Wreq.customMethod'.
customMethod :: String -> Session -> String -> IO (Response L.ByteString)
customMethod :: String -> Session -> String -> IO (Response ByteString)
customMethod = (String
 -> Options -> Session -> String -> IO (Response ByteString))
-> Options
-> String
-> Session
-> String
-> IO (Response ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Options -> Session -> String -> IO (Response ByteString)
customMethodWith Options
defaults

-- | 'Session'-specific version of 'Network.Wreq.getWith'.
getWith :: Options -> Session -> String -> IO (Response L.ByteString)
getWith :: Options -> Session -> String -> IO (Response ByteString)
getWith Options
opts Session
sesh String
url = Mapping ByteString -> Session -> Run ByteString
forall a. Mapping a -> Session -> Run a
run Mapping ByteString
string Session
sesh Run ByteString -> IO Req -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> String -> IO Req
prepareGet Options
opts String
url

-- | 'Session'-specific version of 'Network.Wreq.postWith'.
postWith :: Postable a => Options -> Session -> String -> a
         -> IO (Response L.ByteString)
postWith :: Options -> Session -> String -> a -> IO (Response ByteString)
postWith Options
opts Session
sesh String
url a
payload =
  Mapping ByteString -> Session -> Run ByteString
forall a. Mapping a -> Session -> Run a
run Mapping ByteString
string Session
sesh Run ByteString -> IO Req -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> String -> a -> IO Req
forall a. Postable a => Options -> String -> a -> IO Req
preparePost Options
opts String
url a
payload

-- | 'Session'-specific version of 'Network.Wreq.headWith'.
headWith :: Options -> Session -> String -> IO (Response ())
headWith :: Options -> Session -> String -> IO (Response ())
headWith Options
opts Session
sesh String
url = Mapping () -> Session -> Run ()
forall a. Mapping a -> Session -> Run a
run Mapping ()
ignore Session
sesh Run () -> IO Req -> IO (Response ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> String -> IO Req
prepareHead Options
opts String
url

-- | 'Session'-specific version of 'Network.Wreq.optionsWith'.
optionsWith :: Options -> Session -> String -> IO (Response ())
optionsWith :: Options -> Session -> String -> IO (Response ())
optionsWith Options
opts Session
sesh String
url = Mapping () -> Session -> Run ()
forall a. Mapping a -> Session -> Run a
run Mapping ()
ignore Session
sesh Run () -> IO Req -> IO (Response ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> String -> IO Req
prepareOptions Options
opts String
url

-- | 'Session'-specific version of 'Network.Wreq.putWith'.
putWith :: Putable a => Options -> Session -> String -> a
        -> IO (Response L.ByteString)
putWith :: Options -> Session -> String -> a -> IO (Response ByteString)
putWith Options
opts Session
sesh String
url a
payload = Mapping ByteString -> Session -> Run ByteString
forall a. Mapping a -> Session -> Run a
run Mapping ByteString
string Session
sesh Run ByteString -> IO Req -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> String -> a -> IO Req
forall a. Putable a => Options -> String -> a -> IO Req
preparePut Options
opts String
url a
payload

-- | 'Session'-specific version of 'Network.Wreq.deleteWith'.
deleteWith :: Options -> Session -> String -> IO (Response L.ByteString)
deleteWith :: Options -> Session -> String -> IO (Response ByteString)
deleteWith Options
opts Session
sesh String
url = Mapping ByteString -> Session -> Run ByteString
forall a. Mapping a -> Session -> Run a
run Mapping ByteString
string Session
sesh Run ByteString -> IO Req -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> String -> IO Req
prepareDelete Options
opts String
url

-- | 'Session'-specific version of 'Network.Wreq.customMethodWith'.
customMethodWith :: String -> Options -> Session -> String -> IO (Response L.ByteString)
customMethodWith :: String -> Options -> Session -> String -> IO (Response ByteString)
customMethodWith String
method Options
opts Session
sesh String
url = Mapping ByteString -> Session -> Run ByteString
forall a. Mapping a -> Session -> Run a
run Mapping ByteString
string Session
sesh Run ByteString -> IO Req -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Method -> Options -> String -> IO Req
prepareMethod Method
methodBS Options
opts String
url
  where
    methodBS :: Method
methodBS = String -> Method
BC8.pack String
method

-- | 'Session'-specific version of 'Network.Wreq.customHistoriedMethodWith'.
--
-- @since 0.5.2.0
customHistoriedMethodWith :: String -> Options -> Session -> String -> IO (HistoriedResponse L.ByteString)
customHistoriedMethodWith :: String
-> Options
-> Session
-> String
-> IO (HistoriedResponse ByteString)
customHistoriedMethodWith String
method Options
opts Session
sesh String
url =
    MappingHistory ByteString -> Session -> RunHistory ByteString
forall a. MappingHistory a -> Session -> RunHistory a
runHistory MappingHistory ByteString
stringHistory Session
sesh RunHistory ByteString
-> IO Req -> IO (HistoriedResponse ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Method -> Options -> String -> IO Req
prepareMethod Method
methodBS Options
opts String
url
  where
    methodBS :: Method
methodBS = String -> Method
BC8.pack String
method

-- | 'Session'-specific version of 'Network.Wreq.customPayloadMethodWith'.
customPayloadMethodWith :: Postable a => String -> Options -> Session -> String -> a
                        -> IO (Response L.ByteString)
customPayloadMethodWith :: String
-> Options -> Session -> String -> a -> IO (Response ByteString)
customPayloadMethodWith String
method Options
opts Session
sesh String
url a
payload =
  Mapping ByteString -> Session -> Run ByteString
forall a. Mapping a -> Session -> Run a
run Mapping ByteString
string Session
sesh Run ByteString -> IO Req -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Method -> Options -> String -> a -> IO Req
forall a. Postable a => Method -> Options -> String -> a -> IO Req
preparePayloadMethod Method
methodBS Options
opts String
url a
payload
  where
    methodBS :: Method
methodBS = String -> Method
BC8.pack String
method

-- | 'Session'-specific version of 'Network.Wreq.customHistoriedPayloadMethodWith'.
--
-- @since 0.5.2.0
customHistoriedPayloadMethodWith :: Postable a => String -> Options -> Session -> String -> a
                        -> IO (HistoriedResponse L.ByteString)
customHistoriedPayloadMethodWith :: String
-> Options
-> Session
-> String
-> a
-> IO (HistoriedResponse ByteString)
customHistoriedPayloadMethodWith String
method Options
opts Session
sesh String
url a
payload =
  MappingHistory ByteString -> Session -> RunHistory ByteString
forall a. MappingHistory a -> Session -> RunHistory a
runHistory MappingHistory ByteString
stringHistory Session
sesh RunHistory ByteString
-> IO Req -> IO (HistoriedResponse ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Method -> Options -> String -> a -> IO Req
forall a. Postable a => Method -> Options -> String -> a -> IO Req
preparePayloadMethod Method
methodBS Options
opts String
url a
payload
  where
    methodBS :: Method
methodBS = String -> Method
BC8.pack String
method


runWithGeneric :: (resp -> Response b) -> Session -> (Req -> IO resp) -> Req -> IO resp
runWithGeneric :: (resp -> Response b)
-> Session -> (Req -> IO resp) -> Req -> IO resp
runWithGeneric resp -> Response b
extract Session{Maybe (IORef CookieJar)
Manager
Session -> RunHistory Body -> RunHistory Body
Session -> Run Body -> Run Body
seshRunHistory :: Session -> RunHistory Body -> RunHistory Body
seshRun :: Session -> Run Body -> Run Body
seshManager :: Manager
seshCookies :: Maybe (IORef CookieJar)
seshRunHistory :: Session -> Session -> RunHistory Body -> RunHistory Body
seshRun :: Session -> Session -> Run Body -> Run Body
seshManager :: Session -> Manager
seshCookies :: Session -> Maybe (IORef CookieJar)
..} Req -> IO resp
act (Req Mgr
_ Request
req) = do
  Request
req' <- (\Maybe CookieJar
c -> Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& (Maybe CookieJar -> Identity (Maybe CookieJar))
-> Request -> Identity Request
Lens' Request (Maybe CookieJar)
Lens.cookieJar ((Maybe CookieJar -> Identity (Maybe CookieJar))
 -> Request -> Identity Request)
-> Maybe CookieJar -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe CookieJar
c) (Maybe CookieJar -> Request) -> IO (Maybe CookieJar) -> IO Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (IORef CookieJar -> IO CookieJar)
-> Maybe (IORef CookieJar) -> IO (Maybe CookieJar)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse IORef CookieJar -> IO CookieJar
forall a. IORef a -> IO a
readIORef Maybe (IORef CookieJar)
seshCookies
  resp
resp <- Req -> IO resp
act (Mgr -> Request -> Req
Req (Manager -> Mgr
forall a b. b -> Either a b
Right Manager
seshManager) Request
req')
  Maybe (IORef CookieJar) -> (IORef CookieJar -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (IORef CookieJar)
seshCookies ((IORef CookieJar -> IO ()) -> IO ())
-> (IORef CookieJar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IORef CookieJar
ref ->
    IORef CookieJar -> CookieJar -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef CookieJar
ref (Response b -> CookieJar
forall body. Response body -> CookieJar
HTTP.responseCookieJar (resp -> Response b
extract resp
resp))
  resp -> IO resp
forall (m :: * -> *) a. Monad m => a -> m a
return resp
resp

runWith :: Session -> Run Body -> Run Body
runWith :: Session -> Run Body -> Run Body
runWith = (Response Body -> Response Body) -> Session -> Run Body -> Run Body
forall resp b.
(resp -> Response b)
-> Session -> (Req -> IO resp) -> Req -> IO resp
runWithGeneric Response Body -> Response Body
forall a. a -> a
id

runWithHistory :: Session -> RunHistory Body -> RunHistory Body
runWithHistory :: Session -> RunHistory Body -> RunHistory Body
runWithHistory = (HistoriedResponse Body -> Response Body)
-> Session -> RunHistory Body -> RunHistory Body
forall resp b.
(resp -> Response b)
-> Session -> (Req -> IO resp) -> Req -> IO resp
runWithGeneric HistoriedResponse Body -> Response Body
forall body. HistoriedResponse body -> Response body
HTTP.hrFinalResponse

type Mapping a = (Body -> a, a -> Body, Run a)
type MappingHistory a = (Body -> a, a -> Body, RunHistory a)

run :: Mapping a -> Session -> Run a
run :: Mapping a -> Session -> Run a
run (Body -> a
to,a -> Body
from,Run a
act) Session
sesh =
  (Response Body -> Response a)
-> IO (Response Body) -> IO (Response a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Body -> a) -> Response Body -> Response a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Body -> a
to) (IO (Response Body) -> IO (Response a)) -> Run Body -> Run a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> Session -> Run Body -> Run Body
seshRun Session
sesh Session
sesh ((Response a -> Response Body)
-> IO (Response a) -> IO (Response Body)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Body) -> Response a -> Response Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Body
from) (IO (Response a) -> IO (Response Body)) -> Run a -> Run Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run a
act)

runHistory :: MappingHistory a -> Session -> RunHistory a
runHistory :: MappingHistory a -> Session -> RunHistory a
runHistory (Body -> a
to,a -> Body
from,RunHistory a
act) Session
sesh =
  (HistoriedResponse Body -> HistoriedResponse a)
-> IO (HistoriedResponse Body) -> IO (HistoriedResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Body -> a) -> HistoriedResponse Body -> HistoriedResponse a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Body -> a
to) (IO (HistoriedResponse Body) -> IO (HistoriedResponse a))
-> RunHistory Body -> RunHistory a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> Session -> RunHistory Body -> RunHistory Body
seshRunHistory Session
sesh Session
sesh ((HistoriedResponse a -> HistoriedResponse Body)
-> IO (HistoriedResponse a) -> IO (HistoriedResponse Body)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Body) -> HistoriedResponse a -> HistoriedResponse Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Body
from) (IO (HistoriedResponse a) -> IO (HistoriedResponse Body))
-> RunHistory a -> RunHistory Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunHistory a
act)

string :: Mapping L.ByteString
string :: Mapping ByteString
string = (\(StringBody ByteString
s) -> ByteString
s, ByteString -> Body
StringBody, Run ByteString
runRead)

stringHistory :: MappingHistory L.ByteString
stringHistory :: MappingHistory ByteString
stringHistory = (\(StringBody ByteString
s) -> ByteString
s, ByteString -> Body
StringBody, RunHistory ByteString
runReadHistory)

ignore :: Mapping ()
ignore :: Mapping ()
ignore = (() -> Body -> ()
forall a b. a -> b -> a
const (), Body -> () -> Body
forall a b. a -> b -> a
const Body
NoBody, Run ()
runIgnore)