{-# options_ghc -Wno-unused-imports -Wno-unused-top-binds #-}
module Algebra.Graph.IO.Internal.Conduit (fetchTarGz, unTarGz, fetch) where
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Function ((&))
import Data.ByteString (ByteString)
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)
import Data.Conduit.Zlib (ungzip)
import System.FilePath ((</>))
import Control.Monad.Catch (MonadThrow(..))
import Network.HTTP.Simple (httpSource, getResponseBody, Response, Request, parseRequest, setRequestMethod, setRequestSecure)
import Control.Monad.Primitive (PrimMonad(..))
import Data.Conduit.Tar (Header(..), untarChunks, TarChunk, withEntries, headerFileType, FileType(..), headerFilePath)
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
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
fetchTarGz :: String
-> FilePath
-> 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 ()
-> 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)