diff --git a/lib/SlackBuilder/Download.hs b/lib/SlackBuilder/Download.hs index 37f0eed..0907218 100644 --- a/lib/SlackBuilder/Download.hs +++ b/lib/SlackBuilder/Download.hs @@ -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) diff --git a/lib/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs index 874cd14..9fc1b7e 100644 --- a/lib/SlackBuilder/LatestVersionCheck.hs +++ b/lib/SlackBuilder/LatestVersionCheck.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 31186a3..d7adc88 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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