{-# LANGUAGE CPP #-}

-- SPDX-License-Identifier: BSD-3-Clause

module Main (main) where

import Control.Monad.Extra
import Data.Char
import Data.List.Extra
import Data.Maybe
import Data.RPM
import Distribution.Koji
import qualified Distribution.Koji.API as Koji
import Network.HTTP.Directory (httpFileSize', httpLastModified', (+/+))
import SimpleCmd
import SimpleCmdArgs
import System.Directory
import System.FilePath
import System.FilePath.Glob
import System.IO

import DownloadDir
import Paths_koji_install (version)

-- mbox kojihub is locked
knownHubs :: [String]
knownHubs = ["fedora","stream","rpmfusion", "or URL"]

hubURL :: String -> String
hubURL "fedora" = fedoraKojiHub
-- later use centosKojiHub
hubURL "stream" = "https://kojihub.stream.centos.org/kojihub"
--hubURL "mbox" = "https://koji.mbox.centos.org/kojihub"
hubURL "rpmfusion" = "https://koji.rpmfusion.org/kojihub"
hubURL "fusion" = "https://koji.rpmfusion.org/kojihub"
hubURL hub =
  if "http" `isPrefixOf` hub
  then hub
  else error' $ "unknown hub: try " ++ show knownHubs

defaultPkgsURL :: String -> String
defaultPkgsURL url =
  case dropSuffix "/" url of
    "https://koji.fedoraproject.org/kojihub" ->
      "https://kojipkgs.fedoraproject.org/packages"
    "https://kojihub.stream.centos.org/kojihub" ->
      "https://kojihub.stream.centos.org/kojifiles/packages"
    _ ->
      if "kojihub" `isSuffixOf` url
      then replace "kojihub" "kojifiles" url +/+ "packages"
      else error' $ "use --files-url to specify kojifiles url for " ++ url

data Mode = All
          | Ask
          -- distinguish except and exclude
          | PkgsReq [String] [String] -- ^ include, except/exclude
  deriving Eq

data Request = ReqName | ReqNV | ReqNVR
  deriving Eq

-- FIXME --include devel, --exclude *
-- FIXME specify tag or task
-- FIXME support enterprise builds
-- FIXME --arch (including src)
-- FIXME --debuginfo
-- FIXME --delete after installing
main :: IO ()
main = do
  sysdisttag <- do
    dist <- cmd "rpm" ["--eval", "%{dist}"]
    return $ if dist == "%{dist}" then "" else dist
  simpleCmdArgs (Just Paths_koji_install.version)
    "Download and install latest package build from Koji tag."
    ("HUB = " ++ intercalate ", " knownHubs) $
    program
    <$> switchWith 'n' "dry-run" "Don't actually download anything"
    <*> switchWith 'D' "debug" "More detailed output"
    <*> optional (strOptionWith 'H' "hub" "HUB"
                  "KojiHub shortname or url [default: fedora]")
    <*> optional (strOptionWith 'P' "packages-url" "URL"
                  "KojiFiles packages url [default: Fedora]")
    <*> switchWith 'l' "list" "List builds"
    <*> modeOpt
    <*> disttagOpt sysdisttag
    <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name"
         <|> flagWith ReqName ReqNVR 'V' "nv" "Give an N-V instead of package name")
    <*> some (strArg "PKG|NVR|TASKID...")
  where
    modeOpt :: Parser Mode
    modeOpt =
      flagWith' All 'a' "all" "all subpackages" <|>
      flagWith' Ask 'A' "ask" "ask for each subpackge [default if not installed]" <|>
      pkgsReqOpts

    pkgsReqOpts = PkgsReq
      <$> many (strOptionWith 'p' "package" "SUBPKG" "Subpackage (glob) to install") <*> many (strOptionWith 'x' "exclude" "SUBPKG" "Subpackage (glob) not to install")

    disttagOpt :: String -> Parser String
    disttagOpt disttag = startingDot <$> strOptionalWith 'd' "disttag" "DISTTAG" ("Use a different disttag [default: " ++ disttag ++ "]") disttag

    startingDot cs =
      case cs of
        "" -> error' "empty disttag"
        (c:_) -> if c == '.' then cs else '.' : cs

program :: Bool -> Bool -> Maybe String -> Maybe String -> Bool -> Mode
        -> String -> Request -> [String] -> IO ()
