gitlab-haskell 0.3.0.1 → 0.3.0.2

raw patch · 20 files changed

+424/−450 lines, 20 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• gitlab-haskell.cabal +1/−1
• src/GitLab/API/Boards.hs +29/−41
• src/GitLab/API/Branches.hs +1/−1
• src/GitLab/API/Commits.hs +4/−3
• src/GitLab/API/Discussions.hs +1/−1
• src/GitLab/API/Groups.hs +8/−7
• src/GitLab/API/Issues.hs +84/−66
• src/GitLab/API/Jobs.hs +1/−1
• src/GitLab/API/Members.hs +8/−6
• src/GitLab/API/MergeRequests.hs +20/−19
• src/GitLab/API/Notes.hs +8/−10
• src/GitLab/API/Pipelines.hs +2/−2
• src/GitLab/API/Projects.hs +27/−18
• src/GitLab/API/Repositories.hs +16/−6
• src/GitLab/API/RepositoryFiles.hs +3/−3
• src/GitLab/API/Tags.hs +1/−1
• src/GitLab/API/Todos.hs +1/−1
• src/GitLab/API/Users.hs +10/−7
• src/GitLab/API/Version.hs +1/−1
• src/GitLab/WebRequests/GitLabWebCalls.hs +198/−255

@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.3.0.1+version:        0.3.0.2 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/>

@@ -14,6 +14,7 @@ import Data.Maybe 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.Client@@ -34,7 +35,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) [IssueBoard]) projectIssueBoards' projectId =-  gitlab (boardsAddr projectId)+  gitlabGetMany (boardsAddr projectId) []   where     boardsAddr :: Int -> Text     boardsAddr projId =@@ -58,7 +59,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard)) projectIssueBoard' projectId boardId = do-  gitlabOne boardAddr+  gitlabGetOne boardAddr []   where     boardAddr :: Text     boardAddr =@@ -83,11 +84,11 @@   Text ->   GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard)) createIssueBoard' projectId boardName = do-  gitlabPost boardAddr T.empty+  gitlabPost boardAddr [("name", Just (T.encodeUtf8 boardName))]   where     boardAddr :: Text     boardAddr =-      "/projects/" <> T.pack (show projectId) <> "/boards/?name=" <> boardName+      "/projects/" <> T.pack (show projectId) <> "/boards"  -- | Updates a project issue board. updateIssueBoard' ::@@ -97,9 +98,9 @@   Int ->   -- | attributes for updating boards   UpdateBoardAttrs ->-  GitLab (Either (Response BSL.ByteString) IssueBoard)+  GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard)) updateIssueBoard' projectId boardId attrs = do-  gitlabPut boardAddr T.empty+  gitlabPut boardAddr (updateBoardAttrs attrs)   where     boardAddr :: Text     boardAddr =@@ -107,7 +108,6 @@         <> T.pack (show projectId)         <> "/boards/"         <> T.pack (show boardId)-        <> T.pack (updateBoardAttrs attrs)  -- | Deletes a project issue board. deleteIssueBoard ::@@ -115,7 +115,7 @@   Project ->   -- | the board   IssueBoard ->-  GitLab (Either (Response BSL.ByteString) ())+  GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteIssueBoard project board = do   deleteIssueBoard' (project_id project) (board_id board) @@ -125,7 +125,7 @@   Int ->   -- | the board ID   Int ->-  GitLab (Either (Response BSL.ByteString) ())+  GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteIssueBoard' projectId boardId = do   gitlabDelete boardAddr   where@@ -156,7 +156,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) [BoardIssue]) projectBoardLists' projectId boardId =-  gitlab boardsAddr+  gitlabGetMany boardsAddr []   where     boardsAddr :: Text     boardsAddr =@@ -186,7 +186,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue)) boardList' projectId boardId listId =-  gitlabOne boardsAddr+  gitlabGetOne boardsAddr []   where     boardsAddr :: Text     boardsAddr =@@ -216,7 +216,7 @@   CreateBoardAttrs ->   GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue)) createBoardList' projectId boardId attrs =-  gitlabPost boardsAddr T.empty+  gitlabPost boardsAddr (createBoardAttrs attrs)   where     boardsAddr :: Text     boardsAddr =@@ -225,7 +225,6 @@         <> "/boards/"         <> T.pack (show boardId)         <> "/lists"-        <> T.pack (createBoardAttrs attrs)  -- | Updates an existing issue board list. This call is used to change list position. reorderBoardList ::@@ -253,7 +252,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue)) reorderBoardList' projectId boardId listId newPosition =-  gitlabPut boardsAddr T.empty+  gitlabPut boardsAddr [("position", Just (T.encodeUtf8 (T.pack (show newPosition))))]   where     boardsAddr :: Text     boardsAddr =@@ -263,7 +262,6 @@         <> T.pack (show boardId)         <> "/lists/"         <> T.pack (show listId)-        <> T.pack ("?position=" <> show newPosition)  -- | Only for administrators and project owners. Deletes a board list. deleteBoardList ::@@ -273,7 +271,7 @@   IssueBoard ->   -- | list ID   Int ->-  GitLab (Either (Response BSL.ByteString) ())+  GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteBoardList project board =   deleteBoardList' (project_id project) (board_id board) @@ -285,7 +283,7 @@   Int ->   -- | list ID   Int ->-  GitLab (Either (Response BSL.ByteString) ())+  GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteBoardList' projectId boardId listId =   gitlabDelete boardsAddr   where@@ -311,20 +309,15 @@ noUpdateBoardAttrs =   UpdateBoardAttrs Nothing Nothing Nothing Nothing Nothing -updateBoardAttrs :: UpdateBoardAttrs -> String+updateBoardAttrs :: UpdateBoardAttrs -> [GitLabParam] updateBoardAttrs attrs =-  case attrsUrl of-    [] -> ""-    (x : xs) -> "?" <> x <> concatMap ('&' :) xs-  where-    attrsUrl =-      catMaybes-        [ (\s -> Just ("name=" <> s)) =<< updateBoard_new_name attrs,-          (\i -> Just ("assignee_id=" <> show i)) =<< updateBoard_assignee_id attrs,-          (\i -> Just ("milestone_id=" <> show i)) =<< updateBoard_milestone_id attrs,-          (\s -> Just ("labels=" <> s)) =<< updateBoard_labels attrs,-          (\i -> Just ("weight=" <> show i)) =<< updateBoard_weight attrs-        ]+  catMaybes+    [ (\s -> Just ("name", Just (T.encodeUtf8 (T.pack s)))) =<< updateBoard_new_name attrs,+      (\i -> Just ("assignee_id", Just (T.encodeUtf8 (T.pack (show i))))) =<< updateBoard_assignee_id attrs,+      (\i -> Just ("milestone_id", Just (T.encodeUtf8 (T.pack (show i))))) =<< updateBoard_milestone_id attrs,+      (\s -> Just ("labels", Just (T.encodeUtf8 (T.pack s)))) =<< updateBoard_labels attrs,+      (\i -> Just ("weight", Just (T.encodeUtf8 (T.pack (show i))))) =<< updateBoard_weight attrs+    ]  -- | exactly one parameter must be provided. data CreateBoardAttrs = CreateBoardAttrs@@ -338,15 +331,10 @@ noCreateBoardAttrs =   CreateBoardAttrs Nothing Nothing Nothing -createBoardAttrs :: CreateBoardAttrs -> String+createBoardAttrs :: CreateBoardAttrs -> [GitLabParam] createBoardAttrs attrs =-  case attrsUrl of-    [] -> ""-    (x : xs) -> "?" <> x <> concatMap ('&' :) xs-  where-    attrsUrl =-      catMaybes-        [ (\i -> Just ("label_id=" <> show i)) =<< createBoard_label_id attrs,-          (\i -> Just ("assignee_id=" <> show i)) =<< createBoard_assignee_id attrs,-          (\i -> Just ("milestone_id=" <> show i)) =<< createBoard_milestone_id attrs-        ]+  catMaybes+    [ (\i -> Just ("label_id", Just (T.encodeUtf8 (T.pack (show i))))) =<< createBoard_label_id attrs,+      (\i -> Just ("assignee_id", Just (T.encodeUtf8 (T.pack (show i))))) =<< createBoard_assignee_id attrs,+      (\i -> Just ("milestone_id", Just (T.encodeUtf8 (T.pack (show i))))) =<< createBoard_milestone_id attrs+    ]

