diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 --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 --token \ - --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) diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 --- a/app/Main.hs +++ /dev/null @@ -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)) diff --git a/gitlab-haskell.cabal b/gitlab-haskell.cabal --- a/gitlab-haskell.cabal +++ b/gitlab-haskell.cabal @@ -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: @@ -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: diff --git a/src/GitLab/Types.hs b/src/GitLab/Types.hs --- a/src/GitLab/Types.hs +++ b/src/GitLab/Types.hs @@ -30,6 +30,7 @@ , Issue(..) , Pipeline(..) , Commit(..) + , CommitTodo(..) , CommitStats(..) , Diff(..) , Repository(..)