{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

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

    -- * Api
    getJobConfig,
    getJobs,
    getProjectConfig,
    getProjects,
    getStatus,
    getTenants,

    -- * Main data types
    Zuul.Job (..),
    Zuul.JobConfig (..),
    Zuul.Node (..),
    Zuul.Nodeset (..),
    Zuul.ProjectPipelineJob (..),
    Zuul.ProjectPipelineConfig (..),
    Zuul.ProjectPipeline (..),
    Zuul.ProjectConfig (..),
    Zuul.Project (..),
    Zuul.Status (..),
    Zuul.SourceContext (..),
    Zuul.Tenant (..),
  )
where

import Data.Aeson (FromJSON, decode, eitherDecode)
import Data.Maybe (fromJust)
import Data.Text (Text, unpack)
import qualified Data.Text as T
import Network.HTTP.Client (Manager, httpLbs, newManager, parseUrlThrow, requestHeaders, responseBody)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import qualified Zuul.Job as Zuul
import qualified Zuul.JobConfig as Zuul
import qualified Zuul.Nodeset as Zuul
import qualified Zuul.Project as Zuul
import qualified Zuul.ProjectConfig as Zuul
import qualified Zuul.SourceContext as Zuul
import qualified Zuul.Status as Zuul
import qualified Zuul.Tenant 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 Text
url ZuulClient -> IO ()
callBack =
  do
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    ZuulClient -> IO ()
callBack (ZuulClient :: Text -> Manager -> ZuulClient
ZuulClient {Text
Manager
baseUrl :: Text
manager :: Manager
manager :: Manager
baseUrl :: Text
..})
  where
    baseUrl :: Text
baseUrl = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"

-- | Update a 'ZuulClient' to work on a tenant
onTenant :: ZuulClient -> Text -> ZuulClient
onTenant :: ZuulClient -> Text -> ZuulClient
onTenant ZuulClient
client Text
tenant = ZuulClient
client {baseUrl :: Text
baseUrl = ZuulClient -> Text
baseUrl ZuulClient
client Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"tenant/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tenant Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"}

zuulGet ::
  (FromJSON a) =>
  Text ->
  ZuulClient ->
  IO a
zuulGet :: Text -> ZuulClient -> IO a
zuulGet Text
path ZuulClient {Text
Manager
manager :: Manager
baseUrl :: Text
manager :: ZuulClient -> Manager
baseUrl :: ZuulClient -> Text
..} =
  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 = [(HeaderName
"Accept", ByteString
"*/*")]}
    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 String
err -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"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
<> String
" failed with: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
      Right 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 Text
"status"

getTenants :: ZuulClient -> IO [Zuul.Tenant]
getTenants :: ZuulClient -> IO [Tenant]
getTenants = Text -> ZuulClient -> IO [Tenant]
forall a. FromJSON a => Text -> ZuulClient -> IO a
zuulGet Text
"tenants"

getProjects :: ZuulClient -> IO [Zuul.Project]
getProjects :: ZuulClient -> IO [Project]
getProjects = Text -> ZuulClient -> IO [Project]
forall a. FromJSON a => Text -> ZuulClient -> IO a
zuulGet Text
"projects"

getProjectConfig :: ZuulClient -> Text -> IO Zuul.ProjectConfig
getProjectConfig :: ZuulClient -> Text -> IO ProjectConfig
getProjectConfig ZuulClient
client Text
project = Text -> ZuulClient -> IO ProjectConfig
forall a. FromJSON a => Text -> ZuulClient -> IO a
zuulGet (Text
"project/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
project) ZuulClient
client

getJobs :: ZuulClient -> IO [Zuul.Job]
getJobs :: ZuulClient -> IO [Job]
getJobs = Text -> ZuulClient -> IO [Job]
forall a. FromJSON a => Text -> ZuulClient -> IO a
zuulGet Text
"jobs"

getJobConfig :: ZuulClient -> Text -> IO [Zuul.JobConfig]
getJobConfig :: ZuulClient -> Text -> IO [JobConfig]
getJobConfig ZuulClient
client Text
job = Text -> ZuulClient -> IO [JobConfig]
forall a. FromJSON a => Text -> ZuulClient -> IO a
zuulGet (Text
"job/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
job) ZuulClient
client