@@ -27,7 +27,7 @@ -- project ID, sorted by name alphabetically. branches' :: Int -> GitLab (Either (Response BSL.ByteString) [Branch]) branches' projectId =-  gitlab addr+  gitlabGetMany addr []   where     addr =       "/projects/"

@@ -13,6 +13,7 @@ import Data.Either 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.Client@@ -33,7 +34,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) [Commit]) projectCommits' projectId =-  gitlabWithAttrs (commitsAddr projectId) "&with_stats=true"+  gitlabGetMany (commitsAddr projectId) [("with_stats", Just "true")]   where     commitsAddr :: Int -> Text     commitsAddr projId =@@ -60,7 +61,7 @@   Text ->   GitLab (Either (Response BSL.ByteString) [Commit]) branchCommits' projectId branchName = do-  gitlabWithAttrs (commitsAddr projectId) ("&ref_name=" <> branchName)+  gitlabGetMany (commitsAddr projectId) [("ref_name", Just (T.encodeUtf8 branchName))]   where     commitsAddr :: Int -> Text     commitsAddr projId =@@ -87,7 +88,7 @@   Text ->   GitLab (Either (Response BSL.ByteString) (Maybe Commit)) commitDetails' projectId hash =-  gitlabOne (commitsAddr projectId)+  gitlabGetOne (commitsAddr projectId) []   where     commitsAddr :: Int -> Text     commitsAddr projId =

@@ -42,4 +42,4 @@             <> "/commits/"             <> T.unpack commitHash             <> "/discussions"-  gitlab urlPath+  gitlabGetMany urlPath []

@@ -30,7 +30,7 @@   Text ->   GitLab (Either (Response BSL.ByteString) [Group]) groupsWithNameOrPath groupName = do-  result <- gitlabWithAttrs "/groups" ("&search=" <> groupName)+  result <- gitlabGetMany "/groups" [("search", Just (T.encodeUtf8 groupName))]   case result of     Left {} -> return result     Right groups ->@@ -87,12 +87,13 @@     -- 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+      gitlabPost addr params       where-        dataBody :: Text-        dataBody =-          "user_id=" <> T.pack (show usrId) <> "&access_level="-            <> T.pack (show access)+        params :: [GitLabParam]+        params =+          [ ("user_id", Just (T.encodeUtf8 (T.pack (show usrId)))),+            ("access_level", Just (T.encodeUtf8 (T.pack (show access))))+          ]         addr =           "/groups/"             <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))@@ -146,4 +147,4 @@           "/groups/"             <> show groupID             <> "/projects"-  gitlab urlPath+  gitlabGetMany urlPath []

