{- This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. -} module Main ( main ) where import Data.Char (isNumber) import Control.Applicative (Applicative(liftA2)) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.IO.Class (MonadIO(..)) import Data.Maybe (fromJust, fromMaybe) import qualified Data.Map as Map import Options.Applicative (execParser) import SlackBuilder.CommandLine import SlackBuilder.Config import SlackBuilder.Trans import SlackBuilder.LatestVersionCheck import qualified Toml import qualified Data.ByteString as ByteString import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import Control.Monad.Trans.Reader (ReaderT(..), asks) import SlackBuilder.Download import SlackBuilder.Package (PackageDescription(..), PackageUpdateData(..)) import qualified SlackBuilder.Package as Package import Text.URI (URI(..), mkURI) import Text.URI.QQ (uri) import Data.Foldable (Foldable(..), for_, find) import qualified Text.URI as URI import System.FilePath ( () , (<.>) , dropExtension , takeBaseName , splitFileName , takeDirectory , takeFileName , dropTrailingPathSeparator ) import SlackBuilder.Info import Text.Megaparsec (parse, errorBundlePretty) import GHC.Records (HasField(..)) import System.Process ( CmdSpec(..) , CreateProcess(..) , StdStream(..) , callProcess , withCreateProcess , waitForProcess ) import System.Console.ANSI ( setSGR , SGR(..) , ColorIntensity(..) , Color(..) , ConsoleLayer(..) ) import System.Directory (listDirectory, doesDirectoryExist, withCurrentDirectory, removeDirectoryRecursive) import Control.Monad (filterM) import Data.List (isPrefixOf, isSuffixOf, partition) import Conduit (runConduitRes, (.|), sourceFile) import Data.Functor ((<&>)) import Data.Bifunctor (Bifunctor(..)) autoUpdatable :: [PackageDescription] autoUpdatable = [ PackageDescription { latest = let ghArguments = PackageOwner{ owner = "universal-ctags", name = "ctags" } templateTail = [ Package.VersionPlaceholder , Package.StaticPlaceholder "/ctags-" , Package.VersionPlaceholder , Package.StaticPlaceholder ".tar.gz" ] template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://github.com/universal-ctags/ctags/archive/" :| templateTail in Package.Updater { detectLatest = latestGitHub ghArguments stableTagTransform , getVersion = reuploadWithTemplate template [] , is64 = False } , name = "universal-ctags" , downloaders = mempty } , PackageDescription { latest = let packagistArguments = PackageOwner{ owner = "composer", name = "composer" } template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://getcomposer.org/download/" :| [Package.VersionPlaceholder, Package.StaticPlaceholder "/composer.phar"] in Package.Updater { detectLatest = latestPackagist packagistArguments , getVersion = downloadWithTemplate template , is64 = False } , name = "composer" , downloaders = mempty } , PackageDescription { latest = let ghArguments = PackageOwner { owner = "jitsi" , name = "jitsi-meet-electron" } template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://github.com/jitsi/jitsi-meet-electron/releases/download/v" :| Package.VersionPlaceholder : [Package.StaticPlaceholder "/jitsi-meet-x86_64.AppImage"] in Package.Updater { detectLatest = latestGitHub ghArguments $ Text.stripPrefix "v" , getVersion = downloadWithTemplate template , is64 = True } , name = "jitsi-meet-desktop" , downloaders = mempty } , PackageDescription { latest = let ghArguments = PackageOwner { owner = "php" , name = "php-src" } checkVersion x | not $ Text.isInfixOf "RC" x , Text.isPrefixOf "php-8.2." x = Text.stripPrefix "php-" x | otherwise = Nothing template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://www.php.net/distributions/php-" :| Package.VersionPlaceholder : [Package.StaticPlaceholder ".tar.xz"] in Package.Updater { detectLatest = latestGitHub ghArguments checkVersion , getVersion = downloadWithTemplate template , is64 = False } , name = "php82" , downloaders = mempty } , PackageDescription { latest = let ghArguments = PackageOwner { owner = "kovidgoyal" , name = "kitty" } templateTail = [ Package.StaticPlaceholder "/kitty-" , Package.VersionPlaceholder , Package.StaticPlaceholder ".tar.xz" ] template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://github.com/kovidgoyal/kitty/releases/download/v" :| Package.VersionPlaceholder : templateTail in Package.Updater { detectLatest = latestGitHub ghArguments stableTagTransform , getVersion = reuploadWithTemplate template [RawCommand "go" ["mod", "vendor"]] , is64 = False } , name = "kitty" , downloaders = mempty } , PackageDescription { latest = let ghArguments = PackageOwner { owner = "rdiff-backup" , name = "rdiff-backup" } template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://github.com/rdiff-backup/rdiff-backup/releases/download/v" :| Package.VersionPlaceholder : Package.StaticPlaceholder "/rdiff-backup-" : Package.VersionPlaceholder : [Package.StaticPlaceholder ".tar.gz"] in Package.Updater { detectLatest = latestGitHub ghArguments $ Text.stripPrefix "v" , getVersion = reuploadWithTemplate template [] , is64 = False } , name = "rdiff-backup" , downloaders = mempty } , PackageDescription { latest = let needle = "Linux—" textArguments = TextArguments { textURL = "https://help.webex.com/en-us/article/mqkve8/Webex-App-%7C-Release-notes" , versionPicker = Text.takeWhile (liftA2 (||) (== '.') isNumber) . Text.drop (Text.length needle) . snd . Text.breakOn needle } template = Package.DownloadTemplate $ pure $ Package.StaticPlaceholder "https://binaries.webex.com/WebexDesktop-Ubuntu-Official-Package/Webex.deb" in Package.Updater { detectLatest = latestText textArguments , getVersion = downloadWithTemplate template , is64 = True } , name = "webex" , downloaders = mempty } , PackageDescription { latest = let ghArguments = PackageOwner { owner = "librsync" , name = "librsync" } template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://github.com/librsync/librsync/archive/v" :| Package.VersionPlaceholder : Package.StaticPlaceholder "/librsync-" : Package.VersionPlaceholder : [Package.StaticPlaceholder ".tar.gz"] in Package.Updater { detectLatest = latestGitHub ghArguments $ Text.stripPrefix "v" , getVersion = reuploadWithTemplate template [] , is64 = True } , name = "librsync" , downloaders = mempty } , PackageDescription { latest = let textArguments = TextArguments { textURL = "https://downloads.dlang.org/releases/LATEST" , versionPicker = Text.strip } template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://downloads.dlang.org/releases/2.x/" :| Package.VersionPlaceholder : Package.StaticPlaceholder "/dmd." : Package.VersionPlaceholder : [Package.StaticPlaceholder ".linux.tar.xz"] in Package.Updater { detectLatest = latestText textArguments , getVersion = downloadWithTemplate template , is64 = False } , name = "dmd" , downloaders = mempty } , PackageDescription { latest = let textArguments = TextArguments { textURL = "https://downloads.dlang.org/releases/LATEST" , versionPicker = Text.strip } template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://codeload.github.com/dlang/tools/tar.gz/v" :| [Package.VersionPlaceholder] in Package.Updater { detectLatest = latestText textArguments , getVersion = reuploadWithTemplate template [] , is64 = False } , name = "d-tools" , downloaders = let dubArguments = PackageOwner{ owner = "dlang", name = "dub" } dscannerArguments = PackageOwner{ owner = "dlang-community", name = "D-Scanner" } dcdArguments = PackageOwner{ owner = "dlang-community", name = "DCD" } latestDub = Package.Updater { detectLatest = latestGitHub dubArguments stableTagTransform , getVersion = downloadWithTemplate dubTemplate , is64 = False } latestDscanner = Package.Updater { detectLatest = latestGitHub dscannerArguments stableTagTransform , getVersion = cloneFromGit dscannerURI "v" , is64 = False } dcdURI = [uri|https://github.com/dlang-community/DCD.git|] latestDcd = Package.Updater { detectLatest = latestGitHub dcdArguments stableTagTransform , getVersion = cloneFromGit dcdURI "v" , is64 = False } dubTemplate = Package.DownloadTemplate $ Package.StaticPlaceholder "https://codeload.github.com/dlang/dub/tar.gz/v" :| [Package.VersionPlaceholder] dscannerURI = [uri|https://github.com/dlang-community/D-Scanner.git|] in Map.fromList [ ("DUB", latestDub) , ("DSCANNER", latestDscanner) , ("DCD", latestDcd) ] } ] up2Date :: Maybe Text -> SlackBuilderT () up2Date = \case Nothing -> for_ autoUpdatable go Just packageName | Just foundPackage <- find ((packageName ==) . getField @"name") autoUpdatable -> go foundPackage | otherwise -> throwM $ UpdaterNotFound packageName where go package = getAndLogLatest package >>= mapM_ updatePackageIfRequired >> liftIO (putStrLn "") check :: SlackBuilderT () check = for_ autoUpdatable go where go package = getAndLogLatest package >>= mapM_ checkUpdateAvailability >> liftIO (putStrLn "") getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData) getAndLogLatest description = do let PackageDescription{ latest = Package.Updater{ detectLatest }, name } = description liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.") detectedVersion <- detectLatest category <- fmap Text.pack <$> findCategory (Text.unpack name) pure $ PackageUpdateData description <$> category <*> detectedVersion checkUpdateAvailability :: PackageUpdateData -> SlackBuilderT (Maybe PackageInfo) checkUpdateAvailability PackageUpdateData{..} = do let name' = Text.unpack $ getField @"name" description packagePath = Text.unpack category name' (name' <.> "info") repository' <- SlackBuilderT $ asks repository infoContents <- liftIO $ ByteString.readFile $ repository' packagePath case parse parseInfoFile packagePath infoContents of Right parsedInfoFile | version == getField @"version" parsedInfoFile -> liftIO $ do setSGR [SetColor Foreground Dull Green] Text.IO.putStrLn $ getField @"name" description <> " is up to date (Version " <> version <> ")." setSGR [Reset] pure Nothing | otherwise -> liftIO $ do setSGR [SetColor Foreground Dull Yellow] Text.IO.putStr $ "A new version of " <> getField @"name" description <> " " <> getField @"version" parsedInfoFile <> " is available (" <> version <> ")." setSGR [Reset] putStrLn "" pure $ Just parsedInfoFile Left errorBundle -> liftIO (putStr $ errorBundlePretty errorBundle) >> pure Nothing updatePackageIfRequired :: PackageUpdateData -> SlackBuilderT () updatePackageIfRequired updateData = checkUpdateAvailability updateData >>= mapM_ (updatePackage updateData) data DownloadUpdated = DownloadUpdated { result :: Package.Download , version :: Text , is64 :: Bool } deriving (Eq, Show) updateDownload :: Text -> Package.Updater -> SlackBuilderT DownloadUpdated updateDownload packagePath Package.Updater{..} = do latestDownloadVersion <- fromJust <$> detectLatest result <- getVersion packagePath latestDownloadVersion pure $ DownloadUpdated { result = result , version = latestDownloadVersion , is64 = is64 } cloneFromGit :: URI -> Text -> Text -> Text -> SlackBuilderT Package.Download cloneFromGit repo tagPrefix packagePath version = do let downloadFileName = URI.unRText $ NonEmpty.last $ snd $ fromJust $ URI.uriPath repo relativeTarball = Text.unpack packagePath (dropExtension (Text.unpack downloadFileName) <> "-" <> Text.unpack version) (uri', checksum) <- cloneAndUpload (URI.render repo) relativeTarball tagPrefix pure $ Package.Download { md5sum = checksum , download = uri' } downloadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilderT Package.Download downloadWithTemplate downloadTemplate packagePath version = do repository' <- SlackBuilderT $ asks repository uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version checksum <- download uri' $ repository' Text.unpack packagePath pure $ Package.Download uri' $ snd checksum reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download reuploadWithTemplate downloadTemplate commands packagePath version = do repository' <- SlackBuilderT $ asks repository uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version let downloadFileName = Text.unpack $ URI.unRText $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri' packagePathRelativeToCurrent = repository' Text.unpack packagePath (checksum, relativeTarball') <- case commands of [] -> do (downloadedFileName, checksum) <- download uri' packagePathRelativeToCurrent pure (checksum, packagePathRelativeToCurrent downloadedFileName) _ -> do changedArchiveRootName <- extractRemote uri' packagePathRelativeToCurrent let relativeTarball = packagePathRelativeToCurrent fromMaybe downloadFileName changedArchiveRootName prepareSource relativeTarball checksum <- liftIO $ runConduitRes $ sourceFile relativeTarball .| sinkHash pure (checksum, relativeTarball) download' <- handleReupload relativeTarball' downloadFileName pure $ Package.Download download' checksum where name' = Text.pack $ takeBaseName $ Text.unpack packagePath prepareSource tarballPath = do let packedDirectory = dropExtension $ dropExtension tarballPath in liftIO (traverse (defaultCreateProcess packedDirectory) commands) >> liftIO ( withCurrentDirectory (takeDirectory tarballPath) $ callProcess "tar" ["Jcvf", takeFileName tarballPath, takeFileName packedDirectory] ) >> liftIO (removeDirectoryRecursive packedDirectory) handleReupload relativeTarball downloadFileName = do downloadURL' <- SlackBuilderT $ asks downloadURL liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball uploadCommand relativeTarball ("/" <> name') liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> Text.pack downloadFileName defaultCreateProcess cwd' cmdSpec = flip withCreateProcess (const . const . const waitForProcess) $ CreateProcess { use_process_jobs = False , std_out = Inherit , std_in = NoStream , std_err = Inherit , new_session = False , env = Nothing , detach_console = False , delegate_ctlc = False , cwd = Just cwd' , create_new_console = False , create_group = False , cmdspec = cmdSpec , close_fds = True , child_user = Nothing , child_group = Nothing } updatePackage :: PackageUpdateData -> PackageInfo -> SlackBuilderT () updatePackage PackageUpdateData{..} info = do let packagePath = category <> "/" <> getField @"name" description latest' = getField @"latest" description repository' <- SlackBuilderT $ asks repository mainDownload <- (, getField @"is64" latest') <$> getField @"getVersion" latest' packagePath version moreDownloads <- traverse (updateDownload packagePath) $ getField @"downloaders" description let (downloads64, allDownloads) = partition snd $ mainDownload : (liftA2 (,) (getField @"result") (getField @"is64") <$> toList moreDownloads) let infoFilePath = repository' Text.unpack packagePath (Text.unpack (getField @"name" description) <.> "info") package' = info { version = version , downloads = getField @"download" . fst <$> allDownloads , checksums = getField @"md5sum" . fst <$> allDownloads , downloadX64 = getField @"download" . fst <$> downloads64 , checksumX64 = getField @"md5sum" . fst <$> downloads64 } liftIO $ Text.IO.writeFile infoFilePath $ generate package' updateSlackBuildVersion packagePath version $ getField @"version" <$> moreDownloads commit packagePath version findCategory :: FilePath -> SlackBuilderT (Maybe FilePath) findCategory packageName = do repository' <- SlackBuilderT $ asks repository go repository' [] "" <&> fmap fst . find ((packageName ==) . snd) where go currentDirectory found accumulatedDirectory = do let fullDirectory = currentDirectory accumulatedDirectory contents <- liftIO $ listDirectory fullDirectory case find (isSuffixOf ".info") contents of Just _ -> let result = first dropTrailingPathSeparator $ splitFileName accumulatedDirectory in pure $ result : found Nothing -> let accumulatedDirectories = (accumulatedDirectory ) <$> filter (not . isPrefixOf ".") contents directoryFilter = liftIO . doesDirectoryExist . (currentDirectory ) in filterM directoryFilter accumulatedDirectories >>= traverse (go currentDirectory found) <&> concat main :: IO () main = do programCommand <- execParser slackBuilderParser settings <- Toml.decodeFile settingsCodec "config/config.toml" latestVersion <- flip runReaderT settings $ runSlackBuilderT $ executeCommand programCommand maybe (pure ()) Text.IO.putStrLn latestVersion where executeCommand = \case CheckCommand -> check >> pure Nothing Up2DateCommand packageName -> up2Date packageName >> pure Nothing