{-# LANGUAGE OverloadedStrings #-}

module Poseidon.CLI.Fetch where

import           Poseidon.EntityTypes   (EntityInput, HasNameAndVersion (..),
                                         PacNameAndVersion (..), PoseidonEntity,
                                         checkIfAllEntitiesExist,
                                         determineRelevantPackages,
                                         isLatestInCollection,
                                         makePacNameAndVersion,
                                         readEntityInputs,
                                         renderNameWithVersion)
import           Poseidon.MathHelpers   (roundTo, roundToStr)
import           Poseidon.Package       (PackageReadOptions (..),
                                         defaultPackageReadOptions,
                                         readPoseidonPackageCollection)
import           Poseidon.ServerClient  (ApiReturnData (..),
                                         ArchiveEndpoint (..),
                                         ExtendedIndividualInfo (..),
                                         PackageInfo (..),
                                         extIndInfo2IndInfoCollection,
                                         processApiResponse, qDefault,
                                         qPacVersion, (+&+))
import           Poseidon.Utils         (LogA, PoseidonException (..),
                                         PoseidonIO, envLogAction, logDebug,
                                         logInfo, logWithEnv, padLeft)

import           Codec.Archive.Zip      (ZipOption (..),
                                         extractFilesFromArchive, toArchive)
import           Conduit                (ResourceT, await, runResourceT,
                                         sinkFile, yield)
import           Control.Exception      (catch, throwIO)
import           Control.Monad          (filterM, forM_, unless, when)
import           Control.Monad.IO.Class (liftIO)
import           Data.Aeson             (eitherDecode')
import qualified Data.ByteString        as B
import           Data.ByteString.Char8  as B8 (unpack)
import qualified Data.ByteString.Lazy   as LB
import           Data.Conduit           (ConduitT, sealConduitT, ($$+-), (.|))
import           Data.List              (intercalate)
import           Data.Maybe             (fromMaybe)
import           Data.Version           (Version, showVersion)
import           Network.HTTP.Conduit   (http, newManager, parseRequest,
                                         responseBody, responseHeaders,
                                         tlsManagerSettings)
import           Network.HTTP.Types     (hContentLength)
import           System.Directory       (createDirectoryIfMissing,
                                         removeDirectory, removeFile)
import           System.FilePath        ((</>))

data FetchOptions = FetchOptions
    { FetchOptions -> [[Char]]
_jaBaseDirs  :: [FilePath]
    , FetchOptions -> [EntityInput PoseidonEntity]
_entityInput :: [EntityInput PoseidonEntity] -- Empty list = All latest packages
    , FetchOptions -> ArchiveEndpoint
_archiveEnd  :: ArchiveEndpoint
    }

data PackageState = NotLocal
    | EqualLocalRemote
    | UnequalLocalRemote

pacReadOpts :: PackageReadOptions
pacReadOpts :: PackageReadOptions
pacReadOpts = PackageReadOptions
defaultPackageReadOptions {
      _readOptIgnoreChecksums :: Bool
_readOptIgnoreChecksums  = Bool
True
    , _readOptIgnoreGeno :: Bool
_readOptIgnoreGeno       = Bool
False
    , _readOptGenoCheck :: Bool
_readOptGenoCheck        = Bool
False
    }

-- | The main function running the Fetch command
runFetch :: FetchOptions -> PoseidonIO ()
runFetch :: FetchOptions -> PoseidonIO ()
runFetch (FetchOptions [[Char]]
baseDirs [EntityInput PoseidonEntity]
entityInputs archiveE :: ArchiveEndpoint
archiveE@(ArchiveEndpoint [Char]
remoteURL Maybe [Char]
archive)) = do
    -- create download directory + temporary storage for downloaded .zip archives
    let downloadDir :: [Char]
downloadDir = [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
baseDirs
        tempDir :: [Char]
tempDir = [Char]
downloadDir [Char] -> [Char] -> [Char]
</> [Char]
".trident_download_folder"
    [Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Download directory (will be created if missing): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
downloadDir
    IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
downloadDir
    -- compile entities
    [PoseidonEntity]
entities <- [EntityInput PoseidonEntity] -> ReaderT Env IO [PoseidonEntity]
forall (m :: * -> *) a.
(MonadIO m, EntitySpec a, Eq a) =>
[EntityInput a] -> m [a]
readEntityInputs [EntityInput PoseidonEntity]
entityInputs
    [Char] -> PoseidonIO ()
logDebug [Char]
"Requested entities:"
    (PoseidonEntity -> PoseidonIO ())
-> [PoseidonEntity] -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> PoseidonIO ()
logDebug ([Char] -> PoseidonIO ())
-> (PoseidonEntity -> [Char]) -> PoseidonEntity -> PoseidonIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonEntity -> [Char]
forall a. Show a => a -> [Char]
show) [PoseidonEntity]
entities
    -- load remote information to decide what to download
    [Char] -> PoseidonIO ()
logInfo [Char]
"Downloading individual list from remote"
    IndividualInfoCollection
remoteIndList <- do
        ApiReturnData
r <- [Char] -> Bool -> PoseidonIO ApiReturnData
processApiResponse ([Char]
remoteURL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/individuals" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
qDefault Maybe [Char]
archive) Bool
False
        case ApiReturnData
r of
            ApiReturnExtIndividualInfo [ExtendedIndividualInfo]
extIndInfos -> IndividualInfoCollection -> ReaderT Env IO IndividualInfoCollection
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IndividualInfoCollection
 -> ReaderT Env IO IndividualInfoCollection)
-> IndividualInfoCollection
-> ReaderT Env IO IndividualInfoCollection
forall a b. (a -> b) -> a -> b
$ [ExtendedIndividualInfo] -> IndividualInfoCollection
extIndInfo2IndInfoCollection [ExtendedIndividualInfo]
extIndInfos
            ApiReturnData
_                               -> [Char] -> ReaderT Env IO IndividualInfoCollection
forall a. HasCallStack => [Char] -> a
error [Char]
"should not happen"


    -- find and report non-existent entities (throws an exception)
    [PoseidonEntity] -> IndividualInfoCollection -> PoseidonIO ()
forall a.
EntitySpec a =>
[a] -> IndividualInfoCollection -> PoseidonIO ()
checkIfAllEntitiesExist [PoseidonEntity]
entities IndividualInfoCollection
remoteIndList
    -- load local packages
    [PoseidonPackage]
allLocalPackages <- PackageReadOptions -> [[Char]] -> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection PackageReadOptions
pacReadOpts [[Char]]
baseDirs
    let localPacs :: [PacNameAndVersion]
localPacs = (PoseidonPackage -> PacNameAndVersion)
-> [PoseidonPackage] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion [PoseidonPackage]
allLocalPackages
    -- check which remote packages the User wants to have
    [Char] -> PoseidonIO ()
logInfo [Char]
"Determine requested packages... "
    -- prepare list of relevant packages with individual list
    [PacNameAndVersion]
desiredPacs <- if [PoseidonEntity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PoseidonEntity]
entities then do
            -- load all latest packages
            [Char] -> PoseidonIO ()
logInfo [Char]
"Downloading package list from remote"
            [PackageInfo]
remotePacListAll <- do
                ApiReturnData
r <- [Char] -> Bool -> PoseidonIO ApiReturnData
processApiResponse ([Char]
remoteURL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/packages" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
qDefault Maybe [Char]
archive) Bool
True
                case ApiReturnData
r of
                    ApiReturnPackageInfo [PackageInfo]
p -> [PackageInfo] -> ReaderT Env IO [PackageInfo]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageInfo]
p
                    ApiReturnData
_                      -> [Char] -> ReaderT Env IO [PackageInfo]
forall a. HasCallStack => [Char] -> a
error [Char]
"should not happen"
            [PackageInfo]
remotePacList <- (PackageInfo -> ReaderT Env IO Bool)
-> [PackageInfo] -> ReaderT Env IO [PackageInfo]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([PackageInfo] -> PackageInfo -> ReaderT Env IO Bool
forall (m :: * -> *) a.
(MonadThrow m, HasNameAndVersion a) =>
[a] -> a -> m Bool
isLatestInCollection [PackageInfo]
remotePacListAll) [PackageInfo]
remotePacListAll
            [PacNameAndVersion] -> ReaderT Env IO [PacNameAndVersion]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PacNameAndVersion] -> ReaderT Env IO [PacNameAndVersion])
