gitlab-haskell 1.0.0.5 → 1.0.1.0

raw patch · 14 files changed

+74/−37 lines, 14 filesdep +data-default-classdep ~crypton-connectionPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default-class

Dependency ranges changed: crypton-connection

API changes (from Hackage documentation)

Files

• README.md +30/−17
• gitlab-haskell.cabal +3/−2
• src/GitLab.hs +6/−4
• src/GitLab/API/Boards.hs +1/−0
• src/GitLab/API/Commits.hs +1/−0
• src/GitLab/API/Groups.hs +1/−0
• src/GitLab/API/Issues.hs +1/−0
• src/GitLab/API/MergeRequests.hs +7/−2
• src/GitLab/API/Projects.hs +7/−2
• src/GitLab/API/Todos.hs +1/−0
• src/GitLab/API/Users.hs +1/−0
• src/GitLab/SystemHooks/GitLabSystemHooks.hs +1/−1
• src/GitLab/Types.hs +8/−6
• src/GitLab/WebRequests/GitLabWebCalls.hs +6/−3

@@ -22,6 +22,8 @@ * Notes * Boards +## gitlab-haskell API+ The library parses JSON results into Haskell data types in the `GitLab.Types` module, allowing you to work with statically typed GitLab data with data types and functions that the library@@ -30,6 +32,27 @@     searchUser     :: Text -> GitLab (Maybe User)     userProjects   :: User -> GitLab (Maybe [Project]) +## Server-side GitLab file hooks++This library can also be used to implement rule based GitLab file+system hooks that, when deployed a GitLab server, react in real time+to GitLab events like project creation, new users, merge requests etc.++The rule based API for implementing file hooks is:++    receive :: [Rule] -> GitLab ()++    class (FromJSON a) => SystemHook a where+      match   :: String -> (a -> GitLab ()) -> Rule+      matchIf :: String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule++For more details about the file system hooks support, see post:+[GitLab automation with file hook rules](https://www.macs.hw.ac.uk/~rs46/posts/2020-06-06-gitlab-system-hooks.html).++This library has almost 100% coverage of the GitLab REST API. For the complete+`gitlab-haskell` API, see the [hackage+documentation](https://hackage.haskell.org/package/gitlab-haskell).+ ## Example  Run all GitLab actions with `runGitLab`: @@ -46,25 +69,15 @@       runGitLab         (defaultGitLabServer            { url = "https://gitlab.example.com"-           , token="my_token"} )-        (searchUser "joe" >>= userProjects . fromJust)--This library can also be used to implement rule based GitLab file-system hooks that, when deployed a GitLab server, react in real time-to GitLab events like project creation, new users, merge requests etc.--The rule based API for implementing file hooks is:--    receive :: [Rule] -> GitLab ()--    class (FromJSON a) => SystemHook a where-      match   :: String -> (a -> GitLab ()) -> Rule-      matchIf :: String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule+           , token = AuthMethodToken "my_token"} )+        (searchUser "joe" >>=  \usr -> userProjects (fromJust usr) defaultProjectSearchAttrs) -For more details about the file system hooks support, see post:-[GitLab automation with file hook rules](https://www.macs.hw.ac.uk/~rs46/posts/2020-06-06-gitlab-system-hooks.html).+## Library use -For the complete `gitlab-haskell` API, see the [hackage documentation](https://hackage.haskell.org/package/gitlab-haskell).+It was initially developed to automate and support computer science+education. See our ICSE-SEET 2024 paper for the details: [_"Integrating Canvas+and GitLab to Enrich Learning+Processes"_](https://doi.org/10.1145/3639474.3640056).  An example of an application using this library is `gitlab-tools`, which is a command line tool for bulk GitLab transactions [link](https://gitlab.com/robstewart57/gitlab-tools).

@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        1.0.0.5+version:        1.0.1.0 synopsis:       A Haskell library for the GitLab web API description:             This library lifts the GitLab REST API into Haskell: <https://docs.gitlab.com/ee/api/>@@ -198,7 +198,7 @@   build-depends:                 base >=4.7 && <5               , http-conduit-              , crypton-connection+              , crypton-connection >= 0.4.1               , aeson >= 2.0.0.0               , bytestring               , text@@ -209,6 +209,7 @@               , temporary               , unix               , mtl+              , data-default-class   default-language: Haskell2010   ghc-options: -Wall                -- the following two for the stan static analysis tool

