koji-tool 0.8.7 → 0.9
raw patch · 9 files changed
+131/−105 lines, 9 files
Files
- ChangeLog.md +5/−0
- README.md +14/−11
- koji-tool.cabal +1/−1
- src/Builds.hs +27/−24
- src/Common.hs +6/−2
- src/Main.hs +12/−11
- src/Quick.hs +24/−19
- src/Tasks.hs +31/−26
- test/tests.hs +11/−11
ChangeLog.md view
@@ -1,5 +1,10 @@ # Version history of koji-tool +## 0.9 (2022-05-20)+- rename 'quick' command to 'find'+- 'builds': compact output now appends url+- 'find': add "details" word+ ## 0.8.7 (2022-05-14) 'quick' enhancements: - better help
README.md view
@@ -12,7 +12,8 @@ A few illustrative examples: `koji-tool tasks --mine --latest --state fail --tail`:-shows details of your last buildArch failure and the tail of the build.log (equivalently you can use `koji-tool quick my last fail`).+shows details of your last buildArch failure and the tail of the build.log+(equivalently you can use `koji-tool find my last fail`). `koji-tool install systemd`: will try to install or update to the newest rpm packages from koji. @@ -22,7 +23,7 @@ ## Commands ```shellsession $ koji-tool --version-0.8.7+0.9 $ koji-tool --help Query and track Koji tasks, and install rpms from Koji. @@ -36,14 +37,14 @@ Available commands: builds Query Koji builds (by default lists most recent builds)- latest Query latest Koji build for tag tasks Query Koji tasks (by default lists most recent buildArch tasks)+ latest Query latest Koji build for tag install Install rpm packages directly from a Koji build task progress Track running Koji tasks by buildlog size buildlog-sizes Show buildlog sizes for nvr patterns- quick Simple common queries using words- ('my','last','fail','complete','current','build')+ find Simple quick common queries using words+ (my,last,fail,complete,current,build,detail,PACKAGE) ``` ## koji-tool builds@@ -191,20 +192,20 @@ https://kojipkgs.fedoraproject.org/work/tasks/5316/86685316/build.log (13kB) ``` -## koji-tool quick+## koji-tool find This provides shortcuts to a few select common searches ### Usage-`koji-tool quick my builds` shows your 10 most recent koji builds (equivalent to `koji-tool builds --mine`)+`koji-tool find my builds` shows your 10 most recent koji builds (equivalent to `koji-tool builds --mine`) -`koji-tool quick my last fail` shows your most recent task failure including the tail of the build.log (equivalent to `koji-tool tasks -MLT -s fail`).+`koji-tool find my last fail` shows your most recent task failure including the tail of the build.log (equivalent to `koji-tool tasks -MLT -s fail`). -`koji-tool quick last complete build` shows the latest completed koji build (equivalent to `koji-tool builds -L -s complete`).+`koji-tool find last complete build` shows the latest completed koji build (equivalent to `koji-tool builds -L -s complete`). ### Help ```shellsession-$ koji-tool quick-koji-tool: quick handles these words:+$ koji-tool find+koji-tool: find handles these words: my mine last latest@@ -212,8 +213,10 @@ complete completed completion close closed finish finished current building open build builds+detail details detailed PACKAGE USER's+ ``` ## koji-tool install
koji-tool.cabal view
@@ -1,5 +1,5 @@ name: koji-tool-version: 0.8.7+version: 0.9 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query
src/Builds.hs view
@@ -47,8 +47,7 @@ -> Maybe Tasks.BeforeAfter -> Maybe String -> Bool -> Bool -> BuildReq -> IO () buildsCmd mhub museropt limit states mdate mtype details debug buildreq = do- let server = maybe fedoraKojiHub hubURL mhub- when (server /= fedoraKojiHub && museropt == Just UserSelf) $+ when (hub /= fedoraKojiHub && museropt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone case buildreq of@@ -58,35 +57,37 @@ let bldinfo = if all isDigit bld then InfoID (read bld) else InfoString bld- mbld <- getBuild server bldinfo- whenJust (mbld >>= maybeBuildResult) $ printBuild server tz+ mbld <- getBuild hub bldinfo+ whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz BuildPackage pkg -> do when (head pkg == '-') $ error' $ "bad combination: not a package: " ++ pkg when (isJust mdate) $ error' "cannot use --package together with timedate"- mpkgid <- getPackageID server pkg+ mpkgid <- getPackageID hub pkg case mpkgid of Nothing -> error' $ "no package id found for " ++ pkg Just pkgid -> do let fullquery = [("packageID", ValueInt pkgid), commonBuildQueryOptions limit] when debug $ print fullquery- builds <- listBuilds server fullquery+ builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds if details || length builds == 1- then mapM_ (printBuild server tz) $ mapMaybe maybeBuildResult builds+ then mapM_ (printBuild hub tz) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds _ -> do- query <- setupQuery server+ query <- setupQuery let fullquery = query ++ [commonBuildQueryOptions limit] when debug $ print fullquery- builds <- listBuilds server fullquery+ builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds if details || length builds == 1- then mapM_ (printBuild server tz) $ mapMaybe maybeBuildResult builds+ then mapM_ (printBuild hub tz) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds where+ hub = maybe fedoraKojiHub hubURL mhub+ shortBuildResult :: TimeZone -> Struct -> Maybe String shortBuildResult tz bld = do nvr <- lookupStruct "nvr" bld@@ -98,9 +99,10 @@ case lookupTime "start" bld of Just t -> compactZonedTime tz t Nothing -> ""- return $ nvr +-+ show state +-+ date+ mbid = lookupStruct "build_id" bld+ return $ nvr +-+ show state +-+ date +-+ maybe "" (buildinfoUrl hub) mbid - setupQuery server = do+ setupQuery = do mdatestring <- case mdate of Nothing -> return Nothing@@ -108,7 +110,7 @@ -- FIXME better output including user whenJust mdatestring $ \date -> putStrLn $ maybe "" show mdate +-+ date- mowner <- maybeGetKojiUser server museropt+ mowner <- maybeGetKojiUser hub museropt return $ [("complete" ++ (capitalize . show) date, ValueString datestring) | Just date <- [mdate], Just datestring <- [mdatestring]] ++ [("userID", ValueInt (getID owner)) | Just owner <- [mowner]]@@ -140,6 +142,10 @@ pPrint #endif +buildinfoUrl :: String -> Int -> String+buildinfoUrl hub bid =+ webUrl hub ++ "/buildinfo?buildID=" ++ show bid+ -- FIXME data BuildResult = BuildResult {_buildNVR :: NVR,@@ -163,20 +169,17 @@ BuildResult nvr state buildid mtaskid start_time mend_time printBuild :: String -> TimeZone -> BuildResult -> IO ()-printBuild server tz task = do+printBuild hub tz task = do putStrLn "" let mendtime = mbuildEndTime task time <- maybe getCurrentTime return mendtime- (mapM_ putStrLn . formatBuildResult server (isJust mendtime) tz) (task {mbuildEndTime = Just time})+ (mapM_ putStrLn . formatBuildResult hub (isJust mendtime) tz) (task {mbuildEndTime = Just time}) formatBuildResult :: String -> Bool -> TimeZone -> BuildResult -> [String]-formatBuildResult server ended tz (BuildResult nvr state buildid mtaskid start mendtime) =- -- FIXME any better way?- let weburl = dropSuffix "hub" server- in+formatBuildResult hub ended tz (BuildResult nvr state buildid mtaskid start mendtime) = [ showNVR nvr +-+ show state- , weburl ++ "/buildinfo?buildID=" ++ show buildid]- ++ [weburl ++ "/taskinfo?taskID=" ++ show taskid | Just taskid <- [mtaskid]]+ , buildinfoUrl hub buildid]+ ++ [Tasks.taskinfoUrl hub taskid | Just taskid <- [mtaskid]] ++ [formatTime defaultTimeLocale "Start: %c" (utcToZonedTime tz start)] ++ case mendtime of@@ -214,8 +217,8 @@ latestCmd :: Maybe String -> Bool -> String -> String -> IO () latestCmd mhub debug tag pkg = do- let server = maybe fedoraKojiHub hubURL mhub- mbld <- kojiLatestBuild server tag pkg+ let hub = maybe fedoraKojiHub hubURL mhub+ mbld <- kojiLatestBuild hub tag pkg when debug $ print mbld tz <- getCurrentTimeZone- whenJust (mbld >>= maybeBuildResult) $ printBuild server tz+ whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz
src/Common.hs view
@@ -2,11 +2,12 @@ knownHubs, hubURL, commonQueryOptions,- commonBuildQueryOptions+ commonBuildQueryOptions,+ webUrl ) where -import Data.List (isPrefixOf)+import Data.List.Extra (dropSuffix, isPrefixOf) import Distribution.Koji (fedoraKojiHub, Value(..)) import SimpleCmd (error') @@ -34,3 +35,6 @@ commonBuildQueryOptions :: Int -> (String, Value) commonBuildQueryOptions limit = ("queryOpts", ValueStruct (commonQueryOptions limit "-build_id"))++webUrl :: String -> String+webUrl = dropSuffix "hub"
src/Main.hs view
@@ -45,14 +45,6 @@ BuildPackage <$> strArg "PACKAGE" <|> pure BuildQuery) - , Subcommand "latest"- "Query latest Koji build for tag" $- latestCmd- <$> hubOpt- <*> switchWith 'D' "debug" "Pretty-print raw XML result"- <*> strArg "TAG"- <*> strArg "PKG"- , Subcommand "tasks" "Query Koji tasks (by default lists most recent buildArch tasks)" $ tasksCmd@@ -76,6 +68,14 @@ <|> argumentWith (maybeReader readTaskReq) "PACKAGE|TASKID" <|> pure TaskQuery) + , Subcommand "latest"+ "Query latest Koji build for tag" $+ latestCmd+ <$> hubOpt+ <*> switchWith 'D' "debug" "Pretty-print raw XML result"+ <*> strArg "TAG"+ <*> strArg "PKG"+ , Subcommand "install" "Install rpm packages directly from a Koji build task" $ installCmd@@ -106,9 +106,10 @@ , Subcommand "buildlog-sizes" "Show buildlog sizes for nvr patterns" $ buildlogSizesCmd <$> strArg "NVRPATTERN" - , Subcommand "quick"- "Simple common queries using words ('my','last','fail','complete','current','build')" $- quickCmd+ , Subcommand "find"+ ("Simple quick common queries using words (" +++ intercalate "," (wordsList head) ++ ")") $+ findCmd <$> hubOpt <*> switchWith 'D' "debug" "Debug output including XML results" <*> many (strArg "PHRASE")
src/Quick.hs view
@@ -3,7 +3,8 @@ -- SPDX-License-Identifier: BSD-3-Clause module Quick (- quickCmd+ findCmd,+ wordsList ) where @@ -16,31 +17,34 @@ import qualified Tasks import User -data Words = Mine | Limit | Failure | Complete | Current | Build+data Words = Mine | Limit | Failure | Complete | Current | Build | Detail deriving (Enum,Bounded) -quickWords :: Words -> [String]-quickWords Mine = ["my","mine"]-quickWords Limit = ["last","latest"]-quickWords Failure = ["fail","failure","failed"]-quickWords Complete = ["complete","completed","completion",+findWords :: Words -> [String]+findWords Mine = ["my","mine"]+findWords Limit = ["last","latest"]+findWords Failure = ["fail","failure","failed"]+findWords Complete = ["complete","completed","completion", "close","closed", "finish","finished"]-quickWords Current = ["current", "building", "open"]-quickWords Build = ["build","builds"]+findWords Current = ["current","building","open"]+findWords Build = ["build","builds"]+findWords Detail = ["detail","details","detailed"] +wordsList :: ([String] -> String) -> [String]+wordsList f =+ map (f . findWords) [minBound..] ++ ["PACKAGE"] -- "USER's" hidden!+ allWords :: [String]-allWords = concatMap quickWords [minBound..]+allWords = concatMap findWords [minBound..] -- FIXME: arch -- FIXME: method -- FIXME: mlt (or mlft)-quickCmd :: Maybe String -> Bool -> [String] -> IO ()-quickCmd _ _ [] = error' $ "quick handles these words:\n\n" ++- unlines- (map (unwords . quickWords) [minBound..] ++- ["PACKAGE", "USER's"])-quickCmd mhub debug args = do+findCmd :: Maybe String -> Bool -> [String] -> IO ()+findCmd _ _ [] = error' $ "find handles these words:\n\n" +++ unlines (wordsList unwords ++ ["USER's"])+findCmd mhub debug args = do let user = if hasWord Mine then Just UserSelf else case filter ("'s" `isSuffixOf`) args of@@ -53,6 +57,7 @@ complete = hasWord Complete current = hasWord Current build = hasWord Build+ detail = hasWord Detail mpkg = case removeUsers (args \\ allWords) of [] -> Nothing@@ -67,15 +72,15 @@ let states = [BuildFailed|failure] ++ [BuildComplete|complete] ++ [BuildBuilding|current] buildreq = maybe Builds.BuildQuery Builds.BuildPackage mpkg- in Builds.buildsCmd mhub user limit states Nothing (Just "rpm") False debug buildreq+ in Builds.buildsCmd mhub user limit states Nothing (Just "rpm") detail debug buildreq else let states = [TaskFailed|failure] ++ [TaskClosed|complete] ++ [TaskOpen|current] taskreq = maybe Tasks.TaskQuery Tasks.Package mpkg- in Tasks.tasksCmd mhub user limit states [] Nothing Nothing False debug Nothing failure taskreq+ in Tasks.tasksCmd mhub user limit states [] Nothing Nothing detail debug Nothing failure taskreq where hasWord :: Words -> Bool- hasWord word = any (`elem` quickWords word) args+ hasWord word = any (`elem` findWords word) args removeUsers :: [String] -> [String] removeUsers = filter (not . ("'s" `isSuffixOf`))
src/Tasks.hs view
@@ -9,7 +9,8 @@ tasksCmd, parseTaskState, kojiMethods,- fedoraKojiHub+ fedoraKojiHub,+ taskinfoUrl ) where @@ -64,66 +65,67 @@ -> [String] -> Maybe BeforeAfter -> Maybe String -> Bool -> Bool -> Maybe TaskFilter -> Bool -> TaskReq -> IO () tasksCmd mhub museropt limit states archs mdate mmethod details debug mfilter' tail' taskreq = do- let server = maybe fedoraKojiHub hubURL mhub- when (server /= fedoraKojiHub && museropt == Just UserSelf) $+ when (hub /= fedoraKojiHub && museropt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone case taskreq of Task taskid -> do when (isJust museropt || isJust mdate || isJust mfilter') $ error' "cannot use --task together with --user, timedate, or filter"- mtask <- kojiGetTaskInfo server (TaskId taskid)+ mtask <- kojiGetTaskInfo hub (TaskId taskid) whenJust mtask$ \task -> do when debug $ pPrintCompact task whenJust (maybeTaskResult task) $ \res -> do let hasparent = isJust $ mtaskParent res printTask hasparent tz res unless hasparent $- tasksCmd (Just server) museropt limit states archs mdate mmethod details debug mfilter' tail' (Parent taskid)+ tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' (Parent taskid) Build bld -> do when (isJust mdate || isJust mfilter') $ error' "cannot use --build together with timedate or filter" mtaskid <- if all isDigit bld- then ((fmap TaskId . lookupStruct "task_id") =<<) <$> getBuild server (InfoID (read bld))- else kojiGetBuildTaskID server bld+ then ((fmap TaskId . lookupStruct "task_id") =<<) <$> getBuild hub (InfoID (read bld))+ else kojiGetBuildTaskID hub bld whenJust mtaskid $ \(TaskId taskid) ->- tasksCmd (Just server) museropt limit states archs mdate mmethod details debug mfilter' tail' (Parent taskid)+ tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' (Parent taskid) Package pkg -> do when (head pkg == '-') $ error' $ "bad combination: not a package " ++ pkg when (isJust mdate || isJust mfilter') $ error' "cannot use --package together with timedate or filter"- mpkgid <- getPackageID server pkg+ mpkgid <- getPackageID hub pkg case mpkgid of Nothing -> error' $ "no package id found for " ++ pkg Just pkgid -> do- builds <- listBuilds server+ builds <- listBuilds hub [("packageID", ValueInt pkgid), commonBuildQueryOptions limit] forM_ builds $ \bld -> do let mtaskid = (fmap TaskId . lookupStruct "task_id") bld whenJust mtaskid $ \(TaskId taskid) ->- tasksCmd (Just server) museropt 10 states archs mdate mmethod details debug mfilter' tail' (Parent taskid)+ tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' (Parent taskid) Pattern pat -> do let buildquery = [("pattern", ValueString pat), commonBuildQueryOptions limit] when debug $ print buildquery- builds <- listBuilds server buildquery+ builds <- listBuilds hub buildquery when debug $ print builds forM_ builds $ \bld -> do let mtaskid = (fmap TaskId . lookupStruct "task_id") bld whenJust mtaskid $ \(TaskId taskid) ->- tasksCmd (Just server) museropt 10 states archs mdate mmethod details debug mfilter' tail' (Parent taskid)+ tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' (Parent taskid) _ -> do- query <- setupQuery server+ query <- setupQuery let queryopts = commonQueryOptions limit "-id" when debug $ print $ query ++ queryopts- tasks <- listTasks server query queryopts+ tasks <- listTasks hub query queryopts when debug $ mapM_ pPrintCompact tasks let detailed = details || length tasks == 1 (mapM_ (printTask detailed tz) . filterResults . mapMaybe maybeTaskResult) tasks where- setupQuery server = do+ hub = maybe fedoraKojiHub hubURL mhub++ setupQuery = do case taskreq of Parent parent -> return $ ("parent", ValueInt parent) : commonParams@@ -136,7 +138,7 @@ warning "buildArch tasks" whenJust mdatestring $ \date -> warning $ maybe "" show mdate +-+ date- mowner <- maybeGetKojiUser server museropt+ mowner <- maybeGetKojiUser hub museropt return $ [("owner", ValueInt (getID owner)) | Just owner <- [mowner]] ++ [("complete" ++ (capitalize . show) date, ValueString datestring) | Just date <- [mdate], Just datestring <- [mdatestring]] ++@@ -204,10 +206,10 @@ if detailed then do putStrLn ""- (mapM_ putStrLn . formatTaskResult mtime tz) task+ (mapM_ putStrLn . formatTaskResult hub mtime tz) task buildlogSize tail' $ taskId task else- (putStrLn . compactTaskResult tz) task+ (putStrLn . compactTaskResult hub tz) task pPrintCompact = #if MIN_VERSION_pretty_simple(4,0,0)@@ -217,21 +219,24 @@ pPrint #endif +taskinfoUrl :: String -> Int -> String+taskinfoUrl hub tid =+ webUrl hub +/+ "taskinfo?taskID=" ++ show tid+ -- FIXME option to hide url (take terminal width into consideration?)-compactTaskResult :: TimeZone -> TaskResult -> String-compactTaskResult tz (TaskResult pkg arch method state _mparent taskid mstart mend) =+compactTaskResult :: String -> TimeZone -> TaskResult -> String+compactTaskResult hub tz (TaskResult pkg arch method state _mparent taskid mstart mend) = let time = case mend of Just end -> compactZonedTime tz end Nothing -> maybe "" (compactZonedTime tz) mstart in showPackage pkg ++ (if method == "buildArch" then '.' : arch ++ replicate (8 - length arch) ' ' else ' ' : method) +-+- show state +-+ time +-+- "https://koji.fedoraproject.org/koji/taskinfo?taskID=" ++ show taskid+ show state +-+ time +-+ taskinfoUrl hub taskid -- FIXME show task owner-formatTaskResult :: Maybe UTCTime -> TimeZone -> TaskResult -> [String]-formatTaskResult+formatTaskResult :: String -> Maybe UTCTime -> TimeZone -> TaskResult -> [String]+formatTaskResult hub #if MIN_VERSION_time(1,9,1) mtime #else@@ -239,7 +244,7 @@ #endif tz (TaskResult pkg arch method state mparent taskid mstart mend) = [ showPackage pkg ++ (if method == "buildArch" then '.' : arch else ' ' : method) +-+ show state- , "https://koji.fedoraproject.org/koji/taskinfo?taskID=" ++ show taskid +-+ maybe "" (\p -> "(parent: " ++ show p ++ ")") mparent] +++ , taskinfoUrl hub taskid +-+ maybe "" (\p -> "(parent: " ++ show p ++ ")") mparent] ++ [formatTime defaultTimeLocale "Start: %c" (utcToZonedTime tz start) | Just start <- [mstart]] ++ [formatTime defaultTimeLocale "End: %c" (utcToZonedTime tz end) | Just end <- [mend]] #if MIN_VERSION_time(1,9,1)
test/tests.hs view
@@ -13,16 +13,6 @@ tests :: Bool -> [([String], [[String]])] tests havedist = [- (["install", "-n", "-y"],- [["podman", "-p", "podman"] ++ sysdist- ,["-l", "coreutils"] ++ sysdist- ,["-l", "-R", "rpmlint-2.2.0-1.fc36"]- ,["-H", "https://kojihub.stream.centos.org/kojihub", "-d", "el9", "bash", "-p", "bash"]- ,["-H", "stream", "-d", "el9", "kernel", "-x", "kernel-devel*", "-x", "*-debug*"]- ,["-l", "-H", "stream", "-d", "el9", "grep"]- ,["-H", "rpmfusion", "ffmpeg", "-p", "ffmpeg", "-p", "ffmpeg-libs"] ++ sysdist- ,["-l", "-H", "rpmfusion", "ffmpeg"] ++ sysdist])- , (["builds"], [["-L", "rust"] ,["-l", "3"]@@ -36,8 +26,18 @@ (["latest"], [["rawhide", "ghc"]]) ,- (["quick"],+ (["find"], [["last", "failed", "build"]])+ ,+ (["install", "-n", "-y"],+ [["podman", "-p", "podman"] ++ sysdist+ ,["-l", "coreutils"] ++ sysdist+ ,["-l", "-R", "rpmlint-2.2.0-1.fc36"]+ ,["-H", "https://kojihub.stream.centos.org/kojihub", "-d", "el9", "bash", "-p", "bash"]+ ,["-H", "stream", "-d", "el9", "kernel", "-x", "kernel-devel*", "-x", "*-debug*"]+ ,["-l", "-H", "stream", "-d", "el9", "grep"]+ ,["-H", "rpmfusion", "ffmpeg", "-p", "ffmpeg", "-p", "ffmpeg-libs"] ++ sysdist+ ,["-l", "-H", "rpmfusion", "ffmpeg"] ++ sysdist]) ] where sysdist = if havedist then [] else ["-d", "fc35"]