-> [PacNameAndVersion] -> ReaderT Env IO [PacNameAndVersion]
forall a b. (a -> b) -> a -> b
$ (PackageInfo -> PacNameAndVersion)
-> [PackageInfo] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map PackageInfo -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion [PackageInfo]
remotePacList
        else [PoseidonEntity]
-> IndividualInfoCollection -> ReaderT Env IO [PacNameAndVersion]
forall (m :: * -> *) a.
(MonadThrow m, EntitySpec a) =>
[a] -> IndividualInfoCollection -> m [PacNameAndVersion]
determineRelevantPackages [PoseidonEntity]
entities IndividualInfoCollection
remoteIndList
    [Char] -> PoseidonIO ()
logDebug [Char]
"Desired packages based on remote individuals list:"
    (PacNameAndVersion -> PoseidonIO ())
-> [PacNameAndVersion] -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> PoseidonIO ()
logDebug ([Char] -> PoseidonIO ())
-> (PacNameAndVersion -> [Char])
-> PacNameAndVersion
-> PoseidonIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PacNameAndVersion -> [Char]
forall a. Show a => a -> [Char]
show) [PacNameAndVersion]
desiredPacs
    -- start comparison/download process
    [Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show ([PacNameAndVersion] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PacNameAndVersion]
desiredPacs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" requested"
    [Char] -> PoseidonIO ()
logInfo   [Char]
"Comparing local and remote packages..."
    Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PacNameAndVersion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PacNameAndVersion]
