{-# LANGUAGE CPP, OverloadedStrings #-}

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

Pagure REST client library
-}

module Fedora.Pagure
  ( pagureProjectInfo
  , pagureListProjects
  , pagureListProjectIssues
  , IssueTitleStatus(..)
  , pagureListProjectIssueTitlesStatus
  , pagureProjectIssueInfo
  , pagureListGitBranches
  , pagureListGitBranchesWithCommits
  , pagureListUsers
  , pagureUserForks
  , pagureUserInfo
  , pagureUserRepos
  , pagureListGroups
  , pagureGroupInfo
  , pagureGroupRepos
  , pagureProjectGitURLs
  , queryPagure
  , queryPagureSingle
  , queryPagureCount
  , queryPagureCountPaged
  , makeKey
  , makeItem
  , maybeKey
  , Query
  , QueryItem
  , lookupKey
  , lookupKey'
  , getRepos
  ) where

import Control.Monad
import Data.Aeson.Types
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Query
import System.IO (hPutStrLn, stderr)

-- | Project info
--
-- @pagureProjectInfo server "<repo>"@
-- @pagureProjectInfo server "<namespace>/<repo>"@
--
-- https://pagure.io/api/0/#projects-tab
pagureProjectInfo :: String -- ^ server
                  -> String -- ^ project
                  -> IO (Either String Object)
pagureProjectInfo :: String -> String -> IO (Either String Object)
pagureProjectInfo String
server String
project = do
  let path :: String
path = String
project
  String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path []

-- | List projects
--
-- https://pagure.io/api/0/#projects-tab
pagureListProjects :: String -- ^ server
                   -> Query  -- ^ parameters
                   -> IO Object
pagureListProjects :: String -> Query -> IO Object
pagureListProjects String
server Query
params = do
  let path :: String
path = String
"projects"
  String -> String -> Query -> IO Object
queryPagure String
server String
path Query
params

-- | List project issues
--
-- https://pagure.io/api/0/#issues-tab
pagureListProjectIssues :: String -- ^ server
                        -> String -- ^ project repo
                        -> Query  -- ^ parameters
                        -> IO (Either String Object)
pagureListProjectIssues :: String -> String -> Query -> IO (Either String Object)
pagureListProjectIssues String
server String
repo Query
params = do
  let path :: String
path = String
repo String -> String -> String
+/+ String
"issues"
  String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path Query
params

data IssueTitleStatus =
  IssueTitleStatus { IssueTitleStatus -> Integer
pagureIssueId :: Integer
                   , IssueTitleStatus -> String
pagureIssueTitle :: String
                   , IssueTitleStatus -> Text
pagureIssueStatus :: T.Text
                   , IssueTitleStatus -> Maybe Text
pagureIssueCloseStatus :: Maybe T.Text
                   }

-- | List project issue titles
--
-- https://pagure.io/api/0/#issues-tab
pagureListProjectIssueTitlesStatus :: String -- ^ server
                                   -> String -- ^ repo
                                   -> Query  -- ^ parameters
  -> IO (Either String [IssueTitleStatus])
pagureListProjectIssueTitlesStatus :: String -> String -> Query -> IO (Either String [IssueTitleStatus])
pagureListProjectIssueTitlesStatus String
server String
repo Query
params = do
  let path :: String
path = String
repo String -> String -> String
+/+ String
"issues"
  Either String Object
res <- String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path Query
params
  Either String [IssueTitleStatus]
-> IO (Either String [IssueTitleStatus])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [IssueTitleStatus]
 -> IO (Either String [IssueTitleStatus]))
-> Either String [IssueTitleStatus]
-> IO (Either String [IssueTitleStatus])
forall a b. (a -> b) -> a -> b
$ case Either String Object
res of
    Left String
e -> String -> Either String [IssueTitleStatus]
forall a b. a -> Either a b
Left String
e
    Right Object
v -> [IssueTitleStatus] -> Either String [IssueTitleStatus]
forall a b. b -> Either a b
Right ([IssueTitleStatus] -> Either String [IssueTitleStatus])
-> [IssueTitleStatus] -> Either String [IssueTitleStatus]
forall a b. (a -> b) -> a -> b
$ (Object -> Maybe IssueTitleStatus)
-> [Object] -> [IssueTitleStatus]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Object -> Maybe IssueTitleStatus
parseIssue ([Object] -> [IssueTitleStatus]) -> [Object] -> [IssueTitleStatus]
forall a b. (a -> b) -> a -> b
$ Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"issues" Object
v
  where
    parseIssue :: Object -> Maybe IssueTitleStatus
    parseIssue :: Object -> Maybe IssueTitleStatus
