{-# LANGUAGE CPP, OverloadedStrings #-}
module Bodhi (
bodhiCreateOverride,
bodhiTestingRepo,
checkAutoBodhiUpdate,
UpdateType(..),
UpdateSeverity(..),
bodhiUpdate,
bodhiBuildExists
)
where
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (fromText)
#endif
import Data.Aeson.Types (Object, (.:), parseEither)
import Data.Char (isDigit)
import Fedora.Bodhi hiding (bodhiUpdate)
import SimplePrompt (promptEnter, promptNonEmpty)
import Text.Read
import qualified Text.ParserCombinators.ReadP as R
import qualified Text.ParserCombinators.ReadPrec as RP
import Branches
import Bugzilla (BugId)
import Common
import Common.System
import qualified Common.Text as T
import Package
checkAutoBodhiUpdate :: Branch -> IO Bool
checkAutoBodhiUpdate Rawhide = return True
-- epel7 returns 'create_automatic_updates: null' !
checkAutoBodhiUpdate (EPEL 7) = return False
-- not sure how to best handle next
checkAutoBodhiUpdate (EPELNext _) = return False
checkAutoBodhiUpdate br =
lookupKey'' "create_automatic_updates" <$> bodhiRelease (show br)
where
-- Error in $: key "create_automatic_updates" not found
lookupKey'' :: T.Text -> Object -> Bool
lookupKey'' k obj =
let errMsg e = error $ e +-+ show obj in
-- bodhi-hs has lookupKeyEither
either errMsg id $ parseEither (.: fromText k) obj
#if !MIN_VERSION_aeson(2,0,0)
fromText :: T.Text -> T.Text
fromText = id
#endif
-- FIXME should determine 3 days for branched devel release
-- FIXME handle expired override?
bodhiCreateOverride :: Bool -> Maybe Int -> String -> IO ()
bodhiCreateOverride dryrun mduration nvr = do
putStrLn $ "Creating Bodhi Override for" +-+ nvr ++ ":"
unless dryrun $ do
ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", show (fromMaybe 4 mduration), "--no-wait", nvr]
if ok
then putStrLn $ "https://bodhi.fedoraproject.org/overrides/" ++ nvr
else do
moverride <- bodhiOverride nvr
case moverride of
Nothing -> do
putStrLn "bodhi override failed"
promptEnter "Press Enter to retry"
bodhiCreateOverride dryrun mduration nvr
-- FIXME prettyprint
Just obj -> error' $ show obj
data UpdateType =
SecurityUpdate | BugfixUpdate | EnhancementUpdate | NewPackageUpdate |
TemplateUpdate
deriving Eq
instance Show UpdateType where
show SecurityUpdate = "security"
show BugfixUpdate = "bugfix"
show EnhancementUpdate = "enhancement"
show NewPackageUpdate = "newpackage"
show TemplateUpdate = error "template update"
instance Read UpdateType where
readPrec = do
s <- look
case lower s of
"security" -> RP.lift (R.string s) >> return SecurityUpdate
"bugfix" -> RP.lift (R.string s) >> return BugfixUpdate
"enhancement" -> RP.lift (R.string s) >> return EnhancementUpdate
"newpackage" -> RP.lift (R.string s) >> return NewPackageUpdate
"template" -> RP.lift (R.string s) >> return TemplateUpdate
_ -> error' "unknown bodhi update type" >> RP.pfail
data UpdateSeverity =
SeverityLow | SeverityMedium | SeverityHigh | SeverityUrgent |
SeverityUnspecified
deriving Eq
instance Show UpdateSeverity where
show SeverityLow = "low"
show SeverityMedium = "medium"
show SeverityHigh = "high"
show SeverityUrgent = "urgent"
show SeverityUnspecified = "unspecified"
instance Read UpdateSeverity where
readPrec = do
s <- look
case lower s of
"low" -> RP.lift (R.string s) >> return SeverityLow
"medium" -> RP.lift (R.string s) >> return SeverityMedium
"high" -> RP.lift (R.string s) >> return SeverityHigh
"urgent" -> RP.lift (R.string s) >> return SeverityUrgent
_ -> error' "unknown bodhi update severity" >> RP.pfail
bodhiTestingRepo :: Branch -> IO (Maybe String)
bodhiTestingRepo Rawhide = return Nothing
bodhiTestingRepo br = do
obj <- bodhiRelease (show br)
return $
case lookupKey "testing_repository" obj :: Maybe String of
Nothing -> Nothing
Just _ -> lookupKey' "testing_tag" obj
-- FIXME support --no-close-bugs
-- push comma separated list of builds for a package to bodhi
bodhiUpdate :: Bool -> (Maybe UpdateType, UpdateSeverity) -> Maybe BugId
-> Bool -> FilePath -> String -> IO ()
bodhiUpdate _ _ _ _ _ [] = error' "cannot make empty update"
bodhiUpdate dryrun (mupdate,severity) mreview usechangelog spec nvrs = do
case mupdate of
Nothing -> return ()
Just updateType ->
unless dryrun $ do
-- use cmdLog to debug, but notes are not quoted
updatedone <- do
mtemplate <- maybeTemplate updateType
case mtemplate of
Just file -> do
cmd_ "bodhi" ["updates", "new", "--file", file, nvrs]
return True
Nothing -> do
-- FIXME also query for open existing bugs
changelog <- if isJust mreview
then getSummaryURL spec
else
if usechangelog
then cleanChangelog spec
else
-- FIXME list open bugs
changeLogPrompt True spec
if trim (lower changelog) `elem` ["no","n"]
then return False
else do
when (length changelog > 10000) $
putStrLn "Bodhi only accepts up to 10000 chars: will be truncated"
let cbugs = extractBugReferences changelog
bugs =
let bids = [show rev | Just rev <- [mreview]] ++ cbugs in
if null bids
then []
else ["--bugs", intercalate "," bids]
when (isJust mreview &&
updateType `elem` [SecurityUpdate,BugfixUpdate]) $
warning "overriding update type with 'newpackage'"
putStrLn $ "Creating Bodhi Update for" +-+ nvrs ++ ":"
-- FIXME check for Bodhi URL to confirm update
-- FIXME returns json error string if it exists:
-- {"status": "error", "errors": [{"location": "body", "name": "builds", "description": "Update for ghc9.2-9.2.5-14.fc36 already exists"}]}
cmd_ "bodhi" $ ["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--severity", show severity, "--request", "testing", "--notes", take 10000 changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvrs]
return True
when updatedone $ do
-- FIXME avoid this if we know the update URLs (split update does not seem to return URLs)
updates <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" nvrs]
if null updates
then do
putStrLn $ "bodhi submission failed for" +-+ nvrs
promptEnter "Press Enter to resubmit to Bodhi"
bodhiUpdate dryrun (mupdate,severity) mreview usechangelog spec nvrs
else
forM_ updates $ \update ->
case lookupKey "url" update of
Nothing -> error' "Update created but no url"
Just uri -> putStrLn uri
where
extractBugReferences :: String -> [String]
extractBugReferences clog =
case dropWhile (/= '#') clog of
"" -> []
rest ->
case span isDigit (tail rest) of
(ds,more) ->
-- make sure is contemporary 7-digit bug
(if length ds > 6 then (ds :) else id) $
extractBugReferences more
maybeTemplate :: UpdateType -> IO (Maybe FilePath)
maybeTemplate TemplateUpdate = do
file <- promptNonEmpty "Please input the update template filepath"
exists <- doesFileExist file
if exists
then return $ Just file
else do
putStrLn ("no such file:" +-+ file)
maybeTemplate TemplateUpdate
maybeTemplate _ = return Nothing
bodhiBuildExists :: String -> IO Bool
bodhiBuildExists nvr = do
obj <- bodhiBuild nvr
return $ isNothing (lookupKey "status" obj :: Maybe String)