module Network.Wreq.Wrecker
( Session
, defaultManagerSettings
, withRecordFunction
, withWreq
, withWreqNoCookies
, withWreqSettings
, logDebug
, logInfo
, logWarn
, logError
, Logger.Logger
, get
, post
, head_
, options
, put
, delete
, getWith
, postWith
, headWith
, optionsWith
, putWith
, deleteWith
, getJSON
, getJSONWith
, postJSON
, postJSONWith
, putJSON
, putJSONWith
, deleteJSON
, deleteJSONWith
) where
import Control.Exception (fromException, handle, throwIO)
import Data.Aeson (FromJSON)
import qualified Data.ByteString.Lazy as L
import Data.Default (def)
import qualified Data.Text.Lazy as Text
import qualified Data.Text.Lazy.Encoding as Encoding
import Network.Connection (ConnectionContext)
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as TLS
import qualified Network.Wreq as Wreq
import qualified Network.Wreq.Session as Session
import qualified Network.Wreq.Types as Wreq
import System.Log.FastLogger (ToLogStr)
import Wrecker
import qualified Wrecker.Logger as Logger
data Session = Session
{ sSession :: Session.Session
, sRecorder :: Recorder
, sRecord :: forall a. Recorder -> String -> IO a -> IO a
, sLogger :: Logger.Logger
}
defaultManagerSettings :: ConnectionContext -> HTTP.ManagerSettings
defaultManagerSettings context =
(TLS.mkManagerSettingsContext (Just context) def Nothing)
{HTTP.managerResponseTimeout = HTTP.responseTimeoutNone}
withWreq :: (Session -> IO a) -> Environment -> IO a
withWreq f env =
withWreqSettings
(recorder env)
(logger env)
(Just (HTTP.createCookieJar []))
(defaultManagerSettings (context env))
f
withWreqNoCookies :: (Session -> IO a) -> Environment -> IO a
withWreqNoCookies f env =
withWreqSettings (recorder env) (logger env) Nothing (defaultManagerSettings (context env)) f
withRecordFunction :: (forall a. Recorder -> String -> IO a -> IO a) -> Session -> Session
withRecordFunction r sess = sess {sRecord = r}
withWreqSettings ::
Recorder
-> Logger.Logger
-> Maybe HTTP.CookieJar
-> HTTP.ManagerSettings
-> (Session -> IO a)
-> IO a
withWreqSettings recorder logFunc cookie settings f = do
session <- Session.newSessionControl cookie settings
f (Session session recorder record logFunc)
withRecorder :: (Session.Session -> String -> IO a) -> Session -> String -> IO a
withRecorder f (Session {..}) key = sRecord sRecorder key $ f sSession key
withRecorder1 :: (Session.Session -> String -> a -> IO b) -> Session -> String -> a -> IO b
withRecorder1 f (Session {..}) key b = sRecord sRecorder key $ f sSession key b
get :: Session -> String -> IO (HTTP.Response L.ByteString)
get = withRecorder Session.get
post :: Wreq.Postable a => Session -> String -> a -> IO (HTTP.Response L.ByteString)
post = withRecorder1 Session.post
head_ :: Session -> String -> IO (HTTP.Response ())
head_ = withRecorder Session.head_
options :: Session -> String -> IO (HTTP.Response ())
options = withRecorder Session.options
put :: Wreq.Putable a => Session -> String -> a -> IO (HTTP.Response L.ByteString)
put = withRecorder1 Session.put
delete :: Session -> String -> IO (HTTP.Response L.ByteString)
delete = withRecorder Session.delete
getWith :: Wreq.Options -> Session -> String -> IO (HTTP.Response L.ByteString)
getWith opts = withRecorder (Session.getWith opts)
postWith ::
Wreq.Postable a => Wreq.Options -> Session -> String -> a -> IO (HTTP.Response L.ByteString)
postWith opts = withRecorder1 (Session.postWith opts)
headWith :: Wreq.Options -> Session -> String -> IO (HTTP.Response ())
headWith opts = withRecorder (Session.headWith opts)
optionsWith :: Wreq.Options -> Session -> String -> IO (HTTP.Response ())
optionsWith opts = withRecorder (Session.optionsWith opts)
putWith ::
Wreq.Putable a => Wreq.Options -> Session -> String -> a -> IO (HTTP.Response L.ByteString)
putWith opts = withRecorder1 (Session.putWith opts)
deleteWith :: Wreq.Options -> Session -> String -> IO (HTTP.Response L.ByteString)
deleteWith opts = withRecorder (Session.deleteWith opts)
getJSON :: FromJSON a => Session -> String -> IO (HTTP.Response a)
getJSON = withRecorder (\sess url -> Session.get sess url >>= fromJSON "GET" url)
postJSON :: (Wreq.Postable a, FromJSON b) => Session -> String -> a -> IO (HTTP.Response b)
postJSON = withRecorder1 (\sess url body -> Session.post sess url body >>= fromJSON "POST" url)
putJSON :: (Wreq.Putable a, FromJSON b) => Session -> String -> a -> IO (HTTP.Response b)
putJSON = withRecorder1 (\sess url body -> Session.put sess url body >>= fromJSON "PUT" url)
deleteJSON :: FromJSON a => Session -> String -> IO (HTTP.Response a)
deleteJSON = withRecorder (\sess url -> Session.delete sess url >>= fromJSON "DELETE" url)
getJSONWith :: FromJSON a => Wreq.Options -> Session -> String -> IO (HTTP.Response a)
getJSONWith opts = withRecorder (\sess url -> Session.getWith opts sess url >>= fromJSON "GET" url)
postJSONWith ::
(Wreq.Postable a, FromJSON b)
=> Wreq.Options
-> Session
-> String
-> a
-> IO (HTTP.Response b)
postJSONWith opts =
withRecorder1 (\sess url body -> Session.postWith opts sess url body >>= fromJSON "POST" url)
putJSONWith ::
(Wreq.Putable a, FromJSON b)
=> Wreq.Options
-> Session
-> String
-> a
-> IO (HTTP.Response b)
putJSONWith opts =
withRecorder1 (\sess url body -> Session.putWith opts sess url body >>= fromJSON "PUT" url)
logDebug :: ToLogStr msg => Session -> msg -> IO ()
logDebug Session {..} = Logger.logDebug sLogger
logInfo :: ToLogStr msg => Session -> msg -> IO ()
logInfo Session {..} = Logger.logDebug sLogger
logWarn :: ToLogStr msg => Session -> msg -> IO ()
logWarn Session {..} = Logger.logDebug sLogger
logError :: ToLogStr msg => Session -> msg -> IO ()
logError Session {..} = Logger.logDebug sLogger
deleteJSONWith :: FromJSON a => Wreq.Options -> Session -> String -> IO (HTTP.Response a)
deleteJSONWith opts =
withRecorder (\sess url -> Session.deleteWith opts sess url >>= fromJSON "DELETE" url)
fromJSON :: FromJSON a => String -> String -> HTTP.Response L.ByteString -> IO (HTTP.Response a)
fromJSON verb url response = handle decorateEx (Wreq.asJSON response)
where
decorateEx ex =
case fromException ex of
Just (Wreq.JSONError err) ->
throwIO
(LogicError
("Error decoding the JSON response from " ++
verb ++
" " ++ url ++ " : " ++ err ++ "\n\n" ++ "Actually got:\n" ++ responseBody))
_ -> throwIO ex
responseBody :: String
responseBody = Text.unpack . Encoding.decodeUtf8 . HTTP.responseBody $ response