Build.hs

{-# LANGUAGE OverloadedStrings #-}

module Cmd.Build (
  buildCmd,
  BuildOpts(..)
  ) where

import SimplePrompt (promptEnter, yesNo)

import Common
import Common.System

import Bodhi
import Bugzilla
import Branches
import Cmd.Merge
import Git
import Krb
import Koji
import Package
import RpmBuild (checkSourcesMatch)
import Types

data BuildOpts = BuildOpts
  { buildoptMerge :: Maybe Bool
  , buildoptNoFailFast :: Bool
  , buildoptSidetagTarget :: Maybe SideTagTarget
  , buildoptOverride :: Maybe Int
  , buildoptWaitrepo :: Maybe Bool
  , buildoptDryrun :: Bool
  , buildoptSkipFetch :: Bool
  , buildoptUpdate :: (Maybe UpdateType, UpdateSeverity)
  , buildoptUseChangelog :: Bool
  , buildoptByPackage :: Bool
  , buildoptAllowDirty :: Bool
  }

-- FIXME --yes
-- FIXME merge --from
-- FIXME check bugs before building?
-- FIXME --sidetag
-- FIXME --sort
-- FIXME --add-to-update nvr
-- FIXME --rpmlint (default for rawhide?)
-- FIXME support --wait-build=NVR
-- FIXME build from ref
-- FIXME tail of failed build.log
-- FIXME --auto-override for deps in testing
-- FIXME -B fails to find new branches (fixed?)
-- FIXME disallow override for autoupdate?
-- FIXME --scratch build first
buildCmd :: BuildOpts -> (BranchesReq, [String]) -> IO ()
buildCmd opts (breq, pkgs) = do
  let singleBrnch = if isJust (buildoptSidetagTarget opts)
                    then ZeroOrOne
                    else AnyNumber
      mlastOfPkgs = if length pkgs > 1
                    then Just (Package (last pkgs))
                    else Nothing
      gitopts
        | buildoptAllowDirty opts = dirtyGitActive
        | buildoptSkipFetch opts = cleanGitActive
        | otherwise = cleanGitFetchActive
  if not (buildoptByPackage opts) && breq /= Branches [] && length pkgs > 1
    then do
    brs <- listOfBranches True True breq
    forM_ brs $ \br ->
      withPackagesByBranches HeaderMay True gitopts singleBrnch (buildBranch mlastOfPkgs opts) (Branches [br], pkgs)
    else
    withPackagesByBranches HeaderMay True gitopts singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs)

-- FIXME what if untracked files
buildBranch :: Maybe Package -> BuildOpts -> Package -> AnyBranch -> IO ()
buildBranch _ _ _ (OtherBranch _) =
  error' "build only defined for release branches"