@@ -31,14 +31,12 @@   ) where -import qualified Data.Aeson as J import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Maybe import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.Lazy-import qualified Data.Text.Lazy.Encoding+import qualified Data.Text.Encoding as T import Data.Time.Clock import Data.Time.Format.ISO8601 import GitLab.Types@@ -141,14 +139,13 @@   -- | the GitLab issues   GitLab (Either (Response BSL.ByteString) [Issue]) projectIssues' projectId attrs =-  gitlab urlPath+  gitlabGetMany urlPath (issuesAttrs attrs)   where     urlPath =       T.pack $         "/projects/"           <> show projectId           <> "/issues"-          <> issuesAttrs attrs  -- | Gets issues count statistics on all issues the authenticated user has access to. issueStatisticsUser ::@@ -157,12 +154,11 @@   -- | the issue statistics   GitLab IssueStatistics issueStatisticsUser attrs =-  gitlabOneUnsafe urlPath+  gitlabUnsafe (gitlabGetOne urlPath (issuesAttrs attrs))   where     urlPath =       T.pack $         "/issues_statistics"-          <> issuesAttrs attrs  -- | Gets issues count statistics for a given group. issueStatisticsGroup ::@@ -188,14 +184,13 @@   -- | the issue statistics   GitLab (Either (Response BSL.ByteString) (Maybe IssueStatistics)) issueStatisticsGroup' groupId attrs =-  gitlabOne urlPath+  gitlabGetOne urlPath (issuesAttrs attrs)   where     urlPath =       T.pack $         "/groups/"           <> show groupId           <> "/issues_statistics"-          <> issuesAttrs attrs  -- | Gets issues count statistics for a given group. issueStatisticsProject ::@@ -221,14 +216,13 @@   -- | the issue statistics   GitLab (Either (Response BSL.ByteString) (Maybe IssueStatistics)) issueStatisticsProject' projId attrs =-  gitlabOne urlPath+  gitlabGetOne urlPath (issuesAttrs attrs)   where     urlPath =       T.pack $         "/projects/"           <> show projId           <> "/issues_statistics"-          <> issuesAttrs attrs  -- | gets all issues create by a user. userIssues ::@@ -236,14 +230,14 @@   User ->   GitLab [Issue] userIssues usr =-  gitlabWithAttrsUnsafe addr attrs+  fromRight (error "userIssues error") <$> gitlabGetMany addr params   where     addr = "/issues"-    attrs =-      T.pack $-        "&author_id="-          <> show (user_id usr)-          <> "&scope=all"+    params :: [GitLabParam]+    params =+      [ ("author_id", Just (T.encodeUtf8 (T.pack (show (user_id usr))))),+        ("scope", Just "all")+      ]  -- | create a new issue. newIssue ::@@ -269,12 +263,11 @@ newIssue' projectId issueTitle issueDescription =   gitlabPost addr dataBody   where-    dataBody :: Text+    dataBody :: [GitLabParam]     dataBody =-      "title="-        <> issueTitle-        <> "&description="-        <> issueDescription+      [ ("title", Just (T.encodeUtf8 issueTitle)),+        ("description", Just (T.encodeUtf8 issueDescription))+      ]     addr =       "/projects/"         <> T.pack (show projectId)@@ -291,13 +284,14 @@         "/projects/" <> T.pack (show projId)           <> "/issues/"           <> T.pack (show issueId)-  gitlabPut-    urlPath-    ( Data.Text.Lazy.toStrict-        ( Data.Text.Lazy.Encoding.decodeUtf8-            (J.encode editIssueReq)-        )-    )+  result <-+    gitlabPut+      urlPath+      (editIssuesAttrs editIssueReq)+  case result of+    Left resp -> return (Left resp)+    Right Nothing -> error "editIssue error"+    Right (Just issue) -> return (Right issue)  ------------------------------- -- Internal functions and types@@ -329,42 +323,66 @@     issueFilter_with_labels_details :: Maybe Bool   } -issuesAttrs :: IssueAttrs -> String+editIssuesAttrs :: EditIssueReq -> [GitLabParam]+editIssuesAttrs filters =+  catMaybes+    [ Just ("id", textToBS (T.pack (show (edit_issue_id filters)))),+      Just ("issue_id", textToBS (T.pack (show (edit_issue_issue_iid filters)))),+      -- (\i -> Just ("assignee_id", textToBS (T.pack (show i)))) =<< edit_issue_issue_id filters,+      (\t -> Just ("title", textToBS t)) =<< edit_issue_title filters,+      (\t -> Just ("description", textToBS t)) =<< edit_issue_description filters,+      (\b -> Just ("confidential", textToBS (showBool b))) =<< edit_issue_confidential filters,+      -- TODO+      -- (\is -> Just ("assignee_ids", textToBS )) =<< edit_issue_assignee_ids filters,+      (\i -> Just ("milestone_id", textToBS (T.pack (show i)))) =<< edit_issue_milestone_id filters,+      -- TODO+      -- (\ts -> Just ("labels", textToBS (T.pack (show i)))) =<< edit_issue_labels filters,+      (\t -> Just ("state_event", textToBS t)) =<< edit_issue_state_event filters,+      (\t -> Just ("updated_at", textToBS t)) =<< edit_issue_updated_at filters,+      (\t -> Just ("due_date", textToBS t)) =<< edit_issue_due_date filters,+      (\i -> Just ("weight", textToBS (T.pack (show i)))) =<< edit_issue_weight filters,+      (\b -> Just ("discussion_locked", textToBS (showBool b))) =<< edit_issue_discussion_locked filters,+      (\i -> Just ("epic_id", textToBS (T.pack (show i)))) =<< edit_issue_epic_id filters,+      (\i -> Just ("epic_iid", textToBS (T.pack (show i)))) =<< edit_issue_epic_iid filters+    ]+  where+    textToBS = Just . T.encodeUtf8+    showBool :: Bool -> Text+    showBool True = "true"+    showBool False = "false"++issuesAttrs :: IssueAttrs -> [GitLabParam] issuesAttrs filters =-  case attrsUrl of-    [] -> ""-    (x : xs) -> "?" <> x <> concatMap ('&' :) xs+  catMaybes+    [ (\i -> Just ("assignee_id", textToBS (T.pack (show i)))) =<< issueFilter_assignee_id filters,+      (\t -> Just ("assignee_username", textToBS (T.pack t))) =<< issueFilter_assignee_username filters,+      (\i -> Just ("author_id", textToBS (T.pack (show i)))) =<< issueFilter_author_id filters,+      (\i -> Just ("author_username", textToBS ((T.pack (show i))))) =<< issueFilter_author_username filters,+      (\b -> Just ("confidential", textToBS (showBool b))) =<< issueFilter_confidential filters,+      (\t -> Just ("created_after", textToBS (showTime t))) =<< issueFilter_created_after filters,+      (\t -> Just ("created_before", textToBS (showTime t))) =<< issueFilter_created_before filters,+      (\due -> Just ("due_date", textToBS (T.pack (show due)))) =<< issueFilter_due_date filters,+      (\iids -> Just ("iids[]", textToBS (T.pack (show iids)))) =<< issueFilter_iids filters,+      (\issueIn -> Just ("assignee_id", textToBS (T.pack (show issueIn)))) =<< issueFilter_in filters,+      (\i -> Just ("iteration_id", textToBS (T.pack (show i)))) =<< issueFilter_iteration_id filters,+      (\s -> Just ("iteration_title", textToBS (T.pack s))) =<< issueFilter_iteration_title filters,+      (\s -> Just ("milestone", textToBS (T.pack s))) =<< issueFilter_milestone filters,+      (\s -> Just ("labels", textToBS (T.pack s))) =<< issueFilter_labels filters,+      (\s -> Just ("my_reaction_emoji", textToBS (T.pack s))) =<< issueFilter_my_reaction_emoji filters,+      (\b -> Just ("non_archived", textToBS (showBool b))) =<< issueFilter_non_archived filters,+      (\x -> Just ("order_by", textToBS (T.pack (show x)))) =<< issueFilter_order_by filters,+      (\x -> Just ("scope", textToBS (T.pack (show x)))) =<< issueFilter_scope filters,+      (\s -> Just ("search", textToBS (T.pack s))) =<< issueFilter_search filters,+      (\x -> Just ("sort", textToBS (T.pack (show x)))) =<< issueFilter_sort filters,+      (\x -> Just ("state", textToBS (T.pack (show x)))) =<< issueFilter_state filters,+      (\t -> Just ("updated_after", textToBS (showTime t))) =<< issueFilter_updated_after filters,+      (\t -> Just ("updated_before", textToBS (showTime t))) =<< issueFilter_updated_before filters,+      (\b -> Just ("with_labels_details", textToBS (showBool b))) =<< issueFilter_with_labels_details filters+    ]   where-    attrsUrl =-      catMaybes-        [ (\i -> Just ("assignee_id=" <> show i)) =<< issueFilter_assignee_id filters,-          (\t -> Just ("assignee_username=" <> t)) =<< issueFilter_assignee_username filters,-          (\i -> Just ("author_id=" <> show i)) =<< issueFilter_author_id filters,-          (\i -> Just ("author_username=" <> show i)) =<< issueFilter_author_username filters,-          (\b -> Just ("confidential=" <> showBool b)) =<< issueFilter_confidential filters,-          (\t -> Just ("created_after=" <> showTime t)) =<< issueFilter_created_after filters,-          (\t -> Just ("created_before=" <> showTime t)) =<< issueFilter_created_before filters,-          (\due -> Just ("due_date=" <> show due)) =<< issueFilter_due_date filters,-          (\iids -> Just ("iids[]=" <> show iids)) =<< issueFilter_iids filters,-          (\issueIn -> Just ("assignee_id=" <> show issueIn)) =<< issueFilter_in filters,-          (\i -> Just ("iteration_id=" <> show i)) =<< issueFilter_iteration_id filters,-          (\s -> Just ("iteration_title=" <> s)) =<< issueFilter_iteration_title filters,-          (\s -> Just ("milestone=" <> s)) =<< issueFilter_milestone filters,-          (\s -> Just ("labels=" <> s)) =<< issueFilter_labels filters,-          (\s -> Just ("my_reaction_emoji=" <> s)) =<< issueFilter_my_reaction_emoji filters,-          (\b -> Just ("non_archived=" <> showBool b)) =<< issueFilter_non_archived filters,-          (\x -> Just ("order_by=" <> show x)) =<< issueFilter_order_by filters,-          (\x -> Just ("scope=" <> show x)) =<< issueFilter_scope filters,-          (\s -> Just ("search=" <> s)) =<< issueFilter_search filters,-          (\x -> Just ("sort=" <> show x)) =<< issueFilter_sort filters,-          (\x -> Just ("state=" <> show x)) =<< issueFilter_state filters,-          (\t -> Just ("updated_after=" <> showTime t)) =<< issueFilter_updated_after filters,-          (\t -> Just ("updated_before=" <> showTime t)) =<< issueFilter_updated_before filters,-          (\b -> Just ("with_labels_details=" <> showBool b)) =<< issueFilter_with_labels_details filters-        ]-      where-        showBool :: Bool -> String-        showBool True = "true"-        showBool False = "false"-        showTime :: UTCTime -> String-        showTime = iso8601Show+    textToBS = Just . T.encodeUtf8+    showBool :: Bool -> Text+    showBool True = "true"+    showBool False = "false"+    showTime :: UTCTime -> Text+    showTime = T.pack . iso8601Show

