gitlab-haskell 0.1.3 → 0.1.4

raw patch · 4 files changed

+5/−475 lines, 4 filesdep −directorydep −filepathdep −gitlab-haskellPVP ok

version bump matches the API change (PVP)

Dependencies removed: directory, filepath, gitlab-haskell, moss, optparse-applicative, temporary

API changes (from Hackage documentation)

Files

• README.md +3/−58
• app/Main.hs +0/−397
• gitlab-haskell.cabal +1/−20
• src/GitLab/Types.hs +1/−0

@@ -1,7 +1,5 @@ # A Haskell library for the GitLab web API -## gitlab-haskell library- This library interacts with a GitLab server's API. It supports queries about and updates to: @@ -21,60 +19,7 @@ The library parses JSON results into Haskell data types in the `GitLab.Types` module. -## gitlab-tools executable--This package also includes a `gitlab-tools` executable.--```-> gitlab-tools --help-Program to execute bulk GitLab actions--Usage: gitlab-tools --host host [--token token] [--filename filename]-                    [--group group] [--project project]-                    [--add-reporters-to-group] [--share-projects-with-group]-                    [--registered]-  Executes actions against a GitLab server--Available options:-  --host host              URL of the GitLab server-  --token token            GitLab access token-  --filename filename      name of a CSV file-  --group group            name of a group-  --project project        name of a project-  --add-reporters-to-group Add users as reporters to a group-  --share-projects-with-group-                           Share all projects with a given name to the specific-                           group-  --registered             prints 'yes' or 'no' depending on whether a user-                           exists on the GitLab server-  -h,--help                Show this help text-```--### Examples--Sharing projects with a group:--```-> gitlab-tools \-    --host <GitLab url> --token <token> \-    --share-projects-with-group --project my_project \-    --group my_group-```--This commands finds all projects called `my_project` then adds the-`my_group` group to all of those projects as a member with the-Reporter role.--Adding users to a group:--```-> gitlab-tools \-    --host <GitLab url> --token <token> \-    --filename <filename>.csv \-    --add-reporters-to-group \-    --group my_group-```+## Applications using this library -This command reads usernames from a comma separated file, and if they-are registered on the GitLab server it adds them to the `my_group`-group with the Reporter role.+* `gitlab-tools`: a command line tool for bulk transactions against a+  GitLab server. [link](https://gitlab.com/robstewart57/gitlab-tools)