program dryrun debug mhuburl mpkgsurl listmode mode disttag request pkgbldtsks = do
  let huburl = maybe fedoraKojiHub hubURL mhuburl
      pkgsurl = fromMaybe (defaultPkgsURL huburl) mpkgsurl
  when debug $ do
    putStrLn huburl
    putStrLn pkgsurl
  -- FIXME use this location?
  dlDir <- setDownloadDir dryrun "rpms"
  when debug $ putStrLn dlDir
  setNoBuffering
  mapM (kojiRPMs huburl pkgsurl dlDir) pkgbldtsks
    >>= if listmode
        then mapM_ putStrLn . mconcat
        else installRPMs dryrun . mconcat
  where
    kojiRPMs :: String -> String -> String -> String -> IO [String] -- ([String],String)
    kojiRPMs huburl pkgsurl dlDir bldtask =
      if all isDigit bldtask
      then kojiTaskRPMs dryrun debug huburl pkgsurl listmode mode dlDir bldtask
      else kojiBuildRPMs huburl pkgsurl dlDir bldtask

    kojiBuildRPMs :: String -> String -> String -> String -> IO [String]
    kojiBuildRPMs huburl pkgsurl dlDir pkgbld = do
      nvrs <- kojiBuildOSBuilds debug huburl listmode disttag request pkgbld
      if listmode
        then if mode /= PkgsReq [] []
             then error' "modes not supported for listing build"
             else return nvrs
        else
        case nvrs of
          [] -> error' $ pkgbld ++ " not found for " ++ disttag
          [nvr] -> do
            putStrLn $ nvr ++ "\n"
            allRpms <- map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr
            when debug $ print allRpms
            dlRpms <- decideRpms listmode mode (maybeNVRName nvr) allRpms
            when debug $ print dlRpms
            unless (dryrun || null dlRpms) $ do
              mapM_ (downloadBuildRpm debug pkgsurl (readNVR nvr)) dlRpms
              -- FIXME once we check file size - can skip if no downloads
              putStrLn $ "Packages downloaded to " ++ dlDir
            return dlRpms
          _ -> error $ "multiple build founds for " ++ pkgbld ++ ": " ++
               unwords nvrs

    debugPkg :: String -> Bool
    debugPkg p = "-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p

kojiTaskRPMs :: Bool -> Bool -> String -> String -> Bool -> Mode -> String
             -> String -> IO [String]
kojiTaskRPMs dryrun debug huburl pkgsurl listmode mode dlDir task = do
  let taskid = read task
  if listmode
    then do
    mtaskinfo <- Koji.getTaskInfo huburl taskid True
    case mtaskinfo of
      Just taskinfo -> do
        when debug $ mapM_ print taskinfo
        if isNothing (lookupStruct "parent" taskinfo :: Maybe Int)
          then do
          children <- Koji.getTaskChildren huburl taskid False
          return $ fromMaybe "" (showTask taskinfo) : mapMaybe showChildTask children
          else getTaskRPMs taskid >>= decideRpms listmode mode Nothing
      Nothing -> error' "failed to get taskinfo"
    else do
    rpms <- getTaskRPMs taskid
    if null rpms
      then do
      kojiTaskRPMs dryrun debug huburl pkgsurl True mode dlDir task >>= mapM_ putStrLn
      return []
      else do
      when debug $ print rpms
      let srpm =
            case filter (".src.rpm" `isExtensionOf`) rpms of
              [src] -> src
              _ -> error' "could not determine nvr from any srpm"
          nvr = dropSuffix ".src.rpm" srpm
      dlRpms <- decideRpms listmode mode (maybeNVRName nvr) $ rpms \\ [srpm]
      when debug $ print dlRpms
      unless (dryrun || null dlRpms) $ do
        mapM_ (downloadTaskRpm debug pkgsurl task) dlRpms
        putStrLn $ "Packages downloaded to " ++ dlDir
      return dlRpms
  where
    getTaskRPMs :: Int -> IO [String]
    getTaskRPMs taskid =
       sort . filter (".rpm" `isExtensionOf`) . map fst <$>
       Koji.listTaskOutput huburl taskid False True False

maybeNVRName :: String -> Maybe String
maybeNVRName = fmap nvrName . maybeNVR

