craze 0.1.1.0 → 0.1.2.0
raw patch · 3 files changed
+73/−25 lines, 3 files
Files
- craze.cabal +1/−1
- src/Network/Craze.hs +35/−18
- test/Network/CrazeSpec.hs +37/−6
craze.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: craze-version: 0.1.1.0+version: 0.1.2.0 synopsis: HTTP Racing Library description: A micro-library for racing HTTP GET requests homepage: https://github.com/etcinit/craze#readme
src/Network/Craze.hs view
@@ -35,6 +35,7 @@ -- , racerHandler = return . respStatus -- , racerChecker = (200 ==) -- , racerDebug = False+-- , racerReturnLast = False -- } :: Racer [(String, String)] ByteString Int) -- in (raceGet racer "https://chromabits.com" >>= print) -- :}@@ -103,7 +104,7 @@ -- | Number of microseconds to delay the request by. , poDelay :: Maybe Int -- | A tag to identify this type provider.- , poTag :: Text+ , poTag :: Text } deriving (Show) instance Default ProviderOptions where@@ -123,15 +124,19 @@ -- | A record describing the rules for racing requests. data Racer headerTy bodyTy a = Racer- { racerHandler :: RacerHandler headerTy bodyTy a- , racerChecker :: RacerChecker a+ { racerHandler :: RacerHandler headerTy bodyTy a+ , racerChecker :: RacerChecker a -- | On a `Racer`, each `RaceProvider` represents a separate client -- configuration. When performing a race, each provider will be used to spwan -- a client and perform a request. This allows one to control the number of -- requests performed and with which `CurlOption`s.- , racerProviders :: [RacerProvider]+ , racerProviders :: [RacerProvider] -- | When set to `True`, debugging messages will be written to stdout.- , racerDebug :: Bool+ , racerDebug :: Bool+ -- | When set to `True`, the Racer will attempt to return the last response+ -- in the event that all responses failed to pass the checker. This can be+ -- used for identifying error conditions.+ , racerReturnLast :: Bool } instance Default (Racer [(String,String)] ByteString ByteString) where@@ -140,6 +145,7 @@ , racerChecker = const True , racerProviders = [] , racerDebug = False+ , racerReturnLast = False } -- | A `Racer` with some default values.@@ -197,9 +203,11 @@ -- -- - If the result of the handler passes the checker, cancel all other -- requests, and return the result.--- - If the check fails, go back to waiting for another request to finish.+-- - If the check fails, go back to waiting for another request to+-- finish. ----- * If the request fails, go back to waiting for another request to finish.+-- * If the request fails, go back to waiting for another request to+-- finish. -- raceGet :: (Eq a, CurlHeader ht, CurlBuffer bt)@@ -216,14 +224,14 @@ -> URLString -> IO (RacerResult a) raceGetResult r url = do- asyncs <- fromList <$> (mapM performGetAsync_ (racerProviders r))+ asyncs <- fromList <$> mapM performGetAsync_ (racerProviders r) when (racerDebug r) $ do TIO.putStr "[racer] Created Asyncs: " print . elems $ mapWithKey identifier asyncs maybeResponse <- waitForOne- asyncs (racerHandler r) (racerChecker r) (racerDebug r)+ asyncs (racerHandler r) (racerChecker r) (racerDebug r) (racerReturnLast r) pure $ case maybeResponse of Nothing -> RacerResult@@ -249,8 +257,9 @@ -> RacerHandler ht bt a -> RacerChecker a -> Bool+ -> Bool -> IO (Maybe (Async (CurlResponse_ ht bt), a))-waitForOne asyncs handler check debug+waitForOne asyncs handler check debug returnLast = if null asyncs then pure Nothing else do winner <- waitAnyCatch (keys asyncs) @@ -258,25 +267,33 @@ (as, Right a) -> do result <- handler a + let remaining = delete as asyncs+ if check result then do- cancelAll (keys $ delete as asyncs)+ cancelAll (keys remaining) when debug $ do TIO.putStr "[racer] Winner: " print (asyncThreadId as) pure $ Just (as, result)- else waitForOne (delete as asyncs) handler check debug- (as, Left _) -> waitForOne (delete as asyncs) handler check debug+ else (if returnLast && null remaining+ then do+ when debug $ do+ TIO.putStr "[racer] Reached last. Returning: "+ print (asyncThreadId as) + pure $ Just (as, result)+ else waitForOne remaining handler check debug returnLast+ )+ (as, Left _) -> waitForOne+ (delete as asyncs) handler check debug returnLast+ cancelAll :: [Async a] -> IO () cancelAll = mapM_ (async . cancel) -except :: (Eq a) => a -> [a] -> [a]-except x = filter (x /=)--identifier :: (Async (CurlResponse_ ht bt)) -> ProviderOptions -> Text-identifier a o = (poTag o) <> ":" <> (pack . show . asyncThreadId $ a)+identifier :: Async (CurlResponse_ ht bt) -> ProviderOptions -> Text+identifier a o = poTag o <> ":" <> (pack . show . asyncThreadId $ a) performGetAsync :: (CurlHeader ht, CurlBuffer bt)
test/Network/CrazeSpec.hs view
@@ -16,18 +16,17 @@ runDelayedProxy :: Integer -> Int -> ByteString -> IO () runDelayedProxy port delay fixedBody = proxyMain (def :: Settings ByteString)- { responseModifier = (\_ res+ { responseModifier = \_ res -> threadDelay (delay * oneSecond) >> return (res { rspBody = fixedBody})- ) , portnum = port , hostname = Just "localhost" } racer :: Racer [(String, String)] ByteString ByteString racer = Racer- { racerHandler = \res -> return (respBody res)- , racerChecker = \x -> not (isInfixOf "Something" x)+ { racerHandler = pure . respBody+ , racerChecker = not . isInfixOf "Something" , racerProviders = [simple [CurlProxy "localhost", CurlProxyPort 8082] , simple [CurlProxy "localhost", CurlProxyPort 8083]@@ -35,11 +34,24 @@ , delayed [CurlProxy "localhost", CurlProxyPort 8085] 2000000 ] , racerDebug = True+ , racerReturnLast = False } +failingRacer :: Racer [(String, String)] ByteString ByteString+failingRacer = racer+ { racerChecker = isInfixOf "OMG WHY"+ , racerReturnLast = True+ , racerProviders+ = [simple [CurlProxy "localhost", CurlProxyPort 8086]+ , simple [CurlProxy "localhost", CurlProxyPort 8087]+ , simple [CurlProxy "localhost", CurlProxyPort 8088]+ , delayed [CurlProxy "localhost", CurlProxyPort 8089] 2000000+ ]+ }+ spec :: Spec spec = describe "Network.Craze" $- describe "raceGet" $+ describe "raceGet" $ do it "should race GET requests" $ do proxies <- mapM (liftIO . forkIO) [ runDelayedProxy 8082 5 "Hoogle"@@ -56,5 +68,24 @@ response `shouldSatisfy` \x -> case x of- Just a -> isInfixOf "Hayoo" a+ Just a -> "Hayoo" `isInfixOf` a Nothing -> False+ it "should return the last when requested" $ do+ proxies <- mapM (liftIO . forkIO)+ [ runDelayedProxy 8086 10 "Hoogle"+ , runDelayedProxy 8087 2 "Hayoo"+ , runDelayedProxy 8088 1 "Something"+ , runDelayedProxy 8089 1 "Slow"+ ]++ liftIO $ threadDelay (1 * oneSecond) >> putStrLn "Waited 1 secs..."++ response <- liftIO $ raceGet failingRacer "http://www.google.com"++ liftIO $ mapM_ killThread proxies++ response `shouldSatisfy`+ \x -> case x of+ Just a -> "Hoogle" `isInfixOf` a+ Nothing -> False+