From a25eeff5acc57215b836345c1aa7c082a1e63ca3 Mon Sep 17 00:00:00 2001 From: amesgen Date: Wed, 28 Jul 2021 04:20:14 +0200 Subject: [PATCH] support forge 1.17.x --- cabal.project | 2 +- hellsmack.cabal | 1 + src/HellSmack/ModLoader/Forge.hs | 122 +++++++++++++++++++++---------- src/HellSmack/Util/Minecraft.hs | 17 ++++- src/HellSmack/Vanilla.hs | 4 +- 5 files changed, 102 insertions(+), 44 deletions(-) diff --git a/cabal.project b/cabal.project index 55d9b05..9caf7e8 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,4 @@ packages: . with-compiler: ghc-8.10.5 -index-state: 2021-06-09T12:48:24Z +index-state: 2021-07-27T18:24:21Z diff --git a/hellsmack.cabal b/hellsmack.cabal index 2a62bf4..905c0bf 100644 --- a/hellsmack.cabal +++ b/hellsmack.cabal @@ -38,6 +38,7 @@ library build-depends: relude >= 1.0 + , split >= 0.2 , these >= 1.1 , semialign >= 1.2 , transformers >= 0.5 diff --git a/src/HellSmack/ModLoader/Forge.hs b/src/HellSmack/ModLoader/Forge.hs index a331672..9234e0a 100644 --- a/src/HellSmack/ModLoader/Forge.hs +++ b/src/HellSmack/ModLoader/Forge.hs @@ -1,6 +1,7 @@ module HellSmack.ModLoader.Forge ( ForgeVersion (..), isPre113, + isJigsaw, allVersionsManifestPath, findVersion, getVersionManifest, @@ -9,12 +10,17 @@ module HellSmack.ModLoader.Forge where import Codec.Archive.Zip +import Control.Lens.Unsound (adjoin) import Data.Conduit.Process.Typed +import Data.List (stripPrefix) +import Data.List.Lens +import Data.List.Split (splitOn) import Data.Text.Lens import Data.Time import HellSmack.Logging import HellSmack.ModLoader import HellSmack.Util +import HellSmack.Util.Meta qualified as Meta import HellSmack.Vanilla qualified as V import HellSmack.Yggdrasil import System.IO.Temp @@ -32,27 +38,30 @@ newtype ForgeVersion = ForgeVersion {unForgeVersion :: Text} -- $ -- >>> isPre113 (ForgeVersion "1.16.4-35.1.28") --- Right False +-- False -- >>> isPre113 (ForgeVersion "1.15-29.0.1") --- Right False +-- False -- >>> isPre113 (ForgeVersion "1.12.1-14.22.1.2480") --- Right True +-- True -- >>> isPre113 (ForgeVersion "1.4.5-6.4.2.447") --- Right True +-- True -- >>> isPre113 (ForgeVersion "1.7.10-10.13.2.1352-1.7.10") --- Right True +-- True -isPre113 :: ForgeVersion -> Either String Bool -isPre113 (ForgeVersion v) = maybeToRight "invalid forge version format" case v +mcMajorMinor :: MonadFail m => ForgeVersion -> m (Int, Int) +mcMajorMinor (ForgeVersion v) = case v & T.takeWhile (/= '-') & T.splitOn "." & take 2 & each %%~ readMaybe . toString of - Just [maj, min] -> pure $ (maj, min) < (1 :: Int, 13) - _ -> Nothing + Just [maj, min] -> pure (maj, min) + _ -> fail [i|invalid forge version format: $v|] -isPre113M :: MonadIO m => ForgeVersion -> m Bool -isPre113M = rethrow . isPre113 +isPre113 :: MonadFail m => ForgeVersion -> m Bool +isPre113 = fmap (< (1, 13)) . mcMajorMinor + +isJigsaw :: MonadFail m => ForgeVersion -> m Bool +isJigsaw = fmap (>= (1, 17)) . mcMajorMinor data VersionManifest = VersionManifest { id :: ForgeVersion, @@ -87,8 +96,7 @@ data Pre113Library = Pre113Library deriving anyclass (FromJSON) data InstallerManifest = InstallerManifest - { path :: MavenId, - dataEntries :: Map Text DataEntry, + { dataEntries :: Map Text DataEntry, processors :: [Processor], libraries :: [V.Library] } @@ -106,7 +114,8 @@ data Processor = Processor { jar :: MavenId, classpath :: [MavenId], args :: [Text], - outputs :: Maybe (Map Text Text) + outputs :: Maybe (Map Text Text), + sides :: Maybe [MCSide] } deriving stock (Show, Generic) deriving anyclass (FromJSON) @@ -146,7 +155,7 @@ getVersionManifest :: ForgeVersion -> m VersionManifest getVersionManifest fv = do - isPre113 <- isPre113M fv + isPre113 <- rethrow $ isPre113 fv let findVersionFile = do es <- mkEntrySelector "version.json" doesEntryExist es >>= \case @@ -291,6 +300,9 @@ getInstallerManifest fv = do decodeJSON . toLazy =<< extractFromInstaller fv toPath (mkEntrySelector "install_profile.json") getEntry +isServerOnlyProcessor :: Processor -> Bool +isServerOnlyProcessor p = MCServer `elem` do p ^.. #sides . #_Just . each + preprocess :: (MonadUnliftIO m, MRHasAll r '[MCSide, DirConfig, Manager, Logger, JavaConfig] m) => ForgeVersion -> @@ -328,16 +340,23 @@ preprocess fv vvm im = do logInfo "running preprocessor steps" tmpDir <- liftIO $ getCanonicalTemporaryDirectory >>= flip createTempDirectory "forge-preprocess" - mainJarPath <- reThrow $ toText . toFilePath <$> V.mainJarPath vvm + extraDataEntries <- + fmap M.fromList . (each . _2 %%~ identity) $ + [ ("{MINECRAFT_JAR}", reThrow $ toText . toFilePath <$> V.mainJarPath vvm), + ("{SIDE}", mcSideName) + ] dataMap <- - (dataMap <>) . (at "{MINECRAFT_JAR}" ?~ mainJarPath) <$> do + M.union extraDataEntries . M.union dataMap <$> do excess & each %%~ \(toString . T.drop 1 -> fp) -> do fp <- reThrow $ parseRelFile fp newFp <- liftIO $ parseAbsFile =<< emptyTempFile tmpDir "embedded" extractFromInstaller' fv fp newFp pure $ toText . toFilePath $ newFp - stepWise (withGenericProgress (length $ im ^. #processors)) \step -> - iforOf_ (#processors . ifolded) im \ipro pro -> step do + let preprocessors = + -- filter out the new (in forge 1.17.1) preprocessor which copies server scripts around + im ^.. #processors . each . filtered (not . isServerOnlyProcessor) + stepWise (withGenericProgress (length preprocessors)) \step -> + ifor_ preprocessors \ipro pro -> step do jarPath <- reThrow $ libraryPath $ pro ^. #jar classpath <- reThrow $ joinClasspath . (jarPath :) <$> traverse libraryPath (pro ^. #classpath) @@ -356,9 +375,9 @@ preprocess fv vvm im = do & setStdin nullStream & setStdout handle & setStderr handle - runProcess p >>= traverseOf #_ExitFailure \_ -> do - logInfo [i|preprocessing log dir: $tmpDir|] - throwString [i|preprocessing ${show ipro} failed!|] + logTrace [i|raw forge preprocessor process: ${show p}|] + runProcess p >>= #_ExitFailure \_ -> + throwString [i|preprocessing ${show ipro} failed! log dir: $tmpDir|] removeDirRecur =<< reThrow (parseAbsDir tmpDir) checkPreprocessingOutputs im (expandVia dataMap) >>= rethrow logInfo "finished preprocessing" @@ -408,7 +427,7 @@ launch fv = do fvm <- getVersionManifest fv libs <- reThrow $ getLibraries fvm vvm <- V.getVersionManifest $ fvm ^. #inheritsFrom - isPre113 <- isPre113M fv + isPre113 <- rethrow $ isPre113 fv unless isPre113 do im <- getInstallerManifest fv preprocess fv vvm im @@ -419,19 +438,44 @@ launch fv = do when isPre113 do logInfo "downloading main jar" V.downloadMainJar vvm - launcherJar <- - libs ^? each . #name . filtered (has $ #artifactId . only "forge") - & rethrow . maybeToRight "launcher library not found" >>= reThrow . libraryPath - jarManifest <- readJarManifest launcherJar - let expectEntry (k :: String) = rethrow . maybeToRight [i|$k not found|] - mainClass <- expectEntry "main class" $ jarManifest ^? ix "Main-Class" . unpacked - otherLibs <- do - raw <- expectEntry "classpath" $ jarManifest ^? ix "Class-Path" . to (T.splitOn " ") - libDir <- siehs @DirConfig #libraryDir - raw & each %%~ \case - (T.stripPrefix "libraries/" -> Just p) -> do - p <- reThrow $ parseRelFile $ toString p - pure $ libDir p - p | "minecraft_server." `T.isPrefixOf` p -> reThrow $ V.mainJarPath vvm - p -> throwString [i|invalid classpath entry: $p|] - runMCJava $ ["-cp", joinClasspath $ launcherJar : otherLibs] ++ [mainClass] + rethrow (isJigsaw fv) >>= \case + True -> do + argsFile <- reThrow $ parseRelFile [i|forge-args-${show fv}.txt|] + toPath <- siehs @DirConfig $ #manifestDir . to ( argsFile) + libraryDir <- toFilePath <$> siehs @DirConfig #libraryDir + let archiveArgsSelector = mkEntrySelector case Meta.os of + Meta.Windows -> "data/win_args.txt" + _ -> "data/unix_args.txt" + patchLibraryDir = + ( prefixed "-p " + `adjoin` prefixed "-DlegacyClassPath=" + `adjoin` prefixed "-DlibraryDirectory=" + ) + %~ \case + "libraries" -> libraryDir + classpath -> + intercalate classpathSeparator + . fmap (libraryDir <>) + . mapMaybe (stripPrefix "libraries/") + . splitOn classpathSeparator + $ classpath + extractArgs = toListOf $ lined . to patchLibraryDir . worded + args <- extractArgs . decodeUtf8 <$> extractFromInstaller fv toPath archiveArgsSelector getEntry + runMCJava args + False -> do + launcherJar <- + libs ^? each . #name . filtered (has $ #artifactId . only "forge") + & rethrow . maybeToRight "launcher library not found" >>= reThrow . libraryPath + jarManifest <- readJarManifest launcherJar + let expectEntry (k :: String) = rethrow . maybeToRight [i|$k not found|] + mainClass <- expectEntry "main class" $ jarManifest ^? ix "Main-Class" . unpacked + otherLibs <- do + raw <- expectEntry "classpath" $ jarManifest ^? ix "Class-Path" . to (T.splitOn " ") + libDir <- siehs @DirConfig #libraryDir + raw & each %%~ \case + (T.stripPrefix "libraries/" -> Just p) -> do + p <- reThrow $ parseRelFile $ toString p + pure $ libDir p + p | "minecraft_server." `T.isPrefixOf` p -> reThrow $ V.mainJarPath vvm + p -> throwString [i|invalid classpath entry: $p|] + runMCJava $ ["-cp", joinClasspath $ launcherJar : otherLibs] ++ [mainClass] diff --git a/src/HellSmack/Util/Minecraft.hs b/src/HellSmack/Util/Minecraft.hs index 891e444..6228784 100644 --- a/src/HellSmack/Util/Minecraft.hs +++ b/src/HellSmack/Util/Minecraft.hs @@ -11,6 +11,7 @@ module HellSmack.Util.Minecraft mavenIdUrl, mavenIdPath, libraryPath, + classpathSeparator, joinClasspath, JavaConfig (..), runMCJava, @@ -150,6 +151,13 @@ libraryPath mi = () <$> siehs @DirConfig #libraryDir <*> mavenIdPath mi data MCSide = MCClient | MCServer deriving stock (Show, Ord, Eq, Generic, Enum, Bounded) +instance FromJSON MCSide where + parseJSON = + parseJSON @Text >=> \case + "client" -> pure MCClient + "server" -> pure MCServer + s -> fail [i|invalid MC side: $s|] + mcSideName :: MRHas r MCSide m => m Text mcSideName = sieh <&> \case @@ -161,8 +169,11 @@ newtype MCVersion = MCVersion {unMCVersion :: Text} deriving newtype (Ord, Eq, FromJSON) deriving (Show) via (ShowWithoutQuotes Text) -joinClasspath :: [Path Abs File] -> String -joinClasspath = fold . intersperse [searchPathSeparator] . fmap toFilePath +classpathSeparator :: String +classpathSeparator = [searchPathSeparator] + +joinClasspath :: [Path Abs File] -> FilePath +joinClasspath = fold . intersperse classpathSeparator . fmap toFilePath data JavaConfig = JavaConfig { javaBin :: SomeBase File, @@ -176,7 +187,7 @@ runMCJava jvmArgs = do gdir <- sieh <&> toFilePath . unGameDir let p = proc (fromSomeFile javaBin) (extraJvmArgs ++ jvmArgs) & setWorkingDir gdir logInfo "launching minecraft" - logTrace [i|raw command: ${show p}|] + logTrace [i|raw MC command: ${show p}|] runProcess p >>= \case ExitSuccess -> logInfo "minecraft finished successfully" _ -> throwString "minecraft crashed :(" diff --git a/src/HellSmack/Vanilla.hs b/src/HellSmack/Vanilla.hs index b4c03cf..49dd15b 100644 --- a/src/HellSmack/Vanilla.hs +++ b/src/HellSmack/Vanilla.hs @@ -477,7 +477,7 @@ processArguments vm assets classpath = do natDir <- reThrow $ toFilePath <$> versionNativeDir vm pure (game, ["-cp", classpath, [i|-Djava.library.path=$natDir|]]) replaceInputs = - packed . [_regex|\$\{(?[\S]+)\}|] %%~ \cap -> + packed . [_regex|\$\{(?[^\}]+)\}|] %%~ \cap -> cap & _capture @0 %%~ const case cap ^. _capture @"prop" of "classpath" -> pure $ toText classpath "natives_directory" -> fromPath $ versionNativeDir vm @@ -497,6 +497,8 @@ processArguments vm assets classpath = do _ -> "unknown" "user_type" -> pure "mojang" -- NOTE legacy? "user_properties" -> pure "{}" + "library_directory" -> fromPath $ siehs @DirConfig #libraryDir + "classpath_separator" -> pure $ toText classpathSeparator input -> throwString [i|invalid input '${input}' in argument|] fromPath = reThrow . fmap (toText . toFilePath)