@@ -31,7 +31,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) [Job]) jobs' projectId =-  gitlab addr+  gitlabGetMany addr []   where     addr =       "/projects/"

@@ -12,8 +12,8 @@  import qualified Data.ByteString.Lazy as BSL import Data.Either-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.Client@@ -42,7 +42,7 @@ -- | the members of a project given its ID. membersOfProject' :: Int -> GitLab (Either (Response BSL.ByteString) [Member]) membersOfProject' projectId =-  gitlab addr+  gitlabGetMany addr []   where     addr =       "/projects/" <> T.pack (show projectId) <> "/members"@@ -73,11 +73,13 @@   Int ->   GitLab (Either (Response BSL.ByteString) (Maybe Member)) addMemberToProject' projectId access userId =-  gitlabPost addr dataBody+  gitlabPost addr params   where-    dataBody :: Text-    dataBody =-      "user_id=" <> T.pack (show userId) <> "&access_level=" <> T.pack (show access)+    params :: [GitLabParam]+    params =+      [ ("user_id", Just (T.encodeUtf8 (T.pack (show userId)))),+        ("access_level", Just (T.encodeUtf8 (T.pack (show access))))+      ]     addr =       "/projects/" <> T.pack (show projectId) <> "/members" 

@@ -13,6 +13,7 @@ import Data.Either 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.Client@@ -37,7 +38,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) mergeRequest' projectId mergeRequestIID =-  gitlabOne addr+  gitlabGetOne addr []   where     addr =       "/projects/"@@ -60,7 +61,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) [MergeRequest]) mergeRequests' projectId =-  gitlabWithAttrs addr "&scope=all"+  gitlabGetMany addr [("scope", Just "all")]   where     addr =       "/projects/"@@ -101,17 +102,16 @@   Text ->   GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) createMergeRequest' projectId sourceBranch targetBranch targetProjectId mrTitle mrDescription =-  gitlabPost addr dataBody+  gitlabPost addr params   where-    dataBody :: Text-    dataBody =-      "source_branch=" <> sourceBranch <> "&target_branch=" <> targetBranch-        <> "&target_project_id="-        <> T.pack (show targetProjectId)-        <> "&title="-        <> mrTitle-        <> "&description="-        <> mrDescription+    params :: [GitLabParam]+    params =+      [ ("source_branch", Just (T.encodeUtf8 sourceBranch)),+        ("target_branch", Just (T.encodeUtf8 targetBranch)),+        ("target_project_id", Just (T.encodeUtf8 (T.pack (show targetProjectId)))),+        ("title", Just (T.encodeUtf8 mrTitle)),+        ("description", Just (T.encodeUtf8 mrDescription))+      ]     addr = T.pack $ "/projects/" <> show projectId <> "/merge_requests"  -- | Accepts a merge request.@@ -131,12 +131,13 @@   -- | merge request IID   Int ->   GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest))-acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr dataBody+acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr params   where-    dataBody :: Text-    dataBody =-      T.pack $-        "id=" <> show projectId <> "&merge_request_iid=" <> show mergeRequestIid+    params :: [GitLabParam]+    params =+      [ ("id", Just (T.encodeUtf8 (T.pack (show projectId)))),+        ("merge_request_iid", Just (T.encodeUtf8 (T.pack (show mergeRequestIid))))+      ]     addr =       T.pack $         "/projects/" <> show projectId <> "/merge_requests/"@@ -149,7 +150,7 @@   Project ->   -- | merge request IID   Int ->-  GitLab (Either (Response BSL.ByteString) ())+  GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteMergeRequest project =   deleteMergeRequest' (project_id project) @@ -159,7 +160,7 @@   Int ->   -- | merge request IID   Int ->-  GitLab (Either (Response BSL.ByteString) ())+  GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteMergeRequest' projectId mergeRequestIid = gitlabDelete addr   where     addr =

