indigo-0.6.0: app/Upgrade.hs

-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Upgrade command implementation
module Upgrade
  ( run
  ) where

import Data.Text qualified as T
import Data.Version
import Network.HTTP.Req
  (GET(GET), HttpException, MonadHttp, NoReqBody(..), Scheme(Https), Url, bsResponse,
  defaultHttpConfig, queryParam, req, responseBody, runReq, (/:))
import Shelly qualified as S
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
import Text.ParserCombinators.ReadP (eof, readP_to_S)
import Universum.Lifted.File (writeFile)

import FileGen.Files (DependenceSnapshotVersion(..), indigoDependenceSnapshotYaml)
import Helper (repo)
import Paths_indigo (version)

run :: Maybe Text -> Bool -> IO ()
run mrevision bforce = do
  S.shelly $ S.escaping False $ S.withTmpDir $ \tempDir -> do
    let revision = fromMaybe "production" mrevision
    remoteVer <- runReq defaultHttpConfig $ do
      eresp <- try @_ @HttpException $ req GET
        (repo revision /: "package.yaml")
        NoReqBody
        bsResponse
        (queryParam @_ @Text "inline" (Just "false"))
      liftIO $ case eresp of
        Left err -> do
          putTextLn "Failed get new indigo version:"
          putStrLn $ displayException err
          exitFailure
        Right resp -> maybe (fail "Invalid package.yaml") (pure . fst) $
          responseBody resp
            & decodeUtf8
            & lines
            & find ("version:" `T.isPrefixOf`)
            >>= listToMaybe . drop 1 . words
            >>= listToMaybe . readP_to_S (parseVersion <* eof) . toString
    if remoteVer <= version && not bforce
    then putStrLn $ "Executable version " <> showVersion version <> " already up to date"
    else do
      runReq defaultHttpConfig $ getFile revision tempDir "indigo-snapshot.yaml"
      writeFile (tempDir </> "indigo-dependence-snapshot.yaml") $
        indigoDependenceSnapshotYaml $
          maybe (DSVPublishedVersion remoteVer) DSVGitCommitSha mrevision
      S.run_ "stack"
        ["install", "indigo", "--resolver"
        , toText $ tempDir </> "indigo-dependence-snapshot.yaml"]

getFile :: (MonadCatch m, MonadHttp m) => Text -> FilePath -> Text -> m ()
getFile revision configDir fn = do
  eresp <- try @_ @HttpException $ req GET
    (url revision fn)
    NoReqBody
    bsResponse
    (queryParam @_ @Text "inline" (Just "false"))
  case eresp of
    Left err -> do
      putStrLn $ "Failed to get " <> fn <> ":"
      putStrLn $ displayException err
    Right resp -> do
      let fp = configDir </> toString fn
          dep = decodeUtf8 $ responseBody resp
      liftIO $ createDirectoryIfMissing True configDir
      writeFile fp dep

url :: Text -> Text -> Url 'Https
url revision fn = repo revision /: "snapshots" /: fn