legion-discovery-client 0.1.0.3 → 0.1.1.0
raw patch · 2 files changed
+58/−23 lines, 2 filesdep −data-default-classdep −networkdep ~aesondep ~basedep ~http-client
Dependencies removed: data-default-class, network
Dependency ranges changed: aeson, base, http-client
Files
legion-discovery-client.cabal view
@@ -1,5 +1,5 @@ name: legion-discovery-client-version: 0.1.0.3+version: 0.1.1.0 synopsis: Client library for communicating with legion-discovery. description: Please see README.md homepage: https://github.com/owensmurray/legion-discovery-client#readme@@ -21,15 +21,13 @@ Network.Legion.Discovery.Client build-depends: Cabal >= 1.22.5.0 && < 1.25,- aeson >= 0.11.2.1 && < 0.12,- base >= 4.7 && < 5,+ aeson >= 0.11.2.1 && < 1.1,+ base >= 4.7 && < 4.10, bytestring >= 0.10.6.0 && < 0.11, containers >= 0.5.6.2 && < 0.6,- data-default-class >= 0.0.1 && < 0.2,- http-client >= 0.4.31.1 && < 0.5,+ http-client >= 0.5.6.1 && < 0.6, http-types >= 0.9.1 && < 0.10, load-balancing >= 1.0 && < 1.1,- network >= 2.6.3.1 && < 2.7, resourcet >= 1.1.7.5 && < 1.2, text >= 1.2.2.1 && < 1.3, transformers >= 0.4.2.0 && < 0.6
src/Network/Legion/Discovery/Client.hs view
@@ -15,6 +15,7 @@ -- * HTTP Utilities. newLB, withResponse,+ httpLbs, -- * Other Types. LBHttp, Discovery,@@ -31,7 +32,6 @@ import Control.Monad.Trans.Resource (runResourceT, allocate) import Data.Aeson (eitherDecode, Value, encode, object, (.=)) import Data.ByteString.Lazy (fromChunks)-import Data.Default.Class (def) import Data.Map (Map) import Data.Monoid ((<>)) import Data.Set (Set)@@ -40,11 +40,13 @@ import Data.Text.Encoding (encodeUtf8) import Distribution.Text (display) import Distribution.Version (VersionRange, Version)-import Network.HTTP.Client (Request, Response, BodyReader,- parseRequest, host, secure, port, Manager, requestHeaders,- checkStatus, responseStatus, brConsume, responseBody, path, method,- RequestBody(RequestBodyLBS), requestBody)+import Network.HTTP.Client (Request, Response, BodyReader, parseRequest,+ host, secure, port, Manager, requestHeaders, responseStatus, brConsume,+ responseBody, path, method, RequestBody(RequestBodyLBS), requestBody,+ defaultRequest) import Network.HTTP.Types (urlEncode, statusIsSuccessful)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL import qualified Data.Map as Map import qualified Data.Set as Set import qualified Network.HTTP.Client as C@@ -75,8 +77,9 @@ via the 'withResponse' function. -} -> IO Discovery-connect name version urls manager =- D name version . LB manager <$> evenlyDistributed (return urls)+connect name version urls manager = do+ lb <- evenlyDistributed (return urls)+ return $ D name version (LB manager lb (pack (show urls))) {- |@@ -115,14 +118,13 @@ let userAgent = encodeUtf8 $ unName (dName d) <> "/" <> pack (display (dVersion d))- req = def {+ req = defaultRequest { path = "/v1/ping", method = "POST", requestHeaders = [ ("user-agent", userAgent), ("content-type", pingRequestCT) ],- checkStatus = const . const . const $ Nothing, requestBody = RequestBodyLBS . encode . object $ [ "serviceAddress" .= unServiceAddr addy ]@@ -147,15 +149,14 @@ let userAgent = encodeUtf8 $ unName (dName d) <> "-" <> pack (display (dVersion d))- req = def {+ req = defaultRequest { path = "/v1/services/" <> urlEncode False (encodeUtf8 (unName name)) <> "/" <> urlEncode False (encodeUtf8 (pack (display range))), method = "GET",- requestHeaders = [("user-agent", userAgent)],- checkStatus = const . const . const $ Nothing+ requestHeaders = [("user-agent", userAgent)] } withResponse req (dLb d) (\case Nothing -> fail "No Discovery instances available."@@ -192,9 +193,9 @@ {- |- Analog of 'C.withResponse', but automatically replaces the host, port,- and scheme portions of the 'Request' with values obtained from the- load balancer.+ Analog of 'http-client''s 'C.withResponse', but automatically replaces+ the host, port, and scheme portions of the 'Request' with values+ obtained from the load balancer. If a 'Nothing' value is passed to the response handler, that means that there are no available instances that match the query params that were@@ -219,11 +220,43 @@ ) +{- |+ Analog of 'http-client''s 'C.httpLbs', but automatically replaces+ the host, port, and scheme portions of the 'Request' with values+ obtained from the load balancer.++ If a 'Nothing' value is returned, that means that there are no available+ instances that match the query params that were passed to 'newLB'.+-}+httpLbs+ :: Request+ -> LBHttp+ -> IO (Maybe (Response BSL.ByteString))+httpLbs r lb = withResponse r lb (\case+ Nothing -> return Nothing+ Just res -> do+ chunks <- consumeAll (responseBody res)+ return (Just res {responseBody = BSL.fromChunks chunks})+ )+ where+ consumeAll :: IO BS.ByteString -> IO [BS.ByteString]+ consumeAll io = do+ chunk <- io+ if BS.null chunk+ then return []+ else do+ more <- consumeAll io+ return (chunk:more)++ {- | A handle on the load balancing context. -} data LBHttp = LB { lbManager :: Manager,- lbLb :: LoadBalanced ServiceAddr+ lbLb :: LoadBalanced ServiceAddr,+ lbDesc :: Text }+instance Show LBHttp where+ show = unpack . lbDesc {- | Create a new load balanced http client, for use with 'withResponse'. -}@@ -236,7 +269,11 @@ {- ^ The range of service versions with which you are compatible. -} -> IO LBHttp {- ^ Returns a load balanced http client, for use with 'withResponse'. -}-newLB d n r = LB (lbManager (dLb d)) <$> evenlyDistributed (query n r d)+newLB d n r =+ LB+ <$> pure (lbManager (dLb d))+ <*> evenlyDistributed (query n r d)+ <*> pure (unName n <> " => " <> pack (display r)) {- | The content type of a ping request. -}