Implement experimental version picking command
All checks were successful
Build / audit (push) Successful in 8s
Build / test (push) Successful in 14m39s

... for webex.
This commit is contained in:
Eugen Wissner 2024-09-24 21:28:01 +02:00
parent 00cc58f87e
commit f758ea7904
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 27 additions and 17 deletions

View File

@ -12,6 +12,7 @@ module SlackBuilder.Download
, hostedSources
, remoteFileExists
, responseBodySource
, reqGet
, sinkFileAndHash
, sinkHash
, updateSlackBuildVersion
@ -76,7 +77,8 @@ import Conduit
, ZipSink(..)
, await
, sourceFile
, leftover, awaitNonNull
, leftover
, awaitNonNull
)
import Data.Conduit.Tar (FileInfo(..), tarFilePath, untar)
import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)

View File

@ -47,6 +47,10 @@ import GHC.Records (HasField(..))
import Control.Monad.Trans.Reader (asks)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Char (isAlpha)
import SlackBuilder.Download (responseBodySource, reqGet)
import Network.HTTP.Client (BodyReader, Response(..))
import Conduit (await)
import Data.Conduit.Process (sourceCmdWithStreams)
data PackageOwner = PackageOwner
{ owner :: Text
@ -182,7 +186,7 @@ latestPackagist PackageOwner{..} = do
/: name <> ".json"
in req GET uri NoReqBody jsonResponse mempty
let packagistPackages = getField @"packages"
$ responseBody (packagistResponse :: JsonResponse PackagistResponse)
$ Network.HTTP.Req.responseBody (packagistResponse :: JsonResponse PackagistResponse)
fullName = Text.intercalate "/" [owner, name]
pure $ HashMap.lookup fullName packagistPackages
@ -191,18 +195,27 @@ latestPackagist PackageOwner{..} = do
-- * Remote text file
data TextArguments = TextArguments
{ versionPicker :: Text -> Text
{ versionPicker :: Either (Text -> Text) [Text]
, textURL :: Text
}
latestText :: TextArguments -> SlackBuilderT (Maybe Text)
latestText TextArguments{..} = do
uri <- liftIO $ useHttpsURI <$> mkURI textURL
packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
case versionPicker of
Left versionPicker' -> do
uri <- liftIO $ useHttpsURI <$> mkURI textURL
pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody
<$> packagistResponse
packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
pure $ versionPicker' . Text.Encoding.decodeUtf8 . Network.HTTP.Req.responseBody
<$> packagistResponse
Right _ -> do
uri' <- mkURI textURL
runReq defaultHttpConfig $ reqGet uri' readResponse
where
readResponse :: Response BodyReader -> IO (Maybe Text)
readResponse response = do
(_, stdout', _) <- sourceCmdWithStreams "grep -oh 'Linux—[[:digit:].]\\+'" (responseBodySource response) await (pure ())
pure $ Text.drop 6 . head . Text.lines . Text.Encoding.decodeUtf8 <$> stdout'
go uri = req GET uri NoReqBody bsResponse mempty
-- * GitHub
@ -276,7 +289,7 @@ latestGitHub PackageOwner{..} pattern' = do
let ghNodes = nodes
$ refs
$ (getField @"repository" :: GhData -> GhRepository)
$ responseBody ghResponse
$ Network.HTTP.Req.responseBody ghResponse
refs' = Vector.catMaybes
$ match pattern' . getField @"name" <$> ghNodes
pure $ refs' !? 0

View File

@ -6,7 +6,6 @@ module Main
( main
) where
import Data.Char (isNumber)
import Control.Monad.Catch (MonadThrow(..), handle)
import Control.Monad.IO.Class (MonadIO(..))
import qualified Data.Map as Map
@ -118,13 +117,9 @@ autoUpdatable packageSettings =
}
, PackageDescription
{ latest =
let needle = "Linux—"
textArguments = TextArguments
let textArguments = TextArguments
{ textURL = fromJust $ getField @"text" setting
, versionPicker = Text.takeWhile (liftA2 (||) (== '.') isNumber)
. Text.drop (Text.length needle)
. snd
. Text.breakOn needle
, versionPicker = Right ["grep", "-oh", "Linux—[[:digit:].]\\+"]
}
setting = fromJust $ find ((== "webex") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
@ -153,7 +148,7 @@ autoUpdatable packageSettings =
{ latest =
let textArguments = TextArguments
{ textURL = fromJust $ getField @"text" setting
, versionPicker = Text.strip
, versionPicker = Left Text.strip
}
setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting
@ -169,7 +164,7 @@ autoUpdatable packageSettings =
{ latest =
let textArguments = TextArguments
{ textURL = fromJust $ getField @"text" setting
, versionPicker = Text.strip
, versionPicker = Left Text.strip
}
setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings
template = Package.DownloadTemplate $ getField @"template" setting