{-# options_ghc -Wno-unused-imports -Wno-unused-top-binds #-}
-- | Miscellaneous conduit-related functionality
--
-- Networking, compression
module Algebra.Graph.IO.Internal.Conduit (fetchTarGz, unTarGz, fetch) where

import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Function ((&))

-- bytestring
import Data.ByteString (ByteString)
-- conduit
import Conduit (MonadUnliftIO(..), MonadResource, runResourceT)
import Data.Conduit (runConduit, ConduitT, (.|), yield, await)
import qualified Data.Conduit.Combinators as C (print, sourceFile, sinkFile, map, mapM, foldM, mapWhile)
-- conduit-extra
import Data.Conduit.Zlib (ungzip)
-- filepath
import System.FilePath ((</>))
-- exceptions
import Control.Monad.Catch (MonadThrow(..))
-- http-conduit
import Network.HTTP.Simple (httpSource, getResponseBody, Response, Request, parseRequest, setRequestMethod, setRequestSecure)
-- primitive
import Control.Monad.Primitive (PrimMonad(..))
-- tar-conduit
import Data.Conduit.Tar (Header(..), untarChunks, TarChunk, withEntries, headerFileType, FileType(..), headerFilePath)


-- | Decompress a .tar.gz stream
unTarGz :: (PrimMonad m, MonadThrow m) => ConduitT ByteString TarChunk m ()
unTarGz :: forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString TarChunk m ()
unTarGz = forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString ByteString m ()
ungzip forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
          forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunks

-- | Download a file
fetch :: MonadResource m => Request -> ConduitT i ByteString m ()
fetch :: forall (m :: * -> *) i.
MonadResource m =>
Request -> ConduitT i ByteString m ()
fetch Request
r = forall (m :: * -> *) (n :: * -> *) i o r.
(MonadResource m, MonadIO n) =>
Request
-> (Response (ConduitM i ByteString n ()) -> ConduitM i o m r)
-> ConduitM i o m r
httpSource (Request
r forall a b. a -> (a -> b) -> b
& Bool -> Request -> Request
setRequestSecure Bool
False) forall a. Response a -> a
getResponseBody

-- | Download, decompress and save a .tar.gz archive
fetchTarGz :: String -- ^ URL with the .tar.gz
           -> FilePath -- ^ directory where to store archive contents
           -> IO ()
fetchTarGz :: String -> String -> IO ()
fetchTarGz String
path String
fp = do
  Request
rq <- forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
path
  forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) i.
MonadResource m =>
Request -> ConduitT i ByteString m ()
fetch Request
rq forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString TarChunk m ()
unTarGz forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    forall (m :: * -> *) o.
MonadThrow m =>
(Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
withEntries (\Header
h -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Header -> FileType
headerFileType Header
h forall a. Eq a => a -> a -> Bool
== FileType
FTNormal) (forall (m :: * -> *) o.
MonadResource m =>
String -> ConduitT ByteString o m ()
C.sinkFile (String
fp String -> String -> String
</> Header -> String
headerFilePath Header
h)))

untarEntries :: MonadThrow m =>
              (Header -> Bool)
           -> ConduitT ByteString o m () -- ^ process the content of each file that satisfies the predicate
           -> ConduitT TarChunk o m ()
untarEntries :: forall (m :: * -> *) o.
MonadThrow m =>
(Header -> Bool)
-> ConduitT ByteString o m () -> ConduitT TarChunk o m ()
untarEntries Header -> Bool
f ConduitT ByteString o m ()
p = forall (m :: * -> *) o.
MonadThrow m =>
(Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
withEntries (\Header
h -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Header -> Bool
f Header
h) ConduitT ByteString o m ()
p)