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" #-}