{-# LANGUAGE CPP, OverloadedStrings #-}

{- |
Copyright: (c) 2020 Jens Petersen
SPDX-License-Identifier: GPL-2.0-only
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
  , pagureProjectGitURLs
  , queryPagure
  , queryPagure'
  , queryPagureSingle
  , queryPagurePaged
  , queryPagureCount
  , makeKey
  , makeItem
  , maybeKey
  , Query
  , QueryItem
  , lookupKey
  , lookupKey'
  ) 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 -> String -> IO (Either String Object)
pagureProjectInfo :: [Char] -> [Char] -> IO (Either [Char] Object)
pagureProjectInfo [Char]
server [Char]
project = do
  let path :: [Char]
path = [Char]
project
  [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path []

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

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

data IssueTitleStatus =
  IssueTitleStatus { IssueTitleStatus -> Integer
pagureIssueId :: Integer
                   , IssueTitleStatus -> [Char]
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 -> String -> Query
  -> IO (Either String [IssueTitleStatus])
pagureListProjectIssueTitlesStatus :: [Char] -> [Char] -> Query -> IO (Either [Char] [IssueTitleStatus])
pagureListProjectIssueTitlesStatus [Char]
server [Char]
repo Query
params = do
  let path :: [Char]
path = [Char]
repo [Char] -> [Char] -> [Char]
+/+ [Char]
"issues"
  Either [Char] Object
res <- [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params
  Either [Char] [IssueTitleStatus]
-> IO (Either [Char] [IssueTitleStatus])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] [IssueTitleStatus]
 -> IO (Either [Char] [IssueTitleStatus]))
-> Either [Char] [IssueTitleStatus]
-> IO (Either [Char] [IssueTitleStatus])
forall a b. (a -> b) -> a -> b
$ case Either [Char] Object
res of
    Left [Char]
e -> [Char] -> Either [Char] [IssueTitleStatus]
forall a b. a -> Either a b
Left [Char]
e
    Right Object
v -> [IssueTitleStatus] -> Either [Char] [IssueTitleStatus]
forall a b. b -> Either a b
Right ([IssueTitleStatus] -> Either [Char] [IssueTitleStatus])
-> [IssueTitleStatus] -> Either [Char] [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 -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Text
title <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
        Text
status <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        Maybe Text
mcloseStatus <- Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"close_status"
        IssueTitleStatus -> Parser IssueTitleStatus
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (IssueTitleStatus -> Parser IssueTitleStatus)
-> IssueTitleStatus -> Parser IssueTitleStatus
forall a b. (a -> b) -> a -> b
$ Integer -> [Char] -> Text -> Maybe Text -> IssueTitleStatus
IssueTitleStatus Integer
id' (Text -> [Char]
T.unpack Text
title) Text
status Maybe Text
mcloseStatus

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

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

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

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

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

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

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

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

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

-- | low-level query
-- Like queryPagure but errors if JSON has "error" field:
-- eg for a non-existent API query path
queryPagure' :: String -> String -> Query -> IO Object
queryPagure' :: [Char] -> [Char] -> Query -> IO Object
queryPagure' [Char]
server [Char]
path Query
params = do
  Either [Char] Object
eres <- [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params
  ([Char] -> IO Object)
-> (Object -> IO Object) -> Either [Char] Object -> IO Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO Object
forall a. HasCallStack => [Char] -> a
error Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] Object
eres

-- | single query
queryPagureSingle :: String -> String -> Query -> IO (Either String Object)
queryPagureSingle :: [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params = do
  Object
res <- [Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path Query
params
  Either [Char] Object -> IO (Either [Char] Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Object -> IO (Either [Char] Object))
-> Either [Char] Object -> IO (Either [Char] 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 -> [Char] -> Either [Char] Object
forall a b. a -> Either a b
Left (Text -> [Char]
T.unpack Text
err)
             Maybe Text
Nothing -> Object -> Either [Char] Object
forall a b. b -> Either a b
Right Object
res

-- | count total number of hits
-- FIXME: errors if the query fails
queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount :: [Char] -> [Char] -> Query -> [Char] -> IO (Maybe Integer)
queryPagureCount [Char]
server [Char]
path Query
params [Char]
pagination = do
  Object
res <- [Char] -> [Char] -> Query -> IO Object
queryPagure' [Char]
server [Char]
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
"per_page" [Char]
"1")
  Maybe Integer -> IO (Maybe Integer)
forall a. a -> IO a
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 ([Char] -> Text
T.pack [Char]
pagination) Object
res Maybe Object -> (Object -> Maybe Integer) -> Maybe Integer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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.
--
-- Errors for a non-existent API path
queryPagurePaged :: String -> String -> Query -> (String,String) -> IO [Object]
queryPagurePaged :: [Char] -> [Char] -> Query -> ([Char], [Char]) -> IO [Object]
queryPagurePaged [Char]
server [Char]
path Query
params ([Char]
pagination,[Char]
paging) = do
  -- FIXME allow overriding per_page
  let maxPerPage :: [Char]
maxPerPage = [Char]
"100"
  Object
res1 <- [Char] -> [Char] -> Query -> IO Object
queryPagure' [Char]
server [Char]
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
"per_page" [Char]
maxPerPage)
  case (Text -> Object -> Maybe Object
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey ([Char] -> Text
T.pack [Char]
pagination) Object
res1 :: Maybe Object) Maybe Object -> (Object -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 a. a -> IO a
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
$
        Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"receiving " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
pages [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" pages × " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
maxPerPage [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO Object
forall {a}. Show a => a -> IO Object
nextPage [Int
2..Int
pages]
      [Object] -> IO [Object]
forall a. a -> IO a
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 =
      [Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
"per_page" [Char]
"100" Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
paging (a -> [Char]
forall a. Show a => a -> [Char]
show a
p))

-- FIXME treat these as special cases/filters of userinfo

-- | list user's repos
pagureUserRepos :: String -> String -> IO [Text]
pagureUserRepos :: [Char] -> [Char] -> IO [Text]
pagureUserRepos [Char]
server [Char]
user = do
  let path :: [Char]
path = [Char]
"user" [Char] -> [Char] -> [Char]
+/+ [Char]
user
  [Object]
pages <- [Char] -> [Char] -> Query -> ([Char], [Char]) -> IO [Object]
queryPagurePaged [Char]
server [Char]
path [] ([Char]
"repos_pagination", [Char]
"repopage")
  [Text] -> IO [Text]
forall a. a -> IO a
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 -> String -> IO [Text]
pagureUserForks :: [Char] -> [Char] -> IO [Text]
pagureUserForks [Char]
server [Char]
user = do
  let path :: [Char]
path = [Char]
"user" [Char] -> [Char] -> [Char]
+/+ [Char]
user
  [Object]
pages <- [Char] -> [Char] -> Query -> ([Char], [Char]) -> IO [Object]
queryPagurePaged [Char]
server [Char]
path [] ([Char]
"forks_pagination", [Char]
"forkpage")
  [Text] -> IO [Text]
forall a. a -> IO a
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

getRepos :: Text -> Object -> [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