gitlab-haskell 0.3.0 → 0.3.0.1

raw patch · 22 files changed

+301/−130 lines, 22 filesdep +http-clientPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-client

API changes (from Hackage documentation)

Files

• data/api/boards/create-board.json +19/−0
• data/api/boards/list-project.json +57/−0
• data/api/boards/update-board.json +52/−0
• gitlab-haskell.cabal +5/−1
• src/GitLab.hs +6/−2
• src/GitLab/API/Boards.hs +16/−15
• src/GitLab/API/Branches.hs +3/−2
• src/GitLab/API/Commits.hs +5/−4
• src/GitLab/API/Discussions.hs +4/−3
• src/GitLab/API/Groups.hs +21/−12
• src/GitLab/API/Issues.hs +18/−17
• src/GitLab/API/Jobs.hs +3/−2
• src/GitLab/API/Members.hs +7/−6
• src/GitLab/API/MergeRequests.hs +11/−10
• src/GitLab/API/Notes.hs +4/−3
• src/GitLab/API/Pipelines.hs +3/−2
• src/GitLab/API/Projects.hs +10/−9
• src/GitLab/API/Repositories.hs +8/−8
• src/GitLab/API/RepositoryFiles.hs +5/−4
• src/GitLab/API/Tags.hs +3/−2
• src/GitLab/API/Version.hs +5/−4
• src/GitLab/WebRequests/GitLabWebCalls.hs +36/−24

@@ -0,0 +1,19 @@+ {+    "id": 1,+    "project": {+      "id": 5,+      "name": "Diaspora Project Site",+      "name_with_namespace": "Diaspora / Diaspora Project Site",+      "path": "diaspora-project-site",+      "path_with_namespace": "diaspora/diaspora-project-site",+      "http_url_to_repo": "http://example.com/diaspora/diaspora-project-site.git",+      "web_url": "http://example.com/diaspora/diaspora-project-site"+    },+    "name": "newboard",+    "lists" : [],+    "group": null,+    "milestone": null,+    "assignee" : null,+    "labels" : [],+    "weight" : null+  }

@@ -0,0 +1,57 @@+[+  {+    "id" : 1,+    "name": "board1",+    "project": {+      "id": 5,+      "name": "Diaspora Project Site",+      "name_with_namespace": "Diaspora / Diaspora Project Site",+      "path": "diaspora-project-site",+      "path_with_namespace": "diaspora/diaspora-project-site",+      "http_url_to_repo": "http://example.com/diaspora/diaspora-project-site.git",+      "web_url": "http://example.com/diaspora/diaspora-project-site"+    },+    "milestone":   {+      "id": 12,+      "title": "10.0"+    },+    "lists" : [+      {+        "id" : 1,+        "label" : {+          "name" : "Testing",+          "color" : "#F0AD4E",+          "description" : null+        },+        "position" : 1,+        "max_issue_count": 0,+        "max_issue_weight": 0,+        "limit_metric": null+      },+      {+        "id" : 2,+        "label" : {+          "name" : "Ready",+          "color" : "#FF0000",+          "description" : null+        },+        "position" : 2,+        "max_issue_count": 0,+        "max_issue_weight": 0,+        "limit_metric":  null+      },+      {+        "id" : 3,+        "label" : {+          "name" : "Production",+          "color" : "#FF5F00",+          "description" : null+        },+        "position" : 3,+        "max_issue_count": 0,+        "max_issue_weight": 0,+        "limit_metric":  null+      }+    ]+  }+]

@@ -0,0 +1,52 @@+ {+    "id": 1,+    "project": {+      "id": 5,+      "name": "Diaspora Project Site",+      "name_with_namespace": "Diaspora / Diaspora Project Site",+      "path": "diaspora-project-site",+      "path_with_namespace": "diaspora/diaspora-project-site",+      "created_at": "2018-07-03T05:48:49.982Z",+      "default_branch": null,+      "tag_list": [],+      "ssh_url_to_repo": "ssh://user@example.com/diaspora/diaspora-project-site.git",+      "http_url_to_repo": "http://example.com/diaspora/diaspora-project-site.git",+      "web_url": "http://example.com/diaspora/diaspora-project-site",+      "readme_url": null,+      "avatar_url": null,+      "star_count": 0,+      "forks_count": 0,+      "last_activity_at": "2018-07-03T05:48:49.982Z"+    },+    "lists": [],+    "name": "new_name",+    "group": null,+    "milestone": {+      "id": 43,+      "iid": 1,+      "project_id": 15,+      "title": "Milestone 1",+      "description": "Milestone 1 desc",+      "state": "active",+      "created_at": "2018-07-03T06:36:42.618Z",+      "updated_at": "2018-07-03T06:36:42.618Z",+      "due_date": null,+      "start_date": null,+      "web_url": "http://example.com/root/board1/milestones/1"+    },+    "assignee": {+      "id": 1,+      "name": "Administrator",+      "username": "root",+      "state": "active",+      "avatar_url": "https://www.gravatar.com/avatar/e64c7d89f26bd1972efa854d13d7dd61?s=80&d=identicon",+      "web_url": "http://example.com/root"+    },+    "labels": [{+      "id": 10,+      "name": "Doing",+      "color": "#5CB85C",+      "description": null+    }],+    "weight": 4+  }

@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.3.0+version:        0.3.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/>@@ -53,6 +53,9 @@ build-type:     Simple extra-source-files:     README.md+  , data/api/boards/list-project.json+  , data/api/boards/create-board.json+  , data/api/boards/update-board.json  source-repository head   type: git@@ -94,6 +97,7 @@               , aeson >= 1.4.4.0               , bytestring               , text+              , http-client               , http-types               , transformers               , unliftio

@@ -28,6 +28,7 @@     module GitLab.API.Todos,     module GitLab.API.Version,     module GitLab.API.Notes,+    module GitLab.API.Boards,     module GitLab.API.Discussions,     module GitLab.SystemHooks.GitLabSystemHooks,     module GitLab.SystemHooks.Types,@@ -37,6 +38,7 @@  import Control.Monad.IO.Class import Control.Monad.Trans.Reader+import GitLab.API.Boards import GitLab.API.Branches import GitLab.API.Commits import GitLab.API.Discussions@@ -94,8 +96,10 @@   -- test the token access   tokenTest <- runReaderT gitlabVersion (GitLabState cfg manager)   case tokenTest of-    Left (Status 401 "Unauthorized") -> error "access token not accepted."-    Left st -> error ("unexpected HTTP status: " <> show st)+    Left response ->+      case responseStatus response of+        (Status 401 "Unauthorized") -> error "access token not accepted."+        st -> error ("unexpected HTTP status: " <> show st)     Right _versionInfo ->       -- it worked, run the user code.       runReaderT action (GitLabState cfg manager)

@@ -9,13 +9,14 @@ -- Stability   : stable module GitLab.API.Boards where +import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | returns all issue boards for a project. projectIssueBoards ::@@ -31,7 +32,7 @@ projectIssueBoards' ::   -- | project ID   Int ->-  GitLab (Either Status [IssueBoard])+  GitLab (Either (Response BSL.ByteString) [IssueBoard]) projectIssueBoards' projectId =   gitlab (boardsAddr projectId)   where@@ -45,7 +46,7 @@   Project ->   -- | the board ID   Int ->-  GitLab (Either Status (Maybe IssueBoard))+  GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard)) projectIssueBoard project = do   projectIssueBoard' (project_id project) @@ -55,7 +56,7 @@   Int ->   -- | the board ID   Int ->-  GitLab (Either Status (Maybe IssueBoard))+  GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard)) projectIssueBoard' projectId boardId = do   gitlabOne boardAddr   where@@ -80,7 +81,7 @@   Int ->   -- | board name   Text ->-  GitLab (Either Status (Maybe IssueBoard))+  GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard)) createIssueBoard' projectId boardName = do   gitlabPost boardAddr T.empty   where@@ -96,7 +97,7 @@   Int ->   -- | attributes for updating boards   UpdateBoardAttrs ->-  GitLab (Either Status IssueBoard)+  GitLab (Either (Response BSL.ByteString) IssueBoard) updateIssueBoard' projectId boardId attrs = do   gitlabPut boardAddr T.empty   where@@ -114,7 +115,7 @@   Project ->   -- | the board   IssueBoard ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) deleteIssueBoard project board = do   deleteIssueBoard' (project_id project) (board_id board) @@ -124,7 +125,7 @@   Int ->   -- | the board ID   Int ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) deleteIssueBoard' projectId boardId = do   gitlabDelete boardAddr   where@@ -153,7 +154,7 @@   Int ->   -- | board ID   Int ->-  GitLab (Either Status [BoardIssue])+  GitLab (Either (Response BSL.ByteString) [BoardIssue]) projectBoardLists' projectId boardId =   gitlab boardsAddr   where@@ -183,7 +184,7 @@   Int ->   -- | list ID   Int ->-  GitLab (Either Status (Maybe BoardIssue))+  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue)) boardList' projectId boardId listId =   gitlabOne boardsAddr   where@@ -213,7 +214,7 @@   Int ->   -- | attributes for creating the board   CreateBoardAttrs ->-  GitLab (Either Status (Maybe BoardIssue))+  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue)) createBoardList' projectId boardId attrs =   gitlabPost boardsAddr T.empty   where@@ -236,7 +237,7 @@   Int ->   -- | the position of the list   Int ->-  GitLab (Either Status (Maybe BoardIssue))+  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue)) reorderBoardList project board =   reorderBoardList' (project_id project) (board_id board) @@ -250,7 +251,7 @@   Int ->   -- | the position of the list   Int ->-  GitLab (Either Status (Maybe BoardIssue))+  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue)) reorderBoardList' projectId boardId listId newPosition =   gitlabPut boardsAddr T.empty   where@@ -272,7 +273,7 @@   IssueBoard ->   -- | list ID   Int ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) deleteBoardList project board =   deleteBoardList' (project_id project) (board_id board) @@ -284,7 +285,7 @@   Int ->   -- | list ID   Int ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) deleteBoardList' projectId boardId listId =   gitlabDelete boardsAddr   where

