{-# 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 :: ConduitT ByteString TarChunk m ()
unTarGz = ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString ByteString m ()
ungzip ConduitT ByteString ByteString m ()
-> ConduitT ByteString TarChunk m ()
-> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
          ConduitT ByteString TarChunk m ()
forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunks

-- | Download a file
fetch :: MonadResource m => Request -> ConduitT i ByteString m ()
fetch :: Request -> ConduitT i ByteString m ()
fetch Request
r = Request
-> (Response (ConduitT i ByteString m ())
    -> ConduitT i ByteString m ())
-> ConduitT i ByteString m ()
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 Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Bool -> Request -> Request
setRequestSecure Bool
False) Response (ConduitT i ByteString m ()) -> ConduitT i ByteString m ()
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 <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
path
  ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) () -> ResourceT IO ())
-> ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$
    Request -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
Request -> ConduitT i ByteString m ()
fetch Request
rq ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    ConduitT ByteString TarChunk (ResourceT IO) ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString TarChunk m ()
unTarGz ConduitT ByteString TarChunk (ResourceT IO) ()
-> ConduitM TarChunk Void (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
    (Header -> ConduitM ByteString Void (ResourceT IO) ())
-> ConduitM TarChunk Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadThrow m =>
(Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
withEntries (\Header
h -> Bool
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Header -> FileType
headerFileType Header
h FileType -> FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType
FTNormal) (String -> ConduitM ByteString Void (ResourceT IO) ()
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 :: (Header -> Bool)
-> ConduitT ByteString o m () -> ConduitT TarChunk o m ()
untarEntries Header -> Bool
f ConduitT ByteString o m ()
p = (Header -> ConduitT ByteString o m ()) -> ConduitT TarChunk o m ()
forall (m :: * -> *) o.
MonadThrow m =>
(Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
withEntries (\Header
h -> Bool -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Header -> Bool
f Header
h) ConduitT ByteString o m ()
p)