Eugen Wissner
fa6d93c5ca
There are source that can be downloaded as archive, for example cloning repositories with submodules. So how source are downloaded should be changable per download.
409 lines
18 KiB
Haskell
409 lines
18 KiB
Haskell
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.IO.Class (MonadIO(..))
|
|
import Data.Maybe (fromJust)
|
|
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 Crypto.Hash (Digest, MD5)
|
|
import Data.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)
|
|
|
|
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
|
|
, 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
|
|
, 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
|
|
, 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
|
|
, 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 = []
|
|
}
|
|
, 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
|
|
, 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}
|
|
latestDub = latestGitHub dubArguments pure
|
|
dubTemplate = Package.DownloadTemplate
|
|
$ Package.StaticPlaceholder "https://codeload.github.com/dlang/dub/tar.gz/v"
|
|
:| [Package.VersionPlaceholder]
|
|
in [Package.Updater latestDub $ downloadWithTemplate dubTemplate]
|
|
}
|
|
]
|
|
|
|
up2Date :: SlackBuilderT ()
|
|
up2Date = for_ autoUpdatable go
|
|
where
|
|
go package = getAndLogLatest package
|
|
>>= mapM_ (updatePackageIfRequired package)
|
|
>> liftIO (putStrLn "")
|
|
getAndLogLatest Package{ latest = Package.Updater{ detectLatest }, name }
|
|
= liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.")
|
|
>> detectLatest
|
|
|
|
updatePackageIfRequired :: Package -> Text -> SlackBuilderT ()
|
|
updatePackageIfRequired package@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]
|
|
| otherwise -> do
|
|
liftIO $ do
|
|
setSGR [SetColor Foreground Dull Yellow]
|
|
Text.IO.putStrLn
|
|
$ "A new version of "
|
|
<> name <> " " <> getField @"version" parsedInfoFile
|
|
<> " is available (" <> version <> ")."
|
|
setSGR [Reset]
|
|
updatePackage package parsedInfoFile version
|
|
Left errorBundle -> liftIO $ putStr $ errorBundlePretty errorBundle
|
|
|
|
updateDownload :: Package -> Package.Updater -> SlackBuilderT (URI, Digest MD5)
|
|
updateDownload package Package.Updater{ detectLatest } = detectLatest
|
|
>>= renderAndDownload package . fromJust
|
|
|
|
downloadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilderT (URI, Digest MD5)
|
|
downloadWithTemplate downloadTemplate 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 (uri', checksum)
|
|
|
|
reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT (URI, Digest MD5)
|
|
reuploadWithTemplate downloadTemplate commands packagePath version = do
|
|
(uri', checksum) <- downloadWithTemplate downloadTemplate packagePath version
|
|
let downloadFileName = URI.unRText
|
|
$ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
|
|
relativeTarball = packagePath <> "/" <> downloadFileName
|
|
download' <- handleReupload relativeTarball downloadFileName
|
|
|
|
pure (download', checksum)
|
|
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 (URI, Digest MD5)
|
|
renderAndDownload Package{..} version = do
|
|
let packagePath = category <> "/" <> name
|
|
Package.Updater _ getVersion = latest
|
|
|
|
getVersion packagePath version
|
|
|
|
updatePackage :: Package -> PackageInfo -> Text -> SlackBuilderT ()
|
|
updatePackage package@Package{..} info version = do
|
|
let packagePath = category <> "/" <> name
|
|
|
|
repository' <- SlackBuilderT $ asks repository
|
|
mainDownload <- renderAndDownload package version
|
|
moreDownloads <- traverse (updateDownload package) downloaders
|
|
let (allDownloads, allChecksums) = unzip $ mainDownload : moreDownloads
|
|
let infoFilePath = repository' </> Text.unpack packagePath
|
|
</> (Text.unpack name <.> "info")
|
|
package' = info
|
|
{ version = version
|
|
, downloads = allDownloads
|
|
, checksums = allChecksums
|
|
}
|
|
liftIO $ Text.IO.writeFile infoFilePath $ generate package'
|
|
updateSlackBuildVersion packagePath version
|
|
|
|
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 _packageName -> do
|
|
repository' <- SlackBuilderT $ asks repository
|
|
categories <- liftIO $ findCategory repository'
|
|
liftIO $ print $ splitFileName . makeRelative repository' <$> categories
|
|
pure Nothing
|
|
SlackBuildCommand packagePath version ->
|
|
updateSlackBuildVersion packagePath version >> pure Nothing
|
|
CommitCommand packagePath version ->
|
|
commit packagePath version >> pure Nothing
|
|
ExistsCommand urlPath -> pure . Text.pack . show
|
|
<$> remoteFileExists urlPath
|
|
ArchiveCommand repo nameVersion tarball tagPrefix ->
|
|
cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing
|
|
DownloadCommand url target
|
|
| Just uri' <- mkURI url -> fmap (Text.pack . show)
|
|
<$> download uri' target
|
|
| otherwise -> pure Nothing
|
|
CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show)
|
|
<$> clone repo tarball tagPrefix
|
|
DownloadAndDeployCommand uri' tarball -> fmap (Text.pack . show)
|
|
<$> downloadAndDeploy uri' tarball
|
|
Up2DateCommand -> up2Date >> pure Nothing
|