-- | This module contains the zuul REST client
module Zuul
  ( -- * Client
    ZuulClient (baseUrl),
    withClient,

    -- * Api
    getStatus,

    -- * Main data types
    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

-- | The ZuulClient record, use 'withClient' to create
data ZuulClient
  = ZuulClient
      { -- | the base url
        ZuulClient -> Text
baseUrl :: Text,
        ZuulClient -> Manager
manager :: Manager
      }

-- | Create the 'ZuulClient'
withClient ::
  -- | The zuul api url
  Text ->
  -- | The callback
  (ZuulClient -> IO ()) ->
  -- | withClient performs the 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

-- | Read the status
getStatus :: ZuulClient -> IO Zuul.Status
getStatus :: ZuulClient -> IO Status
getStatus = Text -> ZuulClient -> IO Status
forall a. FromJSON a => Text -> ZuulClient -> IO a
zuulGet "status"