{-# LANGUAGE CPP #-}

{- |
Copyright: (c) 2020 Jens Petersen
SPDX-License-Identifier: GPL-2.0-only
Maintainer: Jens Petersen <petersen@redhat.com>

Copr REST client library
-}

module Web.Fedora.Copr.API
  ( coprGetProject
  , coprGetProjectsList
  , coprSearchProjects
  , coprGetBuild
  , coprGetBuildSourceChroot
  , coprGetBuildSourceConfig
  , coprGetBuildList
  , coprGetBuildPackageList
  , coprGetBuildChroot
  , coprGetBuildChrootList
  , coprGetBuildChrootConfig
--  , coprGetBuiltPackages
  , coprMockChrootList
  , coprMonitorProject
  , coprGetPackage
  , coprGetPackageList
  , coprGetProjectChroot
  , coprGetProjectChrootBuildConfig
  , queryCopr
  , maybeKey
  , makeKey
  , makeItem
  , lookupKey
  , lookupKey'
  )
where

import Data.Aeson.Types
import Data.List (intercalate)
import Network.HTTP.Query

-- # Projects

-- | List project details
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/project.py#_9
coprGetProject :: String -> String -> String -> IO Object
coprGetProject :: String -> String -> String -> IO Object
coprGetProject String
server String
owner String
project = do
  let path :: String
path = String
"project"
      params :: [QueryItem]
params = [String -> String -> QueryItem
makeItem String
"ownername" String
owner, String -> String -> QueryItem
makeItem String
"projectname" String
project]
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- | List projects of owner
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/project.py#_37
coprGetProjectsList :: String -> String -> IO Object
-- FIXME limit=int or maybe pagination?
coprGetProjectsList :: String -> String -> IO Object
coprGetProjectsList String
server String
owner = do
  let path :: String
path = String
"project/list"
      params :: [QueryItem]
params = String -> String -> [QueryItem]
makeKey String
"ownername" String
owner
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- | search projects by query string
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/project.py#_43
coprSearchProjects :: String -> String -> IO Object
coprSearchProjects :: String -> String -> IO Object
coprSearchProjects String
server String
query = do
  let path :: String
path = String
"project/search"
      params :: [QueryItem]
params = String -> String -> [QueryItem]
makeKey String
"query" String
query
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- # Builds

-- | get build
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build.py#_10
coprGetBuild :: String -> Int -> IO Object
coprGetBuild :: String -> Int -> IO Object
coprGetBuild String
server Int
bid = do
  let path :: String
path = String
"build" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
bid
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path []

-- | get srpm build
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build.py#_22
coprGetBuildSourceChroot :: String -> Int -> IO Object
coprGetBuildSourceChroot :: String -> Int -> IO Object
coprGetBuildSourceChroot String
server Int
bid = do
  let path :: String
path = String
"build/source-chroot" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
bid
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path []

-- | get build source config
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build.py#_34
coprGetBuildSourceConfig :: String -> Int -> IO Object
coprGetBuildSourceConfig :: String -> Int -> IO Object
coprGetBuildSourceConfig String
server Int
bid = do
  let path :: String
path = String
"build/source-build-config" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
bid
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path []

-- | get list of builds
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build.py#_56
coprGetBuildList :: String -> String -> String -> Query -> IO Object
coprGetBuildList :: String -> String -> String -> [QueryItem] -> IO Object
coprGetBuildList String
server String
owner String
project [QueryItem]
params = do
  let path :: String
path = String
"build/list"
      params' :: [QueryItem]
params' = [String -> String -> QueryItem
makeItem String
"ownername" String
owner,
                String -> String -> QueryItem
makeItem String
"projectname" String
project] [QueryItem] -> [QueryItem] -> [QueryItem]
forall a. [a] -> [a] -> [a]
++ [QueryItem]
params
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params'

-- | get list of packages
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build.py#_46
coprGetBuildPackageList :: String -> Query -> IO Object
coprGetBuildPackageList :: String -> [QueryItem] -> IO Object
coprGetBuildPackageList String
server [QueryItem]
params = do
  let path :: String
path = String
"build/list"
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- # Build chroot

-- | get build chroot
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build_chroot.py#_8
coprGetBuildChroot :: String -> Int -> String -> IO Object
coprGetBuildChroot :: String -> Int -> String -> IO Object
coprGetBuildChroot String
server Int
bid String
chroot = do
  let path :: String
path = String
"build-chroot" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
bid String -> String -> String
+/+ String
chroot
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path []

