craze 0.0.1.1 → 0.1.0.0
raw patch · 4 files changed
+81/−37 lines, 4 files
Files
- app/Main.hs +3/−1
- craze.cabal +1/−1
- src/Network/Craze.hs +64/−24
- test/Network/CrazeSpec.hs +13/−11
app/Main.hs view
@@ -27,7 +27,9 @@ let clientCount = (unHelpful . clients) opts let racer = defaultRacer- { racerProviders = map ((const . return) []) [1..clientCount]+ { racerProviders+ = ((const . return) defaultProviderOptions) + <$> [1..clientCount] , racerDebug = (debug opts) }
craze.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: craze-version: 0.0.1.1+version: 0.1.0.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
@@ -1,7 +1,7 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE ImpredicativeTypes #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-} -- | Craze is a small module for performing multiple similar HTTP GET requests -- in parallel. This is performed through the `raceGet` function, which will@@ -27,7 +27,10 @@ -- -- >>> :{ -- let racer = (Racer--- { racerProviders = [return [], return []]+-- { racerProviders =+-- [ return defaultProviderOptions+-- , return defaultProviderOptions+-- ] -- , racerHandler = return . respStatus -- , racerChecker = (200 ==) -- , racerDebug = False@@ -41,15 +44,22 @@ RacerHandler , RacerChecker , Racer(..)+ , ProviderOptions(..) -- * Functions , defaultRacer+ , defaultProviderOptions , raceGet+ -- * Providers+ , simple+ , delayed ) where -import Data.ByteString (ByteString)-import Data.Default.Class (Default, def)-import Network.Curl+import Control.Concurrent (threadDelay) import Control.Concurrent.Async+import Control.Monad (when)+import Data.ByteString (ByteString)+import Data.Default.Class (Default, def)+import Network.Curl -- | A `RacerHandler` is simply a function for transforming a response after it -- is received. The handler is only applied to successful requests before they@@ -68,21 +78,34 @@ -- Limitting, etc). type RacerChecker a = a -> Bool --- | A function that returns a list of `CurlOption`s to use for making a--- request.-type RacerProvider = IO [CurlOption]+-- | A function that returns the @ProviderOptions@ to use for making a request.+type RacerProvider = IO ProviderOptions +-- | Options for a specific provider.+data ProviderOptions = ProviderOptions+ { -- | Options to pass down to Curl.+ poOptions :: [CurlOption]+ -- | Number of microseconds to delay the request by.+ , poDelay :: Maybe Int+ }++instance Default ProviderOptions where+ def = ProviderOptions+ { poOptions = []+ , poDelay = Nothing+ }+ -- | 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] -- | When set to `True`, debugging messages will be written to stdout.- , racerDebug :: Bool+ , racerDebug :: Bool } instance Default (Racer [(String,String)] ByteString ByteString) where@@ -103,11 +126,27 @@ -- @ -- -- If this is not the desired behavior, or if the response should be parsed or--- processed, you should use the `Racer` constructor directly and provide all +-- processed, you should use the `Racer` constructor directly and provide all -- fields. defaultRacer :: Racer [(String,String)] ByteString ByteString defaultRacer = def +-- | A default set of options for a provider.+defaultProviderOptions :: ProviderOptions+defaultProviderOptions = def++-- | A simple provider. It does not delay requests.+simple :: [CurlOption] -> IO ProviderOptions+simple xs = pure $ def { poOptions = xs }++-- | A provider which will delay a request by the provided number of +-- microseconds.+delayed :: [CurlOption] -> Int -> IO ProviderOptions+delayed xs d = pure $ def+ { poOptions = xs+ , poDelay = Just d+ }+ -- | Perform a GET request on the provided URL using all providers in -- parallel. --@@ -132,11 +171,9 @@ raceGet r url = do asyncs <- mapM performGetAsync_ (racerProviders r) - if (racerDebug r) - then do+ when (racerDebug r) $ do putStr "[racer] Created Asyncs: " print (map asyncThreadId asyncs)- else return () waitForOne asyncs (racerHandler r) (racerChecker r) (racerDebug r) where@@ -164,11 +201,7 @@ if check result then do cancelAll (except as asyncs) - if debug - then do- putStr "[racer] Winner: "- print (asyncThreadId as)- else return ()+ when debug $ putStr "[racer] Winner: " >> print (asyncThreadId as) pure $ Just result else waitForOne (except as asyncs) handler check debug@@ -178,12 +211,19 @@ cancelAll = mapM_ (async . cancel) except :: (Eq a) => a -> [a] -> [a]-except x xs = filter (x /=) xs+except x = filter (x /=) performGetAsync :: (CurlHeader ht, CurlBuffer bt) => URLString -> RacerProvider -> IO (Async (CurlResponse_ ht bt))-performGetAsync url provider = async $ provider >>= curlGetResponse_ url+performGetAsync url provider = async $ do+ options <- provider++ case poDelay options of+ Nothing -> pure ()+ Just delay -> threadDelay delay++ curlGetResponse_ url (poOptions options)
test/Network/CrazeSpec.hs view
@@ -2,22 +2,22 @@ module Network.CrazeSpec where -import Test.Hspec import Control.Concurrent import Control.Monad.IO.Class-import Data.ByteString (ByteString, isInfixOf)+import Data.ByteString (ByteString, isInfixOf) import Network.Craze import Network.Curl+import Network.HTTP.Base hiding (port) import Network.HTTP.Proxy.Server-import Network.HTTP.Base hiding (port)+import Test.Hspec oneSecond :: Int oneSecond = 1000000 runDelayedProxy :: Integer -> Int -> ByteString -> IO () runDelayedProxy port delay fixedBody = proxyMain (def :: Settings ByteString)- { responseModifier = (\_ res - -> threadDelay (delay * oneSecond) + { responseModifier = (\_ res+ -> threadDelay (delay * oneSecond) >> return (res { rspBody = fixedBody}) ) , portnum = port@@ -29,9 +29,10 @@ { racerHandler = \res -> return (respBody res) , racerChecker = \x -> not (isInfixOf "Something" x) , racerProviders- = [pure [CurlProxy "localhost", CurlProxyPort 8082]- , pure [CurlProxy "localhost", CurlProxyPort 8083]- , pure [CurlProxy "localhost", CurlProxyPort 8084]+ = [simple [CurlProxy "localhost", CurlProxyPort 8082]+ , simple [CurlProxy "localhost", CurlProxyPort 8083]+ , simple [CurlProxy "localhost", CurlProxyPort 8084]+ , delayed [CurlProxy "localhost", CurlProxyPort 8085] 2000000 ] , racerDebug = True }@@ -41,9 +42,10 @@ describe "raceGet" $ it "should race GET requests" $ do proxies <- mapM (liftIO . forkIO)- [runDelayedProxy 8082 5 "Hoogle"- ,runDelayedProxy 8083 2 "Hayoo"- ,runDelayedProxy 8084 1 "Something"+ [ runDelayedProxy 8082 5 "Hoogle"+ , runDelayedProxy 8083 2 "Hayoo"+ , runDelayedProxy 8084 1 "Something"+ , runDelayedProxy 8085 1 "Slow" ] liftIO $ threadDelay (1 * oneSecond) >> putStrLn "Waited 1 secs..."