1 {-# LANGUAGE FlexibleContexts #-} 2 {-# LANGUAGE FlexibleInstances #-} 3 {-# LANGUAGE GADTs #-} 4 {-# LANGUAGE ImpredicativeTypes #-} 5 {-# LANGUAGE MultiParamTypeClasses #-} 6 {-# LANGUAGE OverloadedStrings #-} 7 {-# LANGUAGE RankNTypes #-} 8 {-# LANGUAGE RecordWildCards #-} 9 10 -- | Craze is a small module for performing multiple similar HTTP GET requests 11 -- in parallel. This is performed through the `raceGet` function, which will 12 -- perform all the requests and pick the first successful response that passes 13 -- a certain check, meaning that the parallel requests are essentially racing 14 -- against each other. 15 -- 16 -- __What is the usefulness of this?__ 17 -- 18 -- If you are dealing with data source or API that is very unreliable (high 19 -- latency, random failures) and there are no limitations on performing 20 -- significantly more requests, then performing multiple requests (through 21 -- direct connections, proxies, VPNs) may increase the chances of getting a 22 -- successful response faster and more reliably. 23 -- 24 -- However, if using a different data source or transport is a possibility, it 25 -- is potentially a better option that this approach. 26 -- 27 -- __Examples:__ 28 -- 29 -- Performing two parallel GET requests against https://chromabits.com and 30 -- returning the status code of the first successful one: 31 -- 32 -- The providers generate two client configurations. The handler "parses" the 33 -- response (in this case it just gets the status code). Finally, the checker 34 -- filters out responses that we don't consider valid (anything that is not 35 -- HTTP 200 in this case). 36 -- 37 -- >>> :set -XOverloadedStrings 38 -- >>> :{ 39 -- let racer = (Racer 40 -- { racerProviders = 41 -- [ simpleTagged [] "Client A" 42 -- , simpleTagged [] "Client B" 43 -- ] 44 -- , racerHandler = return . respStatus 45 -- , racerChecker = (200 ==) 46 -- , racerDebug = False 47 -- , racerReturnLast = False 48 -- } :: Racer [(String, String)] ByteString Int) 49 -- in (raceGet racer "https://chromabits.com" >>= print) 50 -- :} 51 -- Just 200 52 -- 53 module Network.Craze ( 54 -- * Types 55 RacerHandler 56 , RacerChecker 57 , Racer(..) 58 , RacerProvider 59 , ProviderOptions(..) 60 , RacerResult(..) 61 , ClientStatus(..) 62 -- * Functions 63 , raceGet 64 , raceGetResult 65 -- * Providers 66 -- $providers 67 , simple 68 , simpleTagged 69 , delayed 70 , delayedTagged 71 -- * Deprecated 72 , defaultRacer 73 , defaultProviderOptions 74 ) where 75 76 import Control.Monad (when) 77 import Data.Map.Lazy (keys, lookup) 78 import Prelude hiding (lookup) 79 80 import Control.Concurrent.Async 81 import Control.Monad.State (runStateT) 82 import Control.Monad.Trans (MonadIO, liftIO) 83 import Data.ByteString (ByteString) 84 import Data.Default.Class (def) 85 import Data.Text (Text, pack) 86 import qualified Data.Text.IO as TIO 87 import Network.Curl 88 89 import Network.Craze.Internal 90 import Network.Craze.Types 91 92 -- | Perform a GET request on the provided URL using all providers in 93 -- parallel. 94 -- 95 -- Rough summary of the algorithm: 96 -- 97 -- - Start all requests 98 -- - Wait for a request to finish. 99 -- 100 -- * If the request is successful, apply the handler on it. 101 -- 102 -- - If the result of the handler passes the checker, cancel all other 103 -- requests, and return the result. 104 -- - If the check fails, go back to waiting for another request to 105 -- finish. 106 -- 107 -- * If the request fails, go back to waiting for another request to 108 -- finish. 109 -- 110 raceGet 111 :: (Eq a, CurlHeader ht, CurlBuffer bt, MonadIO m) 112 => Racer ht bt a 113 -> URLString 114 -> m (Maybe a) 115 raceGet r url = rrResponse <$> raceGetResult r url 116 117 -- | Same as @raceGet@, but returns a @RacerResult@ which contains more 118 -- information about the race performed. 119 raceGetResult 120 :: (Eq a, CurlHeader ht, CurlBuffer bt, MonadIO m) 121 => Racer ht bt a 122 -> URLString 123 -> m (RacerResult a) 124 raceGetResult r@Racer{..} url = do 125 initialState@RaceState{..} <- makeRaceState (pack url) r 126 127 let asyncs = keys _rsClientMap 128 129 when racerDebug . liftIO $ do 130 TIO.putStr "[racer] Created Asyncs: " 131 print $ asyncThreadId <$> asyncs 132 133 (maybeResponse, finalState) <- runStateT waitForOne initialState 134 135 pure $ case maybeResponse of 136 Nothing -> RacerResult 137 { rrResponse = Nothing 138 , rrWinner = Nothing 139 , rrProviders = racerProviders 140 , rrStatuses = extractStatuses finalState 141 } 142 Just (as, response) -> RacerResult 143 { rrResponse = Just response 144 , rrWinner = _csOptions <$> lookup as _rsClientMap 145 , rrProviders = racerProviders 146 , rrStatuses = extractStatuses finalState 147 } 148 149 -- $providers 150 -- 151 -- 'RacerProvider' provide client configurations. Craze comes bundled with a 152 -- few built-in providers which can be used for quickly building client 153 -- configurations. 154 155 -- | A simple provider. It does not delay requests. 156 simple :: Monad m => [CurlOption] -> m ProviderOptions 157 simple xs = pure $ def { poOptions = xs } 158 159 -- | Like @simple@, but with a tag for identification. 160 simpleTagged :: Monad m => [CurlOption] -> Text -> m ProviderOptions 161 simpleTagged xs t = do 162 opts <- simple xs 163 pure $ opts { poTag = t } 164 165 -- | A provider which will delay a request by the provided number of 166 -- microseconds. 167 delayed :: Monad m => [CurlOption] -> Int -> m ProviderOptions 168 delayed xs d = pure $ def 169 { poOptions = xs 170 , poDelay = Just d 171 } 172 173 -- | Like @delayed@, but with a tag for identification. 174 delayedTagged :: Monad m => [CurlOption] -> Int -> Text -> m ProviderOptions 175 delayedTagged xs d t = do 176 opts <- delayed xs d 177 pure $ opts { poTag = t } 178 179 -- | A `Racer` with some default values. 180 -- 181 -- __Note:__ The handler will extract the response body as a `ByteString` and 182 -- ignore everything else, hence the type: 183 -- 184 -- @ 185 -- Racer [(String, String)] ByteString ByteString 186 -- @ 187 -- 188 -- If this is not the desired behavior, or if the response should be parsed or 189 -- processed, you should use the `Racer` constructor directly and provide all 190 -- fields. 191 defaultRacer :: Racer [(String,String)] ByteString ByteString 192 defaultRacer = def 193 {-# DEPRECATED defaultRacer "Use Data.Default.Class.def instead" #-} 194 195 -- | A default set of options for a provider. 196 defaultProviderOptions :: ProviderOptions 197 defaultProviderOptions = def 198 {-# DEPRECATED defaultProviderOptions "Use Data.Default.Class.def instead" #-}