{-# 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
  , pagureProjectGitURLs
  , 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 :: 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 -> Query -> 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 -> String -> Query
                        -> 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 -> String -> Query
  -> 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 -> String -> Int -> 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 -> String -> 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 -> String -> 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 -> String -> 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 -> String -> Query -> 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 -> Maybe String -> Query -> 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

-- | Project Git URLs
--
-- https://pagure.io/api/0/#projects-tab
pagureProjectGitURLs :: String -> String -> 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 -> String -> Query -> 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 -> String -> Query -> 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 -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount String
server String
path Query
params String
pagination = do
  Object
res <- 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
"1")
  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
--
-- Note this can potentially download very large amount of data.
-- For potentially large queries, it is a good idea to queryPagureCount first.
queryPagurePaged :: String -> String -> Query -> (String,String) -> 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"
  Object
res1 <- 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
maxPerPage)
  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
$
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (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 -> String -> 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

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

-- | list user's forks
pagureUserForks :: String -> String -> 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