Build.hs

{-# LANGUAGE OverloadedStrings #-}

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

import Common
import Common.System

import Bodhi
import Bugzilla
import Branches
import Cmd.Merge
import Git
import Krb
import Koji
import Package
import SimplePrompt
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 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 --yes
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
                        putStrLn $ "Warning: " ++ newest ++ " still in testing?"
                        prompt_ "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 Nothing "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