-- | list of build chroots
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build_chroot.py#_25
coprGetBuildChrootList :: String -> Int -> IO Object
coprGetBuildChrootList :: String -> Int -> IO Object
coprGetBuildChrootList String
server Int
bid = do
  let path :: String
path = String
"build-chroot/list" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
bid
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path []

-- | get build config for chroot
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/build_chroot.py#_44
coprGetBuildChrootConfig :: String -> Int -> String -> IO Object
coprGetBuildChrootConfig :: String -> Int -> String -> IO Object
coprGetBuildChrootConfig String
server Int
bid String
chroot = do
  let path :: String
path = String
"build-chroot/build-config" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
bid String -> String -> String
+/+ String
chroot
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path []

-- # Mock chroot

-- | list of all available mock chroots
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/mock_chroot.py
coprMockChrootList :: String -> IO Object
coprMockChrootList :: String -> IO Object
coprMockChrootList String
server = do
  let path :: String
path = String
"mock-chroots/list"
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path []

-- # Package

-- | Get project package details
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/package.py#_9
coprGetPackage :: String -> String -> String -> String -> IO Object
coprGetPackage :: String -> String -> String -> String -> IO Object
coprGetPackage String
server String
owner String
project String
package = do
  let path :: String
path = String
"package"
      params :: [QueryItem]
params = [String -> String -> QueryItem
makeItem String
"ownername" String
owner,
                String -> String -> QueryItem
makeItem String
"projectname" String
project,
                String -> String -> QueryItem
makeItem String
"packagename" String
package]
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- | List project packages
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/package.py#_28
coprGetPackageList :: String -> String -> String -> IO Object
coprGetPackageList :: String -> String -> String -> IO Object
coprGetPackageList String
server String
owner String
project = do
  let path :: String
path = String
"package/list"
      params :: [QueryItem]
params = [String -> String -> QueryItem
makeItem String
"ownername" String
owner, String -> String -> QueryItem
makeItem String
"projectname" String
project]
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- # Project chroot

-- | get build chroot
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/project_chroot.py#_10
coprGetProjectChroot :: String -> String -> String -> String -> IO Object
coprGetProjectChroot :: String -> String -> String -> String -> IO Object
coprGetProjectChroot String
server String
owner String
project String
chroot = do
  let path :: String
path = String
"project-chroot"
      params :: [QueryItem]
params = [String -> String -> QueryItem
makeItem String
"ownername" String
owner,
                String -> String -> QueryItem
makeItem String
"projectname" String
project,
                String -> String -> QueryItem
makeItem String
"chrootname" String
chroot]
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- | list of build chroots
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/project_chroot.py#_29
coprGetProjectChrootBuildConfig :: String -> String -> String -> String
                                -> IO Object
coprGetProjectChrootBuildConfig :: String -> String -> String -> String -> IO Object
coprGetProjectChrootBuildConfig String
server String
owner String
project String
chroot = do
  let path :: String
path = String
"project-chroot/build-config"
      params :: [QueryItem]
params = [String -> String -> QueryItem
makeItem String
"ownername" String
owner,
                String -> String -> QueryItem
makeItem String
"projectname" String
project,
                String -> String -> QueryItem
makeItem String
"chrootname" String
chroot]
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- | monitor info for the latest project chroot builds.
--
-- https://pagure.io/copr/copr/blob/main/f/python/copr/v3/proxies/monitor.py#_16
coprMonitorProject :: String -> String -> String -> [String] -> IO Object
coprMonitorProject :: String -> String -> String -> [String] -> IO Object
coprMonitorProject String
server String
owner String
project [String]
fields = do
  let path :: String
path = String
"monitor"
      params :: [QueryItem]
params = [String -> String -> QueryItem
makeItem String
"ownername" String
owner,
                String -> String -> QueryItem
makeItem String
"projectname" String
project,
                String -> String -> QueryItem
makeItem String
"additional_fields" (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
fields)]
  String -> String -> [QueryItem] -> IO Object
forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params

-- | low-level API query
queryCopr :: FromJSON a
          => String -- ^ server
          -> String -- ^ path
          -> Query -- ^ parameters
          -> IO a
queryCopr :: forall a. FromJSON a => String -> String -> [QueryItem] -> IO a
queryCopr String
server String
path [QueryItem]
params =
  let url :: String
url = String
"https://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
server String -> String -> String
+/+ String
"api_3" String -> String -> String
+/+ String
path
  in String -> [QueryItem] -> IO a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
String -> [QueryItem] -> m a
webAPIQuery String
url [QueryItem]
params