{-# LANGUAGE OverloadedStrings #-}

module Package.C.Fetch ( fetchUrl
                       ) where

import           CPkgPrelude
import qualified Data.ByteString.Lazy    as BSL
import           Data.List               (isSuffixOf)
import           Data.Maybe              (fromJust)
import           Network.HTTP.Client
import           Network.HTTP.Client.TLS (tlsManagerSettings)
import           Network.URI
import           Package.C.Db.Register
import           Package.C.Error
import           Package.C.Logging
import           Package.C.Monad
import           Package.C.Unpack
import           System.Directory        (createDirectoryIfMissing)
import           System.FilePath         (takeFileName)

urlToCompression :: MonadIO m => String -> m Compression
urlToCompression :: forall (m :: * -> *). MonadIO m => [Char] -> m Compression
urlToCompression [Char]
s | [Char]
".tar.gz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s Bool -> Bool -> Bool
|| [Char]
".tgz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compression -> m Compression) -> Compression -> m Compression
forall a b. (a -> b) -> a -> b
$ TarCompress -> Compression
Tar TarCompress
Gz
                   | [Char]
".tar.xz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s Bool -> Bool -> Bool
|| [Char]
".txz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compression -> m Compression) -> Compression -> m Compression
forall a b. (a -> b) -> a -> b
$ TarCompress -> Compression
Tar TarCompress
Xz
                   | [Char]
".tar.bz2" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compression -> m Compression) -> Compression -> m Compression
forall a b. (a -> b) -> a -> b
$ TarCompress -> Compression
Tar TarCompress
Bz2
                   | [Char]
".tar.lz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compression -> m Compression) -> Compression -> m Compression
forall a b. (a -> b) -> a -> b
$ TarCompress -> Compression
Tar TarCompress
Lz
                   | [Char]
".tar.zst" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compression -> m Compression) -> Compression -> m Compression
forall a b. (a -> b) -> a -> b
$ TarCompress -> Compression
Tar TarCompress
Zstd
                   | [Char]
".cpio.gz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compression -> m Compression) -> Compression -> m Compression
forall a b. (a -> b) -> a -> b
$ TarCompress -> Compression
Cpio TarCompress
Gz
                   | [Char]
".tar" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compression -> m Compression) -> Compression -> m Compression
forall a b. (a -> b) -> a -> b
$ TarCompress -> Compression
Tar TarCompress
None
                   | [Char]
".zip" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s = Compression -> m Compression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Compression
Zip
                   | Bool
otherwise = [Char] -> m Compression
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
unrecognized [Char]
s

asFilename :: String -> Maybe String
asFilename :: [Char] -> Maybe [Char]
asFilename = (URI -> [Char]) -> Maybe URI -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char]
takeFileName ([Char] -> [Char]) -> (URI -> [Char]) -> URI -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> [Char]
uriPath) (Maybe URI -> Maybe [Char])
-> ([Char] -> Maybe URI) -> [Char] -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe URI
parseURI

cacheDir :: MonadIO m => m FilePath
cacheDir :: forall (m :: * -> *). MonadIO m => m [Char]
cacheDir = ([Char] -> [Char] -> [Char]
</> [Char]
"cache") ([Char] -> [Char]) -> m [Char] -> m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Char]
forall (m :: * -> *). MonadIO m => m [Char]
globalPkgDir

fetchUrl :: String -- ^ URL
         -> String -- ^ Package name
         -> FilePath -- ^ Directory to unpack to
         -> PkgM ()
fetchUrl :: [Char] -> [Char] -> [Char] -> PkgM ()
fetchUrl [Char]
url [Char]
name [Char]
dirName = do

        let tarballName :: [Char]
tarballName = Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
asFilename [Char]
url)
        [Char]
tarballDir <- ([Char] -> [Char] -> [Char]
</> [Char]
tarballName) ([Char] -> [Char])
-> StateT InstallDb (ReaderT Verbosity IO) [Char]
-> StateT InstallDb (ReaderT Verbosity IO) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InstallDb (ReaderT Verbosity IO) [Char]
forall (m :: * -> *). MonadIO m => m [Char]
cacheDir
        Bool
shouldDownload <- Bool -> Bool
not (Bool -> Bool)
-> StateT InstallDb (ReaderT Verbosity IO) Bool
-> StateT InstallDb (ReaderT Verbosity IO) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool -> StateT InstallDb (ReaderT Verbosity IO) Bool
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO Bool
doesFileExist [Char]
tarballDir)

        Compression
compression <- [Char] -> StateT InstallDb (ReaderT Verbosity IO) Compression
forall (m :: * -> *). MonadIO m => [Char] -> m Compression
urlToCompression [Char]
url

        ByteString
response <-
            if Bool
shouldDownload
                then do
                    [Char] -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
[Char] -> m ()
putNormal ([Char]
"Downloading " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name)

                    [Char] -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
[Char] -> m ()
putLoud ([Char]
"from URL " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
url)

                    Manager
manager <- IO Manager -> StateT InstallDb (ReaderT Verbosity IO) Manager
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> StateT InstallDb (ReaderT Verbosity IO) Manager)
-> IO Manager -> StateT InstallDb (ReaderT Verbosity IO) Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
                    Request
initialRequest <- IO Request -> StateT InstallDb (ReaderT Verbosity IO) Request
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> StateT InstallDb (ReaderT Verbosity IO) Request)
-> IO Request -> StateT InstallDb (ReaderT Verbosity IO) Request
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest [Char]
url
                    IO ByteString -> StateT InstallDb (ReaderT Verbosity IO) ByteString
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> StateT InstallDb (ReaderT Verbosity IO) ByteString)
-> IO ByteString
-> StateT InstallDb (ReaderT Verbosity IO) ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs (Request
initialRequest { method = "GET" }) Manager
manager
                else do
                    [Char] -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
[Char] -> m ()
putDiagnostic ([Char]
"Using cached tarball at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tarballDir)
                    IO ByteString -> StateT InstallDb (ReaderT Verbosity IO) ByteString
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> StateT InstallDb (ReaderT Verbosity IO) ByteString)
-> IO ByteString
-> StateT InstallDb (ReaderT Verbosity IO) ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BSL.readFile [Char]
tarballDir

        Bool
cacheDirExists <- IO Bool -> StateT InstallDb (ReaderT Verbosity IO) Bool
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> IO [Char] -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Char]
forall (m :: * -> *). MonadIO m => m [Char]
cacheDir)
        Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cacheDirExists
            (IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True ([Char] -> IO ()) -> IO [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Char]
forall (m :: * -> *). MonadIO m => m [Char]
cacheDir)

        Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldDownload (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
            -- TODO: should cache/compress to .tar.xz?
            [Char] -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
[Char] -> m ()
putLoud ([Char]
"Caching " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tarballName)
            IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> IO ()
BSL.writeFile [Char]
tarballDir ByteString
response

        [Char] -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
[Char] -> m ()
putNormal ([Char]
"Unpacking " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name)

        IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Compression -> [Char] -> ByteString -> IO ()
unpackResponse Compression
compression [Char]
dirName ByteString
response