gitlab-haskell 0.1.0.0 → 0.1.0.1

raw patch · 11 files changed

+50/−116 lines, 11 filesdep −arraydep −asyncdep −containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: array, async, containers, random, time

API changes (from Hackage documentation)

Files

• README.md +2/−2
• gitlab-haskell.cabal +4/−18
• src/GitLab/API/Commits.hs +4/−4
• src/GitLab/API/Groups.hs +2/−10
• src/GitLab/API/Issues.hs +4/−15
• src/GitLab/API/Members.hs +2/−8
• src/GitLab/API/Projects.hs +21/−28
• src/GitLab/API/RepositoryFiles.hs +2/−2
• src/GitLab/API/Users.hs +0/−15
• src/GitLab/Types.hs +0/−5
• src/GitLab/WebRequests/GitLabWebCalls.hs +9/−9

@@ -1,7 +1,7 @@ # A Haskell library for the GitLab web API -A library that interacts with a GitLab server's API. It supports-queries about and updates to:+This library interacts with a GitLab server's API. It supports queries+about and updates to:  * Branches * Commits

@@ -1,21 +1,11 @@-cabal-version: 1.12+cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.1.0.0+version:        0.1.0.1 synopsis:       A Haskell library for the GitLab web API description:   This Haskell library queries and updates the database of a GitLab instance using the GitLab web API: <https://docs.gitlab.com/ee/api/>   .-  An example that returns projects for which issue creation is enabled is:-  .-  > projectsWithIssuesEnabled :: IO [Project]-  > projectsWithIssuesEnabled = runGitLab myConfig $ filter (issueEnabled . issues_enabled) <$> allProjects-  >   where myConfig = defaultGitLabServer-  >             { url = "https://gitlab.example.com"-  >             , token = "my_access_token" }-  >         issueEnabled Nothing = False-  >         issueEnabled (Just t) = t-  .   Unsurprisingly, GitLab hosts this Haskell library: <https://gitlab.com/robstewart57/gitlab-haskell>                   @@ -24,7 +14,7 @@ author:         Rob Stewart maintainer:     robstewart57@gmail.com copyright:      2019 Rob Stewart, Heriot-Watt University-license:        BSD3+license:        BSD-3-Clause license-file:   LICENSE build-type:     Simple extra-source-files:@@ -61,13 +51,9 @@               , aeson               , bytestring               , text-              , async               , http-types-              , containers-              , random-              , array-              , time               , transformers               , unliftio               , unliftio-core   default-language: Haskell2010+  ghc-options: -Wall

@@ -31,8 +31,8 @@   gitlab (commitsAddr projectId)   where     commitsAddr :: Int -> Text-    commitsAddr projectId =-      "/projects/" <> T.pack (show projectId) <> "/repository" <> "/commits"+    commitsAddr projId =+      "/projects/" <> T.pack (show projId) <> "/repository" <> "/commits"  -- | returns a commit for the given project and commit hash, if such -- a commit exists.@@ -52,9 +52,9 @@   gitlabOne (commitsAddr projectId)   where     commitsAddr :: Int -> Text-    commitsAddr projectId =+    commitsAddr projId =       "/projects/"-      <> T.pack (show projectId)+      <> T.pack (show projId)       <> "/repository"       <> "/commits"       <> "/" <> hash

@@ -11,20 +11,11 @@ -} module GitLab.API.Groups where -import Control.Concurrent.Async-import Control.Monad import Control.Monad.IO.Class-import Control.Monad.Trans.Reader-import Data.Aeson-import qualified Data.ByteString.Lazy as BSL import Data.Maybe import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import GHC.Generics-import Network.HTTP.Conduit import Network.HTTP.Types.Status-import Network.HTTP.Types.URI  import GitLab.API.Members import GitLab.API.Users@@ -49,7 +40,8 @@   -> AccessLevel -- ^ level of access granted   -> User -- ^ the user   -> GitLab m (Either Status Member)-addUserToGroup groupName access user = addUserToGroup' groupName access (user_id user)+addUserToGroup groupName access usr =+  addUserToGroup' groupName access (user_id usr)  -- | adds a list of users to a group. addUsersToGroup ::

@@ -11,34 +11,23 @@ -} module GitLab.API.Issues where -import Control.Concurrent.Async-import Control.Monad import Control.Monad.IO.Class import Control.Monad.IO.Unlift-import Control.Monad.Trans.Reader-import Data.Array.IO-import Data.List-import Data.Text (Text) import qualified Data.Text as T-import Data.Time.Calendar-import Network.HTTP.Types.Status-import System.IO-import System.Random-import UnliftIO.Async  import GitLab.WebRequests.GitLabWebCalls import GitLab.Types  -- | returns all issues against a project. projectOpenedIssues ::-     (MonadIO m)+     (MonadIO m, MonadUnliftIO m)   => Project -- ^ the project   -> GitLab m [Issue] projectOpenedIssues = projectOpenedIssues' . project_id  -- | returns all issues against a project given its project ID. projectOpenedIssues' ::-     (MonadIO m)+     (MonadIO m, MonadUnliftIO m)   => Int -- ^ the project ID   -> GitLab m [Issue] projectOpenedIssues' projectId = do@@ -51,11 +40,11 @@      (MonadIO m)   => User -- ^ the user   -> GitLab m [Issue]-userIssues user =+userIssues usr =   gitlabWithAttrs addr attrs   where     addr = "/issues"     attrs = T.pack $       "&author_id="-      <> show (user_id user)+      <> show (user_id usr)       <> "&scope=all"

@@ -11,16 +11,10 @@ -} module GitLab.API.Members where -import Control.Concurrent.Async-import Control.Monad import Control.Monad.IO.Class-import Control.Monad.Trans.Reader-import Data.List import Data.Text (Text) import qualified Data.Text as T-import Data.Time.Calendar import Network.HTTP.Types.Status-import System.IO  import GitLab.Types import GitLab.WebRequests.GitLabWebCalls@@ -61,8 +55,8 @@      -> AccessLevel -- ^ level of access      -> User -- ^ the user      -> GitLab m (Either Status Member)-addMemberToProject project access user =-  addMemberToProject' (project_id project) access (user_id user)+addMemberToProject project access usr =+  addMemberToProject' (project_id project) access (user_id usr)  -- | adds a user to a project with the given access level, given the -- project's ID and the user's ID. Returns @Right Member@ for each

@@ -11,25 +11,14 @@ -} module GitLab.API.Projects where -import Control.Monad import Control.Monad.IO.Class import Control.Monad.IO.Unlift-import Control.Monad.Trans.Reader-import Data.Aeson-import qualified Data.ByteString.Lazy as BSL import Data.List-import Data.Map (Map)-import qualified Data.Map as Map import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T-import Data.Time.Clock-import GHC.Generics-import Network.HTTP.Conduit-import Network.HTTP.Types.Status import Network.HTTP.Types.URI-import System.IO import UnliftIO.Async  import GitLab.API.Commits@@ -52,11 +41,11 @@   => Text -- ^ name or namespace of the project   -> GitLab m [Project] projectForks projectName = do-  let path =+  let urlPath =         "/projects/" <>         T.decodeUtf8 (urlEncode False (T.encodeUtf8 projectName)) <>         "/forks"-  gitlab path+  gitlab urlPath  -- | searches for a 'Project' with the given project ID, returns -- 'Nothing' if a project with the given ID is not found.@@ -64,8 +53,8 @@   => Int -- ^ project ID   -> GitLab m (Maybe Project) searchProjectId projectId = do-  let path = T.pack ("/projects/" <> show projectId)-  gitlabOne path+  let urlPath = T.pack ("/projects/" <> show projectId)+  gitlabOne urlPath  -- | gets all projects with the given project name. --@@ -119,9 +108,9 @@   userMaybe <- searchUser username   case userMaybe of     Nothing -> return Nothing-    Just user -> Just <$> gitlab (path (user_id user))+    Just usr -> Just <$> gitlab (urlPath (user_id usr))   where-    path userId = "/users/" <> T.pack (show userId) <> "/projects"+    urlPath userId = "/users/" <> T.pack (show userId) <> "/projects"  -- | gets the 'GitLab.Types.Project' against which the given 'Issue' -- was created.@@ -138,12 +127,12 @@ -- user has created issues for. issuesCreatedByUser :: (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe (User,[Project])) issuesCreatedByUser username = do-  user <- searchUser username-  case user of+  user_maybe <- searchUser username+  case user_maybe of     Nothing -> return Nothing     Just usr -> do-      issues <- userIssues usr-      projects <- mapConcurrently projectOfIssue issues+      usersIssues <- userIssues usr+      projects <- mapConcurrently projectOfIssue usersIssues       return (Just (usr, projects))  -- | searches for all projects with the given name, and returns a list@@ -157,10 +146,14 @@   projects <- projectsWithName projectName   mapM processProject projects   where+    processProject ::+         (MonadUnliftIO m, MonadIO m)+      => Project+      -> GitLab m (Project, [Issue], [User])     processProject proj = do-      issues <- projectOpenedIssues proj-      let authors = map issue_author issues-      return (proj, issues, authors)+      (openIssues :: [Issue]) <- projectOpenedIssues proj+      let authors = map issue_author openIssues+      return (proj, openIssues, authors)  -- | returns a (namespace,members) tuple for the given 'Project', -- where namespace is the namespace of the project@@ -187,7 +180,7 @@   pipes <- pipelines project   case pipes of     [] -> return False-    (x:xs) -> return (pipeline_status x == "success")+    (x:_) -> return (pipeline_status x == "success")  -- | searches for a username, and returns a user ID for that user, or -- 'Nothing' if a user cannot be found. @@ -195,7 +188,7 @@   => Text -- ^ name or namespace of project    -> GitLab m (Maybe Int) namespacePathToUserId namespacePath = do-  user <- searchUser namespacePath-  case user of+  user_maybe <- searchUser namespacePath+  case user_maybe of     Nothing -> return Nothing-    Just user -> return (Just (user_id user))+    Just usr -> return (Just (user_id usr))