@@ -9,11 +9,12 @@ -- Stability   : stable module GitLab.API.Branches where +import qualified Data.ByteString.Lazy as BSL import Data.Either import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | Get a list of repository branches from a project, sorted by name -- alphabetically.@@ -24,7 +25,7 @@  -- | Get a list of repository branches from a project given its -- project ID, sorted by name alphabetically.-branches' :: Int -> GitLab (Either Status [Branch])+branches' :: Int -> GitLab (Either (Response BSL.ByteString) [Branch]) branches' projectId =   gitlab addr   where

@@ -9,12 +9,13 @@ -- Stability   : stable module GitLab.API.Commits where +import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Text (Text) import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | returns all commits for a project. projectCommits ::@@ -30,7 +31,7 @@ projectCommits' ::   -- | project ID   Int ->-  GitLab (Either Status [Commit])+  GitLab (Either (Response BSL.ByteString) [Commit]) projectCommits' projectId =   gitlabWithAttrs (commitsAddr projectId) "&with_stats=true"   where@@ -57,7 +58,7 @@   Int ->   -- | branch name   Text ->-  GitLab (Either Status [Commit])+  GitLab (Either (Response BSL.ByteString) [Commit]) branchCommits' projectId branchName = do   gitlabWithAttrs (commitsAddr projectId) ("&ref_name=" <> branchName)   where@@ -84,7 +85,7 @@   Int ->   -- | the commit hash   Text ->-  GitLab (Either Status (Maybe Commit))+  GitLab (Either (Response BSL.ByteString) (Maybe Commit)) commitDetails' projectId hash =   gitlabOne (commitsAddr projectId)   where

@@ -10,11 +10,12 @@ -- Stability   : stable module GitLab.API.Discussions where +import qualified Data.ByteString.Lazy as BSL import Data.Text (Text) import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | gets all discussion for a commit for a project. commitDiscussions ::@@ -22,7 +23,7 @@   Project ->   -- | commit hash   Text ->-  GitLab (Either Status [Discussion])+  GitLab (Either (Response BSL.ByteString) [Discussion]) commitDiscussions proj = commitDiscussions' (project_id proj)  -- | gets all discussion for a commit for a project given its project ID.@@ -31,7 +32,7 @@   Int ->   -- | commit hash   Text ->-  GitLab (Either Status [Discussion])+  GitLab (Either (Response BSL.ByteString) [Discussion]) commitDiscussions' projId commitHash = do   let urlPath =         T.pack $

@@ -10,6 +10,7 @@ -- Stability   : stable module GitLab.API.Groups where +import qualified Data.ByteString.Lazy as BSL import Data.Maybe import Data.Text (Text) import qualified Data.Text as T@@ -18,7 +19,7 @@ import GitLab.API.Users import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client import Network.HTTP.Types.URI  -- | gets groups with the given group name or path.@@ -27,7 +28,7 @@ groupsWithNameOrPath ::   -- | group name being searched for.   Text ->-  GitLab (Either Status [Group])+  GitLab (Either (Response BSL.ByteString) [Group]) groupsWithNameOrPath groupName = do   result <- gitlabWithAttrs "/groups" ("&search=" <> groupName)   case result of@@ -49,7 +50,7 @@   Text ->   -- | level of access granted   AccessLevel ->-  GitLab [Either Status (Maybe Member)]+  GitLab [Either (Response BSL.ByteString) (Maybe Member)] addAllUsersToGroup groupName access = do   allRegisteredUsers <- allUsers   let allUserIds = map user_username allRegisteredUsers@@ -63,7 +64,7 @@   AccessLevel ->   -- | the user   User ->-  GitLab (Either Status (Maybe Member))+  GitLab (Either (Response BSL.ByteString) (Maybe Member)) addUserToGroup groupName access usr =   addUserToGroup' groupName access (user_id usr) @@ -75,12 +76,16 @@   AccessLevel ->   -- | user ID   Int ->-  GitLab (Either Status (Maybe Member))+  GitLab (Either (Response BSL.ByteString) (Maybe Member)) addUserToGroup' groupName access usrId = do   attempt <- groupsWithNameOrPath groupName   case attempt of-    Left httpStatus -> return (Left httpStatus)-    Right [] -> return (Left (mkStatus 404 (T.encodeUtf8 (T.pack "cannot find group"))))+    Left resp -> return (Left resp)+    Right [] ->+      -- TODO crreate response+      error "foo"+    -- return (Left (mk (Response BSL.ByteString) 404 (T.encodeUtf8 (T.pack "cannot find group"))))+    -- return (Left (mk (Response (T.encodeUtf8 (T.pack "cannot find group"))))     Right [grp] ->       gitlabPost addr dataBody       where@@ -93,8 +98,12 @@             <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))             <> "/members"     Right (_ : _) ->-      return (Left (mkStatus 404 (T.encodeUtf8 (T.pack "too many groups found"))))+      -- return (Left (Response (T.encodeUtf8 (T.pack "too many groups found"))))+      -- TODO crreate response+      error "foo" +-- return (Left (mk (Response BSL.ByteString) 404 (T.encodeUtf8 (T.pack "too many groups found"))))+ -- | adds a list of users to a group. addUsersToGroup ::   -- | group name@@ -103,7 +112,7 @@   AccessLevel ->   -- | list of usernames to be added to the group   [User] ->-  GitLab [Either Status (Maybe Member)]+  GitLab [Either (Response BSL.ByteString) (Maybe Member)] addUsersToGroup groupName access =   mapM (addUserToGroup groupName access) @@ -115,7 +124,7 @@   AccessLevel ->   -- | list of usernames to be added to the group   [Text] ->-  GitLab [Either Status (Maybe Member)]+  GitLab [Either (Response BSL.ByteString) (Maybe Member)] addUsersToGroup' groupName access usernames = do   users <- catMaybes <$> mapM searchUser usernames   mapM (addUserToGroup' groupName access . user_id) users@@ -123,14 +132,14 @@ groupProjects ::   -- | group   Group ->-  GitLab (Either Status [Project])+  GitLab (Either (Response BSL.ByteString) [Project]) groupProjects group = do   groupProjects' (group_id group)  groupProjects' ::   -- | group ID   Int ->-  GitLab (Either Status [Project])+  GitLab (Either (Response BSL.ByteString) [Project]) groupProjects' groupID = do   let urlPath =         T.pack $

@@ -32,6 +32,7 @@ where  import qualified Data.Aeson as J+import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Maybe import Data.Text (Text)@@ -42,7 +43,7 @@ import Data.Time.Format.ISO8601 import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | No issue filters, thereby returning all issues. Default scope is "all". defaultIssueFilters :: IssueAttrs@@ -138,11 +139,11 @@   -- | filter the issues, see https://docs.gitlab.com/ee/api/issues.html#list-issues   IssueAttrs ->   -- | the GitLab issues-  GitLab (Either Status [Issue])+  GitLab (Either (Response BSL.ByteString) [Issue]) projectIssues' projectId attrs =-  gitlab path+  gitlab urlPath   where-    path =+    urlPath =       T.pack $         "/projects/"           <> show projectId@@ -156,9 +157,9 @@   -- | the issue statistics   GitLab IssueStatistics issueStatisticsUser attrs =-  gitlabOneUnsafe path+  gitlabOneUnsafe urlPath   where-    path =+    urlPath =       T.pack $         "/issues_statistics"           <> issuesAttrs attrs@@ -185,11 +186,11 @@   -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics   IssueAttrs ->   -- | the issue statistics-  GitLab (Either Status (Maybe IssueStatistics))+  GitLab (Either (Response BSL.ByteString) (Maybe IssueStatistics)) issueStatisticsGroup' groupId attrs =-  gitlabOne path+  gitlabOne urlPath   where-    path =+    urlPath =       T.pack $         "/groups/"           <> show groupId@@ -218,11 +219,11 @@   -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics   IssueAttrs ->   -- | the issue statistics-  GitLab (Either Status (Maybe IssueStatistics))+  GitLab (Either (Response BSL.ByteString) (Maybe IssueStatistics)) issueStatisticsProject' projId attrs =-  gitlabOne path+  gitlabOne urlPath   where-    path =+    urlPath =       T.pack $         "/projects/"           <> show projId@@ -252,7 +253,7 @@   Text ->   -- | issue description   Text ->-  GitLab (Either Status (Maybe Issue))+  GitLab (Either (Response BSL.ByteString) (Maybe Issue)) newIssue project =   newIssue' (project_id project) @@ -264,7 +265,7 @@   Text ->   -- | issue description   Text ->-  GitLab (Either Status (Maybe Issue))+  GitLab (Either (Response BSL.ByteString) (Maybe Issue)) newIssue' projectId issueTitle issueDescription =   gitlabPost addr dataBody   where@@ -284,14 +285,14 @@   ProjectId ->   IssueId ->   EditIssueReq ->-  GitLab (Either Status Issue)+  GitLab (Either (Response BSL.ByteString) Issue) editIssue projId issueId editIssueReq = do-  let path =+  let urlPath =         "/projects/" <> T.pack (show projId)           <> "/issues/"           <> T.pack (show issueId)   gitlabPut-    path+    urlPath     ( Data.Text.Lazy.toStrict         ( Data.Text.Lazy.Encoding.decodeUtf8             (J.encode editIssueReq)

@@ -9,11 +9,12 @@ -- Stability   : stable module GitLab.API.Jobs where +import qualified Data.ByteString.Lazy as BSL import Data.Either import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | returns all jobs ran on a project. jobs ::@@ -28,7 +29,7 @@ jobs' ::   -- | the project ID   Int ->-  GitLab (Either Status [Job])+  GitLab (Either (Response BSL.ByteString) [Job]) jobs' projectId =   gitlab addr   where

@@ -10,12 +10,13 @@ -- Stability   : stable module GitLab.API.Members where +import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Text (Text) import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | the access levels for project members. See <https://docs.gitlab.com/ee/user/permissions.html#project-members-permissions> data AccessLevel@@ -39,7 +40,7 @@   return (fromRight (error "membersOfProject error") result)  -- | the members of a project given its ID.-membersOfProject' :: Int -> GitLab (Either Status [Member])+membersOfProject' :: Int -> GitLab (Either (Response BSL.ByteString) [Member]) membersOfProject' projectId =   gitlab addr   where@@ -56,7 +57,7 @@   AccessLevel ->   -- | the user   User ->-  GitLab (Either Status (Maybe Member))+  GitLab (Either (Response BSL.ByteString) (Maybe Member)) addMemberToProject project access usr =   addMemberToProject' (project_id project) access (user_id usr) @@ -70,7 +71,7 @@   AccessLevel ->   -- | user ID   Int ->-  GitLab (Either Status (Maybe Member))+  GitLab (Either (Response BSL.ByteString) (Maybe Member)) addMemberToProject' projectId access userId =   gitlabPost addr dataBody   where@@ -90,7 +91,7 @@   AccessLevel ->   -- | users to add to the project   [User] ->-  GitLab [Either Status (Maybe Member)]+  GitLab [Either (Response BSL.ByteString) (Maybe Member)] addMembersToProject project access =   mapM (addMemberToProject project access) @@ -104,6 +105,6 @@   AccessLevel ->   -- | IDs of users to add to the project   [Int] ->-  GitLab [Either Status (Maybe Member)]+  GitLab [Either (Response BSL.ByteString) (Maybe Member)] addMembersToProject' projectId access =   mapM (addMemberToProject' projectId access)

@@ -9,12 +9,13 @@ -- Stability   : stable module GitLab.API.MergeRequests where +import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Text (Text) import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | returns the merge request for a project given its merge request -- IID.@@ -23,7 +24,7 @@   Project ->   -- | merge request IID   Int ->-  GitLab (Either Status (Maybe MergeRequest))+  GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) mergeRequest project =   mergeRequest' (project_id project) @@ -34,7 +35,7 @@   Int ->   -- | merge request IID   Int ->-  GitLab (Either Status (Maybe MergeRequest))+  GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) mergeRequest' projectId mergeRequestIID =   gitlabOne addr   where@@ -57,7 +58,7 @@ mergeRequests' ::   -- | project ID   Int ->-  GitLab (Either Status [MergeRequest])+  GitLab (Either (Response BSL.ByteString) [MergeRequest]) mergeRequests' projectId =   gitlabWithAttrs addr "&scope=all"   where@@ -80,7 +81,7 @@   Text ->   -- | merge request description   Text ->-  GitLab (Either Status (Maybe MergeRequest))+  GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) createMergeRequest project =   createMergeRequest' (project_id project) @@ -98,7 +99,7 @@   Text ->   -- | merge request description   Text ->-  GitLab (Either Status (Maybe MergeRequest))+  GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) createMergeRequest' projectId sourceBranch targetBranch targetProjectId mrTitle mrDescription =   gitlabPost addr dataBody   where@@ -119,7 +120,7 @@   Project ->   -- | merge request IID   Int ->-  GitLab (Either Status (Maybe MergeRequest))+  GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) acceptMergeRequest project =   acceptMergeRequest' (project_id project) @@ -129,7 +130,7 @@   Int ->   -- | merge request IID   Int ->-  GitLab (Either Status (Maybe MergeRequest))+  GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr dataBody   where     dataBody :: Text@@ -148,7 +149,7 @@   Project ->   -- | merge request IID   Int ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) deleteMergeRequest project =   deleteMergeRequest' (project_id project) @@ -158,7 +159,7 @@   Int ->   -- | merge request IID   Int ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) deleteMergeRequest' projectId mergeRequestIid = gitlabDelete addr   where     addr =

@@ -9,11 +9,12 @@ -- Stability   : stable module GitLab.API.Notes where +import qualified Data.ByteString.Lazy as BSL import Data.Text (Text) import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  createMergeRequestNote ::   -- | project@@ -22,7 +23,7 @@   Int ->   -- | the note   Text ->-  GitLab (Either Status (Maybe ()))+  GitLab (Either (Response BSL.ByteString) (Maybe ())) createMergeRequestNote project =   createMergeRequestNote' (project_id project) @@ -33,7 +34,7 @@   Int ->   -- | the note   Text ->-  GitLab (Either Status (Maybe ()))+  GitLab (Either (Response BSL.ByteString) (Maybe ())) createMergeRequestNote' projectId mergeRequestIID comment =   gitlabPost addr dataBody   where

@@ -9,11 +9,12 @@ -- Stability   : stable module GitLab.API.Pipelines where +import qualified Data.ByteString.Lazy as BSL import Data.Either import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | returns the pipelines for a project. pipelines ::@@ -28,7 +29,7 @@ pipelines' ::   -- | the project ID   Int ->-  GitLab (Either Status [Pipeline])+  GitLab (Either (Response BSL.ByteString) [Pipeline]) pipelines' projectId =   gitlabWithAttrs     addr

@@ -10,6 +10,7 @@ -- Stability   : stable module GitLab.API.Projects where +import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.List import Data.Text (Text)@@ -22,7 +23,7 @@ import GitLab.API.Users import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client import Network.HTTP.Types.URI import UnliftIO.Async @@ -38,7 +39,7 @@ projectForks ::   -- | name or namespace of the project   Text ->-  GitLab (Either Status [Project])+  GitLab (Either (Response BSL.ByteString) [Project]) projectForks projectName = do   let urlPath =         "/projects/"@@ -51,7 +52,7 @@ searchProjectId ::   -- | project ID   Int ->-  GitLab (Either Status (Maybe Project))+  GitLab (Either (Response BSL.ByteString) (Maybe Project)) searchProjectId projectId = do   let urlPath = T.pack ("/projects/" <> show projectId)   gitlabWithAttrsOne urlPath "&statistics=true"@@ -72,7 +73,7 @@ -- > projectsWithNameAndUser "user1" "project1" -- -- looks for "user1/project1"-projectsWithNameAndUser :: Text -> Text -> GitLab (Either Status (Maybe Project))+projectsWithNameAndUser :: Text -> Text -> GitLab (Either (Response BSL.ByteString) (Maybe Project)) projectsWithNameAndUser username projectName =   gitlabWithAttrsOne     ( "/projects/"@@ -97,12 +98,12 @@  -- | gets the email addresses in the author information in all commit -- for a project defined by the project's ID.-commitsEmailAddresses' :: Int -> GitLab (Either Status [Text])+commitsEmailAddresses' :: Int -> GitLab (Either (Response BSL.ByteString) [Text]) commitsEmailAddresses' projectId = do   -- (commits :: [Commit]) <- projectCommits' projectId   attempt <- projectCommits' projectId   case attempt of-    Left httpStatus -> return (Left httpStatus)+    Left resp -> return (Left resp)     Right (commits :: [Commit]) ->       return (Right (map author_email commits)) @@ -210,13 +211,13 @@     Just usr -> return (Just (user_id usr))  -- | gets all diffs in a project for a given commit SHA.-projectDiffs :: Project -> Text -> GitLab (Either Status [Diff])+projectDiffs :: Project -> Text -> GitLab (Either (Response BSL.ByteString) [Diff]) projectDiffs proj =   projectDiffs' (project_id proj)  -- | gets all diffs in a project for a given project ID, for a given -- commit SHA.-projectDiffs' :: Int -> Text -> GitLab (Either Status [Diff])+projectDiffs' :: Int -> Text -> GitLab (Either (Response BSL.ByteString) [Diff]) projectDiffs' projId commitSha =   gitlab     ( "/projects/"@@ -234,7 +235,7 @@   Int ->   -- | level of access granted   AccessLevel ->-  GitLab (Either Status (Maybe GroupShare))+  GitLab (Either (Response BSL.ByteString) (Maybe GroupShare)) addGroupToProject groupId projectId access =   gitlabPost addr dataBody   where

@@ -15,7 +15,7 @@ import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | returns a list of repository files and directories in a project. repositories ::@@ -30,7 +30,7 @@ repositories' ::   -- | the project ID   Int ->-  GitLab (Either Status [Repository])+  GitLab (Either (Response BSL.ByteString) [Repository]) repositories' projectId =   gitlab addr   where@@ -50,7 +50,7 @@   ArchiveFormat ->   -- | file path to store the archive   FilePath ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) getFileArchive project = getFileArchive' (project_id project)  -- | get a file archive of the repository files as a@@ -62,7 +62,7 @@   Project ->   -- | file format   ArchiveFormat ->-  GitLab (Either Status BSL.ByteString)+  GitLab (Either (Response BSL.ByteString) BSL.ByteString) getFileArchiveBS project = getFileArchiveBS' (project_id project)  -- | get a file archive of the repository files using the project's@@ -76,13 +76,13 @@   ArchiveFormat ->   -- | file path to store the archive   FilePath ->-  GitLab (Either Status ())-getFileArchive' projectId format path = do+  GitLab (Either (Response BSL.ByteString) ())+getFileArchive' projectId format fPath = do   attempt <- getFileArchiveBS' projectId format   case attempt of     Left st -> return (Left st)     Right archiveData ->-      Right <$> liftIO (BSL.writeFile path archiveData)+      Right <$> liftIO (BSL.writeFile fPath archiveData)  -- | get a file archive of the repository files as a 'BSL.ByteString' --   using the project's ID. For example:@@ -93,7 +93,7 @@   Int ->   -- | file format   ArchiveFormat ->-  GitLab (Either Status BSL.ByteString)+  GitLab (Either (Response BSL.ByteString) BSL.ByteString) getFileArchiveBS' projectId format =   gitlabReqByteString addr   where

@@ -9,12 +9,13 @@ -- Stability   : stable module GitLab.API.RepositoryFiles where +import qualified Data.ByteString.Lazy as BSL import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client import Network.HTTP.Types.URI  -- | Get a list of repository files and directories in a project.@@ -25,7 +26,7 @@   Text ->   -- | name of the branch, tag or commit   Text ->-  GitLab (Either Status (Maybe RepositoryFile))+  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFile)) repositoryFiles project = repositoryFiles' (project_id project)  -- | Get a list of repository files and directories in a project given@@ -37,7 +38,7 @@   Text ->   -- | name of the branch, tag or commit   Text ->-  GitLab (Either Status (Maybe RepositoryFile))+  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFile)) repositoryFiles' projectId filePath reference =   gitlabWithAttrsOne addr ("&ref=" <> reference)   where@@ -55,7 +56,7 @@   Int ->   -- | blob SHA   Text ->-  GitLab (Either Status String)+  GitLab (Either (Response BSL.ByteString) String) repositoryFileBlob projectId blobSha =   gitlabReqText addr   where