parseIssue =
      (Object -> Parser IssueTitleStatus)
-> Object -> Maybe IssueTitleStatus
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe ((Object -> Parser IssueTitleStatus)
 -> Object -> Maybe IssueTitleStatus)
-> (Object -> Parser IssueTitleStatus)
-> Object
-> Maybe IssueTitleStatus
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Integer
id' <- Object
obj Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Text
title <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"title"
        Text
status <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"status"
        Maybe Text
mcloseStatus <- Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"close_status"
        IssueTitleStatus -> Parser IssueTitleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (IssueTitleStatus -> Parser IssueTitleStatus)
-> IssueTitleStatus -> Parser IssueTitleStatus
forall a b. (a -> b) -> a -> b
$ Integer -> String -> Text -> Maybe Text -> IssueTitleStatus
IssueTitleStatus Integer
id' (Text -> String
T.unpack Text
title) Text
status Maybe Text
mcloseStatus

-- | Issue information
--
-- https://pagure.io/api/0/#issues-tab
pagureProjectIssueInfo :: String -- ^ server
                       -> String -- ^ repo
                       -> Int    -- ^ issue number
                       -> IO (Either String Object)
pagureProjectIssueInfo :: String -> String -> Int -> IO (Either String Object)
pagureProjectIssueInfo String
server String
repo Int
issue = do
  let path :: String
path = String
repo String -> String -> String
+/+ String
"issue" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
issue
  String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path []

-- | List repo branches
--
-- https://pagure.io/api/0/#projects-tab
pagureListGitBranches :: String -- ^ server
                      -> String -- ^ repo
                      -> IO (Either String [String])
pagureListGitBranches :: String -> String -> IO (Either String [String])
pagureListGitBranches String
server String
repo = do
  let path :: String
path = String
repo String -> String -> String
+/+ String
"git/branches"
  Either String Object
