    {-# LANGUAGE DeriveDataTypeable #-}

    module Propellor.Bootstrap (
            Bootstrapper(..),
            Builder(..),
            defaultBootstrapper,
            getBootstrapper,
            bootstrapPropellorCommand,
            checkBinaryCommand,
            installGitCommand,
            buildPropellor,
            checkDepsCommand,
            buildCommand,
    ) where

    import Propellor.Base
    import Propellor.Types.Info
    import Propellor.Git.Config

    import System.Posix.Files
    import Data.List

    type ShellCommand = String

    -- | Different ways that Propellor's dependencies can be installed,
    -- and propellor can be built. The default is `Robustly Cabal`
    --
    -- `Robustly Cabal` and `Robustly Stack` use the OS's native packages
    -- as much as possible to install Cabal, Stack, and propellor's build
    -- dependencies. When necessary, dependencies are built from source
    -- using Cabal or Stack rather than using the OS's native packages.
    --
    -- `OSOnly` uses the OS's native packages of Cabal and all of propellor's
    -- build dependencies. It may not work on all systems.
    data Bootstrapper = Robustly Builder | OSOnly
            deriving (Show, Typeable)

    data Builder = Cabal | Stack
            deriving (Show, Typeable)

    defaultBootstrapper :: Bootstrapper
    defaultBootstrapper = Robustly Cabal

    -- | Gets the Bootstrapper for the Host propellor is running on.
    getBootstrapper :: Propellor Bootstrapper
    getBootstrapper = go <$> askInfo
      where
            go NoInfoVal = defaultBootstrapper
            go (InfoVal bs) = bs

    getBuilder :: Bootstrapper -> Builder
    getBuilder (Robustly b) = b
    getBuilder OSOnly = Cabal

    -- Shell command line to ensure propellor is bootstrapped and ready to run.
    -- Should be run inside the propellor config dir, and will install
    -- all necessary build dependencies and build propellor.
    bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> ShellCommand
    bootstrapPropellorCommand bs msys = checkDepsCommand bs msys ++
            "&& if ! test -x ./propellor; then "
                    ++ buildCommand bs ++
            "; fi;" ++ checkBinaryCommand bs

    -- Use propellor --check to detect if the local propellor binary has
    -- stopped working (eg due to library changes), and must be rebuilt.
    checkBinaryCommand :: Bootstrapper -> ShellCommand
    checkBinaryCommand bs = "if test -x ./propellor && ! ./propellor --check; then " ++ go (getBuilder bs) ++ "; fi"
      where
            go Cabal = intercalate " && "
                    [ "cabal clean"
                    , buildCommand bs
                    ]
            go Stack = intercalate " && "
                    [ "stack clean"
                    , buildCommand bs
                    ]

    buildCommand :: Bootstrapper -> ShellCommand
    buildCommand bs = intercalate " && " (go (getBuilder bs))
      where
            go Cabal =
                    [ "cabal configure"
                    , "cabal build -j1 propellor-config"
                    , "ln -sf dist/build/propellor-config/propellor-config propellor"
                    ]
            go Stack =
                    [ "stack build :propellor-config"
                    , "ln -sf $(stack path --dist-dir)/build/propellor-config/propellor-config propellor"
                    ]

    -- Check if all dependencies are installed; if not, run the depsCommand.
    checkDepsCommand :: Bootstrapper -> Maybe System -> ShellCommand
    checkDepsCommand bs sys = go (getBuilder bs)
      where
            go Cabal = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"
            go Stack = "if ! stack build --dry-run >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"

    data Dep = Dep String | OldDep String

    -- Install build dependencies of propellor, using the specified
    -- Bootstrapper.
    --
    -- When bootstrapping Robustly, first try to install the builder,
    -- and all haskell libraries that propellor uses from OS packages.
    -- Some packages may not be available in some versions of the OS,
    -- or propellor may need a newer version. So, as a second step,
    -- ny other dependencies are installed from source using the builder.
    --
    -- Note: May succeed and leave some deps not installed.
    depsCommand :: Bootstrapper -> Maybe System -> ShellCommand
    depsCommand bs msys = "( " ++ intercalate " ; " (go bs) ++ ") || true"
      where
            go (Robustly Cabal) = osinstall Cabal ++
                    [ "cabal update"
                    , "cabal install --only-dependencies"
                    ]
            go (Robustly Stack) = osinstall Stack ++
                    [ "stack setup"
                    , "stack build --only-dependencies :propellor-config"
                    ]
            go OSOnly = osinstall Cabal

            osinstall builder = case msys of
                    Just (System (FreeBSD _) _) -> map pkginstall (fbsddeps builder)
                    Just (System (ArchLinux) _) -> map pacmaninstall (archlinuxdeps builder)
                    Just (System (Debian _ _) _) -> useapt builder
                    Just (System (Buntish _) _) -> useapt builder
                    -- assume a Debian derived system when not specified
                    Nothing -> useapt builder

            useapt builder = "apt-get update" : map aptinstall (debdeps builder)

            aptinstall (Dep p) = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
            aptinstall (OldDep p) = "if LANG=C apt-cache policy " ++ p ++ "| grep -q Candidate:; then " ++ aptinstall (Dep p) ++ "; fi"
            pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
            pacmaninstall p = "pacman -S --noconfirm --needed " ++ p

            debdeps Cabal =
                    [ Dep "gnupg"
                    -- Below are the same deps listed in debian/control.
                    , Dep "ghc"
                    , Dep "cabal-install"
                    , Dep "libghc-async-dev"
                    , Dep "libghc-split-dev"
                    , Dep "libghc-hslogger-dev"
                    , Dep "libghc-unix-compat-dev"
                    , Dep "libghc-ansi-terminal-dev"
                    , Dep "libghc-ifelse-dev"
                    , Dep "libghc-network-dev"
                    , Dep "libghc-mtl-dev"
                    , Dep "libghc-transformers-dev"
                    , Dep "libghc-exceptions-dev"
                    , Dep "libghc-text-dev"
                    , Dep "libghc-hashable-dev"
                    -- Deps that are only needed on old systems.
                    , OldDep "libghc-stm-dev"
                    ]
            debdeps Stack =
                    [ Dep "gnupg"
                    , Dep "haskell-stack"
                    ]

            fbsddeps Cabal =
                    [ "gnupg"
                    , "ghc"
                    , "hs-cabal-install"
                    , "hs-async"
                    , "hs-split"
                    , "hs-hslogger"
                    , "hs-unix-compat"
                    , "hs-ansi-terminal"
                    , "hs-IfElse"
                    , "hs-network"
                    , "hs-mtl"
                    , "hs-transformers-base"
                    , "hs-exceptions"
                    , "hs-stm"
                    , "hs-text"
                    , "hs-hashable"
                    ]
            fbsddeps Stack =
                    [ "gnupg"
                    , "stack"
                    ]

            archlinuxdeps Cabal =
                    [ "gnupg"
                    , "ghc"
                    , "cabal-install"
                    , "haskell-async"
                    , "haskell-split"
                    , "haskell-hslogger"
                    , "haskell-unix-compat"
                    , "haskell-ansi-terminal"
                    , "haskell-hackage-security"
                    , "haskell-ifelse"
                    , "haskell-network"
                    , "haskell-mtl"
                    , "haskell-transformers-base"
                    , "haskell-exceptions"
                    , "haskell-stm"
                    , "haskell-text"
                    , "hashell-hashable"
                    ]
            archlinuxdeps Stack =
                    [ "gnupg"
                    , "stack"
                    ]

    installGitCommand :: Maybe System -> ShellCommand
    installGitCommand msys = case msys of
            (Just (System (Debian _ _) _)) -> use apt
            (Just (System (Buntish _) _)) -> use apt
            (Just (System (FreeBSD _) _)) -> use
                    [ "ASSUME_ALWAYS_YES=yes pkg update"
                    , "ASSUME_ALWAYS_YES=yes pkg install git"
                    ]
            (Just (System (ArchLinux) _)) -> use
                    [ "pacman -S --noconfirm --needed git"]
            -- assume a debian derived system when not specified
            Nothing -> use apt
      where
            use cmds = "if ! git --version >/dev/null 2>&1; then " ++ intercalate " && " cmds ++ "; fi"
            apt =
                    [ "apt-get update"
                    , "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
                    ]

    -- Build propellor, and symlink the built binary to ./propellor.
    --
    -- When the Host has a Buildsystem specified it is used. If none is
    -- specified, look at git config propellor.buildsystem.
    buildPropellor :: Maybe Host -> IO ()
    buildPropellor mh = unlessM (actionMessage "Propellor build" build) $
            errorMessage "Propellor build failed!"
      where
            msys = case fmap (fromInfo . hostInfo) mh of
                    Just (InfoVal sys) -> Just sys
                    _ -> Nothing

            build = catchBoolIO $ do
                    case fromInfo (maybe mempty hostInfo mh) of
                            NoInfoVal -> do
                                    bs <- getGitConfigValue "propellor.buildsystem"
                                    case bs of
                                            Just "stack" -> stackBuild msys
                                            _ -> cabalBuild msys
                            InfoVal bs -> case getBuilder bs of
                                    Cabal -> cabalBuild msys
                                    Stack -> stackBuild msys

    -- For speed, only runs cabal configure when it's not been run before.
    -- If the build fails cabal may need to have configure re-run.
    --
    -- If the cabal configure fails, and a System is provided, installs
    -- dependencies and retries.
    cabalBuild :: Maybe System -> IO Bool
    cabalBuild msys = do
            make "dist/setup-config" ["propellor.cabal"] cabal_configure
            unlessM cabal_build $
                    unlessM (cabal_configure <&&> cabal_build) $
                            error "cabal build failed"
            -- For safety against eg power loss in the middle of the build,
            -- make a copy of the binary, and move it into place atomically.
            -- This ensures that the propellor symlink only ever points at
            -- a binary that is fully built. Also, avoid ever removing
            -- or breaking the symlink.
            --
            -- Need cp -pfRL to make build timestamp checking work.
            unlessM (boolSystem "cp" [Param "-pfRL", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
                    error "cp of binary failed"
            rename (tmpfor safetycopy) safetycopy
            symlinkPropellorBin safetycopy
            return True
      where
            cabalbuiltbin = "dist/build/propellor-config/propellor-config"
            safetycopy = cabalbuiltbin ++ ".built"
            cabal_configure = ifM (cabal ["configure"])
                    ( return True
                    , case msys of
                            Nothing -> return False
                            Just sys ->
                                    boolSystem "sh" [Param "-c", Param (depsCommand (Robustly Cabal) (Just sys))]
                                            <&&> cabal ["configure"]
                    )
            -- The -j1 is to only run one job at a time -- in some situations,
            -- eg in qemu, ghc does not run reliably in parallel.
            cabal_build = cabal ["build", "-j1", "propellor-config"]

    stackBuild :: Maybe System -> IO Bool
    stackBuild _msys = do
            createDirectoryIfMissing True builddest
            ifM (stack buildparams)
                    ( do
                            symlinkPropellorBin (builddest </> "propellor-config")
                            return True
                    , return False
                    )
      where
            builddest = ".built"
            buildparams =
                    [ "--local-bin-path", builddest
                    , "build"
                    , ":propellor-config" -- only build config program
                    , "--copy-bins"
                    ]

    -- Atomic symlink creation/update.
    symlinkPropellorBin :: FilePath -> IO ()
    symlinkPropellorBin bin = do
            createSymbolicLink bin (tmpfor dest)
            rename (tmpfor dest) dest
      where
            dest = "propellor"

    tmpfor :: FilePath -> FilePath
    tmpfor f = f ++ ".propellortmp"

    make :: FilePath -> [FilePath] -> IO Bool -> IO ()
    make dest srcs builder = do
            dt <- getmtime dest
            st <- mapM getmtime srcs
            when (dt == Nothing || any (> dt) st) $
                    unlessM builder $
                            error $ "failed to make " ++ dest
      where
            getmtime = catchMaybeIO . getModificationTime

    cabal :: [String] -> IO Bool
    cabal = boolSystem "cabal" . map Param

    stack :: [String] -> IO Bool
    stack = boolSystem "stack" . map Param