diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/SlackBuilder/Download.hs | 4 | ||||
| -rw-r--r-- | lib/SlackBuilder/LatestVersionCheck.hs | 29 |
2 files changed, 24 insertions, 9 deletions
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 - - pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody - <$> packagistResponse + case versionPicker of + Left versionPicker' -> do + uri <- liftIO $ useHttpsURI <$> mkURI textURL + + 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 |