fedora-composes (empty) → 0.1
raw patch · 6 files changed
+371/−0 lines, 6 filesdep +basedep +bytestringdep +extra
Dependencies added: base, bytestring, extra, http-conduit, http-directory, simple-cmd, simple-cmd-args, text, time
Files
- ChangeLog.md +4/−0
- LICENSE +30/−0
- README.md +98/−0
- fedora-composes.cabal +66/−0
- src/Main.hs +137/−0
- test/tests.hs +36/−0
+ ChangeLog.md view
@@ -0,0 +1,4 @@+# Version history for fedora-composes++## 0.1 (2022-08-11)+- initial release with list and status commands and filtering
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2022, Jens Petersen++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jens Petersen nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,98 @@+# fedora-composes++A small tool to list and check the status of Fedora composes.++## Examples++```shellsession+$ fedora-composes list rawhide+Fedora-Rawhide-20220809.n.0+$ fedora-composes list branched+Fedora-36-20220506.n.0+Fedora-37-20220811.n.0+$ fedora-composes status branched 37+2022-08-11 08:58:46 +08 -> 2022-08-11 08:58:48 +08 STARTED Fedora-37-20220811.n.0+```++## Usage++```shellsession+$ fedora-composes --version+0.1+$ fedora-composes --help+check status of fedora composes++Usage: fedora-composes [--version] COMMAND+ description here++Available options:+ -h,--help Show this help text+ --version Show version++Available commands:+ list List dirs/composes (by default only last compose)+ status Show compose status+```++There is the notation of repos and composes.++For example `Fedora-36-updates` is a repo+and `Fedora-36-updates-20220810.0` is a compose for it.++Filtering is case insensitive.++### list++`fedora-composes list` lists releases and other subdirs (rawhide, updates, branched, etc)++`fedora-composes list updates` shows latest updates composes++`fedora-composes list updates fedora-36` shows latest F36 updates composes++`fedora-composes list branched` shows latest branched composes++```shellsession+$ fedora-composes list --help+Usage: fedora-composes list [-d|--debug] [(-a|--all-repos) | (-n|--num NOREPOS)]+ [(-A|--all-composes) | (-l|--limit LIMIT)]+ [-r|--repos] [DIR] [SUBSTR]+ List dirs/composes (by default only last compose)++Available options:+ -d,--debug debug output+ -a,--all-repos All repos+ -n,--num NOREPOS Number of repos (default: 6)+ -A,--all-composes All composes+ -l,--limit LIMIT Number of composes (default: 1)+ -r,--repos Only list target repos+ -h,--help Show this help text+```++### status++`fedora-composes status rawhide` shows time and status of newest rawhide++`fedora-composes status updates fedora-36` shows time and status of updates push++`fedora-composes status branched 37` shows time and status of branched compose++```shellsession+$ fedora-composes status --help+Usage: fedora-composes status [-d|--debug]+ [(-a|--all-repos) | (-n|--num NOREPOS)]+ [(-A|--all-composes) | (-l|--limit LIMIT)] DIR+ [SUBSTR]+ Show compose status++Available options:+ -d,--debug debug output+ -a,--all-repos All repos+ -n,--num NOREPOS Number of repos (default: 6)+ -A,--all-composes All composes+ -l,--limit LIMIT Number of composes (default: 1)+ -h,--help Show this help text+```++## Installation++stack/cabal/cabal-rpm install
+ fedora-composes.cabal view
@@ -0,0 +1,66 @@+name: fedora-composes+version: 0.1+synopsis: Query Fedora composes+description:+ CLI tool to list and check status of Fedora composes+license: BSD3+license-file: LICENSE+author: Jens Petersen <juhpetersen@gmail.com>+maintainer: Jens Petersen <juhpetersen@gmail.com>+copyright: 2022 Jens Petersen <juhpetersen@gmail.com>+category: Utility+homepage: https://github.com/juhp/fedora-composes+bug-reports: https://github.com/juhp/fedora-composes/issues+build-type: Simple+extra-doc-files: README.md+ ChangeLog.md+cabal-version: 2.0+tested-with: GHC == 8.6.5+ || == 8.8.4+ || == 8.10.7+ || == 9.0.2++source-repository head+ type: git+ location: https://github.com/juhp/fedora-composes.git++executable fedora-composes+ main-is: Main.hs+ other-modules: Paths_fedora_composes+ autogen-modules: Paths_fedora_composes+ hs-source-dirs: src+ build-depends: base < 5,+ bytestring,+ extra,+ http-conduit,+ http-directory >= 0.1.9,+ simple-cmd-args >= 0.1.7,+ text,+ time+ default-language: Haskell2010+ ghc-options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages++test-suite test+ main-is: tests.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test++ default-language: Haskell2010++ ghc-options: -Wall+ build-depends: base >= 4 && < 5,+ simple-cmd+ build-tool-depends: fedora-composes:fedora-composes
+ src/Main.hs view
@@ -0,0 +1,137 @@+-- SPDX-License-Identifier: BSD-3-Clause++module Main (main) where++import Control.Monad.Extra (when)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Char ( isDigit )+import Data.Functor ((<&>))+import Data.List.Extra ( lower, groupOn, sort, sortOn, takeEnd)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Time.LocalTime (getCurrentTimeZone, utcToZonedTime)+import Network.HTTP.Directory+ ( (+/+), httpDirectory', httpLastModified', noTrailingSlash )+import Network.HTTP.Simple+ ( parseRequest, getResponseBody, httpLBS )+import SimpleCmdArgs++import Paths_fedora_composes (version)++main :: IO ()+main =+ simpleCmdArgs' (Just version)+ "check status of fedora composes"+ "description here" $+ subcommands+ [ Subcommand "list"+ "List dirs/composes (by default only last compose)" $+ listCmd+ <$> debugOpt+ <*> numOpt+ <*> limitOpt+ <*> switchWith 'r' "repos" "Only list target repos"+ <*> optional dirOpt+ <*> optional snapOpt+ , Subcommand "status"+ "Show compose status" $+ statusCmd+ <$> debugOpt+ <*> numOpt+ <*> limitOpt+ <*> dirOpt+ <*> optional snapOpt+ ]+ where+ debugOpt = switchWith 'd' "debug" "debug output"++ numOpt =+ flagWith' Nothing 'a' "all-repos" "All repos" <|>+ Just <$> optionalWith auto 'n' "num" "NOREPOS" "Number of repos (default: 6)" 6++ limitOpt =+ flagWith' Nothing 'A' "all-composes" "All composes" <|>+ Just <$> optionalWith auto 'l' "limit" "LIMIT" "Number of composes (default: 1)" 1++ dirOpt = strArg "DIR"++ snapOpt = strArg "SUBSTR"++topUrl :: String+topUrl = "https://kojipkgs.fedoraproject.org/compose"++httpDirectories :: String -> IO [Text]+httpDirectories = fmap (map noTrailingSlash) . httpDirectory'++listCmd :: Bool -> Maybe Int -> Maybe Int -> Bool -> Maybe String+ -> Maybe String -> IO ()+listCmd _ _ _ _ Nothing _ =+ httpDirectories topUrl >>= mapM_ T.putStrLn+listCmd debug mrepos mlimit onlyrepos (Just dir) mpat =+ getComposes debug mrepos mlimit onlyrepos dir mpat >>= mapM_ T.putStrLn++getComposes :: Bool -> Maybe Int -> Maybe Int -> Bool -> FilePath+ -> Maybe String -> IO [Text]+getComposes debug mrepos mlimit onlyrepos dir mpat = do+ let url = topUrl +/+ dir+ when debug $ putStrLn url+ repocomposes <-+ groupOn (T.dropWhileEnd (/= '-')) .+ sortOn (T.dropWhileEnd (/= '-')) . subset .+ filter (\c -> isDigit (T.last c) && T.any (== '.') c) <$>+ httpDirectories url+ when debug $ print $ map last repocomposes+ return $+ (if onlyrepos+ then mconcat . map limitRepos . groupOn removeRelease . map removeDate+ else mconcat . map (sort . limitComposes) . limitRepos) repocomposes+ where+ subset = maybe id (\n -> filter ((T.pack (lower n) `T.isInfixOf`) . T.toLower)) mpat++ limitRepos = maybe id takeEnd mrepos+ limitComposes = maybe id takeEnd mlimit++ removeDate = T.init . T.dropWhileEnd (/= '-') . head++ removeRelease t =+ let reldash = (T.dropWhileEnd isDigit . T.dropWhileEnd (not . isDigit)) t+ in if T.null reldash+ then t+ else T.init reldash++-- FIXME sort output by timestamp+statusCmd :: Bool -> Maybe Int -> Maybe Int -> FilePath -> Maybe String+ -> IO ()+statusCmd debug mrepos mlimit dir mpat = do+ tz <- getCurrentTimeZone+ getComposes debug mrepos mlimit False dir mpat >>=+ mapM (checkStatus tz) >>= mapM_ putStrLn . sort+ where+ checkStatus tz compose = do+ let snapurl = topUrl +/+ dir +/+ T.unpack compose+ when debug $ putStrLn snapurl+ status <- getComposeFile snapurl "STATUS"+-- putChar ' '+ -- FIXME use formatTime+ mstart <- fmap (utcToZonedTime tz) <$>+ httpLastModified' (snapurl +/+ "COMPOSE_ID")+ mfinish <- fmap (utcToZonedTime tz) <$>+ httpLastModified' (snapurl +/+ "STATUS")+ composeId <- getComposeFile snapurl "COMPOSE_ID"+ return $ unwords [maybe "" ((++ " ->") . show) mstart,+ maybe "" show mfinish,+ B.unpack status,+ B.unpack composeId]++ getComposeFile url file =+ parseRequest (url +/+ file)+ >>= httpLBS+ <&> removeFinalNewLine . getResponseBody+++ removeFinalNewLine bs = if B.last bs == '\n' then B.init bs else bs++-- capitalize :: String -> String+-- capitalize "" = ""+-- capitalize (h:t) = toUpper h : t
+ test/tests.hs view
@@ -0,0 +1,36 @@+import SimpleCmd+import System.IO++program :: (String, [[String]]) -> IO ()+program (c, argsv) =+ putStrLn ("\n# " ++ c) >>+ mapM_ run argsv+ where+ run args = do+ putStrLn ""+ cmdLog "fedora-composes" (c : args)++tests :: [(String, [[String]])]+tests =+ [+ ("list",+ [["rawhide"]+ ,["-r", "-n4", "updates"]+ ,["-l2", "updates"]+ ,["updates", "fedora-36"]+ ])+ ,+ ("status",+ [["updates"]+ ,["updates", "fedora-36"]+ ,["rawhide"]+ ,["branched"]+ ,["branched", "37"]+ ])+ ]++main :: IO ()+main = do+ hSetBuffering stdout NoBuffering+ mapM_ program tests+ putStrLn $ "\n" ++ show (length tests) ++ " command tests run"