@@ -1,397 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}-module Main where--import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.IO.Unlift-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T-import GitLab-import Network.HTTP.Types.Status-import Data.Semigroup ((<>))-import Options.Applicative-import qualified Data.ByteString.Char8 as C-import Stanford.Moss-import Data.Maybe-import System.FilePath.Posix-import System.IO.Temp-import System.Directory--main :: IO ()-main = processOptions =<< execParser opts-  where-    opts = info (parser <**> helper)-           ( fullDesc-             <> progDesc "Executes actions against a GitLab server"-             <> header "Program to execute bulk GitLab actions" )--data Options =-  Options-  { gitlabUrl :: String-  , gitlabToken :: String-  , usersFilename :: String-  , group :: String-  , project :: String-  , addReportersToGroup :: Bool-  , addGroupToProject :: Bool-  , isRegistered :: Bool-  , plagiarism :: Bool-  , mossUserId :: String-  , mossLang :: String-  , plagiarismProject :: String-  , plagiarismFilePaths :: String-  , parentUser :: String-  , projectLinks :: Bool-  }-  deriving (Show)--parser :: Parser Options-parser = Options-  <$> strOption-  ( long "host"-    <> metavar "host"-    <> help "URL of the GitLab server" )-  <*> strOption-  ( long "token"-    <> metavar "token"-    <> value ""-    <> help "GitLab access token" )-  <*> strOption-  ( long "userFilename"-    <> metavar "userFilename"-    <> value ""-    <> help "name of a CSV file with user IDs" )-  <*> strOption-  ( long "group"-    <> metavar "group"-    <> value ""-    <> help "name of a group" )-  <*> strOption-  ( long "project"-    <> metavar "project"-    <> value ""-    <> help "name of a project" )-  <*> switch-  ( long "add-reporters-to-group"-    <> help "Add users as reporters to a group" )-  <*> switch-  ( long "share-projects-with-group"-    <> help "Share all projects with a given name to the specific group" )-  <*> switch-  ( long "registered"-    <> help "prints 'yes' or 'no' depending on whether a user exists on the GitLab server" )-  <*> switch-  ( long "plagiarism"-    <> help "use MOSS to detect plagiarism" )-  <*> strOption-  ( long "mossUser"-    <> metavar "mossUser"-    <> value ""-    <> help "MOSS user ID" )-  <*> strOption-  ( long "mossLang"-    <> metavar "mossLang"-    <> value ""-    <> help "languge to pass to MOSS" )-  <*> strOption-  ( long "plagiarismProject"-    <> metavar "plagiarismProject"-    <> value ""-    <> help "project to detect plagiarism in" )-  <*> strOption-  ( long "plagiarismFiles"-    <> metavar "plagiarismFiles"-    <> value ""-    <> help "comma separated list of plagiarism files" )-  <*> strOption-  ( long "parent"-    <> metavar "parent"-    <> value ""-    <> help "parent username of skeleton code" )-  <*> switch-  ( long "projectLinks"-    <> help "get the URL links for searched for projects" )--processOptions :: Options -> IO ()-processOptions opts = go-  where-    go-      | addReportersToGroup opts && usersFilename opts == "" = return ()-      | addReportersToGroup opts && group opts == "" =-        putStrLn "you must specify a group name too"-      | addReportersToGroup opts && addGroupToProject opts =-        putStrLn-          "you can only choose one of adding users to group or adding group to projects"-         -- add reporters to a group-      | addReportersToGroup opts && usersFilename opts /= "" = do-        text <- T.readFile (usersFilename opts)-        let usernames = T.splitOn "," text-        runGitLab-          (defaultGitLabServer-           {url = T.pack (gitlabUrl opts), token = T.pack (gitlabToken opts)})-          (addUsersToGroupDbg (T.pack (group opts)) Reporter usernames)-      | not (addReportersToGroup opts) &&-          addGroupToProject opts && null (group opts) && null (project opts) =-        error-          "for --share-project you must specify a group name and a project name"-       -- add group as a member to all projects with a given name, as Reporter-      | not (addReportersToGroup opts) && addGroupToProject opts =-        runGitLab-          (defaultGitLabServer-           {url = T.pack (gitlabUrl opts), token = T.pack (gitlabToken opts)})-          (do groups <- groupsWithNameOrPath (T.pack (group opts))-              void $-                liftIO $-                when (null groups) (error ("group not found: " ++ group opts))-              void $-                liftIO $-                when-                  (length groups > 1)-                  (error ("multiple groups found for: " ++ group opts))-               -- should only be 1 group with this head-              let grp = head groups-              projects <- projectsWithName (T.pack (project opts))-              mapM_-                (\prj -> do-                   result <--                     shareProjectWithGroup-                       (group_id grp)-                       (project_id prj)-                       Reporter-                   case result of-                     Left st ->-                       liftIO-                         (putStrLn-                            ("unable to share project " ++-                             show (project_id prj) ++-                             " with group " ++-                             show (group_id grp) ++ ". Reason: " ++ show st))-                     Right _details ->-                       liftIO-                         (putStrLn-                            ("Added group " ++-                             show (group_id grp) ++-                             " to project " ++-                             show (project_id prj) ++ " as a Reporter")))-                projects)-       -- ask if users are registered for a given GitLab server-      | not (addReportersToGroup opts) &&-          not (addGroupToProject opts) && isRegistered opts =-        putStrLn "--registered needs a filename with --filename"-      | not (addReportersToGroup opts) &&-          not (addGroupToProject opts) &&-          isRegistered opts && usersFilename opts == "" =-        putStrLn "--registered needs a filename with --filename"-      | not (addReportersToGroup opts) &&-          not (addGroupToProject opts) && isRegistered opts = do-        text <- T.readFile (usersFilename opts)-        let usernames = T.splitOn "," text-        runGitLab-          (defaultGitLabServer-           {url = T.pack (gitlabUrl opts), token = T.pack (gitlabToken opts)})-          (mapM_-             (\usrName -> do-                res <- searchUser usrName-                      -- empty list of returned users-                if null res-                  then liftIO $ putStrLn (T.unpack usrName ++ ": no")-                  else liftIO $ putStrLn (T.unpack usrName ++ ": yes"))-             usernames)-      | plagiarism opts &&-          ((mossUserId opts == "") ||-           (mossLang opts == "") ||-           (plagiarismFilePaths opts == "") ||-           (plagiarismProject opts == "") ||-           (parentUser opts == "") || (usersFilename opts == "")) =-        putStrLn-          "--plagiarism needs a MOSS user, MOSS language, filepath list and a parent user"-      | plagiarism opts = do-        usersData <- readFile (usersFilename opts)-        let usernames = T.splitOn "," (T.pack usersData)-        let files = T.splitOn "," (T.pack (plagiarismFilePaths opts))-        runGitLab-          (defaultGitLabServer-           {url = T.pack (gitlabUrl opts), token = T.pack (gitlabToken opts)})-          (do reports <--                runMoss-                  files-                  usernames-                  (T.pack (parentUser opts))-                  (T.pack (plagiarismProject opts))-                  (T.pack (mossUserId opts))-                  (T.pack (mossLang opts))-              liftIO (putStrLn "MOSS reports:")-              liftIO $ mapM_ T.putStr reports)-      | projectLinks opts && null (project opts) =-        error "--projectLinks must also be used with --project"-      | projectLinks opts = do-        usersData <- readFile (usersFilename opts)-        let usernames = T.splitOn "," (T.pack usersData)-        runGitLab-          (defaultGitLabServer-           {url = T.pack (gitlabUrl opts), token = T.pack (gitlabToken opts)})-          (mapM_-            (\username -> do-                projects <--                  projectsWithNameAndUser username (T.pack (project opts))-                case projects of-                  Nothing -> return ()-                  Just proj -> do-                    isPassing <- projectCISuccess proj-                    numCommits <- projectCommits proj-                    liftIO $-                      putStrLn-                      (T.unpack (project_web_url proj) <> " (" <>-                        (if isPassing-                         then "passing, "-                         else "failing, ")-                        <> show (length numCommits) <> " commits)"))-                usernames)-      | otherwise = error "combination of flags not recognised"--{- add users -}-  -addUsersToGroupDbg ::-  (MonadIO m, MonadUnliftIO m) => Text -> AccessLevel -> [Text] -> GitLab m ()-addUsersToGroupDbg groupName access usernames = do-  (users :: [User]) <--    catMaybes <$>-    mapM (\username ->-            do maybeUser <- searchUser username-               case maybeUser of-                 Nothing -> do-                   liftIO $ putStrLn $ T.unpack username <> " not found on server."-                   return Nothing-                 u -> return u-         ) usernames-  (results :: [Either Status Member]) <--    addUsersToGroup groupName access users-  liftIO $ mapM_-    (\(result :: Either Status Member) ->-       case result of-         Left errorStatus -> print errorStatus-         Right member ->-           putStrLn-             ("Added to " ++-              show groupName ++ ": " ++ show (member_username member)))-    results--{- plagiarism detection -}--runMoss :: (MonadIO m, MonadUnliftIO m) => [Text] -> [Text] -> Text -> Text -> Text -> Text -> GitLab m [Text]-runMoss filepaths usernames skeletonUser projectName mossUserKey lang =-  mapM-    (\fpath -> do-       liftIO $ putStrLn ("Processing file " ++ T.unpack fpath ++ "\n")-       liftIO $-         putStrLn-           ("getting handed out code " ++-            T.unpack skeletonUser ++ "/" ++ T.unpack projectName ++ "\n")-       skeletonCode <--         fromJust <$> getCode fpath "master" skeletonUser projectName-       userSubmissions <--         mapM-           (\usr -> do-              liftIO-                (putStrLn-                   ("getting " ++ T.unpack fpath ++ " from " ++-                    T.unpack usr ++ "/" ++ T.unpack projectName))-              maybe_userCode <- getCode fpath "master" usr projectName-              case maybe_userCode of-                Nothing -> return Nothing-                Just userCode -> return (Just (usr, userCode)))-           usernames-       liftIO (putStrLn "sending job to moss")-       result <- moss fpath skeletonCode (catMaybes userSubmissions) mossUserKey lang-       liftIO $ putStrLn ("File " ++ T.unpack fpath ++ " processed.\n")-       return result-    )-    filepaths--moss :: (MonadIO m, MonadUnliftIO m) => Text -> Text -> [(Text,Text)] -> Text -> Text -> GitLab m Text-moss skeletonFilename skeletonData studentCode mossUserKey lang = do-  let language =-        case T.unpack lang of-          "C" -> C-          "CPP" -> CPP-          "Java" -> Java-          "CSharp" -> CSharp-          "Python" -> Python-          "VisualBasic" -> VisualBasic-          "Javascript" -> Javascript-          "FORTRAN" -> FORTRAN-          "ML" -> ML-          "Haskell" -> Haskell-          "Lisp" -> Lisp-          "Scheme" -> Scheme-          "Pascal" -> Pascal-          "Modula2" -> Modula2-          "Ada" -> Ada-          "Perl" -> Perl-          "TCL" -> TCL-          "Matlab" -> Matlab-          "VHDL" -> VHDL-          "Verilog" -> Verilog-          _ -> error "unrecognised MOSS language name"-  let ext =-        case T.unpack lang of-          "C" -> ".c"-          "CPP" -> ".cpp"-          "Java" -> ".java"-          "CSharp" -> ".cs"-          "Python" -> ".py"-          "VisualBasic" -> ".vb"-          "Javascript" -> ".js"-          "FORTRAN" -> ".f"-          "ML" -> ".ml"-          "Haskell" -> ".hs"-          "Lisp" -> ".lisp"-          "Scheme" -> ".scm"-          "Pascal" -> ".pas"-          "Modula2" -> ".mod"-          "Ada" -> ".ada"-          "Perl" -> ".pl"-          "TCL" -> ".tcl"-          "Matlab" -> ".m"-          "VHDL" -> ".vhdl"-          "Verilog" -> ".v"-          _ -> error "unrecognised MOSS language name"        -  let cfg :: MossCfg-      cfg = defaultMossCfg {-        mossLanguage = language-        , mossUser = C.pack (T.unpack mossUserKey)-        }-  tmpSkelFile <- liftIO $ writeSystemTempFile (takeFileName (T.unpack skeletonFilename)) (T.unpack skeletonData)-  userFiles <- mapM (\(userId,code) -> do-                        userFile <- liftIO $ writeSystemTempFile (T.unpack userId <> ext) (T.unpack code)-                        return (userFile,userId)-                    )-               studentCode-  liftIO $ withMoss cfg $ do-    addBaseFile "Skeleton" tmpSkelFile-    mapM_ (\(userFile,userId) ->-           addFile (T.unpack userId) userFile-          ) userFiles-    res <- fromJust <$> query (C.pack ("moss-" <> takeFileName (T.unpack skeletonFilename)))--    -- remove temporary files-    liftIO $ removeFile tmpSkelFile-    liftIO $ mapM_ (\(fileName,_) -> removeFile fileName) userFiles-    -    return (T.pack (C.unpack res))--getCode :: (MonadIO m, MonadUnliftIO m) => Text -> Text -> Text -> Text -> GitLab m (Maybe Text)-getCode filepath branch username projectName = do-    maybe_proj <- projectsWithNameAndUser username projectName-    case maybe_proj of-      Nothing -> return Nothing-      Just proj -> do-        maybe_file <- repositoryFiles proj filepath branch-        case maybe_file of-          Nothing -> error "repo file not found"-          Just repoFile -> do-            let blobHash = blob_id repoFile-            contents <- repositoryFileBlob (project_id proj) blobHash-            return (Just (T.pack contents))

@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.1.3+version:        0.1.4 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/>@@ -23,25 +23,6 @@ source-repository head   type: git   location: https://gitlab.com/robstewart57/gitlab-haskell--executable gitlab-tools-  main-is: Main.hs-  hs-source-dirs:-      app-  ghc-options: -threaded -rtsopts -with-rtsopts=-N-  build-depends:-                base >=4.7 && <5-              , gitlab-haskell-              , text-              , http-types-              , optparse-applicative-              , bytestring-              , moss-              , filepath-              , unliftio-core-              , temporary-              , directory-  default-language: Haskell2010  library   exposed-modules:

@@ -30,6 +30,7 @@   , Issue(..)   , Pipeline(..)   , Commit(..)+  , CommitTodo(..)   , CommitStats(..)   , Diff(..)   , Repository(..)