mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2025-06-08 09:41:00 +00:00
added error handling to the web request (and changed from req to wreq)
This commit is contained in:
parent
6f50add62a
commit
a460fd561f
5 changed files with 44 additions and 34 deletions
|
@ -1,18 +1,25 @@
|
|||
{-# LANGUAGE OverloadedStrings, DataKinds#-}
|
||||
module Requester(request) where
|
||||
|
||||
import Network.HTTP.Req
|
||||
-- import qualified Data.Text as T
|
||||
import Control.Monad.IO.Class(MonadIO)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Network.Wreq as N
|
||||
import Network.HTTP.Client (HttpException)
|
||||
import qualified Control.Exception as E
|
||||
import Control.Lens.Getter ((^.))
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Monad
|
||||
|
||||
url :: Url 'Https
|
||||
url = https "md.darmstadt.ccc.de" /: "mathechor-probenplanung" /: "download"
|
||||
url :: String
|
||||
url = "https://md.darmstadt.ccc.de/mathechor-probenplanung/download"
|
||||
|
||||
eitherToFail :: (Show a, MonadFail m) => Either a b -> m b
|
||||
eitherToFail (Right a) = return a
|
||||
eitherToFail (Left b) = fail $ show b
|
||||
|
||||
|
||||
requestRunner :: (MonadIO m)=> m BsResponse
|
||||
requestRunner = runReq defaultHttpConfig $ req GET url NoReqBody bsResponse mempty
|
||||
|
||||
request :: (MonadIO m) => m B.ByteString
|
||||
request = fmap responseBody requestRunner
|
||||
request :: (MonadIO m, MonadFail m) => m LBS.ByteString
|
||||
request = do
|
||||
-- catch might seem to be more convenient instead of catch. But the handler in catch forces
|
||||
-- IO and not MonadIO, so we can't call fail. We use try to escape so we can escape IO first
|
||||
-- and then handle the error (with fail in scope)
|
||||
responseWithError <- liftIO (E.try (N.get url) :: IO (Either HttpException (N.Response LBS.ByteString)))
|
||||
response <- eitherToFail responseWithError
|
||||
return $ response ^. N.responseBody
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue