Skip to content

Instantly share code, notes, and snippets.

@k-bx

k-bx/WebHandler.hs Secret

Last active Aug 29, 2015
Embed
What would you like to do?
Abstract bug description
import Control.Concurrent.Async (mapConcurrently)
import Control.Exception.Enclosed (catchAny)
import qualified Network.Wreq as W
import System.Timeout (timeout)
someHandler :: Handler ()
someHandler = do
-- we use single http-client's Manager
mgr <- _appWreqManager
candidates <- getCandidates
res <- liftIO $ fmap catMaybes $ mapConcurrently (fetch mgr) candidates
log "Got responses!"
renderResponses res
where
fetch :: Manager -> IO (Maybe CandidateData)
fetch mgr candidate = ctch $ tm $ do
log ("Provider: " <> show candidate)
case candidate of
CandidateProvider1 -> do
let opts = defaults & manager .~ (Right mgr)
r <- W.getWith opts "http://candidate1api.example.com/get-data"
log ("CandidateProvider1 responded with: " <> show r)
return (CandidateData1 r)
CandidateProvider2 -> do
log ("CandidateProvider2 doesn't need to fetch anything, returning pure value")
return CandidateData2
tm f = do
res <- timeout (100000 * 5) f
case res of
Nothing -> do
logErr ("Got timeout while requesting " <> show candidate)
return Nothing
Just r -> return r
ctch f = catchAny f (\e -> logErr ("Exception while fetching " <> show candidate
<> ": " <> show e)
>> return ())
data CandidateData
getCandidates = undefined
renderResponses = undefined
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment