Provide own lzma conduit adapters

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

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

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

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

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(..))

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