@@ -12,6 +12,7 @@ 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.Client@@ -36,17 +37,14 @@   Text ->   GitLab (Either (Response BSL.ByteString) (Maybe ())) createMergeRequestNote' projectId mergeRequestIID comment =-  gitlabPost addr dataBody+  gitlabPost addr params   where-    dataBody :: Text-    dataBody =-      T.pack $-        "id="-          <> show projectId-          <> "&merge_request_iid="-          <> show mergeRequestIID-          <> "&body="-          <> T.unpack comment+    params :: [GitLabParam]+    params =+      [ ("id", Just (T.encodeUtf8 (T.pack (show projectId)))),+        ("merge_request_iid", Just (T.encodeUtf8 (T.pack (show mergeRequestIID)))),+        ("body", Just (T.encodeUtf8 comment))+      ]     addr =       T.pack $         "/projects/" <> show projectId <> "/merge_requests/"

@@ -31,9 +31,9 @@   Int ->   GitLab (Either (Response BSL.ByteString) [Pipeline]) pipelines' projectId =-  gitlabWithAttrs+  gitlabGetMany     addr-    "&sort=desc" -- most recent first+    [("sort", Just "desc")] -- most recent first   where     addr =       "/projects/"

@@ -30,7 +30,8 @@ -- | gets all projects. allProjects :: GitLab [Project] allProjects =-  gitlabWithAttrsUnsafe "/projects" "&statistics=true"+  fromRight (error "allProjects error")+    <$> gitlabGetMany "/projects" [("statistics", Just "true")]  -- | gets all forks of a project. Supports use of namespaces. --@@ -45,7 +46,7 @@         "/projects/"           <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 projectName))           <> "/forks"-  gitlab urlPath+  gitlabGetMany urlPath []  -- | searches for a 'Project' with the given project ID, returns -- 'Nothing' if a project with the given ID is not found.@@ -55,7 +56,7 @@   GitLab (Either (Response BSL.ByteString) (Maybe Project)) searchProjectId projectId = do   let urlPath = T.pack ("/projects/" <> show projectId)-  gitlabWithAttrsOne urlPath "&statistics=true"+  gitlabGetOne urlPath [("statistics", Just "true")]  -- | gets all projects with the given project name. --@@ -64,9 +65,13 @@   -- | project name being searched for.   Text ->   GitLab [Project]-projectsWithName projectName =-  filter (\project -> projectName == project_path project)-    <$> gitlabWithAttrsUnsafe "/projects" ("&search=" <> projectName)+projectsWithName projectName = do+  results <- gitlabGetMany "/projects" [("search", Just (T.encodeUtf8 projectName))]+  case results of+    Left _ -> error "projectsWithName error"+    Right projects ->+      return $+        filter (\project -> projectName == project_path project) projects  -- | gets a project with the given name for the given username. E.g. --@@ -75,12 +80,12 @@ -- looks for "user1/project1" projectsWithNameAndUser :: Text -> Text -> GitLab (Either (Response BSL.ByteString) (Maybe Project)) projectsWithNameAndUser username projectName =-  gitlabWithAttrsOne+  gitlabGetOne     ( "/projects/"         <> T.decodeUtf8           (urlEncode False (T.encodeUtf8 (username <> "/" <> projectName)))     )-    "&statistics=true"+    [("statistics", Just "true")]  -- | returns 'True' if a project has multiple committers, according to -- the email addresses of the commits.@@ -115,7 +120,11 @@   userMaybe <- searchUser username   case userMaybe of     Nothing -> return Nothing-    Just usr -> Just <$> gitlabUnsafe (urlPath (user_id usr))+    Just usr -> do+      result <- gitlabGetMany (urlPath (user_id usr)) []+      case result of+        Left _ -> error "userProjects' error"+        Right projs -> return (Just projs)   where     urlPath usrId = "/users/" <> T.pack (show usrId) <> "/projects" @@ -183,7 +192,7 @@     count = do       let addr =             "/projects/" <> T.pack (show (project_id project)) <> "/members/all"-      (res :: [Member]) <- gitlabUnsafe addr+      (res :: [Member]) <- fromRight (error "projectMembersCount error") <$> gitlabGetMany addr []       return (map (\x -> (member_username x, member_name x)) res)  -- | returns 'True' is the last commit for a project passes all@@ -219,13 +228,14 @@ -- commit SHA. projectDiffs' :: Int -> Text -> GitLab (Either (Response BSL.ByteString) [Diff]) projectDiffs' projId commitSha =-  gitlab+  gitlabGetMany     ( "/projects/"         <> T.pack (show projId)         <> "/repository/commits/"         <> commitSha         <> "/diff/"     )+    []  -- | add a group to a project. addGroupToProject ::@@ -237,14 +247,13 @@   AccessLevel ->   GitLab (Either (Response BSL.ByteString) (Maybe GroupShare)) addGroupToProject groupId projectId access =-  gitlabPost addr dataBody+  gitlabPost addr params   where-    dataBody :: Text-    dataBody =-      "group_id="-        <> T.pack (show groupId)-        <> "&group_access="-        <> T.pack (show access)+    params :: [GitLabParam]+    params =+      [ ("group_id", Just (T.encodeUtf8 (T.pack (show groupId)))),+        ("group_access", Just (T.encodeUtf8 (T.pack (show access))))+      ]     addr =       "/projects/"         <> T.pack (show projectId)

@@ -32,7 +32,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) [Repository]) repositories' projectId =-  gitlab addr+  gitlabGetMany addr []   where     addr =       "/projects/"@@ -63,7 +63,12 @@   -- | file format   ArchiveFormat ->   GitLab (Either (Response BSL.ByteString) BSL.ByteString)-getFileArchiveBS project = getFileArchiveBS' (project_id project)+getFileArchiveBS project format = do+  result <- getFileArchiveBS' (project_id project) format+  case result of+    Left resp -> return (Left resp)+    Right Nothing -> error "could not download file"+    Right (Just bs) -> return (Right bs)  -- | get a file archive of the repository files using the project's --   ID. For example:@@ -81,7 +86,9 @@   attempt <- getFileArchiveBS' projectId format   case attempt of     Left st -> return (Left st)-    Right archiveData ->+    Right Nothing ->+      Right <$> error "cannot download file"+    Right (Just archiveData) ->       Right <$> liftIO (BSL.writeFile fPath archiveData)  -- | get a file archive of the repository files as a 'BSL.ByteString'@@ -93,9 +100,12 @@   Int ->   -- | file format   ArchiveFormat ->-  GitLab (Either (Response BSL.ByteString) BSL.ByteString)-getFileArchiveBS' projectId format =-  gitlabReqByteString addr+  GitLab (Either (Response BSL.ByteString) (Maybe BSL.ByteString))+getFileArchiveBS' projectId format = do+  result <- gitlabGetOne addr [] :: GitLab (Either (Response BSL.ByteString) (Maybe Bool))+  case result of+    Left response -> return (Right (Just (responseBody response)))+    Right _b -> error "impossible" -- we're asking it to parse BS as a Bool, which shouldn't be possible.   where     addr =       "/projects/"

@@ -40,7 +40,7 @@   Text ->   GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFile)) repositoryFiles' projectId filePath reference =-  gitlabWithAttrsOne addr ("&ref=" <> reference)+  gitlabGetOne addr [("ref", Just (T.encodeUtf8 reference))]   where     addr =       "/projects/"@@ -56,9 +56,9 @@   Int ->   -- | blob SHA   Text ->-  GitLab (Either (Response BSL.ByteString) String)+  GitLab (Either (Response BSL.ByteString) (Maybe String)) repositoryFileBlob projectId blobSha =-  gitlabReqText addr+  gitlabGetOne addr []   where     addr =       "/projects/"

@@ -32,7 +32,7 @@   Int ->   GitLab (Either (Response BSL.ByteString) [Tag]) tags' projectId = do-  gitlabWithAttrs (commitsAddr projectId) ""+  gitlabGetMany (commitsAddr projectId) []   where     commitsAddr :: Int -> Text     commitsAddr projId =

@@ -14,4 +14,4 @@  -- | returns all pending todos for the user, as defined by the access token. todos :: GitLab [Todo]-todos = gitlabUnsafe "/todos"+todos = gitlabUnsafe (gitlabGetOne "/todos" [])

@@ -10,10 +10,12 @@ -- Stability   : stable module GitLab.API.Users where +import Data.Either import Data.List import Data.Maybe import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Encoding as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls @@ -21,7 +23,7 @@ allUsers :: GitLab [User] allUsers = do   let path = "/users"-  gitlabUnsafe path+  fromRight (error "allUsers error") <$> gitlabGetMany path []  -- | searches for a user given a user ID. Returns @Just User@ if the -- user is found, otherwise @Nothing@.@@ -33,7 +35,7 @@   let path =         "/users/"           <> T.pack (show usrId)-  res <- gitlabOne path+  res <- gitlabGetOne path []   case res of     Left _err -> return Nothing     Right Nothing -> return Nothing@@ -47,11 +49,12 @@   GitLab (Maybe User) searchUser username = do   let path = "/users"-      attrs = "&username=" <> username-  res <- gitlabWithAttrsUnsafe path attrs-  case res of-    [] -> return Nothing-    (user : _) -> return (Just user)+      params = [("username", Just (T.encodeUtf8 username))]+  result <- gitlabGetMany path params+  case result of+    Left _err -> return Nothing+    Right [] -> return Nothing+    Right (x : _) -> return (Just x)  -- | searches for users given a list of usernames, returns them in -- alphabetical order of their usernames.

@@ -18,4 +18,4 @@ gitlabVersion :: GitLab (Either (Response BSL.ByteString) (Maybe Version)) gitlabVersion = do   let urlPath = "/version"-  gitlabOne urlPath+  gitlabGetOne urlPath []