@@ -32,8 +32,8 @@   -> Text -- ^ the file path   -> Text -- ^ name of the branch, tag or commit   -> GitLab m (Maybe RepositoryFile)-repositoryFiles' projectId filePath ref =-  gitlabWithAttrsOne addr ("&ref=" <> ref)+repositoryFiles' projectId filePath reference =+  gitlabWithAttrsOne addr ("&ref=" <> reference)   where     addr =       "/projects/"

@@ -11,25 +11,10 @@ -} module GitLab.API.Users where -import Control.Concurrent.Async-import Control.Monad import Control.Monad.IO.Class-import Control.Monad.Trans.Reader-import Data.Aeson-import qualified Data.ByteString.Lazy as BSL import Data.List-import Data.Map (Map)-import qualified Data.Map as Map import Data.Maybe import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Time.Clock-import GHC.Generics-import Network.HTTP.Conduit-import Network.HTTP.Types.Status-import Network.HTTP.Types.URI-import System.IO  import GitLab.Types import GitLab.WebRequests.GitLabWebCalls

@@ -36,16 +36,11 @@   , MergeRequest(..)   ) where -import qualified Data.ByteString.Lazy as BSL import Data.Aeson import Data.Text (Text) import GHC.Generics-import qualified Data.Text as T-import qualified Data.Text.Encoding as T import Network.HTTP.Conduit--- import APICalls import Control.Monad.Trans.Reader-import Network.Connection (TLSSettings (..))  -- | type synonym for all GitLab actions. type GitLab m a = ReaderT GitLabState m a

@@ -11,7 +11,6 @@   , gitlabPost   ) where -import Network.Connection (TLSSettings (..)) import Network.HTTP.Conduit import qualified Data.ByteString.Lazy as BSL import Data.Text (Text)@@ -19,7 +18,6 @@ import qualified Data.Text.Encoding as T import Data.Aeson import qualified Control.Exception as E-import System.IO import Network.HTTP.Types.Status import GitLab.Types import Control.Monad.Trans.Reader@@ -42,10 +40,12 @@                 , requestBody = RequestBodyBS (T.encodeUtf8 dataBody) }   res <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing   case responseStatus res of-    status@(Status 404 msg) -> return (Left status)-    status@(Status 409 msg) -> return (Left status)+    resp@(Status 404 _msg) -> return (Left resp)+    resp@(Status 409 _msg) -> return (Left resp)     _ -> return (case parseBSOne (responseBody res) of-                   Just x -> Right x)+                   Just x -> Right x+                   Nothing -> Left $+                     mkStatus 409 "unable to parse POST response")  tryGitLab ::      Int -- ^ the current retry count@@ -54,12 +54,12 @@   -> Manager -- ^ HTTP manager   -> Maybe HttpException -- ^ the exception to report if maximum retries met   -> IO (Response BSL.ByteString)-tryGitLab i request retries manager ex-  | i == retries = error (show ex)+tryGitLab i request maxRetries manager lastException+  | i == maxRetries = error (show lastException)   | otherwise =       httpLbs request manager       `E.catch`-        \ex -> tryGitLab (i+1) request retries manager (Just ex)+        \ex -> tryGitLab (i+1) request maxRetries manager (Just ex)  parseBSOne :: FromJSON a => BSL.ByteString -> Maybe a parseBSOne bs =@@ -142,5 +142,5 @@   in findPages hdrs   where     findPages [] = 1 -- error "cannot find X-Total-Pages in header"-    findPages (("X-Total-Pages",bs):xs) = read (T.unpack (T.decodeUtf8 bs))+    findPages (("X-Total-Pages",bs):_) = read (T.unpack (T.decodeUtf8 bs))     findPages (_:xs) = findPages xs