legion-discovery-client 0.1.0.0 → 0.1.0.1
raw patch · 2 files changed
+43/−21 lines, 2 files
Files
legion-discovery-client.cabal view
@@ -1,5 +1,5 @@ name: legion-discovery-client-version: 0.1.0.0+version: 0.1.0.1 synopsis: Client library for communicating with legion-discovery. description: Please see README.md homepage: https://github.com/owensmurray/legion-discovery-client#readme
src/Network/Legion/Discovery/Client.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {- | This module contains a client library for communicating with the- 'om-discovery' service discovery program.+ 'legion-discovery' service discovery program. -} module Network.Legion.Discovery.Client ( -- * Establishing a Connection.@@ -48,7 +48,7 @@ import qualified Data.Set as Set import qualified Network.HTTP.Client as C -{- | This type represents a handle on the discovery service. -}+{- | This type represents a handle on the discovery service. -} data Discovery = D { dName :: Name, dVersion :: Version,@@ -56,7 +56,7 @@ } -{- | Create a connection to the discovery service. -}+{- | Create a connection to the discovery service. -} connect :: Name {- ^@@ -66,7 +66,7 @@ -> Version {- ^ The version of the local program. -} -> Set ServiceAddr- {- ^ The well-known set of urls where the discovery service lives. -}+ {- ^ The well-known set of urls where the discovery service lives. -} -> Manager {- ^ The http manager used to manage communication to the discovery@@ -81,7 +81,14 @@ {- | Run a registered service, making sure to unregister upon ternination. -}-withService :: ServiceAddr -> Discovery -> IO a -> IO a+withService+ :: ServiceAddr+ {- ^ The service address on which your service instance can be contacted. -}+ -> Discovery+ {- ^ A handle on the discovery service, obtained via `connect`. -}+ -> IO a+ {- ^ The IO action to perform while registered as a service. -}+ -> IO a withService addy d = bracket launchPing stopPing . const where@@ -112,27 +119,30 @@ <> "/" <> urlEncode False (encodeUtf8 (pack (display (dVersion d)))), method = "POST",- requestHeaders = [("user-agent", userAgent)],+ requestHeaders = [+ ("user-agent", userAgent),+ ("content-type", pingRequestCT)+ ], checkStatus = const . const . const $ Nothing, requestBody = RequestBodyLBS . encode . object $ [ "serviceAddress" .= unServiceAddr addy ] }- {- TODO figure out what we want to do when the ping failes. -}+ {- TODO figure out what we want to do when the ping failes. -} withResponse req (dLb d) (const (return ())) tenSeconds :: Int- tenSeconds = 10000000 {- in microseconds. -}+ tenSeconds = 10000000 {- in microseconds. -} -{- | Query the discovery service. -}+{- | Query the discovery service. -} query :: Name- {- ^ The name of the service you are looking for. -}+ {- ^ The name of the service you are looking for. -} -> VersionRange- {- ^ The range of service versions with which you are compatible. -}+ {- ^ The range of service versions with which you are compatible. -} -> Discovery- {- ^ A handle on the discovery service. -}+ {- ^ A handle on the discovery service. -} -> IO (Set ServiceAddr) query name range d = do let@@ -165,7 +175,7 @@ ) -{- | The name of a service. -}+{- | The name of a service. -} newtype Name = Name {unName :: Text} deriving (IsString) @@ -183,8 +193,9 @@ {- |- Similar to 'C.withResponse', but automatically replaces the host,- port, and scheme portions with one obtained from the load balancer.+ Analog of '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@@ -209,17 +220,28 @@ ) -{- | A handle on the load balancing context. -}+{- | A handle on the load balancing context. -} data LBHttp = LB { lbManager :: Manager, lbLb :: LoadBalanced ServiceAddr } -{- |- Create a new load balanced http client, for use with 'withResponse'.--}-newLB :: Discovery -> Name -> VersionRange -> IO LBHttp+{- | Create a new load balanced http client, for use with 'withResponse'. -}+newLB+ :: Discovery+ {- ^ A handle on the discovery service, obtained via 'connect'. -}+ -> Name+ {- ^ The name of the target service. -}+ -> VersionRange+ {- ^ 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)+++{- | The content type of a ping request. -}+pingRequestCT :: (IsString a) => a+pingRequestCT = "application/vnd.legion-discovery.ping-request+json"