res <- String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path []
  Either String [String] -> IO (Either String [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [String] -> IO (Either String [String]))
-> Either String [String] -> IO (Either String [String])
forall a b. (a -> b) -> a -> b
$ case Either String Object
res of
    Left String
e -> String -> Either String [String]
forall a b. a -> Either a b
Left String
e
    Right Object
v -> (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String])
-> Either String [Text] -> Either String [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Object -> Either String [Text]
forall a. FromJSON a => Text -> Object -> Either String a
lookupKeyEither Text
"branches" Object
v

-- | List repo branches with commits
--
-- https://pagure.io/api/0/#projects-tab
pagureListGitBranchesWithCommits :: String -- ^ server
                                 -> String -- ^ repo
                                 -> IO (Either String Object)
pagureListGitBranchesWithCommits :: String -> String -> IO (Either String Object)
pagureListGitBranchesWithCommits String
server String
repo = do
  let path :: String
path = String
repo String -> String -> String
+/+ String
"git/branches"
      params :: Query
params = String -> String -> Query
makeKey String
"with_commits" String
"1"
  Either String Object
res <- String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path Query
params
  Either String Object -> IO (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> IO (Either String Object))
-> Either String Object -> IO (Either String Object)
forall a b. (a -> b) -> a -> b
$ case Either String Object
res of
    Left String
e -> String -> Either String Object
forall a b. a -> Either a b
Left String
e
    Right Object
v -> Text -> Object -> Either String Object
forall a. FromJSON a => Text -> Object -> Either String a
lookupKeyEither Text
"branches" Object
v

-- | List users
--
-- https://pagure.io/api/0/#users-tab
pagureListUsers :: String -- ^ server
                -> String -- ^ pattern
                -> IO Object
pagureListUsers :: String -> String -> IO Object
pagureListUsers String
server String
pat = do
  let path :: String
path = String
"users"
      params :: Query
params = String -> String -> Query
makeKey String
"pattern" String
pat
  String -> String -> Query -> IO Object
queryPagure String
server String
path Query
params

-- | User information
--
-- https://pagure.io/api/0/#users-tab
pagureUserInfo :: String -- ^ server
               -> String -- ^ user
               -> Query  -- ^ parameters
               -> IO (Either String Object)
pagureUserInfo :: String -> String -> Query -> IO (Either String Object)
pagureUserInfo String
server String
user Query
params = do
  let path :: String
path = String
"user" String -> String -> String
+/+ String
user
  String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path Query
params

-- | List groups
--
-- https://pagure.io/api/0/#groups-tab
pagureListGroups :: String -- ^ server
                 -> Maybe String -- ^ optional pattern
                 -> Query  -- ^ parameters
                 -> IO Object
pagureListGroups :: String -> Maybe String -> Query -> IO Object
pagureListGroups String
server Maybe String
mpat Query
paging = do
  let path :: String
path = String
"groups"
      params :: Query
params = String -> Maybe String -> Query
maybeKey String
"pattern" Maybe String
mpat Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ Query
paging
  String -> String -> Query -> IO Object
queryPagure String
server String
path Query
params

-- | Group information
--
-- https://pagure.io/api/0/#groups-tab
pagureGroupInfo :: String -- ^ server
                -> String -- ^ group
                -> Query  -- ^ parameters
                -> IO (Either String Object)
pagureGroupInfo :: String -> String -> Query -> IO (Either String Object)
pagureGroupInfo String
server String
group Query
params = do
  let path :: String
path = String
"group" String -> String -> String
+/+ String
group
  String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path Query
params

-- | Project Git URLs
--
-- https://pagure.io/api/0/#projects-tab
pagureProjectGitURLs :: String -- ^ server
                     -> String -- ^ repo
                     -> IO (Either String Object)
pagureProjectGitURLs :: String -> String -> IO (Either String Object)
pagureProjectGitURLs String
server String
repo = do
  let path :: String
path = String
repo String -> String -> String
+/+ String
"git/urls"
  String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path []

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

-- | single query
queryPagureSingle :: String -- ^ server
                  -> String -- ^ api path
                  -> Query  -- ^ parameters
                  -> IO (Either String Object)
queryPagureSingle :: String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path Query
params = do
  Object
res <- String -> String -> Query -> IO Object
queryPagure String
server String
path Query
params
  Either String Object -> IO (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> IO (Either String Object))
-> Either String Object -> IO (Either String Object)
forall a b. (a -> b) -> a -> b
$ case Text -> Object -> Maybe Text
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"error" Object
res of
             Just Text
err -> String -> Either String Object
forall a b. a -> Either a b
Left (Text -> String
T.unpack Text
err)
             Maybe Text
Nothing -> Object -> Either String Object
forall a b. b -> Either a b
Right Object
res

-- | count total number of hits
queryPagureCount :: String -- ^ server
                 -> String -- ^ api path
                 -> Query  -- ^ parameters
                 -> String -- ^ pagination name
                 -> IO (Maybe Integer)
queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount String
server String
path Query
params String
pagination = do
  Either String Object
eres <- String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
"per_page" String
"1")
  case Either String Object
eres of
    Left String
err -> do
      String -> IO ()
warning String
err
      Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
    Right Object
res ->
      Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer -> IO (Maybe Integer))
-> Maybe Integer -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Maybe Object
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey (String -> Text
T.pack String
pagination) Object
res Maybe Object -> (Object -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Object -> Maybe Integer
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"pages"

-- | get all pages of results
--
-- Warning: this can potentially download very large amounts of data.
-- For potentially large queries, it is a good idea to queryPagureCount first.
queryPagurePaged :: String -- ^ server
                 -> String -- ^ api path
                 -> Query  -- ^ parameters
                 -> (String,String) -- ^  pagination and paging names
                 -> IO [Object]
queryPagurePaged :: String -> String -> Query -> (String, String) -> IO [Object]
queryPagurePaged String
server String
path Query
params (String
pagination,String
paging) = do
  -- FIXME allow overriding per_page
  let maxPerPage :: String
maxPerPage = String
"100"
  Either String Object
eres <- String -> String -> Query -> IO (Either String Object)
queryPagureSingle String
server String
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
"per_page" String
maxPerPage)
  case Either String Object
eres of
    Left String
err -> do
      String -> IO ()
