fbrnch-1.3.3: src/Cmd/Import.hs
{-# LANGUAGE OverloadedStrings #-}
module Cmd.Import (importCmd) where
import Common
import Common.System
import qualified Common.Text as T
import Network.URI
import SimplePrompt (promptEnter)
import Branches
import Bugzilla
import Cmd.RequestBranch (requestPkgBranches)
import Git
import Koji
import Krb
import ListReviews
import Package
-- FIXME separate pre-checked listReviews and direct pkg call, which needs checks
-- FIXME add --dryrun
importCmd :: Bool -> (BranchesReq,[String]) -> IO ()
importCmd mock (breq, ps) = do
pkgs <- if null ps
then map reviewBugToPackage <$> listReviews ReviewRepoCreated
else return ps
mapM_ importPkg pkgs
where
-- FIXME check not in a different git dir
importPkg :: String -> IO ()
importPkg pkg = do
putPkgHdr (Package pkg)
dir <- getCurrentDirectory
when (pkg /= takeFileName dir) $ do
-- FIXME check git repo exists
clonePkg True UserClone Nothing pkg
putNewLn
setCurrentDirectory pkg
-- FIXME: check branch is rawhide
unlessM isGitRepo $ error' "Not a git repo"
newrepo <- initialPkgRepo
if not newrepo
then putStrLn "Skipping: already imported"
else do
checkWorkingDirClean
-- FIXME get session from importPkgs
(bid,session) <- approvedReviewBugIdSession pkg
putBugId bid
putNewLn
comments <- getComments session bid
mapM_ showComment comments
putNewLn
putStr "Review bug: "
putBugId bid
putNewLn
promptEnter "Press Enter to continue"
let srpms = map (T.replace "/reviews//" "/reviews/") $ concatMap findSRPMs comments
mapM_ T.putStrLn srpms
case (filter (".src.rpm" `isSuffixOf`) . words . T.unpack . last) srpms of
[] -> error' "no srpm filename found"
srcrpms ->
case filter (isURI . maybeEncodeURI) srcrpms of
[] -> error "no valid srpm urls found"
[srpmurl] -> do
let srpmfile = takeFileName srpmurl
-- FIXME if havesrpm then print local filename
promptEnter $ "Press Enter to import" +-+ srpmfile
havesrpm <- doesFileExist srpmfile
unless havesrpm $
cmd_ "curl" ["--silent", "--show-error", "--remote-name", srpmurl]
krbTicket
fedpkg_ "import" [srpmfile]
git_ "commit" ["--message", "import rhbz#" ++ show bid]
nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec")
promptEnter $ "Press Enter to push and build" +-+ nvr
gitPush True Nothing
-- FIXME build more branches
kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"]
putBugBuild False session bid nvr
existing <- fedoraBranchesNoRawhide (localBranches False)
when (null existing) $ do
brs <- getRequestedBranches [] breq
requestPkgBranches False False mock (Branches brs) (Package pkg)
srpmurls -> error' $ "multiple srpm urls:" +-+ unwords srpmurls
when (pkg /= takeFileName dir) $
setCurrentDirectory dir
where
findSRPMs :: Comment -> [T.Text]
findSRPMs =
filter (\ l -> "https://" `T.isInfixOf` l && any (`T.isPrefixOf` T.toLower l) ["srpm url:", "srpm:", "new srpm:", "updated srpm:"] && ".src.rpm" `T.isSuffixOf` l) . T.lines . commentText
maybeEncodeURI cs =
if '%' `elem` cs
then cs
else escapeURIString isUnescapedInURI cs