module Zuul
(
ZuulClient (baseUrl),
withClient,
getStatus,
Zuul.Status (..),
)
where
import Data.Aeson (FromJSON, decode, eitherDecode)
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Data.Text (Text, unpack)
import Network.HTTP.Client
import Network.HTTP.Client.TLS (tlsManagerSettings)
import qualified Zuul.Status as Zuul
data ZuulClient
= ZuulClient
{
ZuulClient -> Text
baseUrl :: Text,
ZuulClient -> Manager
manager :: Manager
}
withClient ::
Text ->
(ZuulClient -> IO ()) ->
IO ()
withClient :: Text -> (ZuulClient -> IO ()) -> IO ()
withClient url :: Text
url callBack :: ZuulClient -> IO ()
callBack =
do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
ZuulClient -> IO ()
callBack (ZuulClient :: Text -> Manager -> ZuulClient
ZuulClient {..})
where
baseUrl :: Text
baseUrl = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/"
zuulGet ::
(FromJSON a) =>
Text ->
ZuulClient ->
IO a
zuulGet :: Text -> ZuulClient -> IO a
zuulGet path :: Text
path ZuulClient {..} =
do
Request
initRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path)
let request :: Request
request = Request
initRequest {requestHeaders :: RequestHeaders
requestHeaders = [("Accept", "*/*")]}
Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String a) -> ByteString -> Either String a
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response of
Left err :: String
err -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ "Decoding of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " failed with: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
Right a :: a
a -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
getStatus :: ZuulClient -> IO Zuul.Status
getStatus :: ZuulClient -> IO Status
getStatus = Text -> ZuulClient -> IO Status
forall a. FromJSON a => Text -> ZuulClient -> IO a
zuulGet "status"