desiredPacs) (PoseidonIO () -> PoseidonIO ()) -> PoseidonIO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
        IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False [Char]
tempDir
        [PacNameAndVersion]
-> (PacNameAndVersion -> PoseidonIO ()) -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PacNameAndVersion]
desiredPacs ((PacNameAndVersion -> PoseidonIO ()) -> PoseidonIO ())
-> (PacNameAndVersion -> PoseidonIO ()) -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ \PacNameAndVersion
pac -> do
            -- perform package download depending on local-remote state
            let packageState :: (PackageState, [Char], Maybe Version, [Maybe Version])
packageState = [PacNameAndVersion]
-> PacNameAndVersion
-> (PackageState, [Char], Maybe Version, [Maybe Version])
determinePackageState [PacNameAndVersion]
localPacs PacNameAndVersion
pac
            [Char]
-> [Char]
-> ArchiveEndpoint
-> (PackageState, [Char], Maybe Version, [Maybe Version])
-> PoseidonIO ()
handlePackageByState [Char]
downloadDir [Char]
tempDir ArchiveEndpoint
archiveE (PackageState, [Char], Maybe Version, [Maybe Version])
packageState
        IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeDirectory [Char]
tempDir
    [Char] -> PoseidonIO ()
logInfo [Char]
"Done"

readServerIndInfo :: LB.ByteString -> IO [ExtendedIndividualInfo]
readServerIndInfo :: ByteString -> IO [ExtendedIndividualInfo]
readServerIndInfo ByteString
bs = do
    case ByteString -> Either [Char] [ExtendedIndividualInfo]
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode' ByteString
bs of
        Left [Char]
err  -> PoseidonException -> IO [ExtendedIndividualInfo]
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> IO [ExtendedIndividualInfo])
-> PoseidonException -> IO [ExtendedIndividualInfo]
forall a b. (a -> b) -> a -> b
$ [Char] -> PoseidonException
PoseidonRemoteJSONParsingException [Char]
err
        Right [ExtendedIndividualInfo]
pac -> [ExtendedIndividualInfo] -> IO [ExtendedIndividualInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ExtendedIndividualInfo]
pac

readServerPackageInfo :: LB.ByteString -> IO [PackageInfo]
readServerPackageInfo :: ByteString -> IO [PackageInfo]
readServerPackageInfo ByteString
bs = do
    case ByteString -> Either [Char] [PackageInfo]
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode' ByteString
bs of
        Left [Char]
err  -> PoseidonException -> IO [PackageInfo]
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> IO [PackageInfo])
-> PoseidonException -> IO [PackageInfo]
forall a b. (a -> b) -> a -> b
$ [Char] -> PoseidonException
PoseidonRemoteJSONParsingException [Char]
err
        Right [PackageInfo]
pac -> [PackageInfo] -> IO [PackageInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageInfo]
pac

determinePackageState :: [PacNameAndVersion] -> PacNameAndVersion -> (PackageState, String, Maybe Version, [Maybe Version])
determinePackageState :: [PacNameAndVersion]
-> PacNameAndVersion
-> (PackageState, [Char], Maybe Version, [Maybe Version])
determinePackageState [PacNameAndVersion]
localPacs desiredRemotePac :: PacNameAndVersion
desiredRemotePac@(PacNameAndVersion [Char]
desiredRemotePacTitle Maybe Version
desiredRemotePacVersion)
    | [Char]
desiredRemotePacTitle [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (PacNameAndVersion -> [Char]) -> [PacNameAndVersion] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PacNameAndVersion -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
getPacName [PacNameAndVersion]
localPacs =
        (PackageState
NotLocal,           [Char]
desiredRemotePacTitle, Maybe Version
desiredRemotePacVersion, [Maybe Version
forall a. Maybe a
Nothing])
    | PacNameAndVersion
desiredRemotePac PacNameAndVersion -> [PacNameAndVersion] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PacNameAndVersion]
localPacs =
        (PackageState
EqualLocalRemote,   [Char]
desiredRemotePacTitle, Maybe Version
desiredRemotePacVersion, [Maybe Version
desiredRemotePacVersion])
    | PacNameAndVersion
desiredRemotePac PacNameAndVersion -> [PacNameAndVersion] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PacNameAndVersion]
localPacs =
        (PackageState
UnequalLocalRemote, [Char]
desiredRemotePacTitle, Maybe Version
desiredRemotePacVersion, [Maybe Version]
localVersionsOfDesired)
    | Bool
otherwise = [Char] -> (PackageState, [Char], Maybe Version, [Maybe Version])
forall a. HasCallStack => [Char] -> a
error [Char]
"determinePackageState: should never happen"
    where
        localVersionsOfDesired :: [Maybe Version]
localVersionsOfDesired = (PacNameAndVersion -> Maybe Version)
-> [PacNameAndVersion] -> [Maybe Version]
forall a b. (a -> b) -> [a] -> [b]
map PacNameAndVersion -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion ([PacNameAndVersion] -> [Maybe Version])
-> [PacNameAndVersion] -> [Maybe Version]
forall a b. (a -> b) -> a -> b
$ (PacNameAndVersion -> Bool)
-> [PacNameAndVersion] -> [PacNameAndVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PacNameAndVersion
x -> PacNameAndVersion -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
getPacName PacNameAndVersion
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
desiredRemotePacTitle) [PacNameAndVersion]
localPacs

