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) import qualified Data.Map as Map import Options.Applicative (execParser) import SlackBuilder.CommandLine import SlackBuilder.Config import SlackBuilder.Trans import SlackBuilder.Updater 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 (Package(..)) 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, makeRelative, splitFileName) 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) import Control.Monad (filterM) import Data.List (isPrefixOf, isSuffixOf, partition) autoUpdatable :: [Package] autoUpdatable = [ Package { latest = let ghArguments = GhArguments{ owner = "universal-ctags", name = "ctags", transform = Nothing} latest' = latestGitHub ghArguments pure 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 latest' $ reuploadWithTemplate template [] , category = "development" , name = "universal-ctags" , downloaders = mempty } , Package { latest = let packagistArguments = PackagistArguments{ vendor = "composer", name = "composer" } latest' = latestPackagist packagistArguments template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://getcomposer.org/download/" :| [Package.VersionPlaceholder, Package.StaticPlaceholder "/composer.phar"] in Package.Updater latest' $ downloadWithTemplate template False , category = "development" , name = "composer" , downloaders = mempty } , Package { latest = let ghArguments = GhArguments { owner = "jitsi" , name = "jitsi-meet-electron" , transform = Nothing } latest' = latestGitHub ghArguments $ Text.stripPrefix "v" 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 latest' $ downloadWithTemplate template False , category = "network" , name = "jitsi-meet-desktop" , downloaders = mempty } , Package { latest = let ghArguments = GhArguments { owner = "php" , name = "php-src" , transform = Nothing } checkVersion x | not $ Text.isInfixOf "RC" x , Text.isPrefixOf "php-8.2." x = Text.stripPrefix "php-" x | otherwise = Nothing latest' = latestGitHub ghArguments checkVersion template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://www.php.net/distributions/php-" :| Package.VersionPlaceholder : [Package.StaticPlaceholder ".tar.xz"] in Package.Updater latest' $ downloadWithTemplate template False , category = "development" , name = "php82" , downloaders = mempty } , Package { latest = let ghArguments = GhArguments { owner = "kovidgoyal" , name = "kitty" , transform = Nothing } latest' = latestGitHub ghArguments $ Text.stripPrefix "v" 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 latest' $ reuploadWithTemplate template [RawCommand "go" ["mod", "vendor"]] , category = "system" , name = "kitty" , downloaders = mempty } , Package { latest = let ghArguments = GhArguments { owner = "rdiff-backup" , name = "rdiff-backup" , transform = Nothing } latest' = latestGitHub ghArguments $ Text.stripPrefix "v" 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 latest' $ reuploadWithTemplate template [] , category = "system" , name = "rdiff-backup" , downloaders = mempty } , Package { 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 } latest' = latestText textArguments template = Package.DownloadTemplate $ pure $ Package.StaticPlaceholder "https://binaries.webex.com/WebexDesktop-Ubuntu-Official-Package/Webex.deb" in Package.Updater latest' $ downloadWithTemplate template True , category = "network" , name = "webex" , downloaders = mempty } , Package { latest = let ghArguments = GhArguments { owner = "librsync" , name = "librsync" , transform = Nothing } latest' = latestGitHub ghArguments $ Text.stripPrefix "v" 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 latest' $ reuploadWithTemplate template [] , category = "libraries" , name = "librsync" , downloaders = mempty } , Package { latest = let textArguments = TextArguments { textURL = "https://downloads.dlang.org/releases/LATEST" , versionPicker = Text.strip } latest' = latestText textArguments 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 latest' $ downloadWithTemplate template False , category = "development" , name = "dmd" , downloaders = mempty } , Package { latest = let textArguments = TextArguments { textURL = "https://downloads.dlang.org/releases/LATEST" , versionPicker = Text.strip } latest' = latestText textArguments template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://codeload.github.com/dlang/tools/tar.gz/v" :| [Package.VersionPlaceholder] in Package.Updater latest' $ reuploadWithTemplate template [] , category = "development" , name = "d-tools" , downloaders = let dubArguments = GhArguments{ owner = "dlang", name = "dub", transform = Nothing} dscannerArguments = GhArguments{ owner = "dlang-community", name = "D-Scanner", transform = Nothing } dcdArguments = GhArguments{ owner = "dlang-community", name = "DCD", transform = Nothing } latestDub = latestGitHub dubArguments pure latestDscanner = latestGitHub dscannerArguments pure latestDcd = latestGitHub dcdArguments pure 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|] dcdURI = [uri|https://github.com/dlang-community/DCD.git|] in Map.fromList [ ("DUB", Package.Updater latestDub $ downloadWithTemplate dubTemplate False) , ("DSCANNER", Package.Updater latestDscanner $ cloneFromGit dscannerURI "v") , ("DCD", Package.Updater latestDcd $ cloneFromGit dcdURI "v") ] } ] 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 package) >> liftIO (putStrLn "") check :: SlackBuilderT () check = for_ autoUpdatable go where go package = getAndLogLatest package >>= mapM_ (checkUpdateAvailability package) >> liftIO (putStrLn "") getAndLogLatest :: Package -> SlackBuilderT (Maybe Text) getAndLogLatest Package{ latest = Package.Updater{ detectLatest }, name } = liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.") >> detectLatest checkUpdateAvailability :: Package -> Text -> SlackBuilderT (Maybe PackageInfo) checkUpdateAvailability Package{..} version = do let packagePath = Text.unpack category Text.unpack name (Text.unpack 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 $ name <> " is up to date (Version " <> version <> ")." setSGR [Reset] pure Nothing | otherwise -> liftIO $ do setSGR [SetColor Foreground Dull Yellow] Text.IO.putStrLn $ "A new version of " <> name <> " " <> getField @"version" parsedInfoFile <> " is available (" <> version <> ")." setSGR [Reset] pure $ Just parsedInfoFile Left errorBundle -> liftIO (putStr $ errorBundlePretty errorBundle) >> pure Nothing updatePackageIfRequired :: Package -> Text -> SlackBuilderT () updatePackageIfRequired package version = checkUpdateAvailability package version >>= mapM_ (updatePackage package version) updateDownload :: Package -> Package.Updater -> SlackBuilderT (Package.Download, Text) updateDownload Package{..} Package.Updater{..} = do latestDownloadVersion <- fromJust <$> detectLatest result <- getVersion (Text.pack $ Text.unpack category Text.unpack name) latestDownloadVersion pure (result, latestDownloadVersion) cloneFromGit :: URI -> Text -> Text -> Text -> SlackBuilderT Package.Download cloneFromGit repo tagPrefix packagePath version = do repository' <- SlackBuilderT $ asks repository let downloadFileName = URI.unRText $ NonEmpty.last $ snd $ fromJust $ URI.uriPath repo relativeTarball = Text.unpack packagePath (dropExtension (Text.unpack downloadFileName) <> "-" <> Text.unpack version) tarball = repository' relativeTarball name' = Text.pack (takeBaseName $ Text.unpack packagePath) checksum <- clone (URI.render repo) (Text.pack tarball) tagPrefix uploadCommand (Text.pack relativeTarball) ("/" <> name') (flip . flip Package.Download) (fromJust checksum) False <$> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name' <> "/" <> downloadFileName) downloadWithTemplate :: Package.DownloadTemplate -> Bool -> Text -> Text -> SlackBuilderT Package.Download downloadWithTemplate downloadTemplate is64' packagePath version = do repository' <- SlackBuilderT $ asks repository uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version let downloadFileName = URI.unRText $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri' relativeTarball = packagePath <> "/" <> downloadFileName tarball = repository' Text.unpack relativeTarball checksum <- fromJust <$> download uri' tarball pure $ Package.Download uri' checksum is64' reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download reuploadWithTemplate downloadTemplate commands packagePath version = do Package.Download{ download = uri', md5sum = checksum } <- downloadWithTemplate downloadTemplate False packagePath version let downloadFileName = URI.unRText $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri' relativeTarball = packagePath <> "/" <> downloadFileName download' <- handleReupload relativeTarball downloadFileName pure $ Package.Download download' checksum False where name' = Text.pack $ takeBaseName $ Text.unpack packagePath handleReupload relativeTarball downloadFileName = do repository' <- SlackBuilderT $ asks repository case commands of [] -> uploadTarball relativeTarball downloadFileName _ -> let tarballPath = repository' Text.unpack relativeTarball packedDirectory = takeBaseName $ dropExtension tarballPath in liftIO (callProcess "tar" ["xvf", tarballPath]) >> liftIO (traverse (defaultCreateProcess packedDirectory) commands) >> liftIO (callProcess "tar" ["Jcvf", tarballPath, packedDirectory]) >> uploadTarball relativeTarball downloadFileName uploadTarball relativeTarball downloadFileName = liftIO (putStrLn $ "Upload the source tarball " <> Text.unpack relativeTarball) >> uploadCommand relativeTarball ("/" <> name') >> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name' <> "/" <> 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 } renderAndDownload :: Package -> Text -> SlackBuilderT Package.Download renderAndDownload Package{..} version = do let packagePath = category <> "/" <> name Package.Updater _ getVersion = latest getVersion packagePath version updatePackage :: Package -> Text -> PackageInfo -> SlackBuilderT () updatePackage package@Package{..} version info = do let packagePath = category <> "/" <> name repository' <- SlackBuilderT $ asks repository mainDownload <- renderAndDownload package version moreDownloads <- traverse (updateDownload package) downloaders let (downloads64, allDownloads) = partition (getField @"is64") $ mainDownload : toList (fst <$> moreDownloads) let infoFilePath = repository' Text.unpack packagePath (Text.unpack name <.> "info") package' = info { version = version , downloads = getField @"download" <$> allDownloads , checksums = getField @"md5sum" <$> allDownloads , downloadX64 = getField @"download" <$> downloads64 , checksumX64 = getField @"md5sum" <$> downloads64 } liftIO $ Text.IO.writeFile infoFilePath $ generate package' updateSlackBuildVersion packagePath version $ snd <$> moreDownloads commit packagePath version findCategory :: FilePath -> IO [FilePath] findCategory currentDirectory = do contents <- liftIO $ listDirectory currentDirectory case find (isSuffixOf ".info") contents of Just _ -> pure [currentDirectory] Nothing -> do let contents' = (currentDirectory ) <$> filter (not . isPrefixOf ".") contents directories <- filterM doesDirectoryExist contents' subCategories <- traverse findCategory directories pure $ concat subCategories 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 CategoryCommand -> do repository' <- SlackBuilderT $ asks repository categories <- liftIO $ findCategory repository' liftIO $ print $ splitFileName . makeRelative repository' <$> categories pure Nothing CheckCommand -> check >> pure Nothing Up2DateCommand packageName -> up2Date packageName >> pure Nothing