Provide own lzma conduit adapters

6 files changed, 42 insertions, 8 deletions

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