gitlab-haskell 0.1.5 → 0.1.6

raw patch · 19 files changed

+1811/−1434 lines, 19 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +9/−7
• gitlab-haskell.cabal +5/−3
• src/GitLab.hs +47/−29
• src/GitLab/API/Branches.hs +17/−16
• src/GitLab/API/Commits.hs +44/−29
• src/GitLab/API/Groups.hs +80/−56
• src/GitLab/API/Issues.hs +36/−29
• src/GitLab/API/Jobs.hs +22/−18
• src/GitLab/API/Members.hs +49/−38
• src/GitLab/API/MergeRequests.hs +82/−60
• src/GitLab/API/Pipelines.hs +26/−20
• src/GitLab/API/Projects.hs +106/−87
• src/GitLab/API/Repositories.hs +78/−36
• src/GitLab/API/RepositoryFiles.hs +44/−35
• src/GitLab/API/Todos.hs +8/−9
• src/GitLab/API/Users.hs +23/−21
• src/GitLab/API/Version.hs +20/−0
• src/GitLab/Types.hs +974/−848
• src/GitLab/WebRequests/GitLabWebCalls.hs +141/−93

@@ -31,15 +31,17 @@  For example: -    myTodos <- runGitLab-                 (defaultGitLabServer-                   { url = "https://gitlab.example.com"-                   , token="my_token"} )-                 todos+    myProjects <-+      runGitLab+        (defaultGitLabServer+           { url = "https://gitlab.example.com"+           , token="my_token"} )+        (searchUser "joe" >>= userProjects . fromJust) -Which uses the `todos` function:+Which uses the` function: -    todos :: MonadIO m => GitLab m [Todo] +    searchUser   :: Text -> GitLab m (Maybe User)+    userProjects :: User -> GitLab m (Maybe [Project])  This returns all GitLab TODO items, as Haskell values of type `Todo` for the user identified with the access token`my_token`.

@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.1.5+version:        0.1.6 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/>@@ -19,11 +19,12 @@             >      (defaultGitLabServer             >          { url = "https://gitlab.example.com"             >          , token="my_token"} )-            >      todos+            >      (searchUser "joe" >>= userProjects . fromJust)             .             Which uses the `todos` function:             .-            > todos :: MonadIO m => GitLab m [Todo] +            > searchUser   :: Text -> GitLab m (Maybe User)+            > userProjects :: User -> GitLab m (Maybe [Project])             .             Unsurprisingly, this library is maintained on GitLab: <https://gitlab.com/robstewart57/gitlab-haskell> @@ -60,6 +61,7 @@                 , GitLab.API.MergeRequests                 , GitLab.API.RepositoryFiles                 , GitLab.API.Todos+                , GitLab.API.Version   other-modules:                   GitLab.WebRequests.GitLabWebCalls   hs-source-dirs:

@@ -1,37 +1,36 @@+{-# LANGUAGE OverloadedStrings #-} -{-|-Module      : GitLab-Description : Contains the 'runGitLab' function to run GitLab actions-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : GitLab+-- Description : Contains the 'runGitLab' function to run GitLab actions+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab-  ( runGitLab-  , module GitLab.Types-  , module GitLab.API.Pipelines-  , module GitLab.API.Groups-  , module GitLab.API.Members-  , module GitLab.API.Commits-  , module GitLab.API.Projects-  , module GitLab.API.Users-  , module GitLab.API.Issues-  , module GitLab.API.Branches-  , module GitLab.API.Jobs-  , module GitLab.API.MergeRequests-  , module GitLab.API.Repositories-  , module GitLab.API.RepositoryFiles-  , module GitLab.API.Todos-  ) where+  ( runGitLab,+    runGitLabWithManager,+    module GitLab.Types,+    module GitLab.API.Pipelines,+    module GitLab.API.Groups,+    module GitLab.API.Members,+    module GitLab.API.Commits,+    module GitLab.API.Projects,+    module GitLab.API.Users,+    module GitLab.API.Issues,+    module GitLab.API.Branches,+    module GitLab.API.Jobs,+    module GitLab.API.MergeRequests,+    module GitLab.API.Repositories,+    module GitLab.API.RepositoryFiles,+    module GitLab.API.Todos,+    module GitLab.API.Version,+  )+where  import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Trans.Reader-import Network.Connection (TLSSettings (..))-import Network.HTTP.Conduit-import System.IO- import GitLab.API.Branches import GitLab.API.Commits import GitLab.API.Groups@@ -45,7 +44,12 @@ import GitLab.API.RepositoryFiles import GitLab.API.Todos import GitLab.API.Users+import GitLab.API.Version import GitLab.Types+import Network.Connection (TLSSettings (..))+import Network.HTTP.Conduit+import Network.HTTP.Types.Status+import System.IO  -- | runs a GitLab action. --@@ -70,4 +74,18 @@   liftIO $ hSetBuffering stdout LineBuffering   let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing   manager <- liftIO $ newManager settings-  runReaderT action (GitLabState cfg manager)+  runGitLabWithManager manager cfg action++-- | The same as 'runGitLab', except that it also takes a connection+-- manager as an argument.+runGitLabWithManager ::+  (MonadUnliftIO m, MonadIO m) => Manager -> GitLabServerConfig -> GitLab m a -> m a+runGitLabWithManager manager cfg action = do+  -- 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)+    Right _versionInfo ->+      -- it worked, run the user code.+      runReaderT action (GitLabState cfg manager)

@@ -1,35 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : Branches-Description : Queries about repository branches-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Branches+-- Description : Queries about repository branches+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Branches where +import Control.Monad.IO.Unlift+import Data.Either import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls-import Control.Monad.IO.Unlift-+import Network.HTTP.Types.Status  -- | Get a list of repository branches from a project, sorted by name -- alphabetically. branches :: (MonadIO m) => Project -> GitLab m [Branch]-branches project = branches' (project_id project)+branches project = do+  result <- branches' (project_id project)+  return (fromRight (error "branches error") result)  -- | Get a list of repository branches from a project given its -- project ID, sorted by name alphabetically.-branches' :: (MonadIO m) => Int -> GitLab m [Branch]+branches' :: (MonadIO m) => Int -> GitLab m (Either Status [Branch]) branches' projectId =   gitlab addr   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/repository"-      <> "/branches"-+        <> T.pack (show projectId)+        <> "/repository"+        <> "/branches"

@@ -1,32 +1,38 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : Commits-Description : Queries about commits in repositories-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Commits+-- Description : Queries about commits in repositories+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Commits where  import Control.Monad.IO.Unlift+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  -- | returns all commits for a project.-projectCommits :: (MonadIO m)-  => Project -- ^ the project-  -> GitLab m [Commit]-projectCommits project = projectCommits' (project_id project)+projectCommits ::+  (MonadIO m) =>+  -- | the project+  Project ->+  GitLab m [Commit]+projectCommits project = do+  result <- projectCommits' (project_id project)+  return (fromRight (error "projectCommits error") result)  -- | returns all commits for a project given its project ID.-projectCommits' :: (MonadIO m)-  => Int -- ^ project ID-  -> GitLab m [Commit]+projectCommits' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  GitLab m (Either Status [Commit]) projectCommits' projectId =   gitlabWithAttrs (commitsAddr projectId) "&with_stats=true"   where@@ -36,25 +42,34 @@  -- | returns a commit for the given project and commit hash, if such -- a commit exists.-commitDetails :: (MonadIO m)-  => Project -- ^ the project-  -> Text    -- ^ the commit hash-  -> GitLab m (Maybe Commit)-commitDetails project = commitDetails' (project_id project)+commitDetails ::+  (MonadIO m) =>+  -- | the project+  Project ->+  -- | the commit hash+  Text ->+  GitLab m (Maybe Commit)+commitDetails project theHash = do+  result <- commitDetails' (project_id project) theHash+  return (fromRight (error "commitDetails error") result)  -- | returns a commit for the given project ID and commit hash, if -- such a commit exists.-commitDetails' :: (MonadIO m)-  => Int  -- ^ project ID-  -> Text -- ^ the commit hash-  -> GitLab m (Maybe Commit)+commitDetails' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | the commit hash+  Text ->+  GitLab m (Either Status (Maybe Commit)) commitDetails' projectId hash =   gitlabOne (commitsAddr projectId)   where     commitsAddr :: Int -> Text     commitsAddr projId =       "/projects/"-      <> T.pack (show projId)-      <> "/repository"-      <> "/commits"-      <> "/" <> hash+        <> T.pack (show projId)+        <> "/repository"+        <> "/commits"+        <> "/"+        <> hash

@@ -1,50 +1,60 @@-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -{-|-Module      : Groups-Description : Queries about and updates to groups-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Groups+-- Description : Queries about and updates to groups+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Groups where  import Control.Monad.IO.Class import Control.Monad.IO.Unlift+import qualified Data.ByteString.Char8 as C import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T-import Network.HTTP.Types.Status-import Network.HTTP.Types.URI-import qualified Data.ByteString.Char8 as C- import GitLab.API.Members import GitLab.API.Users import GitLab.Types import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status+import Network.HTTP.Types.URI  -- | gets groups with the given group name or path. -- -- > projectsWithNameOrPath "group1"-groupsWithNameOrPath :: (MonadUnliftIO m, MonadIO m)-  => Text -- ^ group name being searched for.-  -> GitLab m [Group]-groupsWithNameOrPath groupName =-  filter (\group ->-            groupName == group_name group-            || groupName == group_path group-         ) <$>-  gitlabWithAttrs "/groups" ("&search=" <> groupName)+groupsWithNameOrPath ::+  (MonadUnliftIO m, MonadIO m) =>+  -- | group name being searched for.+  Text ->+  GitLab m (Either Status [Group])+groupsWithNameOrPath groupName = do+  result <- gitlabWithAttrs "/groups" ("&search=" <> groupName)+  case result of+    Left {} -> return result+    Right groups ->+      return+        ( Right+            $filter+            ( \group ->+                groupName == group_name group+                  || groupName == group_path group+            )+            groups+        )  -- | adds all registered users to a group. addAllUsersToGroup ::-     (MonadIO m, MonadUnliftIO m)-  => Text -- ^ group name-  -> AccessLevel -- ^ level of access granted-  -> GitLab m [Either Status Member]+  (MonadIO m, MonadUnliftIO m) =>+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  GitLab m [Either Status Member] addAllUsersToGroup groupName access = do   allRegisteredUsers <- allUsers   let allUserIds = map user_username allRegisteredUsers@@ -52,55 +62,69 @@  -- | adds a user to a group. addUserToGroup ::-     (MonadIO m, MonadUnliftIO m)-  => Text -- ^ group name-  -> AccessLevel -- ^ level of access granted-  -> User -- ^ the user-  -> GitLab m (Either Status Member)+  (MonadIO m, MonadUnliftIO m) =>+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | the user+  User ->+  GitLab m (Either Status Member) addUserToGroup groupName access usr =   addUserToGroup' groupName access (user_id usr)  -- | adds a user with a given user ID to a group. addUserToGroup' ::-     (MonadIO m, MonadUnliftIO m)-  => Text -- ^ group name-  -> AccessLevel -- ^ level of access granted-  -> Int -- ^ user ID-  -> GitLab m (Either Status Member)+  (MonadIO m, MonadUnliftIO m) =>+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | user ID+  Int ->+  GitLab m (Either Status Member) addUserToGroup' groupName access userId = do-  groups <- groupsWithNameOrPath groupName-  case groups of-    [] -> return (Left (mkStatus 404 (C.pack "cannot find group")))-    [grp] ->+  attempt <- groupsWithNameOrPath groupName+  case attempt of+    Left httpStatus -> return (Left httpStatus)+    Right [] -> return (Left (mkStatus 404 (C.pack "cannot find group")))+    Right [grp] -> do       gitlabPost addr dataBody       where         dataBody :: Text         dataBody =-          "user_id=" <> T.pack (show userId) <> "&access_level=" <>-          T.pack (show access)-        addr = "/groups/"-               <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))-               <> "/members"-    (_:_) ->+          "user_id=" <> T.pack (show userId) <> "&access_level="+            <> T.pack (show access)+        addr =+          "/groups/"+            <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))+            <> "/members"+    Right (_ : _) ->       return (Left (mkStatus 404 (C.pack "too many groups found")))  -- | adds a list of users to a group. addUsersToGroup ::-     (MonadIO m, MonadUnliftIO m)-  => Text -- ^ group name-  -> AccessLevel -- ^ level of access granted-  -> [User] -- ^ list of usernames to be added to the group-  -> GitLab m [Either Status Member]+  (MonadIO m, MonadUnliftIO m) =>+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | list of usernames to be added to the group+  [User] ->+  GitLab m [Either Status Member] addUsersToGroup groupName access =   mapM (addUserToGroup groupName access)  -- | adds a list of users to a group. addUsersToGroup' ::-     (MonadIO m, MonadUnliftIO m)-  => Text -- ^ group name-  -> AccessLevel -- ^ level of access granted-  -> [Text] -- ^ list of usernames to be added to the group-  -> GitLab m [Either Status Member]+  (MonadIO m, MonadUnliftIO m) =>+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | list of usernames to be added to the group+  [Text] ->+  GitLab m [Either Status Member] addUsersToGroup' groupName access usernames = do   users <- catMaybes <$> mapM searchUser usernames   mapM (addUserToGroup' groupName access . user_id) users

@@ -1,50 +1,57 @@-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -{-|-Module      : Issues-Description : Queries about issues created against projects-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Issues+-- Description : Queries about issues created against projects+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Issues where  import Control.Monad.IO.Class import Control.Monad.IO.Unlift+import Data.Either import qualified Data.Text as T--import GitLab.WebRequests.GitLabWebCalls import GitLab.Types+import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status  -- | returns all issues against a project. projectOpenedIssues ::-     (MonadIO m, MonadUnliftIO m)-  => Project -- ^ the project-  -> GitLab m [Issue]-projectOpenedIssues = projectOpenedIssues' . project_id+  (MonadIO m, MonadUnliftIO m) =>+  -- | the project+  Project ->+  GitLab m [Issue]+projectOpenedIssues p = do+  result <- projectOpenedIssues' (project_id p)+  return (fromRight (error "projectOpenedIssues error") result)  -- | returns all issues against a project given its project ID. projectOpenedIssues' ::-     (MonadIO m, MonadUnliftIO m)-  => Int -- ^ the project ID-  -> GitLab m [Issue]+  (MonadIO m, MonadUnliftIO m) =>+  -- | the project ID+  Int ->+  GitLab m (Either Status [Issue]) projectOpenedIssues' projectId = do-    let path = "/projects/" <> T.pack (show projectId) <> "/issues"-    gitlab path-    -- gitlabReq path "&state=opened"+  let path = "/projects/" <> T.pack (show projectId) <> "/issues"+  gitlab path +-- gitlabReq path "&state=opened"+ -- | gets all issues create by a user. userIssues ::-     (MonadIO m)-  => User -- ^ the user-  -> GitLab m [Issue]+  (MonadIO m) =>+  -- | the user+  User ->+  GitLab m [Issue] userIssues usr =-  gitlabWithAttrs addr attrs+  gitlabWithAttrsUnsafe addr attrs   where     addr = "/issues"-    attrs = T.pack $-      "&author_id="-      <> show (user_id usr)-      <> "&scope=all"+    attrs =+      T.pack $+        "&author_id="+          <> show (user_id usr)+          <> "&scope=all"

@@ -1,37 +1,41 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : Jobs-Description : Queries about jobs ran on projects-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Jobs+-- Description : Queries about jobs ran on projects+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Jobs where  import Control.Monad.IO.Unlift+import Data.Either import qualified Data.Text as T- import GitLab.Types import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status  -- | returns all jobs ran on a project. jobs ::-     (MonadIO m)-  => Project -- ^ the project-  -> GitLab m [Job]-jobs project = jobs' (project_id project)+  (MonadIO m) =>+  -- | the project+  Project ->+  GitLab m [Job]+jobs project = do+  result <- jobs' (project_id project)+  return (fromRight (error "jobs error") result)  -- | returns all jobs ran on a project given its project ID. jobs' ::-     (MonadIO m)-  => Int -- ^ the project ID-  -> GitLab m [Job]+  (MonadIO m) =>+  -- | the project ID+  Int ->+  GitLab m (Either Status [Job]) jobs' projectId =   gitlab addr   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/jobs"+        <> T.pack (show projectId)+        <> "/jobs"

@@ -1,27 +1,26 @@-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -{-|-Module      : Members-Description : Queries about and updates to members of projects-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Members+-- Description : Queries about and updates to members of projects+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Members where  import Control.Monad.IO.Class+import Data.Either import Data.Text (Text) import qualified Data.Text as T-import Network.HTTP.Types.Status- import GitLab.Types import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status  -- | the access levels for project members. See <https://docs.gitlab.com/ee/user/permissions.html#project-members-permissions>-data AccessLevel =-  Guest+data AccessLevel+  = Guest   | Reporter   | Developer   | Maintainer@@ -36,10 +35,12 @@  -- | the members of a project. membersOfProject :: (MonadIO m) => Project -> GitLab m [Member]-membersOfProject  = membersOfProject' . project_id+membersOfProject p = do+  result <- membersOfProject' (project_id p)+  return (fromRight (error "membersOfProject error") result)  -- | the members of a project given its ID.-membersOfProject' :: (MonadIO m) => Int -> GitLab m [Member]+membersOfProject' :: (MonadIO m) => Int -> GitLab m (Either Status [Member]) membersOfProject' projectId =   gitlab addr   where@@ -50,11 +51,14 @@ -- 'Right Member' for each successful action, otherwise it returns -- 'Left Status'. addMemberToProject ::-     (MonadIO m)-     => Project -- ^ the project-     -> AccessLevel -- ^ level of access-     -> User -- ^ the user-     -> GitLab m (Either Status Member)+  (MonadIO m) =>+  -- | the project+  Project ->+  -- | level of access+  AccessLevel ->+  -- | the user+  User ->+  GitLab m (Either Status Member) addMemberToProject project access usr =   addMemberToProject' (project_id project) access (user_id usr) @@ -62,30 +66,35 @@ -- project's ID and the user's ID. Returns @Right Member@ for each -- successful action, otherwise it returns @Left Status@. addMemberToProject' ::-     (MonadIO m)-     => Int -- ^ project ID-     -> AccessLevel -- ^ level of access-     -> Int -- ^ user ID-     -> GitLab m (Either Status Member)+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | level of access+  AccessLevel ->+  -- | user ID+  Int ->+  GitLab m (Either Status Member) addMemberToProject' projectId access userId =   gitlabPost addr dataBody   where     dataBody :: Text     dataBody =-        "user_id=" <> T.pack (show userId) <> "&access_level=" <> T.pack (show access)+      "user_id=" <> T.pack (show userId) <> "&access_level=" <> T.pack (show access)     addr =       "/projects/" <> T.pack (show projectId) <> "/members" - -- | adds a list of users to a project with the given access -- level. Returns 'Right Member' for each successful action, otherwise -- it returns 'Left Status'. addMembersToProject ::-     (MonadIO m)-  => Project -- ^ the project-  -> AccessLevel -- ^ level of access-  -> [User] -- ^ users to add to the project-  -> GitLab m [Either Status Member]+  (MonadIO m) =>+  -- | the project+  Project ->+  -- | level of access+  AccessLevel ->+  -- | users to add to the project+  [User] ->+  GitLab m [Either Status Member] addMembersToProject project access =   mapM (addMemberToProject project access) @@ -93,11 +102,13 @@ -- given the project's ID and the user IDs. Returns @Right Member@ for -- each successful action, otherwise it returns @Left Status@. addMembersToProject' ::-     (MonadIO m)-     => Int -- ^ project ID-     -> AccessLevel -- ^ level of acces-     -> [Int] -- ^ IDs of users to add to the project-     -> GitLab m [Either Status Member]+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | level of acces+  AccessLevel ->+  -- | IDs of users to add to the project+  [Int] ->+  GitLab m [Either Status Member] addMembersToProject' projectId access =   mapM (addMemberToProject' projectId access)-

@@ -1,100 +1,122 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : MergeRequests-Description : Queries about merge requests against projects-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : MergeRequests+-- Description : Queries about merge requests against projects+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.MergeRequests where  import Control.Monad.IO.Unlift+import Data.Either import Data.Text (Text) import qualified Data.Text as T-import Network.HTTP.Types.Status- import GitLab.Types import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status  -- | returns the merge requests for a project.-mergeRequests :: (MonadIO m)-  => Project -- ^ the project-  -> GitLab m [MergeRequest]-mergeRequests = mergeRequests' . project_id+mergeRequests ::+  (MonadIO m) =>+  -- | the project+  Project ->+  GitLab m [MergeRequest]+mergeRequests p = do+  result <- mergeRequests' (project_id p)+  return (fromRight (error "mergeRequests error") result)  -- | returns the merge requests for a project given its project ID.-mergeRequests' :: (MonadIO m)-  => Int -- ^ project ID-  -> GitLab m [MergeRequest]+mergeRequests' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  GitLab m (Either Status [MergeRequest]) mergeRequests' projectId =   gitlabWithAttrs addr "&scope=all"   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/merge_requests"+        <> T.pack (show projectId)+        <> "/merge_requests"  -- | Creates a merge request.-createMergeRequest-  :: (MonadIO m)-  => Project -- ^ project-  -> Text -- ^ source branch-  -> Text -- ^ target branch-  -> Int -- ^ target project ID-  -> Text -- ^ merge request title-  -> Text -- ^ merge request description-  -> GitLab m  (Either Status MergeRequest)+createMergeRequest ::+  (MonadIO m) =>+  -- | project+  Project ->+  -- | source branch+  Text ->+  -- | target branch+  Text ->+  -- | target project ID+  Int ->+  -- | merge request title+  Text ->+  -- | merge request description+  Text ->+  GitLab m (Either Status MergeRequest) createMergeRequest project =   createMergeRequest' (project_id project)-  + -- | Creates a merge request.-createMergeRequest'-  :: (MonadIO m)-  => Int -- ^ project ID-  -> Text -- ^ source branch-  -> Text -- ^ target branch-  -> Int -- ^ target project ID-  -> Text -- ^ merge request title-  -> Text -- ^ merge request description-  -> GitLab m  (Either Status MergeRequest)+createMergeRequest' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | source branch+  Text ->+  -- | target branch+  Text ->+  -- | target project ID+  Int ->+  -- | merge request title+  Text ->+  -- | merge request description+  Text ->+  GitLab m (Either Status MergeRequest) createMergeRequest' projectId sourceBranch targetBranch targetProjectId mrTitle mrDescription =   gitlabPost addr dataBody   where     dataBody :: Text     dataBody =-      "source_branch=" <> sourceBranch <> "&target_branch=" <> targetBranch <>-      "&target_project_id=" <>-      T.pack (show targetProjectId) <>-      "&title=" <>-      mrTitle <>-      "&description=" <>-      mrDescription+      "source_branch=" <> sourceBranch <> "&target_branch=" <> targetBranch+        <> "&target_project_id="+        <> T.pack (show targetProjectId)+        <> "&title="+        <> mrTitle+        <> "&description="+        <> mrDescription     addr = T.pack $ "/projects/" <> show projectId <> "/merge_requests"  -- | Accepts a merge request.-acceptMergeRequest-  :: (MonadIO m)-  => Project -- ^ project-  -> Int -- ^ merge request IID-  -> GitLab m  (Either Status MergeRequest)+acceptMergeRequest ::+  (MonadIO m) =>+  -- | project+  Project ->+  -- | merge request IID+  Int ->+  GitLab m (Either Status MergeRequest) acceptMergeRequest project =   acceptMergeRequest' (project_id project)  -- | Accepts a merge request.-acceptMergeRequest'-  :: (MonadIO m)-  => Int -- ^ project ID-  -> Int -- ^ merge request IID-  -> GitLab m  (Either Status MergeRequest)+acceptMergeRequest' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | merge request IID+  Int ->+  GitLab m (Either Status MergeRequest) acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr dataBody   where     dataBody :: Text-    dataBody = T.pack $-      "id=" <> show projectId <> "&merge_request_iid=" <> show mergeRequestIid+    dataBody =+      T.pack $+        "id=" <> show projectId <> "&merge_request_iid=" <> show mergeRequestIid     addr =       T.pack $-      "/projects/" <> show projectId <> "/merge_requests/" <>-      show mergeRequestIid <>-      "/merge"+        "/projects/" <> show projectId <> "/merge_requests/"+          <> show mergeRequestIid+          <> "/merge"

@@ -1,37 +1,43 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : Pipelines-Description : Queries about project pipelines-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Pipelines+-- Description : Queries about project pipelines+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Pipelines where  import Control.Monad.IO.Unlift+import Data.Either import qualified Data.Text as T- import GitLab.Types import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status  -- | returns the pipelines for a project.-pipelines :: (MonadIO m)-  => Project -- ^ the project-  -> GitLab m [Pipeline]-pipelines = pipelines' . project_id+pipelines ::+  (MonadIO m) =>+  -- | the project+  Project ->+  GitLab m [Pipeline]+pipelines p = do+  result <- pipelines' (project_id p)+  return (fromRight (error "pipelines error") result)  -- | returns the pipelines for a project given its project ID.-pipelines' :: (MonadIO m)-  => Int -- ^ the project ID-  -> GitLab m [Pipeline]+pipelines' ::+  (MonadIO m) =>+  -- | the project ID+  Int ->+  GitLab m (Either Status [Pipeline]) pipelines' projectId =   gitlabWithAttrs-  addr-  "&sort=desc" -- most recent first+    addr+    "&sort=desc" -- most recent first   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/pipelines"+        <> T.pack (show projectId)+        <> "/pipelines"

@@ -1,27 +1,23 @@-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -{-|-Module      : Projects-Description : Queries about projects-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Projects+-- Description : Queries about projects+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Projects where  import Control.Monad.IO.Class import Control.Monad.IO.Unlift+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 Network.HTTP.Types.URI-import Network.HTTP.Types.Status-import UnliftIO.Async- import GitLab.API.Commits import GitLab.API.Issues import GitLab.API.Members@@ -29,62 +25,68 @@ import GitLab.API.Users import GitLab.Types import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status+import Network.HTTP.Types.URI+import UnliftIO.Async  -- | gets all projects. allProjects :: (MonadIO m) => GitLab m [Project] allProjects =-  gitlabWithAttrs "/projects" "&statistics=true"+  gitlabWithAttrsUnsafe "/projects" "&statistics=true"  -- | gets all forks of a project. Supports use of namespaces. -- -- > projectForks "project1" -- > projectForks "group1/project1"-projectForks :: (MonadUnliftIO m, MonadIO m)-  => Text -- ^ name or namespace of the project-  -> GitLab m [Project]+projectForks ::+  (MonadUnliftIO m, MonadIO m) =>+  -- | name or namespace of the project+  Text ->+  GitLab m (Either Status [Project]) projectForks projectName = do   let urlPath =-        "/projects/" <>-        T.decodeUtf8 (urlEncode False (T.encodeUtf8 projectName)) <>-        "/forks"+        "/projects/"+          <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 projectName))+          <> "/forks"   gitlab urlPath  -- | searches for a 'Project' with the given project ID, returns -- 'Nothing' if a project with the given ID is not found.-searchProjectId :: (MonadIO m)-  => Int -- ^ project ID-  -> GitLab m (Maybe Project)+searchProjectId ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  GitLab m (Either Status (Maybe Project)) searchProjectId projectId = do   let urlPath = T.pack ("/projects/" <> show projectId)-  gitlabWithAttrsOne urlPath  "&statistics=true"+  gitlabWithAttrsOne urlPath "&statistics=true"  -- | gets all projects with the given project name. -- -- > projectsWithName "project1"-projectsWithName :: (MonadUnliftIO m, MonadIO m)-  => Text -- ^ project name being searched for.-  -> GitLab m [Project]+projectsWithName ::+  (MonadUnliftIO m, MonadIO m) =>+  -- | project name being searched for.+  Text ->+  GitLab m [Project] projectsWithName projectName =-  filter (\project -> projectName == project_path project) <$>-  gitlabWithAttrs "/projects" ("&search=" <> projectName)+  filter (\project -> projectName == project_path project)+    <$> gitlabWithAttrsUnsafe "/projects" ("&search=" <> projectName) --- | gets a project with the given name for the given username. E.g. +-- | gets a project with the given name for the given username. E.g. -- -- > projectsNamespaceName "user1" "project1" -- -- looks for "user1/project1" projectsWithNameAndUser ::-     (MonadUnliftIO m, MonadIO m) => Text -> Text -> GitLab m (Maybe Project)+  (MonadUnliftIO m, MonadIO m) => Text -> Text -> GitLab m (Either Status (Maybe Project)) projectsWithNameAndUser username projectName =-  -- gitlabOne-  -- ("/projects/" <>-  --  T.decodeUtf8-  --     (urlEncode False (T.encodeUtf8 (username <> "/" <> projectName))))   gitlabWithAttrsOne-  ("/projects/" <>-   T.decodeUtf8-      (urlEncode False (T.encodeUtf8 (username <> "/" <> projectName))))-  "&statistics=true"+    ( "/projects/"+        <> T.decodeUtf8+          (urlEncode False (T.encodeUtf8 (username <> "/" <> projectName)))+    )+    "&statistics=true"  -- | returns 'True' if a project has multiple committers, according to -- the email addresses of the commits.@@ -94,28 +96,34 @@   return (length (nub emailAddresses) > 1)  -- | gets the email addresses in the author information in all commit--- for a project. +-- for a project. commitsEmailAddresses ::-     (MonadUnliftIO m, MonadIO m) => Project -> GitLab m [Text]-commitsEmailAddresses = commitsEmailAddresses' . project_id+  (MonadUnliftIO m, MonadIO m) => Project -> GitLab m [Text]+commitsEmailAddresses project = do+  result <- commitsEmailAddresses' (project_id project)+  return (fromRight (error "commitsEmailAddresses error") result)  -- | gets the email addresses in the author information in all commit--- for a project defined by the project's ID. -commitsEmailAddresses' :: (MonadUnliftIO m, MonadIO m) => Int -> GitLab m [Text]+-- for a project defined by the project's ID.+commitsEmailAddresses' :: (MonadUnliftIO m, MonadIO m) => Int -> GitLab m (Either Status [Text]) commitsEmailAddresses' projectId = do-  (commits :: [Commit]) <- projectCommits' projectId-  return (map author_email commits)+  -- (commits :: [Commit]) <- projectCommits' projectId+  attempt <- projectCommits' projectId+  case attempt of+    Left httpStatus -> return (Left httpStatus)+    Right (commits :: [Commit]) ->+      return (Right (map author_email commits))  -- | gets all projects for a user given their username. -- -- > userProjects "harry" userProjects' ::-     (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe [Project])+  (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe [Project]) userProjects' username = do   userMaybe <- searchUser username   case userMaybe of     Nothing -> return Nothing-    Just usr -> Just <$> gitlab (urlPath (user_id usr))+    Just usr -> Just <$> gitlabUnsafe (urlPath (user_id usr))   where     urlPath userId = "/users/" <> T.pack (show userId) <> "/projects" @@ -123,14 +131,16 @@ -- -- > userProjects myUser userProjects ::-     (MonadUnliftIO m, MonadIO m) => User -> GitLab m (Maybe [Project])-userProjects theUser = userProjects' (user_username theUser)+  (MonadUnliftIO m, MonadIO m) => User -> GitLab m (Maybe [Project])+userProjects theUser =+  userProjects' (user_username theUser)  -- | gets the 'GitLab.Types.Project' against which the given 'Issue' -- was created. projectOfIssue :: (MonadIO m) => Issue -> GitLab m Project-projectOfIssue issue =-  fromJust <$> searchProjectId (issue_project_id issue)+projectOfIssue issue = do+  result <- searchProjectId (issue_project_id issue)+  return (fromJust (fromRight (error "projectOfIssue error") result))  -- | finds all issues created by a user. --@@ -139,7 +149,7 @@ -- returns a (user,projects) tuple, where 'user' is the 'User' found -- for the given searched username, and a list of 'Project's that the -- user has created issues for.-issuesCreatedByUser :: (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe (User,[Project]))+issuesCreatedByUser :: (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe (User, [Project])) issuesCreatedByUser username = do   user_maybe <- searchUser username   case user_maybe of@@ -153,17 +163,18 @@ -- of triples of: 1) the found project, 2) the list of issues for the -- found projects, and 3) a list of users who've created issues. issuesOnForks ::-     (MonadUnliftIO m, MonadIO m)-  => Text -- ^ name or namespace of the project-  -> GitLab m [(Project, [Issue], [User])]+  (MonadUnliftIO m, MonadIO m) =>+  -- | name or namespace of the project+  Text ->+  GitLab m [(Project, [Issue], [User])] issuesOnForks projectName = do   projects <- projectsWithName projectName   mapM processProject projects   where     processProject ::-         (MonadUnliftIO m, MonadIO m)-      => Project-      -> GitLab m (Project, [Issue], [User])+      (MonadUnliftIO m, MonadIO m) =>+      Project ->+      GitLab m (Project, [Issue], [User])     processProject proj = do       (openIssues :: [Issue]) <- projectOpenedIssues proj       let authors = map issue_author openIssues@@ -173,7 +184,7 @@ -- where namespace is the namespace of the project -- e.g. "user1/project1", and members is a list of (username,name) -- tuples about all members of the project.-projectMemebersCount :: (MonadIO m) => Project -> GitLab m (Text,[(Text,Text)])+projectMemebersCount :: (MonadIO m) => Project -> GitLab m (Text, [(Text, Text)]) projectMemebersCount project = do   friends <- count   return (namespace_name (namespace project), friends)@@ -181,26 +192,29 @@     count = do       let addr =             "/projects/" <> T.pack (show (project_id project)) <> "/members/all"-      (res :: [Member]) <- gitlab addr+      (res :: [Member]) <- gitlabUnsafe addr       return (map (\x -> (member_username x, member_name x)) res)  -- | returns 'True' is the last commit for a project passes all -- continuous integration tests. projectCISuccess ::-     (MonadIO m)-  => Project -- ^ the name or namespace of the project-  -> GitLab m Bool+  (MonadIO m) =>+  -- | the name or namespace of the project+  Project ->+  GitLab m Bool projectCISuccess project = do   pipes <- pipelines project   case pipes of     [] -> return False-    (x:_) -> 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. -namespacePathToUserId :: (MonadIO m)-  => Text -- ^ name or namespace of project -  -> GitLab m (Maybe Int)+-- 'Nothing' if a user cannot be found.+namespacePathToUserId ::+  (MonadIO m) =>+  -- | name or namespace of project+  Text ->+  GitLab m (Maybe Int) namespacePathToUserId namespacePath = do   user_maybe <- searchUser namespacePath   case user_maybe of@@ -208,37 +222,42 @@     Just usr -> return (Just (user_id usr))  -- | gets all diffs in a project for a given commit SHA.-projectDiffs :: (MonadIO m) => Project -> Text -> GitLab m [Diff]+projectDiffs :: (MonadIO m) => Project -> Text -> GitLab m (Either Status [Diff]) projectDiffs proj =   projectDiffs' (project_id proj)  -- | gets all diffs in a project for a given project ID, for a given -- commit SHA.-projectDiffs' :: (MonadIO m) => Int -> Text -> GitLab m [Diff]+projectDiffs' :: (MonadIO m) => Int -> Text -> GitLab m (Either Status [Diff]) projectDiffs' projId commitSha =   gitlab-  ("/projects/"-   <> T.pack (show projId)-   <> "/repository/commits/"-   <> commitSha-   <> "/diff/")+    ( "/projects/"+        <> T.pack (show projId)+        <> "/repository/commits/"+        <> commitSha+        <> "/diff/"+    )  -- | share a project with a group. shareProjectWithGroup ::-     (MonadIO m)-  => Int -- ^ group ID-  -> Int -- ^ project ID-  -> AccessLevel -- ^ level of access granted-  -> GitLab m (Either Status GroupShare)+  (MonadIO m) =>+  -- | group ID+  Int ->+  -- | project ID+  Int ->+  -- | level of access granted+  AccessLevel ->+  GitLab m (Either Status GroupShare) shareProjectWithGroup groupId projectId access =   gitlabPost addr dataBody   where     dataBody :: Text     dataBody =       "group_id="-      <> T.pack (show groupId)-      <> "&group_access="-      <> T.pack (show access)-    addr = "/projects/"-           <> T.pack (show projectId)-           <> "/share"+        <> T.pack (show groupId)+        <> "&group_access="+        <> T.pack (show access)+    addr =+      "/projects/"+        <> T.pack (show projectId)+        <> "/share"

@@ -1,69 +1,111 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : Repositories-Description : Queries about project repositories-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Repositories+-- Description : Queries about project repositories+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Repositories where  import Control.Monad.IO.Unlift 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  -- | returns a list of repository files and directories in a project.-repositories :: (MonadIO m)-  => Project -- ^ the project-  -> GitLab m [Repository]-repositories project = repositories' (project_id project)+repositories ::+  (MonadIO m) =>+  -- | the project+  Project ->+  GitLab m [Repository]+repositories project =+  fromRight (error "repositories error") <$> repositories' (project_id project)  -- | returns a list of repository files and directories in a project -- given its project ID.-repositories' :: (MonadIO m)-  => Int -- ^ the project ID-  -> GitLab m [Repository]+repositories' ::+  (MonadIO m) =>+  -- | the project ID+  Int ->+  GitLab m (Either Status [Repository]) repositories' projectId =   gitlab addr   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/repository"-      <> "/tree"+        <> T.pack (show projectId)+        <> "/repository"+        <> "/tree"  -- | get a file archive of the repository files. For example: -- -- > getFileArchive myProject TarGz "/tmp/myProject.tar.gz"-getFileArchive :: (MonadIO m)-  => Project -- ^ project-  -> ArchiveFormat -- ^ file format-  -> FilePath -- ^ file path to store the archive-  -> GitLab m ()+getFileArchive ::+  (MonadIO m) =>+  -- | project+  Project ->+  -- | file format+  ArchiveFormat ->+  -- | file path to store the archive+  FilePath ->+  GitLab m () getFileArchive project = getFileArchive' (project_id project) +-- | get a file archive of the repository files as a+-- 'BSL.ByteString'. For example:+--+-- > getFileArchiveBS myProject TarGz "/tmp/myProject.tar.gz"+getFileArchiveBS ::+  (MonadIO m) =>+  -- | project+  Project ->+  -- | file format+  ArchiveFormat ->+  GitLab m (Either Status BSL.ByteString)+getFileArchiveBS project = getFileArchiveBS' (project_id project)+ -- | get a file archive of the repository files using the project's --   ID. For example: -- -- > getFileArchive' 3453 Zip "/tmp/myProject.zip"-getFileArchive' :: (MonadIO m)-  => Int -- ^ project ID-  -> ArchiveFormat -- ^ file format-  -> FilePath -- ^ file path to store the archive-  -> GitLab m ()+getFileArchive' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | file format+  ArchiveFormat ->+  -- | file path to store the archive+  FilePath ->+  GitLab m () getFileArchive' projectId format path = do-  archiveData <- gitlabReqByteString addr-  liftIO $ BSL.writeFile path archiveData+  attempt <- getFileArchiveBS' projectId format+  case attempt of+    Left _status -> return ()+    Right archiveData ->+      liftIO $ BSL.writeFile path archiveData++-- | get a file archive of the repository files as a 'BSL.ByteString'+--   using the project's ID. For example:+--+-- > getFileArchiveBS' 3453 Zip "/tmp/myProject.zip"+getFileArchiveBS' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | file format+  ArchiveFormat ->+  GitLab m (Either Status BSL.ByteString)+getFileArchiveBS' projectId format = do+  gitlabReqByteString addr   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/repository"-      <> "/archive"-      <> T.pack (show format)-  +        <> T.pack (show projectId)+        <> "/repository"+        <> "/archive"+        <> T.pack (show format)

@@ -1,63 +1,72 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : RepositoryFiles-Description : Queries about project repository files-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : RepositoryFiles+-- Description : Queries about project repository files+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.RepositoryFiles where  import Control.Monad.IO.Unlift import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T-import Network.HTTP.Types.URI- import GitLab.Types import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status+import Network.HTTP.Types.URI  -- | Get a list of repository files and directories in a project.-repositoryFiles :: (MonadIO m)-  => Project -- ^ the project-  -> Text -- ^ the file path-  -> Text -- ^ name of the branch, tag or commit-  -> GitLab m (Maybe RepositoryFile)+repositoryFiles ::+  (MonadIO m) =>+  -- | the project+  Project ->+  -- | the file path+  Text ->+  -- | name of the branch, tag or commit+  Text ->+  GitLab m (Either Status (Maybe RepositoryFile)) repositoryFiles project = repositoryFiles' (project_id project)  -- | Get a list of repository files and directories in a project given -- the project's ID.-repositoryFiles' :: (MonadIO m)-  => Int -- ^ project ID-  -> Text -- ^ the file path-  -> Text -- ^ name of the branch, tag or commit-  -> GitLab m (Maybe RepositoryFile)+repositoryFiles' ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | the file path+  Text ->+  -- | name of the branch, tag or commit+  Text ->+  GitLab m (Either Status (Maybe RepositoryFile)) repositoryFiles' projectId filePath reference =   gitlabWithAttrsOne addr ("&ref=" <> reference)   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/repository"-      <> "/files"-      <> "/"-      <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 filePath))-      -- <> filePath+        <> T.pack (show projectId)+        <> "/repository"+        <> "/files"+        <> "/"+        <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 filePath))  -- | Get raw data for a given file blob hash.-repositoryFileBlob :: (MonadIO m)-  => Int -- ^ project ID-  -> Text -- ^ blob SHA-  -> GitLab m String+repositoryFileBlob ::+  (MonadIO m) =>+  -- | project ID+  Int ->+  -- | blob SHA+  Text ->+  GitLab m (Either Status String) repositoryFileBlob projectId blobSha =   gitlabReqText addr   where     addr =       "/projects/"-      <> T.pack (show projectId)-      <> "/repository"-      <> "/blobs/"-      <> blobSha-      <> "/raw"+        <> T.pack (show projectId)+        <> "/repository"+        <> "/blobs/"+        <> blobSha+        <> "/raw"

@@ -1,13 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -{-|-Module      : Todos-Description : Queries about todos for users.-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Todos+-- Description : Queries about todos for users.+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Todos where  import Control.Monad.IO.Class@@ -16,4 +15,4 @@  -- | returns all pending todos for the user, as defined by the access token. todos :: (MonadIO m) => GitLab m [Todo]-todos = gitlab "/todos"+todos = gitlabUnsafe "/todos"

@@ -1,48 +1,50 @@-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -{-|-Module      : Users-Description : Queries about registered users-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}+-- |+-- Module      : Users+-- Description : Queries about registered users+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable module GitLab.API.Users where  import Control.Monad.IO.Class import Data.List import Data.Maybe import Data.Text (Text)- import GitLab.Types import GitLab.WebRequests.GitLabWebCalls  -- | all registered users. allUsers :: (MonadIO m) => GitLab m [User] allUsers = do-    let path = "/users"-    gitlab path+  let path = "/users"+  gitlabUnsafe path  -- | searches for a user given a username. Returns @Just User@ if the -- user is found, otherwise @Nothing@.-searchUser :: (MonadIO m)-  => Text -- ^ username to search for-  -> GitLab m (Maybe User)+searchUser ::+  (MonadIO m) =>+  -- | username to search for+  Text ->+  GitLab m (Maybe User) searchUser username = do   let path = "/users"       attrs = "&username=" <> username-  res <- gitlabWithAttrs path attrs+  res <- gitlabWithAttrsUnsafe path attrs   if null res-  then return Nothing-  else return (Just (head res))+    then return Nothing+    else return (Just (head res))  -- | searches for users given a list of usernames, returns them in -- alphabetical order of their usernames.-orderedUsers :: (MonadIO m)-  => [Text] -- ^ usernames to search for-  -> GitLab m [User]+orderedUsers ::+  (MonadIO m) =>+  -- | usernames to search for+  [Text] ->+  GitLab m [User] orderedUsers usernames = do   users <- catMaybes <$> mapM searchUser usernames   return (orderUsersByName users)

@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : Version+-- Description : Queries about GitLab instance version+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable+module GitLab.API.Version where++import Control.Monad.IO.Class+import GitLab.Types+import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status++gitlabVersion :: (MonadIO m) => GitLab m (Either Status (Maybe Version))+gitlabVersion = do+  let path = "/version"+  gitlabOne path

@@ -1,848 +1,974 @@-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}--{-|-Module      : GitLab.Types-Description : Haskell records corresponding to JSON data from GitLab API calls-Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019-License     : BSD3-Maintainer  : robstewart57@gmail.com-Stability   : stable--}-module GitLab.Types-  (-    GitLab-  , GitLabState(..)-  , GitLabServerConfig(..)-  , defaultGitLabServer-  , ArchiveFormat(..)-  , Member(..)-  , Namespace(..)-  , Links(..)-  , Owner(..)-  , Permissions(..)-  , Project(..)-  , ProjectStats(..)-  , User(..)-  , Milestone(..)-  , TimeStats(..)-  , Issue(..)-  , Pipeline(..)-  , Commit(..)-  , CommitTodo(..)-  , CommitStats(..)-  , Diff(..)-  , Repository(..)-  , Job(..)-  , Artifact(..)-  , Group(..)-  , GroupShare(..)-  , Branch(..)-  , RepositoryFile(..)-  , MergeRequest(..)-  , Todo(..)-  , TodoAction(..)-  , TodoTarget(..)-  , TodoState(..)-  , URL-  ) where--import Control.Monad.Trans.Reader-import Data.Aeson-import Data.Aeson.Types-import Data.Text (Text)-import Data.Time.Clock-import GHC.Generics-import Network.HTTP.Conduit---- | type synonym for all GitLab actions.-type GitLab m a = ReaderT GitLabState m a---- | state used by GitLab actions, used internally.-data GitLabState =-  GitLabState-  { serverCfg :: GitLabServerConfig-  , httpManager :: Manager-  }---- | configuration data specific to a GitLab server.-data GitLabServerConfig =-  GitLabServerConfig-  { url :: Text-  , token :: Text -- ^ personal access token, see <https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html>-  , timeout :: Int -- ^ milliseconds-  , retries :: Int -- ^ how many times to retry a HTTP request before giving up and returning an error.-  }---- | default settings, the 'url' and 'token' values will need to be overwritten.-defaultGitLabServer :: GitLabServerConfig-defaultGitLabServer =-  GitLabServerConfig-  { url = "https://gitlab.com"-  , token = ""-  , timeout = 15000000 -- 15 seconds-  , retries = 5-  }---- https://docs.gitlab.com/ee/api/repositories.html#get-file-archive--- tar.gz, tar.bz2, tbz, tbz2, tb2, bz2, tar, and zip---- | archive format for file archives of repositories.--- See 'GitLab.API.Repositories.getFileArchive' in 'GitLab.API.Repositories'.-data ArchiveFormat-  = TarGz -- ^ ".tar.gz"-  | TarBz2 -- ^ ".tar.bz2"-  | Tbz -- ^ ".tbz"-  | Tbz2 -- ^ ".tbz2"-  | Tb2 -- ^ ".tb2"-  | Bz2 -- ^ ".bz2"-  | Tar -- ^ ".tar"-  | Zip -- ^ ".zip"--instance Show ArchiveFormat where-  show TarGz = ".tar.gz"-  show TarBz2 = ".tar.bz2"-  show Tbz = ".tbz"-  show Tbz2 = ".tbz2"-  show Tb2 = ".tb2"-  show Bz2 = ".bz2"-  show Tar = ".tar"-  show Zip = ".zip"----- | member of a project.-data Member =-  Member-  { member_id :: Int-  , member_name :: Text-  , member_username :: Text-  , member_state :: Text-  , member_avatar_uri :: Maybe Text-  , member_web_url :: Maybe Text-  , access_level :: Int-  , expires_at :: Maybe Text-  } deriving (Generic, Show)---- | namespaces.-data Namespace =-  Namespace-  { namespace_id :: Int-  , namespace_name :: Text-  , namespace_path :: Text-  , kind :: Text-  , full_path :: Text-  , parent_id :: Maybe Text-  } deriving (Generic, Show)---- | links.-data Links =-  Links-  { self :: Text-  , issues :: Text-  , merge_requests :: Text-  , repo_branches :: Text-  , link_labels :: Text-  , link_events :: Text-  , members :: Text-  } deriving (Generic, Show)---- | owners.-data Owner =-  Ownwer-  { owner_id :: Int-  , owner_name :: Text-  , owner_username :: Text-  , state :: Text-  , owner_avatar_url :: Maybe Text-  , owner_web_url :: Text-  } deriving (Generic, Show)---- | permissions.-data Permissions =-  Permissions-  { project_access :: Maybe Object-  , group_access :: Maybe Object-  } deriving (Generic, Show)---- | projects.-data Project =-  Project-  { project_id :: Int-  , description :: Maybe Text-  , project_name :: Text-  , name_with_namespace :: Text-  , project_path :: Text-  , path_with_namespace :: Text-  , project_created_at :: Text-  , default_branch :: Maybe Text-  , tag_list:: [Text] -- check-  , ssh_url_to_repo:: Text-  , http_url_to_repo:: Text-  , project_web_url:: Text-  , readme_url :: Maybe Text -- check-  , project_avatar_url:: Maybe Text -- check-  , star_count:: Int-  , forks_count:: Int-  , last_activity_at:: Text-  , namespace :: Namespace-  , _links :: Maybe Links-  , archived :: Maybe Bool-  , visibility :: Maybe Text-  , owner :: Maybe Owner-  , resolve_outdated_diff_discussions :: Maybe Bool-  , container_registry_enabled :: Maybe Bool-  , issues_enabled :: Maybe Bool-  , merge_requests_enabled:: Maybe Bool-  , wiki_enabled :: Maybe Bool-  , jobs_enabled :: Maybe Bool-  , snippets_enabled :: Maybe Bool-  , shared_runners_enabled :: Maybe Bool-  , lfs_enabled :: Maybe Bool-  , creator_id :: Maybe Int-  , forked_from_project :: Maybe Project-  , import_status :: Maybe String-  , open_issues_count :: Maybe Int-  , public_jobs :: Maybe Bool-  , ci_config_path :: Maybe Text -- check null-  , shared_with_groups :: Maybe [Object]-  , only_allow_merge_if_pipeline_succeeds :: Maybe Bool-  , request_access_enabled :: Maybe Bool-  , only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool-  , printing_merge_request_link_enabled :: Maybe Bool-  , merge_method:: Maybe Text-  , permissions :: Maybe Permissions-  , project_stats :: Maybe ProjectStats-  } deriving (Generic, Show)---- | project statistics.-data ProjectStats =-  ProjectStats-  { commit_count :: Int-  , storage_size :: Int-  , repository_size :: Int-  , wiki_size :: Maybe Int-  , lfs_objects_size :: Maybe Int-  , job_artifacts_size :: Maybe Int-  , packages_size :: Maybe Int-  } deriving (Generic, Show)---- | registered users.-data User =-  User-  { user_id :: Int-  , user_username :: Text-  , user_name :: Text-  , user_state :: Text-  , user_avatar_uri :: Maybe Text-  , user_web_url :: Maybe Text-  } deriving (Generic, Show)---- | milestone state.-data MilestoneState = MSActive-                    | MSClosed-                    deriving (Show)-instance FromJSON MilestoneState where-  parseJSON (String "active") = return MSActive-  parseJSON (String "closed") = return MSClosed-  parseJSON x = unexpected x---- | milestones.-data Milestone =-  Milestone-  { milestone_project_id :: Maybe Int-  , milestone_group_id :: Maybe Int-  , milestone_description :: Text-  , milestone_state :: MilestoneState-  , milestone_due_date :: Maybe UTCTime-  , milestone_iid :: Int-  , milestone_created_at :: Maybe UTCTime-  , milestone_title :: Text-  , milestone_id :: Int-  , milestone_updated_at :: UTCTime-  , milestone_web_url :: URL-  } deriving (Generic, Show)-instance FromJSON Milestone where-  parseJSON = genericParseJSON (defaultOptions { fieldLabelModifier = drop 10 })---- | time stats.-data TimeStats =-  TimeStats-  { time_estimate :: Int-  , total_time_spent :: Int-  , humane_time_estimate :: Maybe Int-  , human_total_time_spent :: Maybe Int-  } deriving (Generic, Show)---- | project issues.-data Issue =-  Issue-  { issue_state :: Text-  , issue_description :: Text-  , issue_author :: User-  , milestone :: Maybe Milestone-  , issue_project_id :: Int-  , assignees :: Maybe [User]-  , assignee :: Maybe User-  , updated_at :: Text-  , closed_at :: Maybe Text-  , closed_by :: Maybe User-  , issue_id :: Int-  , issue_title :: Text-  , issue_created_at :: Text-  , iid :: Int-  , issue_labels :: [Text]-  , upvotes :: Int-  , downvotes :: Int-  , user_notes_count :: Int-  , issue_due_date :: Maybe Text-  , issue_web_url :: Text-  , confidential :: Bool-  , weight :: Maybe Text -- Int?-  , discussion_locked :: Maybe Bool-  , time_stats :: TimeStats-  } deriving (Generic, Show)---- | project pipelines-data Pipeline =-  Pipeline-  { pipeline_id :: Int-  , sha :: Text-  , pipeline_ref :: Text-  , pipeline_status :: Text-  , pipeline_web_url :: Maybe Text-  } deriving (Generic, Show)---- | code commits.-data Commit =-  Commit-  { commit_id :: Text-  , short_id :: Text-  , title :: Text-  , author_name :: Text-  , author_email :: Text-  , authored_date :: Text-  , committer_name :: Text-  , committer_email :: Text-  , committed_date :: Text-  , commit_created_at :: Text-  , message :: Text-  , parent_ids :: Maybe [Text]-  , last_pipeline :: Maybe Pipeline-  , commit_stats :: Maybe CommitStats-  , commit_status :: Maybe Text-  } deriving (Generic, Show)---- | summary of a code commit for TODOs.-data CommitTodo =-  CommitTodo-  { todo_commit_id :: Text-  , todo_commit_short_id :: Text-  , todo_commit_created_at :: Text-  , todo_parent_ids :: Maybe [Text]-  } deriving (Generic, Show)---- | commit stats.-data CommitStats =-  Stats-  { additions :: Int-  , deletions :: Int-  , total :: Int-  } deriving (Generic, Show)---- | diff between two commits.-data Diff =-  Diff-  { diff :: Text-  , new_path :: Text-  , old_path :: Text-  , a_mode :: Maybe Text-  , b_mode :: Maybe Text-  , new_file :: Bool-  , renamed_file :: Bool-  , deleted_file :: Bool-  } deriving (Generic, Show)---- | repositories.-data Repository =-  Repository-  { repository_id :: Text-  , repository_name :: Text-  , repository_type :: Text-  , repository_path :: Text-  , mode :: Text-  } deriving (Generic, Show)---- | jobs.-data Job =-  Job-  {-    commit :: Commit-  , coverage :: Maybe Text -- ?-  , created_at :: Text-  , started_at :: Text-  , finished_at :: Text-  , duration :: Double-  , artifacts_expire_at :: Maybe Text-  , id :: Int-  , name :: Text-  , pipeline :: Pipeline-  , job_ref :: Text-  , artifacts :: [Artifact]-  -- , runner :: Maybe Text-  , stage :: Text-  , status :: Text-  , tag :: Bool-  , job_web_url :: Text-  , user :: User-  } deriving (Generic, Show)---- | artifacts.-data Artifact =-  Artifact-  { file_type :: Text-  , size :: Int-  , filename :: Text-  , file_format :: Maybe Text-  } deriving (Generic, Show)---- | groups.-data Group =-  Group-  {-    group_id :: Int-  , group_name :: Text-  , group_path :: Text-  , group_description :: Text-  , group_visibility :: Text-  , group_lfs_enabled :: Bool-  , group_avatar_url :: Maybe Text-  , group_web_url :: Text-  , group_request_access_enabled :: Bool-  , group_full_name :: Text-  , group_full_path :: Text-  , group_file_template_project_id :: Maybe Int-  , group_parent_id :: Maybe Int-  } deriving (Generic, Show)---- | response to sharing a project with a group.-data GroupShare =-  GroupShare-  { share_id :: Int-  , share_project_id :: Int-  , share_group_id :: Int-  , share_group_access :: Int-  , share_expires_at :: Maybe Text-  } deriving (Generic, Show)---- | code branches.-data Branch =-  Branch-  { branch_name :: Text-  , merged :: Bool-  , protected :: Bool-  , branch_default :: Bool-  , developers_can_push :: Bool-  , developers_can_merge :: Bool-  , can_push :: Bool-  , branch_commit :: Commit-  } deriving (Generic, Show)---- | files in a repository.-data RepositoryFile =-  RepositoryFile-  { repository_file_file_name :: Text-  , repository_file_file_path :: Text-  , repository_file_size :: Int-  , encoding :: Text-  , content :: Text-  , content_sha256 :: Text-  , ref :: Text-  , blob_id :: Text-  , repository_file_commit_id :: Text-  , last_commit_id :: Text-  } deriving (Generic, Show)---- | project merge requests.-data MergeRequest =-  MergeRequest-  { merge_request_id :: Int-  , merge_request_iid :: Int-  , merge_request_project_id :: Int-  , merge_request_title :: Text-  , merge_request_description :: Text-  , merge_request_state :: Text-  , merge_request_merged_by :: Maybe User-  , merge_request_merged_at :: Maybe Text-  , merge_request_closed_by :: Maybe User-  , merge_request_closed_at :: Maybe Text-  , merge_request_created_at :: Text-  , merge_request_updated_at :: Text-  , merge_request_target_branch :: Text-  , merge_request_source_branch :: Text-  , merge_request_upvotes :: Int-  , merge_request_downvotes :: Int-  , merge_request_author :: User-  , merge_request_assignee :: Maybe User-  , merge_request_source_project_id :: Int-  , merge_request_target_project_id :: Int-  , merge_request_labels :: [Text]-  , merge_request_work_in_progress :: Bool-  , merge_request_milestone :: Maybe Milestone-  , merge_request_merge_when_pipeline_succeeds :: Bool-  , merge_request_merge_status :: Text-  , merge_request_sha :: Text-  , merge_request_merge_commit_sha :: Maybe Text-  , merge_request_user_notes_count ::Int-  , merge_request_discussion_locked :: Maybe Bool-  , merge_request_should_remove_source_branch :: Maybe Bool-  , merge_request_force_remove_source_branch :: Maybe Bool-  , merge_request_allow_collaboration :: Maybe Bool-  , merge_request_allow_maintainer_to_push :: Maybe Bool-  , merge_request_web_url :: Text-  , merge_request_time_stats :: TimeStats-  , merge_request_squash :: Bool-  , merge_request_changes_count :: Maybe Int-  , merge_request_pipeline :: Maybe Pipeline-  , merge_request_diverged_commits_count :: Maybe Int-  , merge_request_rebase_in_progress :: Maybe Bool-  , merge_request_has_conflicts :: Bool-  , merge_request_blocking_discussions_resolved :: Maybe Bool-  , merge_request_approvals_before_merge :: Maybe Bool -- ?-  } deriving (Generic, Show)---- | TODO actions.-data TodoAction = TAAssigned-                | TAMentioned-                | TABuildFailed-                | TAMarked-                | TAApprovalRequired-                | TAUnmergeable-                | TADirectlyAddressed-                deriving (Show)-instance FromJSON TodoAction where-  parseJSON (String "assigned") = return TAAssigned-  parseJSON (String "mentioned") = return TAMentioned-  parseJSON (String "build_failed") = return TABuildFailed-  parseJSON (String "marked") = return TAMarked-  parseJSON (String "approval_required") = return TAApprovalRequired-  parseJSON (String "unmergeable") = return TAUnmergeable-  parseJSON (String "directly_addressed") = return TADirectlyAddressed-  parseJSON x = unexpected x---- | TODO targets.-data TodoTarget = TTIssue Issue-                | TTMergeRequest MergeRequest-                | TTCommit CommitTodo-                deriving (Show)---- | URL is a synonym for 'Text'.-type URL = Text---- | TODO states.-data TodoState = TSPending-               | TSDone-               deriving (Show)-instance FromJSON TodoState where-  parseJSON (String "pending") = return TSPending-  parseJSON (String "done") = return TSDone-  parseJSON x = unexpected x--data TodoProject = TP { tp_id :: Int-                      , tp_description :: Text-                      , tp_name :: Text-                      , tp_name_with_namespace :: Text-                      , tp_path :: Text-                      , tp_path_with_namespace :: Text-                      , tp_created_at :: UTCTime }-                 deriving (Generic, Show)-instance FromJSON TodoProject where-  parseJSON = genericParseJSON (defaultOptions { fieldLabelModifier = drop 3 })---- | TODOs.-data Todo = Todo { todo_id :: Int-                 , todo_project :: TodoProject-                 , todo_author :: User-                 , todo_action_name :: TodoAction-                 , todo_target :: TodoTarget-                 , todo_target_url :: URL-                 , todo_body :: Text-                 , todo_state :: TodoState-                 , todo_created_at :: UTCTime }-          deriving (Show)-instance FromJSON Todo where-  parseJSON = withObject "Todo" $ \v -> Todo-    <$> v .: "id"-    <*> v .: "project"-    <*> v .: "author"-    <*> v .: "action_name"-    <*> (v .: "target_type" >>= \case-      "MergeRequest" -> TTMergeRequest <$> v .: "target"-      "Issue" -> TTIssue <$> v .: "target"-      "Commit" -> TTCommit <$> v .: "target"-      (_ :: Text) -> fail "" )-    <*> v .: "target_url"-    <*> v .: "body"-    <*> v .: "state"-    <*> v .: "created_at"---------------------------------- JSON GitLab parsers below--------------------------------bodyNoPrefix :: String -> String-bodyNoPrefix "commit_created_at" = "created_at"-bodyNoPrefix "commit_id" = "id"-bodyNoPrefix "commit_status" = "status"-bodyNoPrefix "todo_commit_id" = "id"-bodyNoPrefix "todo_commit_short_id" = "short_id"-bodyNoPrefix "todo_commit_created_at" = "created_at"-bodyNoPrefix "todo_parent_ids" = "parent_ids"-bodyNoPrefix "issue_author" = "author"-bodyNoPrefix "issue_created_at" = "created_at"-bodyNoPrefix "issue_description" = "description"-bodyNoPrefix "issue_due_date" = "due_date"-bodyNoPrefix "issue_id" = "id"-bodyNoPrefix "issue_labels" = "labels"-bodyNoPrefix "issue_project_id" = "project_id"-bodyNoPrefix "issue_state" = "state"-bodyNoPrefix "issue_title" = "title"-bodyNoPrefix "issue_web_url" = "web_url"-bodyNoPrefix "job_web_url" = "web_url"-bodyNoPrefix "link_events" = "events"-bodyNoPrefix "link_labels" = "labels"-bodyNoPrefix "member_avatar_url" = "avatar_url"-bodyNoPrefix "member_id" = "id"-bodyNoPrefix "member_name" = "name"-bodyNoPrefix "member_state" = "state"-bodyNoPrefix "member_username" = "username"-bodyNoPrefix "member_web_url" = "we_url"-bodyNoPrefix "namespace_id" = "id"-bodyNoPrefix "namespace_name" = "name"-bodyNoPrefix "namespace_path" = "path"-bodyNoPrefix "owner_avatar_url" = "avatar_url"-bodyNoPrefix "owner_id" = "id"-bodyNoPrefix "owner_name" = "name"-bodyNoPrefix "owner_username" = "username"-bodyNoPrefix "owner_web_url" = "web_url"-bodyNoPrefix "pipeline_id" = "id"-bodyNoPrefix "pipeline_status" = "status"-bodyNoPrefix "pipeline_web_url" = "web_url"-bodyNoPrefix "project_avatar_url" = "avatar_url"-bodyNoPrefix "project_created_at" = "created_at"-bodyNoPrefix "project_id" = "id"-bodyNoPrefix "project_name" = "name"-bodyNoPrefix "project_path" = "path"-bodyNoPrefix "project_web_url" = "web_url"-bodyNoPrefix "repository_id" = "id"-bodyNoPrefix "repository_name" = "name"-bodyNoPrefix "repository_path" = "path"-bodyNoPrefix "repository_type" = "type"-bodyNoPrefix "user_avatar_url" = "avatar_url"-bodyNoPrefix "user_id" = "id"-bodyNoPrefix "user_name" = "name"-bodyNoPrefix "user_state" = "state"-bodyNoPrefix "user_username" = "username"-bodyNoPrefix "user_web_url" = "we_url"--bodyNoPrefix "event_title" = "title"-bodyNoPrefix "event_project_id" = "project_id"--bodyNoPrefix "job_ref" = "ref"-bodyNoPrefix "pipeline_ref" = "ref"--bodyNoPrefix "branch_name" = "name"-bodyNoPrefix "branch_default" = "default"-bodyNoPrefix "branch_commit" = "commit"--bodyNoPrefix "repository_file_file_name" = "file_name"-bodyNoPrefix "repository_file_file_path" = "file_path"-bodyNoPrefix "repository_file_size" = "size"-bodyNoPrefix "repository_file_commit_id" = "commit_id"--bodyNoPrefix "merge_request_id" = "id"-bodyNoPrefix "merge_request_iid" = "iid"-bodyNoPrefix "merge_request_project_id" = "project_id"-bodyNoPrefix "merge_request_title" = "title"-bodyNoPrefix "merge_request_description" = "description"-bodyNoPrefix "merge_request_state" = "state"-bodyNoPrefix "merge_request_merged_by" = "merged_by"-bodyNoPrefix "merge_request_merged_at" = "merged_at"-bodyNoPrefix "merge_request_closed_by" = "closed_by"-bodyNoPrefix "merge_request_closed_at" = "closed_at"-bodyNoPrefix "merge_request_created_at" = "created_at"-bodyNoPrefix "merge_request_updated_at" = "updated_at"-bodyNoPrefix "merge_request_target_branch" = "target_branch"-bodyNoPrefix "merge_request_source_branch" = "source_branch"-bodyNoPrefix "merge_request_upvotes" = "upvotes"-bodyNoPrefix "merge_request_downvotes" = "downvotes"-bodyNoPrefix "merge_request_author" = "author"-bodyNoPrefix "merge_request_assignee" = "assignee"-bodyNoPrefix "merge_request_source_project_id" = "source_project_id"-bodyNoPrefix "merge_request_target_project_id" = "target_project_id"-bodyNoPrefix "merge_request_labels" = "labels"-bodyNoPrefix "merge_request_work_in_progress" = "work_in_progress"-bodyNoPrefix "merge_request_milestone" = "milestone"-bodyNoPrefix "merge_request_merge_when_pipeline_succeeds" = "merge_when_pipeline_succeeds"-bodyNoPrefix "merge_request_merge_status" = "merge_status"-bodyNoPrefix "merge_request_sha" = "sha"-bodyNoPrefix "merge_request_merge_commit_sha" = "merge_commit_sha"-bodyNoPrefix "merge_request_user_notes_count" = "user_notes_count"-bodyNoPrefix "merge_request_discussion_locked" = "discussion_locked"-bodyNoPrefix "merge_request_should_remove_source_branch" = "should_remove_source_branch"-bodyNoPrefix "merge_request_force_remove_source_branch" = "force_remove_source_branch"-bodyNoPrefix "merge_request_allow_collaboration" = "allow_collaboration"-bodyNoPrefix "merge_request_allow_maintainer_to_push" = "allow_maintainer_to_push"-bodyNoPrefix "merge_request_web_url" = "web_url"-bodyNoPrefix "merge_request_time_stats" = "time_stats"-bodyNoPrefix "merge_request_squash" = "squash"-bodyNoPrefix "merge_request_approvals_before_merge" = "approvals_before_merge"-bodyNoPrefix "merge_request_allow_contribution" = "allow_contribution"-bodyNoPrefix "merge_request_changes_count" = "changes_count"-bodyNoPrefix "merge_request_pipeline" = "pipeline"-bodyNoPrefix "merge_request_diverged_commits_count" = "diverged_commits_count"-bodyNoPrefix "merge_request_rebase_in_progress" = "rebase_in_progress"-bodyNoPrefix "merge_request_has_conflicts" = "has_conflicts"-bodyNoPrefix "merge_request_blocking_discussions_resolved" = "blocking_discussions_resolved"---bodyNoPrefix "project_stats" = "statistics"-bodyNoPrefix "commit_stats" = "stats"--bodyNoPrefix "share_id" = "id"-bodyNoPrefix "share_project_id" = "project_id"-bodyNoPrefix "share_group_id" = "group_id"-bodyNoPrefix "share_group_access" = "group_access"-bodyNoPrefix "share_expires_at" = "expires_at"--bodyNoPrefix "group_id" = "id"-bodyNoPrefix "group_name" = "name"-bodyNoPrefix "group_path" = "path"-bodyNoPrefix "group_description" = "description"-bodyNoPrefix "group_visibility" = "visibility"-bodyNoPrefix "group_lfs_enabled" = "lfs_enabled"-bodyNoPrefix "group_avatar_url" = "avatar_url"-bodyNoPrefix "group_web_url" = "web_url"-bodyNoPrefix "group_request_access_enabled" = "request_access_enabled"-bodyNoPrefix "group_full_name" = "full_name"-bodyNoPrefix "group_full_path" = "full_path"-bodyNoPrefix "group_file_template_project_id" = "file_template_project_id"-bodyNoPrefix "group_parent_id" = "parent_id"--- TODO field names for Issues data type-bodyNoPrefix s = s--instance FromJSON TimeStats where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Issue where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON User where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Commit where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON CommitTodo where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON CommitStats where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Pipeline where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Member where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Permissions where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Owner where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Links where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Namespace where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Project where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON ProjectStats where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Repository where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Job where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Artifact where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Group where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON GroupShare where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Branch where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON RepositoryFile where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON MergeRequest where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })--instance FromJSON Diff where-  parseJSON = genericParseJSON-              (defaultOptions-               { fieldLabelModifier = bodyNoPrefix })+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : GitLab.Types+-- Description : Haskell records corresponding to JSON data from GitLab API calls+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable+module GitLab.Types+  ( GitLab,+    GitLabState (..),+    GitLabServerConfig (..),+    defaultGitLabServer,+    ArchiveFormat (..),+    Member (..),+    Namespace (..),+    Links (..),+    Owner (..),+    Permissions (..),+    Project (..),+    ProjectStats (..),+    User (..),+    Milestone (..),+    TimeStats (..),+    Issue (..),+    Pipeline (..),+    Commit (..),+    CommitTodo (..),+    CommitStats (..),+    Diff (..),+    Repository (..),+    Job (..),+    Artifact (..),+    Group (..),+    GroupShare (..),+    Branch (..),+    RepositoryFile (..),+    MergeRequest (..),+    Todo (..),+    TodoAction (..),+    TodoTarget (..),+    TodoState (..),+    Version (..),+    URL,+  )+where++import Control.Monad.Trans.Reader+import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import Data.Time.Clock+import GHC.Generics+import Network.HTTP.Conduit++-- | type synonym for all GitLab actions.+type GitLab m a = ReaderT GitLabState m a++-- | state used by GitLab actions, used internally.+data GitLabState+  = GitLabState+      { serverCfg :: GitLabServerConfig,+        httpManager :: Manager+      }++-- | configuration data specific to a GitLab server.+data GitLabServerConfig+  = GitLabServerConfig+      { url :: Text,+        -- | personal access token, see <https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html>+        token :: Text,+        -- | milliseconds+        timeout :: Int,+        -- | how many times to retry a HTTP request before giving up and returning an error.+        retries :: Int+      }++-- | default settings, the 'url' and 'token' values will need to be overwritten.+defaultGitLabServer :: GitLabServerConfig+defaultGitLabServer =+  GitLabServerConfig+    { url = "https://gitlab.com",+      token = "",+      timeout = 15000000, -- 15 seconds+      retries = 5+    }++-- https://docs.gitlab.com/ee/api/repositories.html#get-file-archive+-- tar.gz, tar.bz2, tbz, tbz2, tb2, bz2, tar, and zip++-- | archive format for file archives of repositories.+-- See 'GitLab.API.Repositories.getFileArchive' in 'GitLab.API.Repositories'.+data ArchiveFormat+  = -- | ".tar.gz"+    TarGz+  | -- | ".tar.bz2"+    TarBz2+  | -- | ".tbz"+    Tbz+  | -- | ".tbz2"+    Tbz2+  | -- | ".tb2"+    Tb2+  | -- | ".bz2"+    Bz2+  | -- | ".tar"+    Tar+  | -- | ".zip"+    Zip++instance Show ArchiveFormat where+  show TarGz = ".tar.gz"+  show TarBz2 = ".tar.bz2"+  show Tbz = ".tbz"+  show Tbz2 = ".tbz2"+  show Tb2 = ".tb2"+  show Bz2 = ".bz2"+  show Tar = ".tar"+  show Zip = ".zip"++-- | member of a project.+data Member+  = Member+      { member_id :: Int,+        member_name :: Text,+        member_username :: Text,+        member_state :: Text,+        member_avatar_uri :: Maybe Text,+        member_web_url :: Maybe Text,+        access_level :: Int,+        expires_at :: Maybe Text+      }+  deriving (Generic, Show)++-- | namespaces.+data Namespace+  = Namespace+      { namespace_id :: Int,+        namespace_name :: Text,+        namespace_path :: Text,+        kind :: Text,+        full_path :: Text,+        parent_id :: Maybe Text+      }+  deriving (Generic, Show)++-- | links.+data Links+  = Links+      { self :: Text,+        issues :: Text,+        merge_requests :: Text,+        repo_branches :: Text,+        link_labels :: Text,+        link_events :: Text,+        members :: Text+      }+  deriving (Generic, Show)++-- | owners.+data Owner+  = Ownwer+      { owner_id :: Int,+        owner_name :: Text,+        owner_username :: Text,+        state :: Text,+        owner_avatar_url :: Maybe Text,+        owner_web_url :: Text+      }+  deriving (Generic, Show)++-- | permissions.+data Permissions+  = Permissions+      { project_access :: Maybe Object,+        group_access :: Maybe Object+      }+  deriving (Generic, Show)++-- | projects.+data Project+  = Project+      { project_id :: Int,+        description :: Maybe Text,+        project_name :: Text,+        name_with_namespace :: Text,+        project_path :: Text,+        path_with_namespace :: Text,+        project_created_at :: Text,+        default_branch :: Maybe Text,+        tag_list :: [Text], -- check+        ssh_url_to_repo :: Text,+        http_url_to_repo :: Text,+        project_web_url :: Text,+        readme_url :: Maybe Text, -- check+        project_avatar_url :: Maybe Text, -- check+        star_count :: Int,+        forks_count :: Int,+        last_activity_at :: Text,+        namespace :: Namespace,+        _links :: Maybe Links,+        archived :: Maybe Bool,+        visibility :: Maybe Text,+        owner :: Maybe Owner,+        resolve_outdated_diff_discussions :: Maybe Bool,+        container_registry_enabled :: Maybe Bool,+        issues_enabled :: Maybe Bool,+        merge_requests_enabled :: Maybe Bool,+        wiki_enabled :: Maybe Bool,+        jobs_enabled :: Maybe Bool,+        snippets_enabled :: Maybe Bool,+        shared_runners_enabled :: Maybe Bool,+        lfs_enabled :: Maybe Bool,+        creator_id :: Maybe Int,+        forked_from_project :: Maybe Project,+        import_status :: Maybe String,+        open_issues_count :: Maybe Int,+        public_jobs :: Maybe Bool,+        ci_config_path :: Maybe Text, -- check null+        shared_with_groups :: Maybe [Object],+        only_allow_merge_if_pipeline_succeeds :: Maybe Bool,+        request_access_enabled :: Maybe Bool,+        only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool,+        printing_merge_request_link_enabled :: Maybe Bool,+        merge_method :: Maybe Text,+        permissions :: Maybe Permissions,+        project_stats :: Maybe ProjectStats+      }+  deriving (Generic, Show)++-- | project statistics.+data ProjectStats+  = ProjectStats+      { commit_count :: Int,+        storage_size :: Int,+        repository_size :: Int,+        wiki_size :: Maybe Int,+        lfs_objects_size :: Maybe Int,+        job_artifacts_size :: Maybe Int,+        packages_size :: Maybe Int+      }+  deriving (Generic, Show)++-- | registered users.+data User+  = User+      { user_id :: Int,+        user_username :: Text,+        user_name :: Text,+        user_state :: Text,+        user_avatar_uri :: Maybe Text,+        user_web_url :: Maybe Text+      }+  deriving (Generic, Show)++-- | milestone state.+data MilestoneState+  = MSActive+  | MSClosed+  deriving (Show)++instance FromJSON MilestoneState where+  parseJSON (String "active") = return MSActive+  parseJSON (String "closed") = return MSClosed+  parseJSON x = unexpected x++-- | milestones.+data Milestone+  = Milestone+      { milestone_project_id :: Maybe Int,+        milestone_group_id :: Maybe Int,+        milestone_description :: Text,+        milestone_state :: MilestoneState,+        milestone_due_date :: Maybe UTCTime,+        milestone_iid :: Int,+        milestone_created_at :: Maybe UTCTime,+        milestone_title :: Text,+        milestone_id :: Int,+        milestone_updated_at :: UTCTime,+        milestone_web_url :: URL+      }+  deriving (Generic, Show)++instance FromJSON Milestone where+  parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = drop 10})++-- | time stats.+data TimeStats+  = TimeStats+      { time_estimate :: Int,+        total_time_spent :: Int,+        humane_time_estimate :: Maybe Int,+        human_total_time_spent :: Maybe Int+      }+  deriving (Generic, Show)++-- | project issues.+data Issue+  = Issue+      { issue_state :: Text,+        issue_description :: Text,+        issue_author :: User,+        milestone :: Maybe Milestone,+        issue_project_id :: Int,+        assignees :: Maybe [User],+        assignee :: Maybe User,+        updated_at :: Text,+        closed_at :: Maybe Text,+        closed_by :: Maybe User,+        issue_id :: Int,+        issue_title :: Text,+        issue_created_at :: Text,+        iid :: Int,+        issue_labels :: [Text],+        upvotes :: Int,+        downvotes :: Int,+        user_notes_count :: Int,+        issue_due_date :: Maybe Text,+        issue_web_url :: Text,+        confidential :: Bool,+        weight :: Maybe Text, -- Int?+        discussion_locked :: Maybe Bool,+        time_stats :: TimeStats+      }+  deriving (Generic, Show)++-- | project pipelines+data Pipeline+  = Pipeline+      { pipeline_id :: Int,+        sha :: Text,+        pipeline_ref :: Text,+        pipeline_status :: Text,+        pipeline_web_url :: Maybe Text+      }+  deriving (Generic, Show)++-- | code commits.+data Commit+  = Commit+      { commit_id :: Text,+        short_id :: Text,+        title :: Text,+        author_name :: Text,+        author_email :: Text,+        authored_date :: Text,+        committer_name :: Text,+        committer_email :: Text,+        committed_date :: Text,+        commit_created_at :: Text,+        message :: Text,+        parent_ids :: Maybe [Text],+        last_pipeline :: Maybe Pipeline,+        commit_stats :: Maybe CommitStats,+        commit_status :: Maybe Text+      }+  deriving (Generic, Show)++-- | summary of a code commit for TODOs.+data CommitTodo+  = CommitTodo+      { todo_commit_id :: Text,+        todo_commit_short_id :: Text,+        todo_commit_created_at :: Text,+        todo_parent_ids :: Maybe [Text]+      }+  deriving (Generic, Show)++-- | commit stats.+data CommitStats+  = Stats+      { additions :: Int,+        deletions :: Int,+        total :: Int+      }+  deriving (Generic, Show)++-- | diff between two commits.+data Diff+  = Diff+      { diff :: Text,+        new_path :: Text,+        old_path :: Text,+        a_mode :: Maybe Text,+        b_mode :: Maybe Text,+        new_file :: Bool,+        renamed_file :: Bool,+        deleted_file :: Bool+      }+  deriving (Generic, Show)++-- | repositories.+data Repository+  = Repository+      { repository_id :: Text,+        repository_name :: Text,+        repository_type :: Text,+        repository_path :: Text,+        mode :: Text+      }+  deriving (Generic, Show)++-- | jobs.+data Job+  = Job+      { commit :: Commit,+        coverage :: Maybe Text, -- ?+        created_at :: Text,+        started_at :: Text,+        finished_at :: Text,+        duration :: Double,+        artifacts_expire_at :: Maybe Text,+        id :: Int,+        name :: Text,+        pipeline :: Pipeline,+        job_ref :: Text,+        artifacts :: [Artifact],+        -- , runner :: Maybe Text+        stage :: Text,+        status :: Text,+        tag :: Bool,+        job_web_url :: Text,+        user :: User+      }+  deriving (Generic, Show)++-- | artifacts.+data Artifact+  = Artifact+      { file_type :: Text,+        size :: Int,+        filename :: Text,+        file_format :: Maybe Text+      }+  deriving (Generic, Show)++-- | groups.+data Group+  = Group+      { group_id :: Int,+        group_name :: Text,+        group_path :: Text,+        group_description :: Text,+        group_visibility :: Text,+        group_lfs_enabled :: Bool,+        group_avatar_url :: Maybe Text,+        group_web_url :: Text,+        group_request_access_enabled :: Bool,+        group_full_name :: Text,+        group_full_path :: Text,+        group_file_template_project_id :: Maybe Int,+        group_parent_id :: Maybe Int+      }+  deriving (Generic, Show)++-- | response to sharing a project with a group.+data GroupShare+  = GroupShare+      { share_id :: Int,+        share_project_id :: Int,+        share_group_id :: Int,+        share_group_access :: Int,+        share_expires_at :: Maybe Text+      }+  deriving (Generic, Show)++-- | code branches.+data Branch+  = Branch+      { branch_name :: Text,+        merged :: Bool,+        protected :: Bool,+        branch_default :: Bool,+        developers_can_push :: Bool,+        developers_can_merge :: Bool,+        can_push :: Bool,+        branch_commit :: Commit+      }+  deriving (Generic, Show)++-- | files in a repository.+data RepositoryFile+  = RepositoryFile+      { repository_file_file_name :: Text,+        repository_file_file_path :: Text,+        repository_file_size :: Int,+        encoding :: Text,+        content :: Text,+        content_sha256 :: Text,+        ref :: Text,+        blob_id :: Text,+        repository_file_commit_id :: Text,+        last_commit_id :: Text+      }+  deriving (Generic, Show)++-- | project merge requests.+data MergeRequest+  = MergeRequest+      { merge_request_id :: Int,+        merge_request_iid :: Int,+        merge_request_project_id :: Int,+        merge_request_title :: Text,+        merge_request_description :: Text,+        merge_request_state :: Text,+        merge_request_merged_by :: Maybe User,+        merge_request_merged_at :: Maybe Text,+        merge_request_closed_by :: Maybe User,+        merge_request_closed_at :: Maybe Text,+        merge_request_created_at :: Text,+        merge_request_updated_at :: Text,+        merge_request_target_branch :: Text,+        merge_request_source_branch :: Text,+        merge_request_upvotes :: Int,+        merge_request_downvotes :: Int,+        merge_request_author :: User,+        merge_request_assignee :: Maybe User,+        merge_request_source_project_id :: Int,+        merge_request_target_project_id :: Int,+        merge_request_labels :: [Text],+        merge_request_work_in_progress :: Bool,+        merge_request_milestone :: Maybe Milestone,+        merge_request_merge_when_pipeline_succeeds :: Bool,+        merge_request_merge_status :: Text,+        merge_request_sha :: Text,+        merge_request_merge_commit_sha :: Maybe Text,+        merge_request_user_notes_count :: Int,+        merge_request_discussion_locked :: Maybe Bool,+        merge_request_should_remove_source_branch :: Maybe Bool,+        merge_request_force_remove_source_branch :: Maybe Bool,+        merge_request_allow_collaboration :: Maybe Bool,+        merge_request_allow_maintainer_to_push :: Maybe Bool,+        merge_request_web_url :: Text,+        merge_request_time_stats :: TimeStats,+        merge_request_squash :: Bool,+        merge_request_changes_count :: Maybe Int,+        merge_request_pipeline :: Maybe Pipeline,+        merge_request_diverged_commits_count :: Maybe Int,+        merge_request_rebase_in_progress :: Maybe Bool,+        merge_request_has_conflicts :: Bool,+        merge_request_blocking_discussions_resolved :: Maybe Bool,+        merge_request_approvals_before_merge :: Maybe Bool -- ?+      }+  deriving (Generic, Show)++-- | TODO actions.+data TodoAction+  = TAAssigned+  | TAMentioned+  | TABuildFailed+  | TAMarked+  | TAApprovalRequired+  | TAUnmergeable+  | TADirectlyAddressed+  deriving (Show)++instance FromJSON TodoAction where+  parseJSON (String "assigned") = return TAAssigned+  parseJSON (String "mentioned") = return TAMentioned+  parseJSON (String "build_failed") = return TABuildFailed+  parseJSON (String "marked") = return TAMarked+  parseJSON (String "approval_required") = return TAApprovalRequired+  parseJSON (String "unmergeable") = return TAUnmergeable+  parseJSON (String "directly_addressed") = return TADirectlyAddressed+  parseJSON x = unexpected x++-- | TODO targets.+data TodoTarget+  = TTIssue Issue+  | TTMergeRequest MergeRequest+  | TTCommit CommitTodo+  deriving (Show)++-- | URL is a synonym for 'Text'.+type URL = Text++-- | TODO states.+data TodoState+  = TSPending+  | TSDone+  deriving (Show)++instance FromJSON TodoState where+  parseJSON (String "pending") = return TSPending+  parseJSON (String "done") = return TSDone+  parseJSON x = unexpected x++data TodoProject+  = TP+      { tp_id :: Int,+        tp_description :: Text,+        tp_name :: Text,+        tp_name_with_namespace :: Text,+        tp_path :: Text,+        tp_path_with_namespace :: Text,+        tp_created_at :: UTCTime+      }+  deriving (Generic, Show)++instance FromJSON TodoProject where+  parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = drop 3})++-- | TODOs.+data Todo+  = Todo+      { todo_id :: Int,+        todo_project :: TodoProject,+        todo_author :: User,+        todo_action_name :: TodoAction,+        todo_target :: TodoTarget,+        todo_target_url :: URL,+        todo_body :: Text,+        todo_state :: TodoState,+        todo_created_at :: UTCTime+      }+  deriving (Show)++instance FromJSON Todo where+  parseJSON = withObject "Todo" $ \v ->+    Todo+      <$> v .: "id"+      <*> v .: "project"+      <*> v .: "author"+      <*> v .: "action_name"+      <*> ( v .: "target_type" >>= \case+              "MergeRequest" -> TTMergeRequest <$> v .: "target"+              "Issue" -> TTIssue <$> v .: "target"+              "Commit" -> TTCommit <$> v .: "target"+              (_ :: Text) -> fail ""+          )+      <*> v .: "target_url"+      <*> v .: "body"+      <*> v .: "state"+      <*> v .: "created_at"++-- | version of the GitLab instance.+data Version+  = Version+      { version :: Text,+        revision :: Text+      }+  deriving (Generic, Show)++-----------------------------+-- JSON GitLab parsers below+-----------------------------++bodyNoPrefix :: String -> String+bodyNoPrefix "commit_created_at" = "created_at"+bodyNoPrefix "commit_id" = "id"+bodyNoPrefix "commit_status" = "status"+bodyNoPrefix "todo_commit_id" = "id"+bodyNoPrefix "todo_commit_short_id" = "short_id"+bodyNoPrefix "todo_commit_created_at" = "created_at"+bodyNoPrefix "todo_parent_ids" = "parent_ids"+bodyNoPrefix "issue_author" = "author"+bodyNoPrefix "issue_created_at" = "created_at"+bodyNoPrefix "issue_description" = "description"+bodyNoPrefix "issue_due_date" = "due_date"+bodyNoPrefix "issue_id" = "id"+bodyNoPrefix "issue_labels" = "labels"+bodyNoPrefix "issue_project_id" = "project_id"+bodyNoPrefix "issue_state" = "state"+bodyNoPrefix "issue_title" = "title"+bodyNoPrefix "issue_web_url" = "web_url"+bodyNoPrefix "job_web_url" = "web_url"+bodyNoPrefix "link_events" = "events"+bodyNoPrefix "link_labels" = "labels"+bodyNoPrefix "member_avatar_url" = "avatar_url"+bodyNoPrefix "member_id" = "id"+bodyNoPrefix "member_name" = "name"+bodyNoPrefix "member_state" = "state"+bodyNoPrefix "member_username" = "username"+bodyNoPrefix "member_web_url" = "we_url"+bodyNoPrefix "namespace_id" = "id"+bodyNoPrefix "namespace_name" = "name"+bodyNoPrefix "namespace_path" = "path"+bodyNoPrefix "owner_avatar_url" = "avatar_url"+bodyNoPrefix "owner_id" = "id"+bodyNoPrefix "owner_name" = "name"+bodyNoPrefix "owner_username" = "username"+bodyNoPrefix "owner_web_url" = "web_url"+bodyNoPrefix "pipeline_id" = "id"+bodyNoPrefix "pipeline_status" = "status"+bodyNoPrefix "pipeline_web_url" = "web_url"+bodyNoPrefix "project_avatar_url" = "avatar_url"+bodyNoPrefix "project_created_at" = "created_at"+bodyNoPrefix "project_id" = "id"+bodyNoPrefix "project_name" = "name"+bodyNoPrefix "project_path" = "path"+bodyNoPrefix "project_web_url" = "web_url"+bodyNoPrefix "repository_id" = "id"+bodyNoPrefix "repository_name" = "name"+bodyNoPrefix "repository_path" = "path"+bodyNoPrefix "repository_type" = "type"+bodyNoPrefix "user_avatar_url" = "avatar_url"+bodyNoPrefix "user_id" = "id"+bodyNoPrefix "user_name" = "name"+bodyNoPrefix "user_state" = "state"+bodyNoPrefix "user_username" = "username"+bodyNoPrefix "user_web_url" = "we_url"+bodyNoPrefix "event_title" = "title"+bodyNoPrefix "event_project_id" = "project_id"+bodyNoPrefix "job_ref" = "ref"+bodyNoPrefix "pipeline_ref" = "ref"+bodyNoPrefix "branch_name" = "name"+bodyNoPrefix "branch_default" = "default"+bodyNoPrefix "branch_commit" = "commit"+bodyNoPrefix "repository_file_file_name" = "file_name"+bodyNoPrefix "repository_file_file_path" = "file_path"+bodyNoPrefix "repository_file_size" = "size"+bodyNoPrefix "repository_file_commit_id" = "commit_id"+bodyNoPrefix "merge_request_id" = "id"+bodyNoPrefix "merge_request_iid" = "iid"+bodyNoPrefix "merge_request_project_id" = "project_id"+bodyNoPrefix "merge_request_title" = "title"+bodyNoPrefix "merge_request_description" = "description"+bodyNoPrefix "merge_request_state" = "state"+bodyNoPrefix "merge_request_merged_by" = "merged_by"+bodyNoPrefix "merge_request_merged_at" = "merged_at"+bodyNoPrefix "merge_request_closed_by" = "closed_by"+bodyNoPrefix "merge_request_closed_at" = "closed_at"+bodyNoPrefix "merge_request_created_at" = "created_at"+bodyNoPrefix "merge_request_updated_at" = "updated_at"+bodyNoPrefix "merge_request_target_branch" = "target_branch"+bodyNoPrefix "merge_request_source_branch" = "source_branch"+bodyNoPrefix "merge_request_upvotes" = "upvotes"+bodyNoPrefix "merge_request_downvotes" = "downvotes"+bodyNoPrefix "merge_request_author" = "author"+bodyNoPrefix "merge_request_assignee" = "assignee"+bodyNoPrefix "merge_request_source_project_id" = "source_project_id"+bodyNoPrefix "merge_request_target_project_id" = "target_project_id"+bodyNoPrefix "merge_request_labels" = "labels"+bodyNoPrefix "merge_request_work_in_progress" = "work_in_progress"+bodyNoPrefix "merge_request_milestone" = "milestone"+bodyNoPrefix "merge_request_merge_when_pipeline_succeeds" = "merge_when_pipeline_succeeds"+bodyNoPrefix "merge_request_merge_status" = "merge_status"+bodyNoPrefix "merge_request_sha" = "sha"+bodyNoPrefix "merge_request_merge_commit_sha" = "merge_commit_sha"+bodyNoPrefix "merge_request_user_notes_count" = "user_notes_count"+bodyNoPrefix "merge_request_discussion_locked" = "discussion_locked"+bodyNoPrefix "merge_request_should_remove_source_branch" = "should_remove_source_branch"+bodyNoPrefix "merge_request_force_remove_source_branch" = "force_remove_source_branch"+bodyNoPrefix "merge_request_allow_collaboration" = "allow_collaboration"+bodyNoPrefix "merge_request_allow_maintainer_to_push" = "allow_maintainer_to_push"+bodyNoPrefix "merge_request_web_url" = "web_url"+bodyNoPrefix "merge_request_time_stats" = "time_stats"+bodyNoPrefix "merge_request_squash" = "squash"+bodyNoPrefix "merge_request_approvals_before_merge" = "approvals_before_merge"+bodyNoPrefix "merge_request_allow_contribution" = "allow_contribution"+bodyNoPrefix "merge_request_changes_count" = "changes_count"+bodyNoPrefix "merge_request_pipeline" = "pipeline"+bodyNoPrefix "merge_request_diverged_commits_count" = "diverged_commits_count"+bodyNoPrefix "merge_request_rebase_in_progress" = "rebase_in_progress"+bodyNoPrefix "merge_request_has_conflicts" = "has_conflicts"+bodyNoPrefix "merge_request_blocking_discussions_resolved" = "blocking_discussions_resolved"+bodyNoPrefix "project_stats" = "statistics"+bodyNoPrefix "commit_stats" = "stats"+bodyNoPrefix "share_id" = "id"+bodyNoPrefix "share_project_id" = "project_id"+bodyNoPrefix "share_group_id" = "group_id"+bodyNoPrefix "share_group_access" = "group_access"+bodyNoPrefix "share_expires_at" = "expires_at"+bodyNoPrefix "group_id" = "id"+bodyNoPrefix "group_name" = "name"+bodyNoPrefix "group_path" = "path"+bodyNoPrefix "group_description" = "description"+bodyNoPrefix "group_visibility" = "visibility"+bodyNoPrefix "group_lfs_enabled" = "lfs_enabled"+bodyNoPrefix "group_avatar_url" = "avatar_url"+bodyNoPrefix "group_web_url" = "web_url"+bodyNoPrefix "group_request_access_enabled" = "request_access_enabled"+bodyNoPrefix "group_full_name" = "full_name"+bodyNoPrefix "group_full_path" = "full_path"+bodyNoPrefix "group_file_template_project_id" = "file_template_project_id"+bodyNoPrefix "group_parent_id" = "parent_id"+-- TODO field names for Issues data type+bodyNoPrefix s = s++instance FromJSON TimeStats where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Issue where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON User where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Commit where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON CommitTodo where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON CommitStats where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Pipeline where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Member where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Permissions where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Owner where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Links where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Namespace where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Project where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON ProjectStats where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Repository where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Job where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Artifact where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Group where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON GroupShare where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Branch where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON RepositoryFile where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON MergeRequest where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Diff where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Version where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )

@@ -1,85 +1,107 @@-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | internal module to support modules in GitLab.API module GitLab.WebRequests.GitLabWebCalls-  (-    gitlab-  , gitlabWithAttrs-  , gitlabOne-  , gitlabWithAttrsOne-  , gitlabPost-  , gitlabReqText-  , gitlabReqByteString-  ) where+  ( gitlab,+    gitlabUnsafe,+    gitlabWithAttrs,+    gitlabWithAttrsUnsafe,+    gitlabOne,+    gitlabWithAttrsOne,+    gitlabWithAttrsOneUnsafe,+    gitlabPost,+    gitlabReqText,+    gitlabReqByteString,+  )+where -import Network.HTTP.Conduit+import qualified Control.Exception as Exception+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Data.Aeson import qualified Data.ByteString.Lazy as BSL+import 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-import Data.Aeson-import qualified Control.Exception as E-import Network.HTTP.Types.Status import GitLab.Types-import Control.Monad.Trans.Reader-import Control.Monad.IO.Class-import Data.ByteString.Lazy.Char8 as C+import Network.HTTP.Conduit+import Network.HTTP.Types.Status import Network.HTTP.Types.URI +newtype GitLabException = GitLabException String+  deriving (Eq, Show)++instance Exception.Exception GitLabException++-- In this module, "unsafe" functions are those that discard HTTP+-- error code responses, e.g. 404, 409.+ gitlabPost ::   (MonadIO m, FromJSON b) =>-  Text -- ^ the URL to post to-  -> Text -- ^ the data to post-  -> GitLab m (Either Status b)+  -- | the URL to post to+  Text ->+  -- | the data to post+  Text ->+  GitLab m (Either Status 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))]-                , requestBody = RequestBodyBS (T.encodeUtf8 dataBody) }-  res <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing-  case responseStatus res of-    resp@(Status 404 _msg) -> return (Left resp)-    resp@(Status 409 _msg) -> return (Left resp)-    _ -> return (case parseBSOne (responseBody res) of-                   Just x -> Right x-                   Nothing -> Left $-                     mkStatus 409 "unable to parse POST response")+      request =+        request'+          { method = "POST",+            requestHeaders =+              [("PRIVATE-TOKEN", T.encodeUtf8 (token cfg))],+            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 $+                mkStatus 409 "unable to parse POST response"+        )+    else return (Left (responseStatus resp))  tryGitLab ::-     Int -- ^ the current retry count-  -> Request -- ^ the GitLab request-  -> Int -- ^ maximum number of retries permitted-  -> Manager -- ^ HTTP manager-  -> Maybe HttpException -- ^ the exception to report if maximum retries met-  -> IO (Response BSL.ByteString)+  -- | the current retry count+  Int ->+  -- | the GitLab request+  Request ->+  -- | maximum number of retries permitted+  Int ->+  -- | HTTP manager+  Manager ->+  -- | the exception to report if maximum retries met+  Maybe HttpException ->+  IO (Response BSL.ByteString) tryGitLab i request maxRetries manager lastException   | i == maxRetries = error (show lastException)   | otherwise =-      httpLbs request manager-      `E.catch`-        \ex -> tryGitLab (i+1) request maxRetries manager (Just ex)+    httpLbs request manager+      `Exception.catch` \ex -> tryGitLab (i + 1) request maxRetries manager (Just ex)  parseBSOne :: FromJSON a => BSL.ByteString -> Maybe a parseBSOne bs =   case eitherDecode bs of     Left _err -> Nothing-      -- useful when debugging-      -- error (show _err)+    -- useful when debugging     Right xs -> Just xs -parseBSMany :: FromJSON a => BSL.ByteString -> [a]+parseBSMany :: FromJSON a => BSL.ByteString -> IO [a] parseBSMany bs =   case eitherDecode bs of-    Left s -> error s-    Right xs -> xs+    Left s -> Exception.throwIO $ GitLabException s+    Right xs -> return xs -gitlabReqJsonMany :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m [a]+gitlabReqJsonMany :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status [a]) gitlabReqJsonMany urlPath attrs =   go 1 []   where@@ -87,74 +109,100 @@       cfg <- serverCfg <$> ask       manager <- httpManager <$> ask       let url' =-               url cfg-            <> "/api/v4"-            <> urlPath-            <> "?per_page=100"-            <> "&page="-            <> T.pack (show i)-            <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 attrs))+            url cfg+              <> "/api/v4"+              <> urlPath+              <> "?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)-            }-      res <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing-      let numPages = totalPages res-          accum' = accum ++ parseBSMany (responseBody res)-      if numPages == i-      then return accum'-      else go (i+1) accum'+          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 (responseStatus resp)) -gitlabReqOne :: (MonadIO m) => (BSL.ByteString -> output) -> Text -> Text -> GitLab m output+gitlabReqOne :: (MonadIO m) => (BSL.ByteString -> output) -> Text -> Text -> GitLab m (Either Status output) gitlabReqOne parser urlPath attrs = go   where     go = do       cfg <- serverCfg <$> ask       manager <- httpManager <$> ask       let url' =-               url cfg-            <> "/api/v4"-            <> urlPath-            <> "?per_page=100"-            <> "&page=1"-            <> attrs+            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)-            }-      res <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing-      return (parser (responseBody res))+          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 (responseStatus resp))+      where -gitlabReqJsonOne :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Maybe a)-gitlabReqJsonOne = gitlabReqOne parseBSOne+gitlabReqJsonOne :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status (Maybe a))+gitlabReqJsonOne gitlabURL attr = do+  gitlabReqOne parseBSOne gitlabURL attr -gitlabReqText :: (MonadIO m) => Text -> GitLab m String+gitlabReqText :: (MonadIO m) => Text -> GitLab m (Either Status String) gitlabReqText urlPath = gitlabReqOne C.unpack urlPath "" -gitlabReqByteString :: (MonadIO m) => Text -> GitLab m BSL.ByteString+gitlabReqByteString :: (MonadIO m) => Text -> GitLab m (Either Status BSL.ByteString) gitlabReqByteString urlPath = gitlabReqOne Prelude.id urlPath "" -gitlab :: (MonadIO m, FromJSON a) => Text -> GitLab m [a]+gitlab :: (MonadIO m, FromJSON a) => Text -> GitLab m (Either Status [a]) gitlab addr = gitlabReqJsonMany addr "" -gitlabOne :: (MonadIO m, FromJSON a) => Text -> GitLab m (Maybe a)+gitlabUnsafe :: (MonadIO m, FromJSON a) => Text -> GitLab m [a]+gitlabUnsafe addr = do+  fromRight (error "gitlabUnsafe error") <$> gitlab addr++gitlabOne :: (MonadIO m, FromJSON a) => Text -> GitLab m (Either Status (Maybe a)) gitlabOne addr = gitlabReqJsonOne addr "" -gitlabWithAttrs :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m [a]-gitlabWithAttrs  = gitlabReqJsonMany+gitlabWithAttrs :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status [a])+gitlabWithAttrs = gitlabReqJsonMany -gitlabWithAttrsOne :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Maybe a)-gitlabWithAttrsOne  = gitlabReqJsonOne+gitlabWithAttrsUnsafe :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m [a]+gitlabWithAttrsUnsafe gitlabURL attrs =+  fromRight (error "gitlabWithAttrsUnsafe error") <$> gitlabReqJsonMany gitlabURL attrs +gitlabWithAttrsOne :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status (Maybe a))+gitlabWithAttrsOne = gitlabReqJsonOne++gitlabWithAttrsOneUnsafe :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Maybe a)+gitlabWithAttrsOneUnsafe gitlabURL attrs =+  fromRight (error "gitlabWithAttrsUnsafe error") <$> gitlabReqJsonOne gitlabURL attrs+ totalPages :: Response a -> Int totalPages resp =   let hdrs = responseHeaders resp-  in findPages hdrs+   in findPages hdrs   where     findPages [] = 1 -- error "cannot find X-Total-Pages in header"-    findPages (("X-Total-Pages",bs):_) = read (T.unpack (T.decodeUtf8 bs))-    findPages (_:xs) = findPages xs+    findPages (("X-Total-Pages", bs) : _) = read (T.unpack (T.decodeUtf8 bs))+    findPages (_ : xs) = findPages xs++successStatus :: Status -> Bool+successStatus (Status n _msg) =+  n >= 200 && n <= 226