{-# LANGUAGE CPP #-}

#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Monad (when, unless)

import qualified Data.ByteString.Char8 as B
import Data.Char (isDigit, toLower, toUpper)
import Data.List
import Data.Maybe
import Data.Semigroup ((<>))
import qualified Data.Text as T

import Network.HTTP.Directory

import Options.Applicative (fullDesc, header, progDescDoc)
import qualified Options.Applicative.Help.Pretty as P

import Paths_dl_fedora (version)

import SimpleCmd (cmd_, error', grep_, pipe_, pipeBool, pipeFile_)
import SimpleCmdArgs

import System.Directory (createDirectoryIfMissing, doesDirectoryExist,
                         doesFileExist, getPermissions, removeFile,
                         setCurrentDirectory, writable)
import System.Environment.XDG.UserDir (getUserDir)
import System.FilePath (joinPath, takeExtension, takeFileName, (<.>))
import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus,
                           readSymbolicLink)

import Text.Read
import qualified Text.ParserCombinators.ReadP as R
import qualified Text.ParserCombinators.ReadPrec as RP
import Text.Regex.Posix

{-# ANN module "HLint: ignore Use camelCase" #-}
data FedoraEdition = Cloud
                   | Container
                   | Everything
                   | Server
                   | Silverblue
                   | Workstation
                   | Cinnamon
                   | KDE
                   | LXDE
                   | LXQt
                   | MATE_Compiz
                   | Soas
                   | Xfce
 deriving (Show, Enum, Bounded, Eq)

instance Read FedoraEdition where
  readPrec = do
    s <- look
    let e = map toLower s
        editionMap =
          map (\ ed -> (map toLower (show ed), ed)) [minBound..maxBound]
        res = lookup e editionMap
    case res of
      Nothing -> error' "unknown edition" >> RP.pfail
      Just ed -> RP.lift (R.string e) >> return ed

fedoraSpins :: [FedoraEdition]
fedoraSpins = [Cinnamon ..]

main :: IO ()
main = do
  let pdoc = Just $ P.text "Tool for downloading Fedora iso file images."
             P.<$$> P.text ("RELEASE = " <> intercalate ", " ["rawhide", "devel", "respin", "test", "or Release version"])
             P.<$$> P.text "EDITION = " <> P.lbrace <> P.align (P.fillCat (P.punctuate P.comma (map (P.text . map toLower . show) [(minBound :: FedoraEdition)..maxBound])) <> P.rbrace)
             P.<$$> P.text "See also <https://fedoramagazine.org/verify-fedora-iso-file>."
  simpleCmdArgsWithMods (Just version) (fullDesc <> header "Fedora iso downloader" <> progDescDoc pdoc) $
    findISO
    <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file"
    <*> switchWith 'C' "no-checksum" "Do not check checksum"
    <*> switchWith 'n' "dry-run" "Don't actually download anything"
    <*> optional (strOptionWith 'm' "mirror" "HOST" "default https://download.fedoraproject.org")
    <*> strOptionalWith 'a' "arch" "ARCH" "architecture (default x86_64)" "x86_64"
    <*> optionalWith auto 'e' "edition" "EDITION" "Fedora edition: workstation [default]" Workstation
    <*> strArg "RELEASE"

findISO :: Bool -> Bool -> Bool -> Maybe String -> String -> FedoraEdition -> String -> IO ()
findISO gpg nochecksum dryrun mhost arch edition tgtrel = do
  (fileurl, prefix, remotesize, mchecksum) <- findURL
  dlDir <- getUserDir "DOWNLOAD"
  if dryrun
    then do
    dirExists <- doesDirectoryExist dlDir
    when dirExists $ setCurrentDirectory dlDir
    else do
    createDirectoryIfMissing False dlDir
    setCurrentDirectory dlDir
  let localfile = takeFileName fileurl
      symlink = dlDir </> prefix <> "-latest" <.> takeExtension fileurl
  done <- downloadFile fileurl remotesize localfile
  when (done && not nochecksum) $ fileChecksum mchecksum
  updateSymlink localfile symlink
  where
    -- (top,path,mfile)
    urlPath :: (String,String,Maybe String)
    urlPath =
      if tgtrel == "respin"
      then ("", "",
            Just ("F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64"))
      else
      let dirpath =
            case tgtrel of
              "rawhide" -> "development"
              "devel" -> "development"
              "test" -> "releases/test"
              rel | all isDigit rel -> "releases"
              _ -> error' "Unknown release"
          -- dirglob = tgtrel `elem` ["devel","test"]
      in ("linux" </> dirpath,
          if edition `elem` fedoraSpins
          then joinPath ["Spins", arch, "iso"]
          else joinPath [show edition, arch, editionMedia edition],
          Nothing)

    -- url, fileprefix, size, checksum
    findURL :: IO (String, String, Maybe Integer, Maybe String)
    findURL = do
      mgr <- httpManager
      let (top,path,mprefix) = urlPath
      topurl <- if tgtrel == "respin"
                then return "https://dl.fedoraproject.org/pub/alt/live-respins/"
                else case mhost of
                       Just host -> return host
                       Nothing -> do
                         let dl = "https://download.fedoraproject.org/"
                         redirect <- httpRedirect mgr dl
                         case redirect of
                           Nothing -> error' $ dl <> " redirect to mirror failed"
                           Just u -> return $ B.unpack u </> top
      mreldir <-
        case tgtrel of
          "rawhide" -> return $ Just "rawhide"
          rel | all isDigit rel -> return $ Just rel
          "respin" -> return Nothing
          -- test and devel branch
          rel -> do
            -- use http-directory-0.1.6 removeTrailing
            rels <- map (T.unpack . T.dropWhileEnd (== '/')) <$> httpDirectory mgr topurl
            return $ listToMaybe $
                       case rels of
                         [] -> error' $ rel <> " release not found in " <> topurl
                         ["rawhide"] -> ["rawhide"]
                         _ -> delete "rawhide" rels
      -- http dirs Should end in "/" probably
      let finalUrl = topurl </> fromMaybe "" mreldir </> path <> "/"
      hrefs <- httpDirectory mgr finalUrl
      let prefixPat = fromMaybe (makeFilePrefix mreldir) mprefix
          selector = if '*' `elem` prefixPat then (=~ prefixPat) else (prefixPat `isPrefixOf`)
          mfile = listToMaybe $ filter selector $ map T.unpack hrefs
          mchecksum = listToMaybe $ filter ((if tgtrel == "respin" then T.isPrefixOf else T.isSuffixOf) (T.pack "CHECKSUM")) hrefs
      case mfile of
        Nothing ->
          error' $ "no match for " <> prefixPat <> " in " <> finalUrl
        Just file -> do
          let finalfile = finalUrl </> file
          putStrLn finalfile
          let prefix = if '*' `elem` prefixPat
                       then file =~ prefixPat
                       else prefixPat
          size <- httpFileSize mgr finalfile
          return (finalfile, prefix, size, (finalUrl </>) . T.unpack <$> mchecksum)
    makeFilePrefix :: Maybe String -> String
    makeFilePrefix mreldir =
      let showRel "rawhide" = "Rawhide"
          showRel r = if last r == '/' then init r else r
          rel = maybeToList (showRel <$> mreldir)
          middle =
            if edition `elem` [Cloud, Container]
            then rel ++ [".*" <> arch]
            else arch : rel
      in
      intercalate "-" (["Fedora", show edition, editionType edition] ++ middle)

    updateSymlink :: FilePath -> FilePath -> IO ()
    updateSymlink target symlink =
      unless dryrun $ do
      symExists <- doesFileExist symlink
      if symExists
        then do
        linktarget <- readSymbolicLink symlink
        when (linktarget /= target) $ do
            removeFile symlink
            createSymbolicLink target symlink
            putStrLn $ unwords [symlink, "->", target]
        else do
        createSymbolicLink target symlink
        putStrLn $ unwords [symlink, "->", target]

    downloadFile :: String -> Maybe Integer -> String -> IO Bool
    downloadFile url remotesize localfile = do
      exists <- doesFileExist localfile
      if exists
        then do
        localsize <- fileSize <$> getFileStatus localfile
        if Just (fromIntegral localsize) == remotesize
          then do
          putStrLn "File already fully downloaded"
          return True
          else do
          canwrite <- writable <$> getPermissions localfile
          unless canwrite $ error' "file does have write permission, aborting!"
          if dryrun then return False
            else do
            cmd_ "curl" ["-C", "-", "-O", url]
            return True
        else
        if dryrun then return False
        else do
          cmd_ "curl" ["-C", "-", "-O", url]
          return False

    fileChecksum :: Maybe FilePath -> IO ()
    fileChecksum mchecksum =
      case mchecksum of
        Nothing -> return ()
        Just url -> do
          let checksum = takeFileName url
          exists <- doesFileExist checksum
          putStrLn ""
          unless exists $
            cmd_ "curl" ["-C", "-", "-s", "-S", "-O", url]
          pgp <- grep_ "PGP" checksum
          when (gpg && pgp) $ do
            havekey <- checkForFedoraKeys
            unless havekey $ do
              putStrLn "Importing Fedora GPG keys:\n"
              -- https://fedoramagazine.org/verify-fedora-iso-file/
              pipe_ ("curl",["-s", "-S", "https://getfedora.org/static/fedora.gpg"]) ("gpg",["--import"])
              putStrLn ""
          chkgpg <- if pgp
            then checkForFedoraKeys
            else return False
          let shasum = if "CHECKSUM512" `isPrefixOf` checksum
                       then "sha512sum" else "sha256sum"
          if chkgpg then do
            putStrLn $ "Running gpg verify and " <> shasum <> ":"
            pipeFile_ checksum ("gpg",["-q"]) (shasum, ["-c", "--ignore-missing"])
            else do
            putStrLn $ "Running " <> shasum <> ":"
            cmd_ shasum ["-c", "--ignore-missing", checksum]

    checkForFedoraKeys :: IO Bool
    checkForFedoraKeys =
      pipeBool ("gpg",["--list-keys"]) ("grep", ["-q", " Fedora .*(" <> tgtrel <> ").*@fedoraproject.org>"])

editionType :: FedoraEdition -> String
editionType Server = "dvd"
editionType Silverblue = "ostree"
editionType Everything = "netinst"
editionType Cloud = "Base"
editionType Container = "Base"
editionType _ = "Live"

editionMedia :: FedoraEdition -> String
editionMedia Cloud = "images"
editionMedia Container = "images"
editionMedia _ = "iso"

liveRespin :: FedoraEdition -> String
liveRespin = take 4 . map toUpper . show

infixr 5 </>
(</>) :: String -> String -> String
"" </> s = s
s </> "" = s
s </> t | last s == '/' = init s </> t
        | head t == '/' = s </> tail t
s </> t = s <> "/" <> t