decideRpms :: Bool -> Mode -> Maybe String -> [String] -> IO [String]
decideRpms listmode mode mbase allRpms =
  case mode of
    All -> if listmode
           then error' "cannot use --list and --all together"
           else return allRpms
    Ask -> if listmode
           then error' "cannot use --list and --ask together"
           else mapMaybeM rpmPrompt allRpms
    PkgsReq [] [] ->
      if listmode
      then return allRpms
      else do
      rpms <- filterM (isInstalled . nvraName) $
              filter isBinaryRpm allRpms
      if null rpms
        then decideRpms listmode Ask mbase allRpms
        else return rpms
    PkgsReq subpkgs exclpkgs ->
      return $ selectRPMs mbase (subpkgs,exclpkgs) allRpms

isInstalled :: String -> IO Bool
isInstalled rpm = cmdBool "rpm" ["--quiet", "-q", rpm]

selectRPMs :: Maybe String -> ([String],[String])  -> [String] -> [String]
selectRPMs mbase (subpkgs,[]) rpms =
  sort . mconcat $
  flip map subpkgs $ \ pkgpat ->
  case filter (match (compile pkgpat) . nvraName) rpms of
    [] -> case mbase of
      Just base | head pkgpat /= '*' ->
                  selectRPMs Nothing ([base ++ '-' : pkgpat],[]) rpms
      _ -> error' $ "no subpackage match for " ++ pkgpat
    result -> result
selectRPMs mbase ([], subpkgs) rpms =
  -- FIXME somehow determine unused excludes
  foldl' (exclude subpkgs) [] rpms
  where
    exclude :: [String] -> [String] -> String -> [String]
    exclude [] acc rpm = acc ++ [rpm]
    exclude (pat:pats) acc rpm =
        if checkMatch (nvraName rpm)
        then acc
        else exclude pats acc rpm
      where
        checkMatch :: String -> Bool
        checkMatch rpmname =
          let comppat = compile pat
          in if isLiteral comppat
             then pat == rpmname ||
                  maybe False (\b -> (b ++ '-' : pat) == rpmname) mbase
             else match comppat rpmname
selectRPMs mbase (subpkgs,exclpkgs) rpms =
  let needed = selectRPMs mbase (subpkgs,[]) rpms
      excluded = selectRPMs mbase ([], exclpkgs) rpms
  in nub . sort $ needed ++ excluded

nvraName :: String -> String
nvraName = rpmName . readNVRA

rpmPrompt :: String -> IO (Maybe String)
rpmPrompt rpm = do
  putStr $ rpm ++ " [y/n]: "
  c <- getChar
  putStrLn ""
  case toLower c of
    'y' -> return $ Just rpm
    'n' -> return Nothing
    _ -> rpmPrompt rpm

kojiBuildOSBuilds :: Bool -> String -> Bool -> String -> Request -> String
                  -> IO [String]
kojiBuildOSBuilds debug hub listmode disttag request pkgpat = do
  let (pkg,full) = packageOfPattern pkgpat
      oldkoji = "rpmfusion" `isInfixOf` hub
  when (oldkoji && ("*" `isInfixOf` pkgpat || request /= ReqName)) $
    error' "cannot use pattern with this kojihub"
  mpkgid <- Koji.getPackageID hub pkg
  case mpkgid of
    Nothing -> error $ "package not found: " ++ pkg
    Just pkgid -> do
      -- strictly should getAPIVersion
      let opts = (if oldkoji
                  then id
                  else (("pattern", ValueString (if full then pkgpat else dropSuffix "*" pkgpat ++ "*" ++ disttag ++ "*")) :))
                 [("packageID", ValueInt pkgid),
                  ("state", ValueInt (fromEnum BuildComplete)),
                  ("queryOpts",ValueStruct
                    [("limit",ValueInt $ if listmode || oldkoji then 10 else 1),
                     ("order",ValueString "-build_id")])]
      when debug $ print opts
      nvrs <- mapMaybe (lookupStruct "nvr") <$> Koji.listBuilds hub opts
      if null nvrs
        then error' $ "no builds found for " ++ disttag
        else
        return $
        if oldkoji
        then case filter (disttag `isInfixOf`) nvrs of
               [] -> error' $ "no builds found for " ++ disttag
               [res] -> [res]
               rs@(r:_) ->
                 if listmode then rs else [r]
        else nvrs
  where
    packageOfPattern :: String -> (String, Bool)
    packageOfPattern pat =
      case request of
        ReqName -> (dropSuffix "-" $ takeWhile (/= '*') pat, False)
        ReqNV ->
          case readNV pat of
            NV n _ -> (n, False)
        ReqNVR ->
          case readNVR pat of
            NVR n _ -> (n, True)

