diff --git a/lib/SlackBuilder/Download.hs b/lib/SlackBuilder/Download.hs index 088f2cc..cf8b496 100644 --- a/lib/SlackBuilder/Download.hs +++ b/lib/SlackBuilder/Download.hs @@ -18,11 +18,13 @@ module SlackBuilder.Download , uploadSource ) where +import qualified Codec.Compression.Lzma as Lzma import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as Char8 import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty +import Data.NonNull (toNullable) import Data.Foldable (find) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -73,11 +75,11 @@ import Conduit , ZipSink(..) , await , sourceFile + , leftover, awaitNonNull ) import Data.Conduit.Tar (FileInfo(..), tarFilePath, untar) import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate) import Data.Void (Void) -import qualified Data.Conduit.Lzma as Lzma import qualified Data.Conduit.Zlib as Zlib import Control.Monad.Catch (MonadThrow(..)) import Data.Maybe (fromMaybe) @@ -191,7 +193,7 @@ cloneAndArchive repo tarballPath tagPrefix = do createLzmaTarball :: FilePath -> FilePath -> IO (Digest MD5) createLzmaTarball input output = runConduitRes $ yield input .| void tarFilePath - .| Lzma.compress Nothing + .| compressLzma .| sinkFileAndHash output responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m () @@ -272,6 +274,37 @@ sinkFileAndHash :: MonadResource m => FilePath -> ConduitT ByteString Void m (Di sinkFileAndHash target = getZipSink $ ZipSink (sinkFile target) *> ZipSink sinkHash +compressLzma :: MonadIO m => ConduitT ByteString ByteString m () +compressLzma = liftIO (Lzma.compressIO Lzma.defaultCompressParams) >>= go + where + go (Lzma.CompressInputRequired flush supplyInput) = do + next <- await + result <- case next of + Just input + | ByteString.null input -> liftIO flush + | otherwise -> liftIO $ supplyInput input + Nothing -> liftIO $ supplyInput mempty + go result + go (Lzma.CompressOutputAvailable output stream) = yield output + >> liftIO stream >>= go + go Lzma.CompressStreamEnd = pure () + +decompressLzma :: (MonadThrow m, MonadIO m) => ConduitT ByteString ByteString m () +decompressLzma = liftIO (Lzma.decompressIO Lzma.defaultDecompressParams) >>= go + where + go (Lzma.DecompressInputRequired processor) = do + next <- awaitNonNull + result <- case next of + Just input -> liftIO $ processor (toNullable input) + Nothing -> liftIO $ processor mempty + go result + go (Lzma.DecompressOutputAvailable output stream) = yield output + >> liftIO stream + >>= go + go (Lzma.DecompressStreamEnd output) = leftover output + go (Lzma.DecompressStreamError lzmaReturn) = throwM + $ LzmaDecompressionFailed lzmaReturn + -- | Downloads a compressed tar archive and extracts its contents on the fly to -- a directory. -- @@ -293,7 +326,7 @@ extractRemote uri' packagePath = | Just directoryName' <- stripExtension ".tar.gz" attachmentName' -> (Zlib.ungzip, Just directoryName') | Just directoryName' <- stripExtension ".tar.xz" attachmentName' -> - (Lzma.decompress Nothing, Just directoryName') + (decompressLzma, Just directoryName') _ -> (pure (), Nothing) runConduitRes $ responseBodySource response .| decompress diff --git a/lib/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs index ad8d6b8..a1e8abc 100644 --- a/lib/SlackBuilder/LatestVersionCheck.hs +++ b/lib/SlackBuilder/LatestVersionCheck.hs @@ -46,7 +46,6 @@ import qualified Data.Aeson.KeyMap as KeyMap import GHC.Records (HasField(..)) import Control.Monad.Trans.Reader (asks) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Applicative (Applicative(liftA2)) import Data.Char (isAlpha) data PackageOwner = PackageOwner diff --git a/lib/SlackBuilder/Trans.hs b/lib/SlackBuilder/Trans.hs index 8d1d5b6..3ab162c 100644 --- a/lib/SlackBuilder/Trans.hs +++ b/lib/SlackBuilder/Trans.hs @@ -17,10 +17,12 @@ import Control.Monad.Catch (MonadCatch(..), MonadThrow(..)) import Control.Exception (Exception(..)) import System.FilePath (()) import Text.URI (URI) +import qualified Codec.Compression.Lzma as Lzma data SlackBuilderException = UpdaterNotFound Text | HttpsUrlExpected URI + | LzmaDecompressionFailed Lzma.LzmaRet deriving Show instance Exception SlackBuilderException diff --git a/slackbuilder.cabal b/slackbuilder.cabal index 614c74f..ca68bce 100644 --- a/slackbuilder.cabal +++ b/slackbuilder.cabal @@ -41,10 +41,10 @@ common dependencies process ^>= 1.6.18, req ^>= 3.13, tar-conduit ^>= 0.4, - lzma-conduit ^>= 1.2, + lzma ^>= 0.0.1, text ^>= 2.1, tomland ^>= 1.3.3, - transformers ^>= 0.5.6, + transformers ^>= 0.6.1, unordered-containers ^>= 0.2.20, vector ^>= 0.13.0, word8 ^>= 0.1.3 @@ -73,6 +73,8 @@ library SlackBuilder.Trans hs-source-dirs: lib ghc-options: -Wall + build-depends: + mono-traversable ^>= 1.0.17 executable slackbuilder import: dependencies diff --git a/src/Main.hs b/src/Main.hs index 1ea73da..ec74432 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,7 +7,6 @@ module Main ) where import Data.Char (isNumber) -import Control.Applicative (Applicative(..)) import Data.List.NonEmpty (NonEmpty(..)) import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.IO.Class (MonadIO(..)) diff --git a/src/SlackBuilder/Update.hs b/src/SlackBuilder/Update.hs index fa7dda1..0c7ce6f 100644 --- a/src/SlackBuilder/Update.hs +++ b/src/SlackBuilder/Update.hs @@ -11,7 +11,6 @@ module SlackBuilder.Update , updatePackageIfRequired ) where -import Control.Applicative (Applicative(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Reader (asks) import qualified Data.ByteString as ByteString