@@ -3,20 +3,13 @@  -- | internal module to support modules in GitLab.API module GitLab.WebRequests.GitLabWebCalls-  ( gitlab,-    gitlabUnsafe,-    gitlabOneUnsafe,-    gitlabWithAttrs,-    gitlabWithAttrsUnsafe,-    gitlabOne,-    -- gitlabOneIO,-    gitlabWithAttrsOne,-    gitlabWithAttrsOneUnsafe,+  ( GitLabParam,+    gitlabGetOne,+    gitlabGetMany,     gitlabPost,     gitlabPut,     gitlabDelete,-    gitlabReqText,-    gitlabReqByteString,+    gitlabUnsafe,   ) where @@ -24,10 +17,8 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Data.Aeson-import qualified Data.ByteString as BS+import Data.ByteString import qualified Data.ByteString.Lazy as BSL-import qualified Data.ByteString.Lazy.Char8 as C-import Data.Either import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -42,98 +33,217 @@  instance Exception.Exception GitLabException --- In this module, "unsafe" functions are those that discard HTTP--- error code responses, e.g. 404, 409.+type GitLabParam = (ByteString, Maybe ByteString) -gitlabPost ::-  (FromJSON b) =>+gitlabGetOne ::+  (FromJSON a) =>   -- | the URL to post to   Text ->   -- | the data to post+  [GitLabParam] ->+  GitLab (Either (Response BSL.ByteString) (Maybe a))+gitlabGetOne urlPath params =+  request+  where+    request =+      gitlabHTTPOne+        "GET"+        "application/x-www-form-urlencoded"+        urlPath+        params+        []++gitlabGetMany ::+  (FromJSON a) =>+  -- | the URL to post to   Text ->-  GitLab (Either (Response BSL.ByteString) (Maybe b))-gitlabPost urlPath dataBody = do-  cfg <- serverCfg <$> ask-  manager <- httpManager <$> ask-  let url' = url cfg <> "/api/v4" <> urlPath-  let request' = parseRequest_ (T.unpack url')-      request =-        request'-          { method = "POST",-            requestHeaders =-              [ ("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-  if successStatus (responseStatus resp)-    then-      return-        ( case parseBSOne (responseBody resp) of-            Just x -> Right (Just x)-            Nothing -> Right Nothing-            -- Nothing ->-            --   Left $-            --     mkStatus 409 "unable to parse POST response"-        )-    else return (Left resp)+  -- | the data to post+  [GitLabParam] ->+  GitLab (Either (Response BSL.ByteString) [a])+gitlabGetMany urlPath params =+  gitlabHTTPMany+    "GET"+    "application/x-www-form-urlencoded"+    urlPath+    params+    [] -gitlabPut ::-  FromJSON b =>+gitlabPost ::+  (FromJSON a) =>   -- | the URL to post to   Text ->   -- | the data to post+  [GitLabParam] ->+  GitLab (Either (Response BSL.ByteString) (Maybe a))+gitlabPost urlPath params = do+  request+  where+    request =+      gitlabHTTPOne+        "POST"+        "application/x-www-form-urlencoded"+        urlPath+        []+        params++gitlabPut ::+  FromJSON a =>+  -- | the URL to post to   Text ->-  GitLab (Either (Response BSL.ByteString) b)-gitlabPut urlPath dataBody = do-  cfg <- serverCfg <$> ask-  manager <- httpManager <$> ask-  let url' = url cfg <> "/api/v4" <> urlPath-  let request' = parseRequest_ (T.unpack url')-      request =-        request'-          { method = "PUT",-            requestHeaders =-              [ ("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-  if successStatus (responseStatus resp)-    then-      return-        ( case parseBSOne (responseBody resp) of-            Just x -> Right x-            Nothing ->-              Left resp-        )-    else return (Left resp)+  -- | the data to post+  [GitLabParam] ->+  GitLab (Either (Response BSL.ByteString) (Maybe a))+gitlabPut urlPath params = do+  request+  where+    request =+      gitlabHTTPOne+        "PUT"+        "application/x-www-form-urlencoded"+        urlPath+        []+        params  gitlabDelete ::   -- | the URL to post to   Text ->-  GitLab (Either (Response BSL.ByteString) ())+  GitLab (Either (Response BSL.ByteString) (Maybe ())) gitlabDelete urlPath = do+  result <- request+  case result of+    Right (Just _) -> return (Right (Just ()))+    x -> return x+  where+    request =+      gitlabHTTPOne+        "DELETE"+        "application/x-www-form-urlencoded"+        urlPath+        []+        []++-- | Assumes that HTTP error code responses, e.g. 404, 409, won't be+-- returned as (Left response) value.+gitlabUnsafe :: GitLab (Either a (Maybe b)) -> GitLab b+gitlabUnsafe query = do+  result <- query+  case result of+    Left _err -> error "gitlabUnsafe error"+    Right Nothing -> error "gitlabUnsafe error"+    Right (Just x) -> return x++---------------------+-- internal functions++gitlabHTTP ::+  -- | HTTP method (PUT, POST, DELETE, GET)+  ByteString ->+  -- | Content type (content-type)+  ByteString ->+  -- | the URL+  Text ->+  -- | the URL parameters for GET calls+  [GitLabParam] ->+  -- | the content paramters for POST, PUT and DELETE calls+  [GitLabParam] ->+  GitLab (Response BSL.ByteString)+gitlabHTTP httpMethod contentType urlPath urlParams contentParams = do   cfg <- serverCfg <$> ask   manager <- httpManager <$> ask-  let url' = url cfg <> "/api/v4" <> urlPath+  let url' = url cfg <> "/api/v4" <> urlPath <> T.decodeUtf8 (renderQuery True urlParams)   let request' = parseRequest_ (T.unpack url')       request =         request'-          { method = "DELETE",+          { method = httpMethod,             requestHeaders =               [ ("PRIVATE-TOKEN", T.encodeUtf8 (token cfg)),-                ("content-type", "application/x-www-form-urlencoded")+                ("content-type", contentType)               ],-            requestBody = RequestBodyBS BS.empty+            requestBody = RequestBodyBS (renderQuery False contentParams)           }-  resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing-  if successStatus (responseStatus resp)-    then return (Right ())-    else return (Left resp)+  response <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing+  return response +gitlabHTTPOne ::+  FromJSON a =>+  -- | HTTP method (PUT, POST, DELETE, GET)+  ByteString ->+  -- | Content type (content-type)+  ByteString ->+  -- | the URL+  Text ->+  -- | the URL query data for GET calls+  [GitLabParam] ->+  -- | the content parameters for POST, PUT and DELETE calls+  [GitLabParam] ->+  GitLab+    (Either (Response BSL.ByteString) (Maybe a))+gitlabHTTPOne httpMethod contentType urlPath urlParams contentParams = do+  response <-+    gitlabHTTP+      httpMethod+      contentType+      urlPath+      urlParams+      contentParams+  if successStatus (responseStatus response)+    then return (Right (parseOne (responseBody response)))+    else return (Left response)++gitlabHTTPMany ::+  (FromJSON a) =>+  -- | HTTP method (PUT, POST, DELETE, GET)+  ByteString ->+  -- | Content type (content-type)+  ByteString ->+  -- | the URL+  Text ->+  -- | the URL query data for GET calls+  [GitLabParam] ->+  -- | the content parameters for POST, PUT and DELETE calls+  [GitLabParam] ->+  GitLab+    (Either (Response BSL.ByteString) [a])+gitlabHTTPMany httpMethod contentType urlPath urlParams contentParams = do+  go 1 []+  where+    go :: FromJSON a => Int -> [a] -> GitLab (Either (Response BSL.ByteString) [a])+    go pageNum accum = do+      response <-+        gitlabHTTP+          httpMethod+          contentType+          urlPath+          (urlParams <> [("per_page", Just "100"), ("page", Just (T.encodeUtf8 (T.pack (show pageNum))))])+          contentParams+      if successStatus (responseStatus response)+        then do+          case parseMany (responseBody response) of+            Nothing -> return (Right accum)+            Just moreResults -> do+              let numPages = totalPages response+                  accum' = accum <> moreResults+              if pageNum == numPages+                then return (Right accum')+                else go (pageNum + 1) accum'+        else return (Left response)++totalPages :: Response a -> Int+totalPages resp =+  let hdrs = responseHeaders resp+   in findPages hdrs+  where+    findPages [] = 1 -- error "cannot find X-Total-Pages in header"+    findPages (("X-Total-Pages", bs) : _) =+      case readMaybe (T.unpack (T.decodeUtf8 bs)) of+        Just s -> s+        Nothing -> error "cannot find X-Total-Pages in header"+    findPages (_ : xs) = findPages xs++successStatus :: Status -> Bool+successStatus (Status n _msg) =+  n >= 200 && n <= 226+ tryGitLab ::   -- | the current retry count   Int ->@@ -152,181 +262,14 @@     httpLbs request manager       `Exception.catch` \ex -> tryGitLab (i + 1) request maxRetries manager (Just ex) -parseBSOne :: FromJSON a => BSL.ByteString -> Maybe a-parseBSOne bs =+parseOne :: FromJSON a => BSL.ByteString -> Maybe a+parseOne bs =   case eitherDecode bs of     Left _err -> Nothing-    -- useful when debugging-    Right xs -> Just xs+    Right x -> Just x -parseBSMany :: FromJSON a => BSL.ByteString -> IO [a]-parseBSMany bs =+parseMany :: FromJSON a => BSL.ByteString -> Maybe [a]+parseMany bs =   case eitherDecode bs of-    Left s -> Exception.throwIO $ GitLabException s-    Right xs -> return xs--gitlabReqJsonMany :: (FromJSON a) => Text -> Text -> GitLab (Either (Response BSL.ByteString) [a])-gitlabReqJsonMany urlPath attrs =-  go 1 []-  where-    go i accum = do-      cfg <- serverCfg <$> ask-      manager <- httpManager <$> ask-      let url' =-            url cfg-              <> "/api/v4"-              <> urlPath-              <> ( if (hasQuestionMark urlPath)-                     then "&"-                     else "?"-                 )-              <> "per_page=100"-              <> "&page="-              <> T.pack (show i)-              <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 attrs))-      let request' = parseRequest_ (T.unpack url')-          request =-            request'-              { requestHeaders =-                  [("PRIVATE-TOKEN", T.encodeUtf8 (token cfg))],-                responseTimeout = responseTimeoutMicro (timeout cfg)-              }-      resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing-      if successStatus (responseStatus resp)-        then do-          moreResults <- liftIO $ parseBSMany (responseBody resp)-          let numPages = totalPages resp-              accum' = accum ++ moreResults-          if numPages == i-            then return (Right accum')-            else go (i + 1) accum'-        else return (Left resp)---- not sure what this was planned for------ gitlabReqOneIO :: Manager -> GitLabServerConfig -> (BSL.ByteString -> output) -> Text -> Text -> IO (Either Status output)--- gitlabReqOneIO manager cfg parser urlPath attrs = go---   where---     go = do---       let url' =---             url cfg---               <> "/api/v4"---               <> urlPath---               <> "?per_page=100"---               <> "&page=1"---               <> attrs---       let request' = parseRequest_ (T.unpack url')---           request =---             request'---               { requestHeaders =---                   [("PRIVATE-TOKEN", T.encodeUtf8 (token cfg))],---                 responseTimeout = responseTimeoutMicro (timeout cfg)---               }---       resp <- tryGitLab 0 request (retries cfg) manager Nothing---       if successStatus (responseStatus resp)---         then return (Right (parser (responseBody resp)))---         else return (Left (responseStatus resp))--gitlabReqOne :: (BSL.ByteString -> output) -> Text -> Text -> GitLab (Either (Response BSL.ByteString) output)-gitlabReqOne parser urlPath attrs = go-  where-    go = do-      cfg <- serverCfg <$> ask-      manager <- httpManager <$> ask-      let url' =-            url cfg-              <> "/api/v4"-              <> urlPath-              <> ( if (hasQuestionMark urlPath)-                     then "&"-                     else "?"-                 )-              <> "per_page=100"-              <> "&page=1"-              <> attrs-      let request' = parseRequest_ (T.unpack url')-          request =-            request'-              { requestHeaders =-                  [("PRIVATE-TOKEN", T.encodeUtf8 (token cfg))],-                responseTimeout = responseTimeoutMicro (timeout cfg)-              }-      resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing-      if successStatus (responseStatus resp)-        then return (Right (parser (responseBody resp)))-        else return (Left resp)---- not sure what this was planned for------ gitlabReqJsonOneIO :: (FromJSON a) => Manager -> GitLabServerConfig -> Text -> Text -> IO (Either Status (Maybe a))--- gitlabReqJsonOneIO mgr cfg urlPath attrs =---   gitlabReqOneIO mgr cfg parseBSOne urlPath attrs--gitlabReqJsonOne :: (FromJSON a) => Text -> Text -> GitLab (Either (Response BSL.ByteString) (Maybe a))-gitlabReqJsonOne =-  gitlabReqOne parseBSOne--gitlabReqText :: Text -> GitLab (Either (Response BSL.ByteString) String)-gitlabReqText urlPath = gitlabReqOne C.unpack urlPath ""--gitlabReqByteString :: Text -> GitLab (Either (Response BSL.ByteString) BSL.ByteString)-gitlabReqByteString urlPath = gitlabReqOne Prelude.id urlPath ""--gitlab :: FromJSON a => Text -> GitLab (Either (Response BSL.ByteString) [a])-gitlab addr = gitlabReqJsonMany addr ""--gitlabUnsafe :: (FromJSON a) => Text -> GitLab [a]-gitlabUnsafe addr =-  fromRight (error "gitlabUnsafe error") <$> gitlab addr---- not sure what this was planned for------ 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 (Response BSL.ByteString) (Maybe a))-gitlabOne addr = gitlabReqJsonOne addr ""--gitlabOneUnsafe :: (FromJSON a) => Text -> GitLab a-gitlabOneUnsafe addr = do-  result <- fromRight (error "gitlabOneUnsafe error") <$> gitlabOne addr-  case result of-    Nothing -> error "gitlabOneUnsafe error"-    Just value -> return value--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 (Response BSL.ByteString) (Maybe a))-gitlabWithAttrsOne = gitlabReqJsonOne--gitlabWithAttrsOneUnsafe :: (FromJSON a) => Text -> Text -> GitLab a-gitlabWithAttrsOneUnsafe gitlabURL attrs = do-  result <- gitlabReqJsonOne gitlabURL attrs-  case result of-    Left s -> error ("gitlabWithAttrsOneUnsafe: " <> show s)-    Right Nothing -> error ("gitlabWithAttrsOneUnsafe: could not parse JSON for " <> show attrs)-    Right (Just x) -> return x--totalPages :: Response a -> Int-totalPages resp =-  let hdrs = responseHeaders resp-   in findPages hdrs-  where-    findPages [] = 1 -- error "cannot find X-Total-Pages in header"-    findPages (("X-Total-Pages", bs) : _) =-      case readMaybe (T.unpack (T.decodeUtf8 bs)) of-        Just s -> s-        Nothing -> error "cannot find X-Total-Pages in header"-    findPages (_ : xs) = findPages xs--successStatus :: Status -> Bool-successStatus (Status n _msg) =-  n >= 200 && n <= 226--hasQuestionMark :: Text -> Bool-hasQuestionMark = T.isInfixOf "?"+    Left _err -> Nothing+    Right xs -> Just xs