@@ -39,6 +39,7 @@  import Control.Monad.IO.Class import Control.Monad.Trans.Reader+import Data.Default.Class import qualified Data.Text as T import GitLab.API.Boards import GitLab.API.Branches@@ -62,7 +63,6 @@ import GitLab.SystemHooks.Rules import GitLab.SystemHooks.Types import GitLab.Types-import Network.Connection (TLSSettings (..)) import Network.HTTP.Conduit import Network.HTTP.Types.Status import System.IO@@ -87,7 +87,7 @@ runGitLab :: GitLabServerConfig -> GitLab a -> IO a runGitLab cfg action = do   liftIO $ hSetBuffering stdout LineBuffering-  let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+  let settings = mkManagerSettings def Nothing   manager <- liftIO $ newManager settings   runGitLabWithManager manager cfg action @@ -106,7 +106,7 @@   hostUrl <- getLine   liftIO (putStr "Enter GitLab access token\n> ")   pass <- getLine-  runGitLab (cfg {url = T.pack hostUrl, token = T.pack pass}) action+  runGitLab (cfg {url = T.pack hostUrl, token = AuthMethodToken (T.pack pass)}) action  -- | The same as 'runGitLab', except that it also takes a connection -- manager as an argument.@@ -130,4 +130,6 @@ runGitLabDbg :: GitLab a -> IO a runGitLabDbg (GitLabT action) = do   liftIO $ hSetBuffering stdout LineBuffering-  runReaderT action undefined+  manager <- liftIO $ newManager (mkManagerSettings def Nothing)+  let cfg = GitLabServerConfig {url = "", token = AuthMethodToken "", retries = 1, debugSystemHooks = False}+  runReaderT action (GitLabState cfg manager)

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : Boards

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : Commits

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : Groups

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-}  -- |

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : MergeRequests@@ -227,7 +228,9 @@       ]     addr =       T.pack $-        "/projects/" <> show projectId <> "/merge_requests/"+        "/projects/"+          <> show projectId+          <> "/merge_requests/"           <> show mergeRequestIid           <> "/merge" @@ -252,7 +255,9 @@   where     addr =       T.pack $-        "/projects/" <> show projectId <> "/merge_requests/"+        "/projects/"+          <> show projectId+          <> "/merge_requests/"           <> show mergeRequestIid  -- | Attributes when searching for merge requests with the

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : Projects@@ -586,12 +587,16 @@ -------------------- -- Additional functionality beyond the GitLab Projects API --- | Returns 'True' is a projecthas multiple email addresses+-- | Returns 'True' is a project has multiple email addresses -- associated with all commits in a project, 'False' otherwise. multipleCommitters :: Project -> GitLab Bool multipleCommitters prj = do   emailAddresses <- commitsEmailAddresses prj-  return (length (nub emailAddresses) > 1)+  return $+    case nub emailAddresses of+      [] -> False+      [_] -> False+      (_ : _) -> True  -- | gets the email addresses in the author information in all commit -- for a project.

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : Todos

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : Users

@@ -46,7 +46,7 @@  traceSystemHook :: Text -> GitLab () traceSystemHook eventContent = do-  cfg <- serverCfg <$> MR.ask+  cfg <- MR.asks serverCfg   liftIO $     E.catch       ( when (debugSystemHooks cfg) $ do

@@ -18,6 +18,7 @@     GitLabT (..),     GitLabState (..),     GitLabServerConfig (..),+    AuthMethod (..),     defaultGitLabServer,     ArchiveFormat (..),     AccessLevel (..),@@ -144,10 +145,7 @@ -- | 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,+    token :: AuthMethod,     -- | how many times to retry a HTTP request before giving up and returning an error.     retries :: Int,     -- | write system hook events to files in the system temporary@@ -160,11 +158,15 @@ defaultGitLabServer =   GitLabServerConfig     { url = "https://gitlab.com",-      token = "",-      timeout = 15000000, -- 15 seconds+      token = AuthMethodToken "",       retries = 5,       debugSystemHooks = False     }++-- | personal access token, see <https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html>+data AuthMethod+  = AuthMethodToken Text+  | AuthMethodOAuth Text  -- https://docs.gitlab.com/ee/api/repositories.html#get-file-archive -- tar.gz, tar.bz2, tbz, tbz2, tb2, bz2, tar, and zip

@@ -169,15 +169,18 @@   [GitLabParam] ->   GitLab (Response BSL.ByteString) gitlabHTTP httpMethod contentType urlPath urlParams contentParams = do-  cfg <- serverCfg <$> MR.ask-  manager <- httpManager <$> MR.ask+  cfg <- MR.asks serverCfg+  manager <- MR.asks httpManager   let url' = url cfg <> "/api/v4" <> urlPath <> T.decodeUtf8 (renderQuery True urlParams)+  let authHeader = case token cfg of+        AuthMethodToken t -> ("PRIVATE-TOKEN", T.encodeUtf8 t)+        AuthMethodOAuth t -> ("Authorization", "Bearer " <> T.encodeUtf8 t)   let request' = parseRequest_ (T.unpack url')       request =         request'           { method = httpMethod,             requestHeaders =-              [ ("PRIVATE-TOKEN", T.encodeUtf8 (token cfg)),+              [ authHeader,                 ("content-type", contentType)               ],             requestBody = RequestBodyBS (renderQuery False contentParams)