@@ -9,12 +9,13 @@ -- Stability   : stable module GitLab.API.Tags where +import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Text (Text) import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | returns all commits with tags. tags ::@@ -29,7 +30,7 @@ tags' ::   -- | project ID   Int ->-  GitLab (Either Status [Tag])+  GitLab (Either (Response BSL.ByteString) [Tag]) tags' projectId = do   gitlabWithAttrs (commitsAddr projectId) ""   where

@@ -9,12 +9,13 @@ -- Stability   : stable module GitLab.API.Version where +import qualified Data.ByteString.Lazy as BSL import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Network.HTTP.Types.Status+import Network.HTTP.Client  -- | Get the version of the GitLab server.-gitlabVersion :: GitLab (Either Status (Maybe Version))+gitlabVersion :: GitLab (Either (Response BSL.ByteString) (Maybe Version)) gitlabVersion = do-  let path = "/version"-  gitlabOne path+  let urlPath = "/version"+  gitlabOne urlPath

@@ -51,7 +51,7 @@   Text ->   -- | the data to post   Text ->-  GitLab (Either Status (Maybe b))+  GitLab (Either (Response BSL.ByteString) (Maybe b)) gitlabPost urlPath dataBody = do   cfg <- serverCfg <$> ask   manager <- httpManager <$> ask@@ -61,7 +61,9 @@         request'           { method = "POST",             requestHeaders =-              [("PRIVATE-TOKEN", T.encodeUtf8 (token cfg))],+              [ ("PRIVATE-TOKEN", T.encodeUtf8 (token cfg)),+                ("content-type", "application/x-www-form-urlencoded")+              ],             requestBody = RequestBodyBS (T.encodeUtf8 dataBody)           }   resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing@@ -75,7 +77,7 @@             --   Left $             --     mkStatus 409 "unable to parse POST response"         )-    else return (Left (responseStatus resp))+    else return (Left resp)  gitlabPut ::   FromJSON b =>@@ -83,7 +85,7 @@   Text ->   -- | the data to post   Text ->-  GitLab (Either Status b)+  GitLab (Either (Response BSL.ByteString) b) gitlabPut urlPath dataBody = do   cfg <- serverCfg <$> ask   manager <- httpManager <$> ask@@ -94,7 +96,7 @@           { method = "PUT",             requestHeaders =               [ ("PRIVATE-TOKEN", T.encodeUtf8 (token cfg)),-                ("content-type", "application/json")+                ("content-type", "application/x-www-form-urlencoded")               ],             requestBody = RequestBodyBS (T.encodeUtf8 dataBody)           }@@ -105,15 +107,14 @@         ( case parseBSOne (responseBody resp) of             Just x -> Right x             Nothing ->-              Left $-                mkStatus 409 "unable to parse PUT response"+              Left resp         )-    else return (Left (responseStatus resp))+    else return (Left resp)  gitlabDelete ::   -- | the URL to post to   Text ->-  GitLab (Either Status ())+  GitLab (Either (Response BSL.ByteString) ()) gitlabDelete urlPath = do   cfg <- serverCfg <$> ask   manager <- httpManager <$> ask@@ -124,14 +125,14 @@           { method = "DELETE",             requestHeaders =               [ ("PRIVATE-TOKEN", T.encodeUtf8 (token cfg)),-                ("content-type", "application/json")+                ("content-type", "application/x-www-form-urlencoded")               ],             requestBody = RequestBodyBS BS.empty           }   resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing   if successStatus (responseStatus resp)     then return (Right ())-    else return (Left (responseStatus resp))+    else return (Left resp)  tryGitLab ::   -- | the current retry count@@ -164,7 +165,7 @@     Left s -> Exception.throwIO $ GitLabException s     Right xs -> return xs -gitlabReqJsonMany :: (FromJSON a) => Text -> Text -> GitLab (Either Status [a])+gitlabReqJsonMany :: (FromJSON a) => Text -> Text -> GitLab (Either (Response BSL.ByteString) [a]) gitlabReqJsonMany urlPath attrs =   go 1 []   where@@ -175,7 +176,11 @@             url cfg               <> "/api/v4"               <> urlPath-              <> "?per_page=100"+              <> ( if (hasQuestionMark urlPath)+                     then "&"+                     else "?"+                 )+              <> "per_page=100"               <> "&page="               <> T.pack (show i)               <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 attrs))@@ -195,7 +200,7 @@           if numPages == i             then return (Right accum')             else go (i + 1) accum'-        else return (Left (responseStatus resp))+        else return (Left resp)  -- not sure what this was planned for --@@ -222,7 +227,7 @@ --         then return (Right (parser (responseBody resp))) --         else return (Left (responseStatus resp)) -gitlabReqOne :: (BSL.ByteString -> output) -> Text -> Text -> GitLab (Either Status output)+gitlabReqOne :: (BSL.ByteString -> output) -> Text -> Text -> GitLab (Either (Response BSL.ByteString) output) gitlabReqOne parser urlPath attrs = go   where     go = do@@ -232,7 +237,11 @@             url cfg               <> "/api/v4"               <> urlPath-              <> "?per_page=100"+              <> ( if (hasQuestionMark urlPath)+                     then "&"+                     else "?"+                 )+              <> "per_page=100"               <> "&page=1"               <> attrs       let request' = parseRequest_ (T.unpack url')@@ -245,7 +254,7 @@       resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing       if successStatus (responseStatus resp)         then return (Right (parser (responseBody resp)))-        else return (Left (responseStatus resp))+        else return (Left resp)  -- not sure what this was planned for --@@ -253,17 +262,17 @@ -- gitlabReqJsonOneIO mgr cfg urlPath attrs = --   gitlabReqOneIO mgr cfg parseBSOne urlPath attrs -gitlabReqJsonOne :: (FromJSON a) => Text -> Text -> GitLab (Either Status (Maybe a))+gitlabReqJsonOne :: (FromJSON a) => Text -> Text -> GitLab (Either (Response BSL.ByteString) (Maybe a)) gitlabReqJsonOne =   gitlabReqOne parseBSOne -gitlabReqText :: Text -> GitLab (Either Status String)+gitlabReqText :: Text -> GitLab (Either (Response BSL.ByteString) String) gitlabReqText urlPath = gitlabReqOne C.unpack urlPath "" -gitlabReqByteString :: Text -> GitLab (Either Status BSL.ByteString)+gitlabReqByteString :: Text -> GitLab (Either (Response BSL.ByteString) BSL.ByteString) gitlabReqByteString urlPath = gitlabReqOne Prelude.id urlPath "" -gitlab :: FromJSON a => Text -> GitLab (Either Status [a])+gitlab :: FromJSON a => Text -> GitLab (Either (Response BSL.ByteString) [a]) gitlab addr = gitlabReqJsonMany addr ""  gitlabUnsafe :: (FromJSON a) => Text -> GitLab [a]@@ -275,7 +284,7 @@ -- gitlabOneIO :: (FromJSON a) => Manager -> GitLabServerConfig -> Text -> IO (Either Status (Maybe a)) -- gitlabOneIO mgr cfg addr = gitlabReqJsonOneIO mgr cfg addr "" -gitlabOne :: (FromJSON a) => Text -> GitLab (Either Status (Maybe a))+gitlabOne :: (FromJSON a) => Text -> GitLab (Either (Response BSL.ByteString) (Maybe a)) gitlabOne addr = gitlabReqJsonOne addr ""  gitlabOneUnsafe :: (FromJSON a) => Text -> GitLab a@@ -285,14 +294,14 @@     Nothing -> error "gitlabOneUnsafe error"     Just value -> return value -gitlabWithAttrs :: (FromJSON a) => Text -> Text -> GitLab (Either Status [a])+gitlabWithAttrs :: (FromJSON a) => Text -> Text -> GitLab (Either (Response BSL.ByteString) [a]) gitlabWithAttrs = gitlabReqJsonMany  gitlabWithAttrsUnsafe :: (FromJSON a) => Text -> Text -> GitLab [a] gitlabWithAttrsUnsafe gitlabURL attrs =   fromRight (error "gitlabWithAttrsUnsafe error") <$> gitlabReqJsonMany gitlabURL attrs -gitlabWithAttrsOne :: (FromJSON a) => Text -> Text -> GitLab (Either Status (Maybe a))+gitlabWithAttrsOne :: (FromJSON a) => Text -> Text -> GitLab (Either (Response BSL.ByteString) (Maybe a)) gitlabWithAttrsOne = gitlabReqJsonOne  gitlabWithAttrsOneUnsafe :: (FromJSON a) => Text -> Text -> GitLab a@@ -318,3 +327,6 @@ successStatus :: Status -> Bool successStatus (Status n _msg) =   n >= 200 && n <= 226++hasQuestionMark :: Text -> Bool+hasQuestionMark = T.isInfixOf "?"