handlePackageByState :: FilePath -> FilePath -> ArchiveEndpoint -> (PackageState, String, Maybe Version, [Maybe Version]) -> PoseidonIO ()
handlePackageByState :: [Char]
-> [Char]
-> ArchiveEndpoint
-> (PackageState, [Char], Maybe Version, [Maybe Version])
-> PoseidonIO ()
handlePackageByState [Char]
downloadDir [Char]
tempDir ArchiveEndpoint
archiveE (PackageState
NotLocal, [Char]
pac, Maybe Version
remoteV, [Maybe Version]
_) = do
    [Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[local _._._" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" x remote " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Version -> [Char]
printV Maybe Version
remoteV [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pac
    [Char]
-> [Char] -> ArchiveEndpoint -> PacNameAndVersion -> PoseidonIO ()
downloadAndUnzipPackage [Char]
downloadDir [Char]
tempDir ArchiveEndpoint
archiveE ([Char] -> Maybe Version -> PacNameAndVersion
PacNameAndVersion [Char]
pac Maybe Version
remoteV)
handlePackageByState [Char]
_ [Char]
_ ArchiveEndpoint
_ (PackageState
EqualLocalRemote, [Char]
pac, Maybe Version
remoteV, [Maybe Version]
localVs) = do
    [Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[local " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Maybe Version] -> [Char]
printVs [Maybe Version]
localVs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = remote " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Version -> [Char]
printV Maybe Version
remoteV [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pac
handlePackageByState [Char]
downloadDir [Char]
tempDir ArchiveEndpoint
archiveE (PackageState
UnequalLocalRemote, [Char]
pac, Maybe Version
remoteV, [Maybe Version]
localVs) = do
    [Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[local " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Maybe Version] -> [Char]
printVs [Maybe Version]
localVs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" < remote " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Version -> [Char]
printV Maybe Version
remoteV [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pac
    [Char]
-> [Char] -> ArchiveEndpoint -> PacNameAndVersion -> PoseidonIO ()
downloadAndUnzipPackage [Char]
downloadDir [Char]
tempDir ArchiveEndpoint
archiveE ([Char] -> Maybe Version -> PacNameAndVersion
PacNameAndVersion [Char]
pac Maybe Version
remoteV)

printVs :: [Maybe Version] -> String
printVs :: [Maybe Version] -> [Char]
printVs [] = [Char]
"?.?.?"
printVs [Maybe Version]
xs = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Maybe Version -> [Char]) -> [Maybe Version] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Version -> [Char]
printV [Maybe Version]
xs

printV :: Maybe Version -> String
printV :: Maybe Version -> [Char]
printV Maybe Version
Nothing  = [Char]
"?.?.?"
printV (Just Version
x) = Version -> [Char]
showVersion Version
x

downloadAndUnzipPackage :: FilePath -> FilePath -> ArchiveEndpoint -> PacNameAndVersion -> PoseidonIO ()
downloadAndUnzipPackage :: [Char]
-> [Char] -> ArchiveEndpoint -> PacNameAndVersion -> PoseidonIO ()
downloadAndUnzipPackage [Char]
baseDir [Char]
tempDir ArchiveEndpoint
archiveE PacNameAndVersion
pacNameAndVersion = do
    let pnv :: [Char]
pnv = PacNameAndVersion -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
renderNameWithVersion PacNameAndVersion
pacNameAndVersion
    [Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Downloading: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pnv
    [Char] -> ArchiveEndpoint -> PacNameAndVersion -> PoseidonIO ()
downloadPackage [Char]
tempDir ArchiveEndpoint
archiveE PacNameAndVersion
pacNameAndVersion
    IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> [Char] -> IO ()
unzipPackage ([Char]
tempDir [Char] -> [Char] -> [Char]
</> [Char]
pnv) ([Char]
baseDir [Char] -> [Char] -> [Char]
</> [Char]
pnv)
        [Char] -> IO ()
removeFile ([Char]
tempDir [Char] -> [Char] -> [Char]
</> [Char]
pnv)

unzipPackage :: FilePath -> FilePath -> IO ()
unzipPackage :: [Char] -> [Char] -> IO ()
unzipPackage [Char]
zip_ [Char]
outDir = do
    ByteString
archiveBS <- [Char] -> IO ByteString
LB.readFile [Char]
zip_
    let archive :: Archive
archive = ByteString -> Archive
toArchive ByteString
archiveBS
    IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch ([ZipOption] -> Archive -> IO ()
extractFilesFromArchive [ZipOption
OptRecursive, [Char] -> ZipOption
OptDestination [Char]
outDir] Archive
archive) (PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> IO ())
-> (SomeException -> PoseidonException) -> SomeException -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> PoseidonException
PoseidonUnzipException)

downloadPackage :: FilePath -> ArchiveEndpoint -> PacNameAndVersion -> PoseidonIO ()
downloadPackage :: [Char] -> ArchiveEndpoint -> PacNameAndVersion -> PoseidonIO ()
downloadPackage [Char]
outDir (ArchiveEndpoint [Char]
remoteURL Maybe [Char]
archive) pacNameAndVersion :: PacNameAndVersion
pacNameAndVersion@(PacNameAndVersion [Char]
pacName Maybe Version
pacVersion) = do
    LogA
logA <- PoseidonIO LogA
envLogAction
    Manager
downloadManager <- IO Manager -> ReaderT Env IO Manager
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> ReaderT Env IO Manager)
-> IO Manager -> ReaderT Env IO Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    Request
packageRequest <- [Char] -> ReaderT Env IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ([Char]
remoteURL [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/zip_file/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pacName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
qDefault Maybe [Char]
archive [Char] -> [Char] -> [Char]
+&+ Maybe Version -> [Char]
qPacVersion Maybe Version
pacVersion)
    --logInfo $ show packageRequest
    IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ 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
$ do
        Response (ConduitM () ByteString (ResourceT IO) ())
response <- Request
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
http Request
packageRequest Manager
downloadManager
        let fileSize :: ByteString
fileSize = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"0" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentLength (Response (ConduitM () ByteString (ResourceT IO) ())
-> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
response)
        let fileSizeKB :: Int
fileSizeKB = ([Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
B8.unpack ByteString
fileSize) :: Int
        let fileSizeMB :: Double
fileSizeMB = Int -> Double -> Double
roundTo Int
1 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fileSizeKB Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000.0)
        LogA -> PoseidonIO () -> ResourceT IO ()
forall (m :: * -> *). MonadIO m => LogA -> PoseidonIO () -> m ()
logWithEnv LogA
logA (PoseidonIO () -> ResourceT IO ())
-> PoseidonIO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> PoseidonIO ()
logInfo ([Char] -> PoseidonIO ()) -> [Char] -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Package size: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Double -> Double
roundTo Int
1 Double
fileSizeMB) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"MB"
        ConduitM () ByteString (ResourceT IO) ()
-> SealedConduitT () ByteString (ResourceT IO) ()
forall i o (m :: * -> *) r.
ConduitT i o m r -> SealedConduitT i o m r
sealConduitT (Response (ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall body. Response body -> body
responseBody Response (ConduitM () ByteString (ResourceT IO) ())
response) SealedConduitT () ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m () -> ConduitT a Void m b -> m b
$$+-
            LogA -> Double -> ConduitT ByteString ByteString (ResourceT IO) ()
printDownloadProgress LogA
logA Double
fileSizeMB ConduitT ByteString ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
            [Char] -> ConduitT ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
[Char] -> ConduitT ByteString o m ()
sinkFile ([Char]
outDir [Char] -> [Char] -> [Char]
</> PacNameAndVersion -> [Char]
forall a. HasNameAndVersion a => a -> [Char]
renderNameWithVersion PacNameAndVersion
pacNameAndVersion)
    () -> PoseidonIO ()
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

printDownloadProgress :: LogA -> Double -> ConduitT B.ByteString B.ByteString (ResourceT IO) ()
printDownloadProgress :: LogA -> Double -> ConduitT ByteString ByteString (ResourceT IO) ()
printDownloadProgress LogA
logA Double
fileSizeMB = Int -> Double -> ConduitT ByteString ByteString (ResourceT IO) ()
forall {m :: * -> *}.
MonadIO m =>
Int -> Double -> ConduitT ByteString ByteString m ()
loop Int
0 Double
0
    where
        loop :: Int -> Double -> ConduitT ByteString ByteString m ()
loop Int
loadedB Double
loadedMB = do
            Maybe ByteString
x <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
            ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT ByteString ByteString m ()
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Double -> Int -> ByteString -> ConduitT ByteString ByteString m ()
showDownloaded Double
fileSizeMB Int
loadedB) Maybe ByteString
x
            where
                showDownloaded :: Double -> Int -> ByteString -> ConduitT ByteString ByteString m ()
showDownloaded Double
fileSizeMB_ Int
loadedB_ ByteString
x = do
                    let newLoadedB :: Int
newLoadedB = Int
loadedB_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
x
                    let curLoadedMB :: Double
curLoadedMB = Int -> Double -> Double
roundTo Int
1 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newLoadedB Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000)
                                          -- update progress counter every 5%
                    let newLoadedMB :: Double
newLoadedMB = if (Double
curLoadedMBDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
fileSizeMB_ Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
loadedMBDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
fileSizeMB_ Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.05 Bool -> Bool -> Bool
&&
                                          -- but only at at least 200KB
                                          Double
curLoadedMB Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
loadedMB Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.2) Bool -> Bool -> Bool
||
                                          -- and of course at the end of the sequence
                                          Double
curLoadedMB Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
fileSizeMB_
                                      then Double
curLoadedMB
                                      else Double
loadedMB
                    Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
loadedMB Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
newLoadedMB) (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
                        let leadedPercent :: Double
leadedPercent = Int -> Double -> Double
roundTo Int
3 (Double
newLoadedMB Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
fileSizeMB_) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
                        LogA -> PoseidonIO () -> ConduitT ByteString ByteString m ()
forall (m :: * -> *). MonadIO m => LogA -> PoseidonIO () -> m ()
logWithEnv LogA
logA (PoseidonIO () -> ConduitT ByteString ByteString m ())
-> PoseidonIO () -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> PoseidonIO ()
logInfo ([Char]
"MB:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
padLeft Int
9 (Double -> [Char]
forall a. Show a => a -> [Char]
show Double
curLoadedMB) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
padLeft Int
5 (Int -> Double -> [Char]
forall a. (PrintfArg a, Floating a) => Int -> a -> [Char]
roundToStr Int
1 Double
leadedPercent) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"% ")
                    ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
x
                    Int -> Double -> ConduitT ByteString ByteString m ()
loop Int
newLoadedB Double
newLoadedMB