warning String
err
      [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right Object
res1 ->
      case (Text -> Object -> Maybe Object
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey (String -> Text
T.pack String
pagination) Object
res1 :: Maybe Object) Maybe Object -> (Object -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Object -> Maybe Int
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"pages" :: Maybe Int of
        Maybe Int
Nothing -> [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just Int
pages -> do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pages Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> IO ()
warning (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"receiving " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
pages String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" pages × " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
maxPerPage String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" results..."
          [Object]
rest <- (Int -> IO Object) -> [Int] -> IO [Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Object
forall a. Show a => a -> IO Object
nextPage [Int
2..Int
pages]
          [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Object
res1 Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object]
rest
  where
    nextPage :: a -> IO Object
nextPage a
p =
      String -> String -> Query -> IO Object
queryPagure String
server String
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
"per_page" String
"100" Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
paging (a -> String
forall a. Show a => a -> String
show a
p))

-- | list user's repos
pagureUserRepos :: String -- ^ server
                -> String -- ^ user
                -> IO [Text]
pagureUserRepos :: String -> String -> IO [Text]
pagureUserRepos String
server String
user = do
  let path :: String
path = String
"user" String -> String -> String
+/+ String
user
  [Object]
pages <- String -> String -> Query -> (String, String) -> IO [Object]
queryPagurePaged String
server String
path [] (String
"repos_pagination", String
"repopage")
  [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Object -> [Text]) -> [Object] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Object -> [Text]
getRepos Text
"repos") [Object]
pages

-- | list user's forks
pagureUserForks :: String -- ^ server
                -> String -- ^ user
                -> IO [Text]
pagureUserForks :: String -> String -> IO [Text]
pagureUserForks String
server String
user = do
  let path :: String
path = String
"user" String -> String -> String
+/+ String
user
  [Object]
pages <- String -> String -> Query -> (String, String) -> IO [Object]
queryPagurePaged String
server String
path [] (String
"forks_pagination", String
"forkpage")
  [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Object -> [Text]) -> [Object] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Object -> [Text]
getRepos Text
"forks") [Object]
pages

-- | list group's repos
pagureGroupRepos :: String -- ^ server
                 -> Bool -- ^ count
                 -> String -- ^ group
                 -> IO [Text]
pagureGroupRepos :: String -> Bool -> String -> IO [Text]
pagureGroupRepos String
server Bool
count String
group = do
  let path :: String
path = String
"group" String -> String -> String
+/+ String
group
      params :: Query
params = String -> String -> Query
makeKey String
"projects" String
"1"
  [Object]
pages <- String
-> Bool -> String -> Query -> (String, String) -> IO [Object]
queryPagureCountPaged String
server Bool
count String
path Query
params (String
"pagination", String
"page")
  [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Object -> [Text]) -> [Object] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Object -> [Text]
getRepos Text
"projects") [Object]
pages

-- | helper to extract fullnames of repos
getRepos :: Text   -- ^ field (eg "repos")
         -> Object -- ^ results page
         -> [Text]
getRepos :: Text -> Object -> [Text]
getRepos Text
field Object
obj =
  (Object -> Text) -> [Object] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Object -> Text
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"fullname") ([Object] -> [Text]) -> [Object] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
field Object
obj

-- | Get count (with queryPagureCount) or full results (queryPagurePaged)
queryPagureCountPaged :: String -- ^ server
                      -> Bool   -- ^ count
                      -> String -- ^ api path
                      -> Query  -- ^ parameters
                      -> (String,String) -- ^ pagination and paging names
                      -> IO [Object]
queryPagureCountPaged :: String
-> Bool -> String -> Query -> (String, String) -> IO [Object]
queryPagureCountPaged String
server Bool
count String
path Query
params (String
pagination,String
paging) =
  if Bool
count
    then do
    Maybe Integer
mnum <- String -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount String
server String
path Query
params String
pagination
    IO () -> (Integer -> IO ()) -> Maybe Integer -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO ()
warning String
"no results found") Integer -> IO ()
forall a. Show a => a -> IO ()
print Maybe Integer
mnum
    [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else String -> String -> Query -> (String, String) -> IO [Object]
queryPagurePaged String
server String
path Query
params (String
pagination,String
paging)

-- from simple-cmd
warning :: String -> IO ()
warning :: String -> IO ()
warning String
s = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$! String
s