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 , hostedSources
, remoteFileExists , remoteFileExists
, responseBodySource , responseBodySource
, reqGet
, sinkFileAndHash , sinkFileAndHash
, sinkHash , sinkHash
, updateSlackBuildVersion , updateSlackBuildVersion
@ -76,7 +77,8 @@ import Conduit
, ZipSink(..) , ZipSink(..)
, await , await
, sourceFile , sourceFile
, leftover, awaitNonNull , leftover
, awaitNonNull
) )
import Data.Conduit.Tar (FileInfo(..), tarFilePath, untar) import Data.Conduit.Tar (FileInfo(..), tarFilePath, untar)
import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate) 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.Trans.Reader (asks)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Data.Char (isAlpha) 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 data PackageOwner = PackageOwner
{ owner :: Text { owner :: Text
@ -182,7 +186,7 @@ latestPackagist PackageOwner{..} = do
/: name <> ".json" /: name <> ".json"
in req GET uri NoReqBody jsonResponse mempty in req GET uri NoReqBody jsonResponse mempty
let packagistPackages = getField @"packages" let packagistPackages = getField @"packages"
$ responseBody (packagistResponse :: JsonResponse PackagistResponse) $ Network.HTTP.Req.responseBody (packagistResponse :: JsonResponse PackagistResponse)
fullName = Text.intercalate "/" [owner, name] fullName = Text.intercalate "/" [owner, name]
pure $ HashMap.lookup fullName packagistPackages pure $ HashMap.lookup fullName packagistPackages
@ -191,18 +195,27 @@ latestPackagist PackageOwner{..} = do
-- * Remote text file -- * Remote text file
data TextArguments = TextArguments data TextArguments = TextArguments
{ versionPicker :: Text -> Text { versionPicker :: Either (Text -> Text) [Text]
, textURL :: Text , textURL :: Text
} }
latestText :: TextArguments -> SlackBuilderT (Maybe Text) latestText :: TextArguments -> SlackBuilderT (Maybe Text)
latestText TextArguments{..} = do latestText TextArguments{..} = do
case versionPicker of
Left versionPicker' -> do
uri <- liftIO $ useHttpsURI <$> mkURI textURL uri <- liftIO $ useHttpsURI <$> mkURI textURL
packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri
pure $ versionPicker' . Text.Encoding.decodeUtf8 . Network.HTTP.Req.responseBody
<$> packagistResponse <$> packagistResponse
Right _ -> do
uri' <- mkURI textURL
runReq defaultHttpConfig $ reqGet uri' readResponse
where 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 go uri = req GET uri NoReqBody bsResponse mempty
-- * GitHub -- * GitHub
@ -276,7 +289,7 @@ latestGitHub PackageOwner{..} pattern' = do
let ghNodes = nodes let ghNodes = nodes
$ refs $ refs
$ (getField @"repository" :: GhData -> GhRepository) $ (getField @"repository" :: GhData -> GhRepository)
$ responseBody ghResponse $ Network.HTTP.Req.responseBody ghResponse
refs' = Vector.catMaybes refs' = Vector.catMaybes
$ match pattern' . getField @"name" <$> ghNodes $ match pattern' . getField @"name" <$> ghNodes
pure $ refs' !? 0 pure $ refs' !? 0

View File

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