buildBranch mlastpkg opts pkg rbr@(RelBranch br) = do
  let moverride = buildoptOverride opts
  whenJust moverride $ \days ->
    when (days < 1) $ error "override duration must be positive number of days"
  gitSwitchBranch rbr
  gitMergeOrigin br
  newrepo <- initialPkgRepo
  tty <- isTty
  (ancestor,unmerged,mnewer) <- newerMergeable br
  -- FIXME if already built or failed, also offer merge
  merged <-
    case buildoptMerge opts of
      Just False -> return False
      Just True -> do
        whenJust mnewer $ \newer ->
          mergeBranch (buildoptDryrun opts) True True False Nothing (ancestor,unmerged) newer br
        return True
      Nothing ->
        if ancestor && (newrepo || tty)
        then do
          whenJust mnewer $ \newer ->
            mergeBranch (buildoptDryrun opts) True False True Nothing (ancestor,unmerged) newer br
          return $ isJust mnewer
        else do
          unless (br == Rawhide) $
            whenJust mnewer $ \newer ->
            putStrLn $ show newer +-+ "branch not mergeable"
          return False
  let spec = packageSpec pkg
  checkForSpecFile spec
  checkSourcesMatch spec
  unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD"
  nvr <- pkgNameVerRel' br spec
  putNewLn
  mpush <-
    if null unpushed
    then return Nothing
    else do
      when (not merged || br == Rawhide) $ do
        putStrLn $ nvr ++ "\n"
        putStrLn "Local commits:"
        displayCommits True unpushed
        putNewLn
      -- see mergeBranch for: unmerged == 1 (774b5890)
      if tty && (not merged || (newrepo && ancestor && length unmerged == 1))
        then refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "")
        else return $ Just $ commitRef $ head unpushed
  let dryrun = buildoptDryrun opts
  buildstatus <- maybeTimeout 30 $ kojiBuildStatus nvr
  let msidetagTarget = buildoptSidetagTarget opts
      mwaitrepo = buildoptWaitrepo opts
  target <- targetMaybeSidetag dryrun br msidetagTarget
  case buildstatus of
    Just BuildComplete -> do
      putStrLn $ nvr +-+ "is already built"
      when (isJust mpush) $
        error' "Please bump the spec file"
      when (br /= Rawhide && isNothing msidetagTarget) $ do
        updateExists <- maybeTimeout 30 $ bodhiBuildExists nvr
        autoupdate <- checkAutoBodhiUpdate br
        -- FIXME update referenced bugs for autoupdate branch
        unless autoupdate $ do
          if updateExists
            then putStrLn "update exists"
            else do
            mbug <- bzReviewAnon
            bodhiUpdate dryrun (buildoptUpdate opts) mbug (buildoptUseChangelog opts) spec nvr
          tags <- maybeTimeout 30 $ kojiNVRTags nvr
          unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $
            whenJust moverride $ \days ->
            bodhiCreateOverride dryrun (Just days) nvr
        when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $
          when ((isJust moverride && mwaitrepo /= Just False) ||
                (autoupdate && mwaitrepo == Just True)) $
            kojiWaitRepo dryrun True True target nvr
    Just BuildBuilding -> do
      putStrLn $ nvr +-+ "is already building"
      when (isJust mpush) $
        error' "Please bump the spec file"
      whenJustM (kojiGetBuildTaskID fedoraHub nvr) kojiWatchTask
      -- FIXME do override
    _ -> do
      mbuildref <-
        case mpush of
          Nothing -> Just <$> git "show-ref" ["--hash", "origin/" ++ show br]
          _ -> return mpush
      opentasks <- kojiOpenTasks pkg mbuildref target
      case opentasks of
        [task] -> do
          putStrLn $ nvr +-+ "task" +-+ displayID task +-+ "is already open"
          when (isJust mpush) $
            error' "Please bump the spec file"
          kojiWatchTask task
        (_:_) -> error' $ show (length opentasks) +-+ "open" +-+ unPackage pkg +-+ "tasks already!"
        [] -> do
          let tag =
                if target == branchTarget br then branchDestTag br else target
          mlatest <- kojiLatestNVR tag $ unPackage pkg
          if equivNVR nvr (fromMaybe "" mlatest)
            then putStrLn $ nvr +-+ "is already latest" +-+ if Just nvr /= mlatest then "(modulo disttag)" else ""
            else do
            when (null unpushed || merged && br /= Rawhide) $ do
              putStrLn $ nvr ++ "\n"
            firstBuild <- do
              mtestingRepo <- bodhiTestingRepo br
              case mtestingRepo of
                Nothing -> return $ isNothing mlatest
                Just testing -> do
                  mnewest <- kojiLatestNVR testing $ unPackage pkg
                  case mnewest of
                    Nothing -> return $ isNothing mlatest
                    Just newest -> do
                      newestTags <- kojiNVRTags newest
                      unless (any (`elem` newestTags) [show br, show br ++ "-updates", show br ++ "-updates-pending"]) $ do
                        -- FIXME print how many days left
                        putStrLn $ "Warning:" +-+ newest +-+ "still in testing?"
                        promptEnter "Press Enter to continue"
                      return False
            unless dryrun krbTicket
            whenJust mpush $ \ref ->
              unless dryrun $
              gitPush False $ Just $ ref ++ ":" ++ show br
            unlessM (null <$> gitOneLineLog ("origin/" ++ show br ++ "..HEAD")) $
              unless dryrun $ do
              ok <- yesNo "Unpushed changes remain, continue"
              unless ok $ error' "aborted"
            unless (buildoptAllowDirty opts) $
              unlessM isGitDirClean $
              error' "local changes remain (dirty)"
            -- FIXME parse build output
            unless dryrun $
              kojiBuildBranch target pkg mbuildref ["--fail-fast" | not (buildoptNoFailFast opts)]
            mBugSess <-
              if firstBuild && isJust (fst (buildoptUpdate opts))
              then bzReviewSession
              else return Nothing
            autoupdate <- checkAutoBodhiUpdate br
            if autoupdate
              then whenJust mBugSess $
                   \ (bid,session) -> putBugBuild dryrun session bid nvr
              else do
              when (isNothing msidetagTarget) $ do
                whenJust (fmap fst mBugSess) $
                  \bid -> putStr "review bug: " >> putBugId bid
                -- FIXME diff previous changelog?
                bodhiUpdate dryrun (buildoptUpdate opts) (fmap fst mBugSess) (buildoptUseChangelog opts) spec nvr
                -- FIXME prompt for override note
                whenJust moverride $ \days ->
                  bodhiCreateOverride dryrun (Just days) nvr
            when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $
              when ((isJust moverride && mwaitrepo /= Just False) ||
                    (autoupdate && mwaitrepo == Just True)) $
              kojiWaitRepo dryrun True True target nvr