kojiGetBuildRPMs :: String -> String -> IO [String]
kojiGetBuildRPMs huburl nvr = do
  mbid <- kojiGetBuildID huburl nvr
  case mbid of
    Nothing -> error $ "Build id not found for " ++ nvr
    Just (BuildId bid) -> do
      rpms <- Koji.listBuildRPMs huburl bid
      sysarch <- cmd "rpm" ["--eval", "%{_arch}"]
      return $ map getNVRA $ filter (forArch sysarch) rpms
   where
     forArch :: String -> Struct -> Bool
     forArch sysarch st =
       case lookupStruct "arch" st of
         Just arch -> arch `elem` [sysarch, "noarch"]
         Nothing -> error $ "No arch found for rpm for: " ++ nvr

     getNVRA :: Struct -> String
     getNVRA st =
       case lookupStruct "nvr" st of
         Nothing -> error' "NVR not found"
         Just pnvr ->
           case lookupStruct "arch" st of
             Nothing -> error "arch not found"
             Just arch ->
               pnvr <.> arch

setNoBuffering :: IO ()
setNoBuffering = do
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering

installRPMs :: Bool -> [FilePath] -> IO ()
installRPMs _ [] = return ()
installRPMs dryrun rpms = do
  installed <- filterM (isInstalled . dropExtension) rpms
  unless (null installed) $
    if dryrun
    then mapM_ putStrLn $ "would update:" : installed
    else sudo_ "dnf" ("reinstall" : installed)
  let rest = rpms \\ installed
  unless (null rest) $
    if dryrun
    then mapM_ putStrLn $ "would install:" : rest
    else sudo_ "dnf" ("localinstall" : rest)

downloadBuildRpm :: Bool -> String -> NVR -> String -> IO ()
downloadBuildRpm debug pkgsurl (NVR n (VerRel v r)) rpm = do
  let arch = rpmArch (readNVRA rpm)
      url = pkgsurl +/+ n  +/+ v +/+ r +/+ arch +/+ rpm
  downloadRPM debug url

downloadTaskRpm :: Bool -> String -> String -> String -> IO ()
downloadTaskRpm debug pkgsurl taskid rpm = do
  let url = dropSuffix "packages" pkgsurl +/+ "work/tasks/" ++ lastFew +/+ taskid +/+ rpm
  downloadRPM debug url
  where
    lastFew =
      let few = dropWhile (== '0') $ takeEnd 4 taskid in
        if null few then "0" else few

-- FIXME check file size
-- FIXME check timestamp
downloadRPM :: Bool -> String -> IO ()
downloadRPM debug url = do
  let rpm = takeFileName url
  exists <- doesFileExist rpm
  notfile <-
    if exists
    then do
      old <- outOfDate rpm
      when old $ removeFile rpm
      return old
    else return True
  when notfile $ do
    putStrLn $ "Downloading " ++ if debug then url else rpm
    cmd_ "curl" ["--remote-time", "--fail", "--silent", "-C-", "--show-error", "--remote-name", url]
  where
    outOfDate :: String -> IO Bool
    outOfDate file = do
      mremotetime <- httpLastModified' url
      case mremotetime of
        Just remotetime -> do
          localtime <- getModificationTime file
          return $ localtime < remotetime
        Nothing -> do
          remotesize <- httpFileSize' url
          localsize <- getFileSize file
          return $ remotesize /= Just localsize

showTask :: Struct -> Maybe String
showTask struct = do
  state <- getTaskState struct
  request <- lookupStruct "request" struct
  method <- lookupStruct "method" struct
  let mparent = lookupStruct "parent" struct :: Maybe Int
      showreq = takeWhileEnd (/= '/') . unwords . mapMaybe getString . take 3
  return $ showreq request +-+ method +-+ (if state == TaskClosed then "" else show state) +-+ maybe "" (\p -> "(" ++ show p ++ ")") mparent

showChildTask :: Struct -> Maybe String
showChildTask struct = do
  arch <- lookupStruct "arch" struct
  state <- getTaskState struct
  method <- lookupStruct "method" struct
  taskid <- lookupStruct "id" struct
  return $ arch ++ replicate (8 - length arch) ' ' +-+ show (taskid :: Int) +-+ method +-+ show state

isBinaryRpm :: FilePath -> Bool
isBinaryRpm file =
  ".rpm" `isExtensionOf` file && not (".src.rpm" `isExtensionOf` file)

#if !MIN_VERSION_filepath(1,4,2)
isExtensionOf :: String -> FilePath -> Bool
isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
#endif