diff --git a/waspc/cli/exe/Main.hs b/waspc/cli/exe/Main.hs index c68e30ebda..49bcb2cbf6 100644 --- a/waspc/cli/exe/Main.hs +++ b/waspc/cli/exe/Main.hs @@ -3,13 +3,14 @@ module Main where import Control.Concurrent (threadDelay) import qualified Control.Concurrent.Async as Async import qualified Control.Exception as E -import Control.Monad (void) +import Control.Monad (void, when) import Data.Char (isSpace) import Data.List (intercalate) import Main.Utf8 (withUtf8) +import System.Directory (doesFileExist, removeFile) import System.Environment (getArgs) import qualified System.Environment as Env -import System.Exit (exitFailure) +import System.Exit (exitFailure, exitSuccess) import Wasp.Cli.Command (runCommand) import Wasp.Cli.Command.BashCompletion (bashCompletion, generateBashCompletionScript, printBashCompletionInstruction) import Wasp.Cli.Command.Build (build) @@ -26,6 +27,7 @@ import qualified Wasp.Cli.Command.Db.Studio as Command.Db.Studio import Wasp.Cli.Command.Deploy (deploy) import Wasp.Cli.Command.Deps (deps) import Wasp.Cli.Command.Dockerfile (printDockerfile) +import qualified System.IO.Error as IOError import Wasp.Cli.Command.Info (info) import Wasp.Cli.Command.Start (start) import qualified Wasp.Cli.Command.Start.Db as Command.Start.Db @@ -42,86 +44,60 @@ import qualified Wasp.Node.Version as NodeVersion import Wasp.Util (indent) import qualified Wasp.Util.Terminal as Term import Wasp.Version (waspVersion) +import qualified Wasp.Cli.Command.Version.VersionManagement as VersionManagement +import qualified Wasp.Cli.Command.Version.Download as VersionDownload +import qualified Wasp.Cli.Command.Version.Executor as VersionExecutor +import qualified Wasp.Cli.Command.Version.Paths as VersionPaths main :: IO () main = withUtf8 . (`E.catch` handleInternalErrors) $ do args <- getArgs - let commandCall = case args of - ("new" : newArgs) -> Command.Call.New newArgs - ("new:ai" : newAiArgs) -> Command.Call.NewAi newAiArgs - ["start"] -> Command.Call.Start - ["start", "db"] -> Command.Call.StartDb - ["clean"] -> Command.Call.Clean - ["ts-setup"] -> Command.Call.TsSetup - ["compile"] -> Command.Call.Compile - ("db" : dbArgs) -> Command.Call.Db dbArgs - ["uninstall"] -> Command.Call.Uninstall - ["version"] -> Command.Call.Version - ["build"] -> Command.Call.Build - ["telemetry"] -> Command.Call.Telemetry - ["deps"] -> Command.Call.Deps - ["dockerfile"] -> Command.Call.Dockerfile - ["info"] -> Command.Call.Info - ["studio"] -> Command.Call.Studio - ["completion"] -> Command.Call.PrintBashCompletionInstruction - ["completion:generate"] -> Command.Call.GenerateBashCompletionScript - ["completion:list"] -> Command.Call.BashCompletionListCommands - ("waspls" : _) -> Command.Call.WaspLS - ("deploy" : deployArgs) -> Command.Call.Deploy deployArgs - ("test" : testArgs) -> Command.Call.Test testArgs - _unknownCommand -> Command.Call.Unknown args + + let commandCall = parseCommand args telemetryThread <- Async.async $ runCommand $ Telemetry.considerSendingData commandCall - -- Before calling any command, check that the node requirement is met. Node is - -- not needed for every command, but checking for every command was decided - -- to be more robust than trying to only check for commands that require it. - -- See https://github.com/wasp-lang/wasp/issues/1134#issuecomment-1554065668 - NodeVersion.getAndCheckUserNodeVersion >>= \case - NodeVersion.VersionCheckFail errorMsg -> do - cliSendMessage $ Message.Failure "Node requirement not met" errorMsg - exitFailure - NodeVersion.VersionCheckSuccess -> pure () + case commandCall of + -- early intercept for version + Command.Call.Version (Just "latest") True -> do + VersionDownload.forceInstallLatest + exitSuccess + Command.Call.Version (Just versionArg) True -> do + VersionDownload.forceInstallSpecific versionArg + exitSuccess + Command.Call.Version (Just versionArg) False -> do + putStrLn $ "Switching to version " ++ versionArg ++ "..." + VersionManagement.switchVersion versionArg + exitSuccess + Command.Call.Version Nothing _ -> do + currentVersion <- VersionManagement.getActiveVersion + putStrLn $ + unlines + [ "Active Wasp version: " ++ currentVersion, + "", + "To switch to a different version of Wasp, use:", + " wasp version ", + "", + "For example:", + " wasp version 0.14.0 # Switch to version 0.14.0", + " wasp version latest # Switch to latest version", + "", + "Add the --force flag to hard install a specific version.", + "Check available versions at:", + " https://github.com/wasp-lang/wasp/releases" + ] + exitSuccess - setDefaultCliEnvVars + -- early intercept for update + Command.Call.Update True -> do + VersionDownload.forceInstallLatest + exitSuccess + Command.Call.Update False -> do + VersionDownload.updateWasp + exitSuccess - case commandCall of - Command.Call.New newArgs -> runCommand $ createNewProject newArgs - Command.Call.NewAi newAiArgs -> case newAiArgs of - ["--stdout", projectName, appDescription, projectConfigJson] -> - runCommand $ - Command.CreateNewProject.AI.createNewProjectNonInteractiveToStdout - projectName - appDescription - projectConfigJson - [projectName, appDescription, projectConfigJson] -> - runCommand $ - Command.CreateNewProject.AI.createNewProjectNonInteractiveOnDisk - projectName - appDescription - projectConfigJson - _unknownCommand -> printWaspNewAiUsage - Command.Call.Start -> runCommand start - Command.Call.StartDb -> runCommand Command.Start.Db.start - Command.Call.Clean -> runCommand clean - Command.Call.TsSetup -> runCommand tsConfigSetup - Command.Call.Compile -> runCommand compile - Command.Call.Db dbArgs -> dbCli dbArgs - Command.Call.Version -> printVersion - Command.Call.Studio -> runCommand studio - Command.Call.Uninstall -> runCommand uninstall - Command.Call.Build -> runCommand build - Command.Call.Telemetry -> runCommand Telemetry.telemetry - Command.Call.Deps -> runCommand deps - Command.Call.Dockerfile -> runCommand printDockerfile - Command.Call.Info -> runCommand info - Command.Call.PrintBashCompletionInstruction -> runCommand printBashCompletionInstruction - Command.Call.GenerateBashCompletionScript -> runCommand generateBashCompletionScript - Command.Call.BashCompletionListCommands -> runCommand bashCompletion - Command.Call.Unknown _ -> printUsage - Command.Call.WaspLS -> runWaspLS - Command.Call.Deploy deployArgs -> runCommand $ deploy deployArgs - Command.Call.Test testArgs -> runCommand $ test testArgs + -- handle delegation + _ -> handleVersionDelegation args commandCall -- If sending of telemetry data is still not done 1 second since commmand finished, abort it. -- We also make sure here to catch all errors that might get thrown and silence them. @@ -129,13 +105,154 @@ main = withUtf8 . (`E.catch` handleInternalErrors) $ do where threadDelaySeconds = let microsecondsInASecond = 1000000 - in threadDelay . (* microsecondsInASecond) + in threadDelay . (* microsecondsInASecond) handleInternalErrors :: E.ErrorCall -> IO () handleInternalErrors e = do putStrLn $ "\nInternal Wasp error (bug in the compiler):\n" ++ indent 2 (show e) exitFailure +handleVersionDelegation :: [String] -> Command.Call.Call -> IO () +handleVersionDelegation args commandCall = do + -- Ensure the version management system is initialized with error handling + ensureSystemResult <- E.try VersionManagement.ensureVersionSystem :: IO (Either IOError.IOError ()) + + case ensureSystemResult of + Left e -> do + putStrLn "Warning: Failed to initialize version management system." + putStrLn $ "Details: " ++ show e + putStrLn "Attempting to continue execution..." + Right _ -> pure () -- Continue normally if it succeeds + + -- Try getting the active version + result <- E.try VersionManagement.getActiveVersion :: IO (Either IOError.IOError String) + + case result of + Left e -> + if IOError.isAlreadyInUseError e then do + putStrLn "Warning: Active version file is locked. Attempting to fix..." + releaseFile <- VersionPaths.getVersionFile "release" + activeFile <- VersionPaths.getVersionFile "active" + + -- Attempt to remove locked files + E.catch (removeFile releaseFile) (\(_ :: IOError.IOError) -> pure ()) + E.catch (removeFile activeFile) (\(_ :: IOError.IOError) -> pure ()) + + -- Retry getting the active version + retryResult <- E.try VersionManagement.getActiveVersion :: IO (Either IOError.IOError String) + case retryResult of + Left err -> do + putStrLn "Error: Failed to read active version even after cleanup." + putStrLn $ "Details: " ++ show err + exitFailure + Right activeVersion -> continueWithActiveVersion activeVersion + else do + putStrLn $ "Error: Unable to read active version due to: " ++ show e + exitFailure + + Right activeVersion -> continueWithActiveVersion activeVersion + + where + continueWithActiveVersion activeVersion = do + releaseFile <- VersionPaths.getVersionFile "release" + releaseExists <- doesFileExist releaseFile + releaseVersion <- if releaseExists then readFile releaseFile else return (show waspVersion) + + when (activeVersion /= releaseVersion) $ do + VersionExecutor.executeWithVersion args + exitSuccess + + -- Before calling any command, check that the node requirement is met. Node is + -- not needed for every command, but checking for every command was decided + -- to be more robust than trying to only check for commands that require it. + -- See https://github.com/wasp-lang/wasp/issues/1134#issuecomment-1554065668 + NodeVersion.getAndCheckUserNodeVersion >>= \case + NodeVersion.VersionCheckFail errorMsg -> do + cliSendMessage $ Message.Failure "Node requirement not met" errorMsg + exitFailure + NodeVersion.VersionCheckSuccess -> pure () + + setDefaultCliEnvVars + runNormalCommand commandCall + +parseCommand :: [String] -> Command.Call.Call +parseCommand args = case args of + ("new" : newArgs) -> Command.Call.New newArgs + ("new:ai" : newAiArgs) -> Command.Call.NewAi newAiArgs + ["start"] -> Command.Call.Start + ["start", "db"] -> Command.Call.StartDb + ["clean"] -> Command.Call.Clean + ["ts-setup"] -> Command.Call.TsSetup + ["compile"] -> Command.Call.Compile + ("db" : dbArgs) -> Command.Call.Db dbArgs + ["uninstall"] -> Command.Call.Uninstall + ["build"] -> Command.Call.Build + ["version", "latest", "--force"] -> Command.Call.Version (Just "latest") True + ["version", versionArg, "--force"] -> Command.Call.Version (Just versionArg) True + ["version", versionArg] -> Command.Call.Version (Just versionArg) False + ["version"] -> Command.Call.Version Nothing False + ["update", "--force"] -> Command.Call.Update True + ["update"] -> Command.Call.Update False + ["telemetry"] -> Command.Call.Telemetry + ["deps"] -> Command.Call.Deps + ["dockerfile"] -> Command.Call.Dockerfile + ["info"] -> Command.Call.Info + ["studio"] -> Command.Call.Studio + ["completion"] -> Command.Call.PrintBashCompletionInstruction + ["completion:generate"] -> Command.Call.GenerateBashCompletionScript + ["completion:list"] -> Command.Call.BashCompletionListCommands + ("waspls" : _) -> Command.Call.WaspLS + ("deploy" : ds) -> Command.Call.Deploy ds + ("test" : ts) -> Command.Call.Test ts + ("secret" : secretArgs) -> Command.Call.Secret secretArgs + _ -> Command.Call.Unknown args + + +runNormalCommand :: Command.Call.Call -> IO () +runNormalCommand commandCall = case commandCall of + Command.Call.New newArgs -> runCommand $ createNewProject newArgs + Command.Call.NewAi newAiArgs -> case newAiArgs of + ["--stdout", projectName, appDescription, projectConfigJson] -> + runCommand $ + Command.CreateNewProject.AI.createNewProjectNonInteractiveToStdout + projectName + appDescription + projectConfigJson + [projectName, appDescription, projectConfigJson] -> + runCommand $ + Command.CreateNewProject.AI.createNewProjectNonInteractiveOnDisk + projectName + appDescription + projectConfigJson + _unknownCommand -> printWaspNewAiUsage + Command.Call.Start -> runCommand start + Command.Call.StartDb -> runCommand Command.Start.Db.start + Command.Call.Clean -> runCommand clean + Command.Call.TsSetup -> runCommand tsConfigSetup + Command.Call.Compile -> runCommand compile + Command.Call.Db dbArgs -> dbCli dbArgs + Command.Call.Studio -> runCommand studio + Command.Call.Uninstall -> runCommand uninstall + Command.Call.Build -> runCommand build + Command.Call.Telemetry -> runCommand Telemetry.telemetry + Command.Call.Deps -> runCommand deps + Command.Call.Dockerfile -> runCommand printDockerfile + Command.Call.Info -> runCommand info + Command.Call.PrintBashCompletionInstruction -> runCommand printBashCompletionInstruction + Command.Call.GenerateBashCompletionScript -> runCommand generateBashCompletionScript + Command.Call.BashCompletionListCommands -> runCommand bashCompletion + Command.Call.Unknown _ -> printUsage + Command.Call.WaspLS -> runWaspLS + Command.Call.Deploy deployArgs -> runCommand $ deploy deployArgs + Command.Call.Test testArgs -> runCommand $ test testArgs + Command.Call.Version _ _ -> + error "runNormalCommand was called with Version, which should never happen." + Command.Call.Update _ -> + error "runNormalCommand was called with Update, which should never happen." + Command.Call.Secret secretArgs -> + putStrLn $ "Secret command for testing versions :) " ++ show secretArgs + + -- | Sets env variables that are visible to the commands run by the CLI. -- For example, we can use this to hide update messages by tools like Prisma. -- The env variables are visible to our CLI and any child processes spawned by it. @@ -169,7 +286,8 @@ printUsage = " You can do the same thing with `wasp new` interactively.", " Run `wasp new:ai` for more info.", "", - cmd " version Prints current version of CLI.", + cmd " version Prints currently activated version of CLI. Run `wasp version` for more info.", + cmd " update Updates Wasp CLI to the latest version. Run `wasp update --force` to hard install the latest version.", cmd " waspls Run Wasp Language Server. Add --help to get more info.", cmd " completion Prints help on bash completion.", cmd " uninstall Removes Wasp from your system.", @@ -199,21 +317,6 @@ printUsage = ] {- ORMOLU_ENABLE -} -printVersion :: IO () -printVersion = do - putStrLn $ - unlines - [ show waspVersion, - "", - "If you wish to install/switch to the latest version of Wasp, do:", - " curl -sSL https://get.wasp-lang.dev/installer.sh | sh -s", - "", - "If you want specific x.y.z version of Wasp, do:", - " curl -sSL https://get.wasp-lang.dev/installer.sh | sh -s -- -v x.y.z", - "", - "Check https://github.com/wasp-lang/wasp/releases for the list of valid versions, including the latest one." - ] - -- TODO: maybe extract to a separate module, e.g. DbCli.hs? dbCli :: [String] -> IO () dbCli args = case args of diff --git a/waspc/cli/src/Wasp/Cli/Command/Call.hs b/waspc/cli/src/Wasp/Cli/Command/Call.hs index 1105322548..ec182a0d6f 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Call.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Call.hs @@ -11,7 +11,8 @@ data Call | Compile | Db Arguments -- db args | Build - | Version + | Version (Maybe String) Bool -- --force + | Update Bool -- --force | Telemetry | Deps | Dockerfile @@ -21,6 +22,7 @@ data Call | GenerateBashCompletionScript | BashCompletionListCommands | WaspLS + | Secret Arguments -- testing versioning passthrough args | Deploy Arguments -- deploy cmd passthrough args | Test Arguments -- "client" | "server", then test cmd passthrough args | Unknown Arguments -- all args diff --git a/waspc/cli/src/Wasp/Cli/Command/Version/Download.hs b/waspc/cli/src/Wasp/Cli/Command/Version/Download.hs new file mode 100644 index 0000000000..ddb8d68261 --- /dev/null +++ b/waspc/cli/src/Wasp/Cli/Command/Version/Download.hs @@ -0,0 +1,226 @@ +module Wasp.Cli.Command.Version.Download + ( downloadVersion + , updateWasp + , getLatestVersionFromGithub + , isVersionLessThan + , forceInstallLatest + , forceInstallSpecific + ) where + +import Control.Monad (when) +import Control.Exception (try, SomeException) +import Network.HTTP.Simple + ( httpBS + , getResponseBody + , parseRequest + , setRequestHeader + , getResponseStatusCode + , httpNoBody + , Response + ) +import qualified Data.ByteString.Char8 as BS +import System.IO.Temp (withSystemTempDirectory) +import System.Directory + ( doesDirectoryExist + , doesFileExist + , copyFile + , removeDirectoryRecursive + , renameDirectory + , removeFile + , executable + , setPermissions + , emptyPermissions + ) +import System.FilePath (()) +import System.Process (callProcess, callCommand) +import System.Exit (exitFailure) +import System.Info (os) +import Data.Aeson (decode) +import qualified Data.Aeson.Types as Aeson (parseMaybe, (.:)) +import qualified Data.ByteString.Lazy.Char8 as LBS +import Wasp.Cli.Command.Version.Paths + ( getVersionPaths + , getVersionFile + , getWaspRootDir + , getWaspBinDir + ) + +-- | Update Wasp to latest version +updateWasp :: IO () +updateWasp = do + currentVer <- getCurrentReleaseVersion + latestVer <- getLatestVersionFromGithub + + when (isVersionLessThan currentVer latestVer) $ do + putStrLn $ "Updating from ${currentVer} to ${latestVer}..." + handleDownloadResult =<< try (downloadVersion latestVer) + updateSystemMetadata latestVer + +getCurrentReleaseVersion :: IO String +getCurrentReleaseVersion = getVersionFile "release" >>= readFile + +handleDownloadResult :: Either SomeException () -> IO () +handleDownloadResult (Left e) = do + putStrLn $ "Update failed: " ++ show e + exitFailure +handleDownloadResult (Right _) = return () + +updateSystemMetadata :: String -> IO () +updateSystemMetadata version = do + updateMainBinary version + writeVersionFiles version + +writeVersionFiles :: String -> IO () +writeVersionFiles version = do + releaseFile <- getVersionFile "release" + activeFile <- getVersionFile "active" + writeFile releaseFile version + writeFile activeFile version + +-- | Download and install specific version +downloadVersion :: String -> IO () +downloadVersion version = do + -- Step 1: Check if the GitHub release exists + versionExists <- checkGitHubRelease version + if not versionExists + then do + putStrLn $ "❌ Error: Version " ++ version ++ " does not exist. See https://github.com/wasp-lang/wasp/releases for available versions." + exitFailure + else do + putStrLn $ "Starting download..." + + -- Step 2: Use a temporary directory for download & extraction + withSystemTempDirectory "wasp-download" $ \tmpDir -> do + let archiveFile = tmpDir getPlatformString + downloadArchive version archiveFile + extractArchive archiveFile tmpDir + _ <- return tmpDir + + versionDir <- getVersionDir version + ensureCleanInstallation versionDir + renameDirectory tmpDir versionDir + putStrLn $ "✅ Wasp version " ++ version ++ " downloaded and activated!" + +downloadArchive :: String -> FilePath -> IO () +downloadArchive version path = do + let url = "https://github.com/wasp-lang/wasp/releases/download/v" + ++ version ++ "/" ++ getPlatformString + putStrLn $ "Downloading from " ++ url + request <- parseRequest url + response <- httpBS request + BS.writeFile path (getResponseBody response) + +extractArchive :: FilePath -> FilePath -> IO () +extractArchive archivePath destDir = do + putStrLn "Extracting..." + callProcess "tar" ["-xzf", archivePath, "-C", destDir] + removeFile archivePath + +ensureCleanInstallation :: FilePath -> IO () +ensureCleanInstallation path = do + exists <- doesDirectoryExist path + when exists $ do + putStrLn "Removing existing installation..." + removeDirectoryRecursive path + +getVersionDir :: String -> IO FilePath +getVersionDir version = ( version) <$> getWaspRootDir + +-- | Get latest release version from GitHub +getLatestVersionFromGithub :: IO String +getLatestVersionFromGithub = do + response <- httpBS =<< setRequestHeader "User-Agent" ["wasp-cli"] + <$> parseRequest "https://api.github.com/repos/wasp-lang/wasp/releases/latest" + case decodeResponse (getResponseBody response) of + Just version -> return $ drop 1 version -- Remove 'v' prefix + Nothing -> error "Failed to parse GitHub response" + +checkGitHubRelease :: String -> IO Bool +checkGitHubRelease version = do + let url = "https://github.com/wasp-lang/wasp/releases/download/v" ++ version ++ "/" + request <- parseRequest url + result <- try (httpNoBody request) :: IO (Either SomeException (Response())) + case result of + Right response -> + let statusCode = getResponseStatusCode response + in return (statusCode == 200) + Left _ -> return False + +decodeResponse :: BS.ByteString -> Maybe String +decodeResponse resp = do + release <- decode (LBS.fromStrict resp) + Aeson.parseMaybe (Aeson..: "tag_name") release + +-- Platform-specific configuration +getPlatformString :: String +getPlatformString = case os of + "darwin" -> "wasp-macos-x86_64.tar.gz" + "linux" -> "wasp-linux-x86_64.tar.gz" + _ -> error $ "Unsupported OS: " ++ os + +-- | Create or update the wrapper script +updateWrapperScript :: FilePath -> FilePath -> FilePath -> IO () +updateWrapperScript name binaryPath dataPath = do + binDir <- getWaspBinDir + let wrapperPath = binDir name + wrapperContent = unlines + [ "#!/usr/bin/env bash" + , "waspc_datadir=" ++ dataPath ++ " " ++ binaryPath ++ " \"$@\"" + ] + writeFile wrapperPath wrapperContent + setPermissions wrapperPath $ emptyPermissions { executable = True } + +-- | Update the main wasp binary to a specific version +updateMainBinary :: String -> IO () +updateMainBinary version = do + (versionBin, dataDir) <- getVersionPaths version + binDir <- getWaspBinDir + let mainBinary = binDir "wasp" + + exists <- doesFileExist versionBin + if exists + then do + -- Copy the binary + copyFile versionBin mainBinary + setPermissions mainBinary $ emptyPermissions { executable = True } + + -- Update the wrapper script + updateWrapperScript "wasp" mainBinary dataDir + putStrLn "Updated wasp wrapper script" + else error $ "Version " ++ version ++ " binary not found" + +-- | Semantic version comparison +isVersionLessThan :: String -> String -> Bool +isVersionLessThan a b = case (parseVersion a, parseVersion b) of + (Just v1, Just v2) -> v1 < v2 + _ -> False + +parseVersion :: String -> Maybe (Int, Int, Int) +parseVersion v = case reads v of + [(major, '.':rest1)] -> case reads rest1 of + [(minor, '.':rest2)] -> case reads rest2 of + [(patch, "")] -> Just (major, minor, patch) + _ -> Nothing + _ -> Nothing + _ -> Nothing + + +-- | Force install latest version of Wasp +forceInstallLatest :: IO () +forceInstallLatest = do + releaseFile <- getVersionFile "release" + activeFile <- getVersionFile "active" + doesFileExist releaseFile >>= flip when (removeFile releaseFile) + doesFileExist activeFile >>= flip when (removeFile activeFile) + putStrLn "Forcing installation of the latest version of Wasp..." + callCommand "curl -sSL https://get.wasp-lang.dev/installer.sh | sh -s" + +-- | Force install a specific version of Wasp +forceInstallSpecific :: String -> IO () +forceInstallSpecific version = do + releaseFile <- getVersionFile "release" + activeFile <- getVersionFile "active" + doesFileExist releaseFile >>= flip when (removeFile releaseFile) + doesFileExist activeFile >>= flip when (removeFile activeFile) + putStrLn $ "Forcing installation of Wasp version " ++ version ++ "..." + callCommand $ "curl -sSL https://get.wasp-lang.dev/installer.sh | sh -s -- -v " ++ version \ No newline at end of file diff --git a/waspc/cli/src/Wasp/Cli/Command/Version/Executor.hs b/waspc/cli/src/Wasp/Cli/Command/Version/Executor.hs new file mode 100644 index 0000000000..ef80ffcbae --- /dev/null +++ b/waspc/cli/src/Wasp/Cli/Command/Version/Executor.hs @@ -0,0 +1,97 @@ +module Wasp.Cli.Command.Version.Executor + ( executeWithVersion + , readProcessWithExitCode + , readProcessWithExitCodeEnv + ) where + +import System.Process ( + proc + , createProcess + , waitForProcess + , StdStream(..) + , std_in + , std_out + , std_err + , env + ) +import qualified Data.ByteString.Char8 as BS +import Control.Concurrent.MVar +import Control.Monad (unless) +import Control.Exception (evaluate) +import Control.Concurrent (forkIO) +import System.Environment (getEnvironment) +import System.IO (hGetContents, hClose) +import System.Exit (exitFailure, exitWith, ExitCode(..)) +import System.Directory (doesFileExist) +import Wasp.Cli.Command.Version.VersionManagement (detectWrapperVersion, getActiveVersion) +import Wasp.Cli.Command.Version.Paths (getVersionPaths, getMainBinaryPath, getVersionFile) + + +-- | Execute a command using appropriate version +executeWithVersion :: [String] -> IO () +executeWithVersion args = do + (activeVer, releaseVer) <- getInstallationVersions + + if activeVer == releaseVer + then runMainProcess args + else runVersionedProcess activeVer args + where + runMainProcess args' = do + binPath <- getMainBinaryPath + (exitCode, _, _) <- readProcessWithExitCode binPath args' "" + exitWith exitCode + + runVersionedProcess ver args' = do + (verBin, dataDir) <- getVersionPaths ver + binExists <- doesFileExist verBin + if binExists + then do + let envVars = [("waspc_datadir", dataDir)] + (exitCode, _, _) <- readProcessWithExitCodeEnv verBin args' envVars + exitWith exitCode + else do + putStrLn $ "Version " ++ ver ++ " not found in: " ++ verBin + exitFailure + +-- | Helper to execute process with additional environment variables +readProcessWithExitCodeEnv :: FilePath -> [String] -> [(String, String)] -> IO (ExitCode, String, String) +readProcessWithExitCodeEnv cmd args envVars = do + oldEnv <- getEnvironment + let newEnv = oldEnv ++ envVars + (_, Just outh, Just errh, ph) <- + createProcess (proc cmd args) { std_out = CreatePipe, std_err = CreatePipe, env = Just newEnv } + out <- hGetContents outh + err <- hGetContents errh + exitCode <- waitForProcess ph + return (exitCode, out, err) + +-- Helper to read process output +readProcessWithExitCode :: FilePath -> [String] -> String -> IO (ExitCode, String, String) +readProcessWithExitCode cmd args stdin = do + (Just inh, Just outh, Just errh, ph) <- + createProcess (proc cmd args){ std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe } + unless (null stdin) $ do + BS.hPutStr inh (BS.pack stdin) + hClose inh + out <- hGetContents outh + err <- hGetContents errh + outMVar <- newMVar "" + errMVar <- newMVar "" + _ <- forkIO $ evaluate (length out) >> putMVar outMVar out + _ <- forkIO $ evaluate (length err) >> putMVar errMVar err + exitCode <- waitForProcess ph + out' <- takeMVar outMVar + err' <- takeMVar errMVar + pure (exitCode, out', err') + +-- | Get both active and release versions +getInstallationVersions :: IO (String, String) +getInstallationVersions = do + active <- getActiveVersion + release <- getReleaseVersion + pure (active, release) + where + getReleaseVersion = do + releaseFile <- getVersionFile "release" + exists <- doesFileExist releaseFile + if exists then readFile releaseFile else detectWrapperVersion \ No newline at end of file diff --git a/waspc/cli/src/Wasp/Cli/Command/Version/Paths.hs b/waspc/cli/src/Wasp/Cli/Command/Version/Paths.hs new file mode 100644 index 0000000000..bb0c7ccbf4 --- /dev/null +++ b/waspc/cli/src/Wasp/Cli/Command/Version/Paths.hs @@ -0,0 +1,48 @@ +module Wasp.Cli.Command.Version.Paths + ( getWaspRootDir + , getWaspBinDir + , getMainBinaryPath + , getVersionFile + , getVersionPaths + ) where + +import qualified Wasp.Cli.FileSystem as FS +import qualified StrongPath as SP +import System.FilePath ((), takeDirectory, takeFileName) +import System.Directory (doesFileExist) + +-- Directory structure constants +waspRootDirName :: FilePath +waspRootDirName = ".local/share/wasp-lang" + +waspBinDirName :: FilePath +waspBinDirName = ".local/bin" + +-- | Get the root directory for Wasp installations +getWaspRootDir :: IO FilePath +getWaspRootDir = do + homeDir <- SP.fromAbsDir <$> FS.getHomeDir + return $ homeDir waspRootDirName + +-- | Get the directory for Wasp binaries +getWaspBinDir :: IO FilePath +getWaspBinDir = do + homeDir <- SP.fromAbsDir <$> FS.getHomeDir + return $ homeDir waspBinDirName + +-- | Path to main wasp wrapper script +getMainBinaryPath :: IO FilePath +getMainBinaryPath = ( "wasp") <$> getWaspBinDir + +-- | Get path to version metadata files +getVersionFile :: String -> IO FilePath +getVersionFile fileName = do + rootDir <- getWaspRootDir + return $ rootDir fileName + +-- | Get paths for a specific version installation +getVersionPaths :: String -> IO (FilePath, FilePath) +getVersionPaths version = do + rootDir <- getWaspRootDir + let versionDir = rootDir version + return (versionDir "wasp-bin", versionDir "data") diff --git a/waspc/cli/src/Wasp/Cli/Command/Version/VersionManagement.hs b/waspc/cli/src/Wasp/Cli/Command/Version/VersionManagement.hs new file mode 100644 index 0000000000..8da550d0a0 --- /dev/null +++ b/waspc/cli/src/Wasp/Cli/Command/Version/VersionManagement.hs @@ -0,0 +1,200 @@ +module Wasp.Cli.Command.Version.VersionManagement + ( switchVersion + , ensureVersionSystem + , getActiveVersion + , listVersions + , isVersionLessThan + , detectWrapperVersion + ) where + +import Control.Monad (unless, when, filterM) +import qualified Control.Exception as E +import Data.List (isInfixOf) +import Data.Maybe (fromMaybe) +import System.Directory + ( createDirectoryIfMissing + , doesFileExist + , doesDirectoryExist + , listDirectory + , executable + , setPermissions + , emptyPermissions + ) +import System.FilePath (takeFileName, takeDirectory, ()) +import System.Exit (exitFailure) +import qualified Wasp.Version as WV +import Wasp.Cli.Command.Version.Download + ( getLatestVersionFromGithub + , downloadVersion + , isVersionLessThan + ) +import Wasp.Cli.Command.Version.Paths + ( getVersionPaths + , getMainBinaryPath + , getVersionFile + , getWaspRootDir + ) +-- | Switch to specified version +switchVersion :: String -> IO () +switchVersion version = do + result <- E.try (performVersionSwitch version) :: IO (Either E.SomeException ()) + case result of + Left e -> do + putStrLn $ "Error: Failed to switch version due to: " ++ show e + putStrLn "Try running 'wasp version latest --force' to install the latest version." + exitFailure + Right _ -> do + putStrLn $ "🐝 Wasp version " ++ version ++ " is now active!" + return () + +performVersionSwitch :: String -> IO () +performVersionSwitch "latest" = handleLatest +performVersionSwitch version = handleSpecificVersion version + +handleLatest :: IO () +handleLatest = getLatestVersionFromGithub >>= switchVersion + +handleSpecificVersion :: String -> IO () +handleSpecificVersion version = do + (binPath, _) <- getVersionPaths version + binExists <- doesFileExist binPath + + unless binExists $ handleMissingVersion version + makeExecutable binPath + updateVersionMetadata version + +handleMissingVersion :: String -> IO () +handleMissingVersion version = do + putStrLn $ "Downloading Wasp version " ++ version ++ "..." + result <- E.try (downloadVersion version) :: IO (Either E.SomeException ()) + case result of + Left e -> do + putStrLn $ "Download failed for version " ++ version + putStrLn "Try running 'wasp version latest --force' to install the latest version." + putStrLn $ "Error details: " ++ show e + exitFailure + Right _ -> return () + +makeExecutable :: FilePath -> IO () +makeExecutable path = do + exists <- doesFileExist path + when exists $ do + let perms = emptyPermissions { executable = True } + setPermissions path perms + +updateVersionMetadata :: String -> IO () +updateVersionMetadata version = do + updateReleaseIfNeeded version + updateActiveVersion version + +updateReleaseIfNeeded :: String -> IO () +updateReleaseIfNeeded version = do + releaseFile <- getVersionFile "release" + currentRelease <- safeReadFile releaseFile + when (maybe False (isVersionLessThan version) currentRelease) $ + writeFile releaseFile version + +updateActiveVersion :: String -> IO () +updateActiveVersion version = do + activeFile <- getVersionFile "active" + createParentDirectories + writeFile activeFile version + where + createParentDirectories = getWaspRootDir >>= createDirectoryIfMissing True + +-- | List all installed versions +listVersions :: IO [String] +listVersions = do + rootDir <- getWaspRootDir + dirs <- listDirectory rootDir + filterM (isValidVersion rootDir) dirs + where + isValidVersion root name = do + isDir <- doesDirectoryExist (root name) + return $ isDir && name `notElem` [".", "..", "active", "release"] + +-- | Initialize version management system +ensureVersionSystem :: IO () +ensureVersionSystem = do + rootDir <- getWaspRootDir + createDirectoryIfMissing True rootDir + + releaseFile <- getVersionFile "release" + ensureFileExists releaseFile detectWrapperVersion + + activeFile <- getVersionFile "active" + ensureFileExists activeFile (getReleaseVersion releaseFile) + + ensureReleaseVersionConsistency + +ensureFileExists :: FilePath -> IO String -> IO () +ensureFileExists path getDefaultContent = do + exists <- doesFileExist path + unless exists $ getDefaultContent >>= writeFile path + +getReleaseVersion :: FilePath -> IO String +getReleaseVersion releaseFile = do + exists <- doesFileExist releaseFile + if exists then readFile releaseFile else detectWrapperVersion + +ensureReleaseVersionConsistency :: IO () +ensureReleaseVersionConsistency = do + releaseFile <- getVersionFile "release" + currentVer <- detectWrapperVersion + releaseExists <- doesFileExist releaseFile + + when releaseExists $ do + releaseVer <- readFile releaseFile + unless (releaseVer == currentVer) $ do + writeFile releaseFile currentVer + syncActiveVersionIfNeeded releaseVer currentVer + +syncActiveVersionIfNeeded :: String -> String -> IO () +syncActiveVersionIfNeeded oldRelease newRelease = do + activeVer <- getActiveVersion + when (activeVer == oldRelease) $ do + activeFile <- getVersionFile "active" + writeFile activeFile newRelease + +-- | Get currently active version +getActiveVersion :: IO String +getActiveVersion = do + activeFile <- getVersionFile "active" + safeReadFile activeFile >>= maybe getFallbackVersion return + where + getFallbackVersion = do + releaseFile <- getVersionFile "release" + safeReadFile releaseFile >>= maybe (return $ show WV.waspVersion) return + +safeReadFile :: FilePath -> IO (Maybe String) +safeReadFile path = do + exists <- doesFileExist path + if exists then Just <$> readFile path else return Nothing + +-- | Extracts the version from the wrapper script +detectWrapperVersion :: IO String +detectWrapperVersion = do + binPath <- getMainBinaryPath + fileExists <- doesFileExist binPath + if fileExists + then do + content <- readFile binPath + let version = extractVersionFromScript content + return (fromMaybe "unknown" version) + else return "unknown" + +-- | Extract version from wrapper script content +extractVersionFromScript :: String -> Maybe String +extractVersionFromScript script = + case filter ("wasp-bin" `isInfixOf`) (lines script) of + (line:_) -> extractVersionFromPath line + _ -> Nothing + +-- | Extract version number from the wrapper script's binary path using regex. +extractVersionFromPath :: String -> Maybe String +extractVersionFromPath line = + let parts = words line + maybePath = case filter ("/wasp-lang/" `isInfixOf`) parts of + (p:_) -> Just p + _ -> Nothing + in fmap (takeFileName . takeDirectory) maybePath diff --git a/waspc/run b/waspc/run index 1a6baa70c5..9e0b56c402 100755 --- a/waspc/run +++ b/waspc/run @@ -19,7 +19,7 @@ RED="\033[31m" DEFAULT_COLOR="\033[39m" BUILD_CMD="cabal build all" -INSTALL_CMD="${SCRIPT_DIR}/tools/install_packages_to_data_dir.sh && cabal install --overwrite-policy=always" +INSTALL_CMD="${SCRIPT_DIR}/tools/install_and_activate.sh" BUILD_ALL_CMD="cabal build all --enable-tests --enable-benchmarks" TEST_UNIT_CMD="cabal test waspc-test" TEST_CLI_CMD="cabal test cli-test" @@ -66,7 +66,7 @@ print_usage () { "Builds the project." print_usage_cmd "install" \ - "Installs the project locally using cabal (runs '${SCRIPT_DIR}/tools/install_packages_to_data_dir.sh' and 'cabal install')." + "Installs the project locally using cabal (${SCRIPT_DIR}/tools/install_and_activate.sh' manages pre- and post-installation tasks)." print_usage_cmd "test" \ "Executes all tests (unit + e2e + headless). Builds the project first if needed." print_usage_cmd "test:unit [pattern]" \ @@ -114,7 +114,13 @@ case $COMMAND in echo_and_eval "$BUILD_CMD" ;; install) - echo_and_eval "$INSTALL_CMD" + FORCE_FLAG="" + for arg in "${ARGS[@]}"; do + if [[ "$arg" == "--force" ]]; then + FORCE_FLAG="--force" + fi + done + echo_and_eval "$INSTALL_CMD $FORCE_FLAG" ;; ghcid) echo_and_eval "$GHCID_CMD" diff --git a/waspc/tools/install_and_activate.sh b/waspc/tools/install_and_activate.sh new file mode 100755 index 0000000000..a38cdd2fa8 --- /dev/null +++ b/waspc/tools/install_and_activate.sh @@ -0,0 +1,91 @@ +#!/bin/bash -e + +SCRIPT_DIR=$(CDPATH= cd -- "$(dirname -- "$0")" && pwd) +HOME_DIR=$HOME +WASP_LANG_DIR=$HOME_DIR/.local/share/wasp-lang +ACTIVE_FILE=$WASP_LANG_DIR/active +BIN_DIR=$HOME_DIR/.local/bin +CABAL_ALIAS=$HOME_DIR/.cabal/bin/wasp-cli +FORCE_INSTALL=false + +for arg in "$@"; do + if [[ "$arg" == "--force" ]]; then + FORCE_INSTALL=true + fi +done + +# get version from waspc.cabal file +WASP_VERSION=$(awk '/^version:/ {print $2}' "$SCRIPT_DIR/../waspc.cabal") +if [[ -z "$WASP_VERSION" ]]; then + echo "Error: Unable to extract version from waspc.cabal" + exit 1 +fi + +TARGET_DIR="$WASP_LANG_DIR/$WASP_VERSION" +FINAL_WASP_VERSION="$WASP_VERSION" + +if [[ -d "$TARGET_DIR" ]]; then + echo "A version directory already exists: $TARGET_DIR" + echo "You can add a suffix to the version or overwrite the existing version." + + while true; do + read -p "Enter a suffix (or press Enter to overwrite): " SUFFIX + CLEANED_SUFFIX=$(echo "$SUFFIX" | sed 's/[^a-zA-Z0-9-]//g') + CLEANED_SUFFIX=$(echo "$CLEANED_SUFFIX" | sed 's/^-*//') + + if [[ -z "$SUFFIX" ]]; then + break + elif [[ "$CLEANED_SUFFIX" == "$SUFFIX" ]]; then + break + else + echo "Invalid suffix. Only letters, numbers, and dashes are allowed, and dashes cannot be at the beginning." + fi + done + + if [[ -n "$CLEANED_SUFFIX" ]]; then + TARGET_DIR="$WASP_LANG_DIR/${WASP_VERSION}-${CLEANED_SUFFIX}" + FINAL_WASP_VERSION="${WASP_VERSION}-${CLEANED_SUFFIX}" + fi +fi + +"$SCRIPT_DIR/install_packages_to_data_dir.sh" + +cabal install --overwrite-policy=always + +echo "Post-install: Setting up your Wasp build..." + +if [[ ! -f "$CABAL_ALIAS" ]]; then + echo "Error: Alias $CABAL_ALIAS does not exist." + exit 1 +fi + +if [[ "$FORCE_INSTALL" == true ]]; then + echo "Overwriting existing version..." + chmod -R u+w "$TARGET_DIR" || sudo chmod -R u+w "$TARGET_DIR" + rm -rf "$TARGET_DIR" +fi + +REAL_PATH=$(realpath "$CABAL_ALIAS") +STORE_DIR=$(dirname "$(dirname "$REAL_PATH")") +SHARE_DIR="$STORE_DIR/share" + +mkdir -p "$TARGET_DIR/data" +cp "$REAL_PATH" "$TARGET_DIR/wasp-bin" +chmod +x "$TARGET_DIR/wasp-bin" +cp -r "$SHARE_DIR/" "$TARGET_DIR/data/" +echo -n "$FINAL_WASP_VERSION" | sed 's/[[:space:]]//g' > "$ACTIVE_FILE" +mkdir -p "$BIN_DIR" +WASP_BIN="$BIN_DIR/wasp" + +# Create alias script at ~/.local/bin/wasp if it does not exist OR if --force is enabled +if [[ ! -f "$WASP_BIN" || "$FORCE_INSTALL" == true ]]; then + echo "Creating alias script at $WASP_BIN" + echo -e "#!/usr/bin/env bash\nwaspc_datadir=\"$TARGET_DIR/data\" \"$TARGET_DIR/wasp-bin\" \"\$@\"" > "$WASP_BIN" + chmod +x "$WASP_BIN" + RELEASE_FILE="$WASP_LANG_DIR/release" + echo -n "$FINAL_WASP_VERSION" | tr -d '[:space:]' > "$RELEASE_FILE" + echo "Updated release version to $FINAL_WASP_VERSION" +fi + +echo "Wasp $FINAL_WASP_VERSION installed successfully and set to the active version!" +echo "You can run it using: wasp " diff --git a/waspc/waspc.cabal b/waspc/waspc.cabal index a70ea00b5a..ceb9541627 100644 --- a/waspc/waspc.cabal +++ b/waspc/waspc.cabal @@ -577,6 +577,10 @@ library cli-lib Wasp.Cli.Command.Telemetry.User Wasp.Cli.Command.Test Wasp.Cli.Command.TsConfigSetup + Wasp.Cli.Command.Version.Download + Wasp.Cli.Command.Version.Executor + Wasp.Cli.Command.Version.VersionManagement + Wasp.Cli.Command.Version.Paths Wasp.Cli.Command.Watch Wasp.Cli.Command.WaspLS Wasp.Cli.Common @@ -594,6 +598,8 @@ executable wasp-cli base , async , waspc + , directory + , filepath , cli-lib , with-utf8 ^>= 1.0.2 other-modules: