module Network.HTTP.Download.File
(
downloadFile
, Overwrite(..)
, ProxyAuth(..)
)
where
import System.Process
import System.Exit
import Network.URI
import Control.Exception
import System.Info(os,arch)
import System.Directory
import System.FilePath
import Paths_downloader(getDataDir, version)
import Data.Version(showVersion)
import GHC.Stack
import Safe
newtype Overwrite = Overwrite { _overwrite :: Bool }
data ProxyAuth = Basic (String, String) | Digest (String, String) deriving Show
downloadFile :: HasCallStack
=> String
-> Maybe (String, Maybe ProxyAuth)
-> FilePath
-> FilePath
-> Overwrite
-> IO FilePath
downloadFile urlString proxyInfo directory outputFilename overwrite = do
u <- getUrl
o <- getOutputPath
proxyM <-
case proxyInfo of
Just pi -> Just <$> getProxyUrl pi
Nothing -> pure Nothing
let (urlOnly, queryParams) = (u { uriQuery = ""}, drop 1 (uriQuery u))
if (os == "mingw32")
then do
res <- lines <$> runPowershellDownload urlOnly proxyM queryParams o
case res of
(['2','0','0']:_) -> pure o
_ -> throwIO (userError (unlines res))
else do
res <- runCurlDownload urlOnly proxyM queryParams o
case res of
Left err -> throwIO (userError err)
Right Nothing -> throwIO (userError $ "No output from download process, expected an HTTP return code")
Right (Just httpCode) ->
if (httpCode == 200)
then pure o
else throwIO (userError $ "HTTP Error code: " ++ show httpCode)
where
userAgent :: String
userAgent = "downloader/" ++ showVersion version ++ "(" ++ os ++ ";" ++ arch ++ ")"
inDataDir :: FilePath -> IO FilePath
inDataDir f = (\dd -> dd </> "scripts" </> f) <$> getDataDir
shScript :: IO String
shScript = inDataDir "download.sh"
powershellScript :: IO String
powershellScript = inDataDir "download.ps1"
getProxyUrl :: (String, Maybe ProxyAuth) -> IO (URI, Maybe ProxyAuth)
getProxyUrl (urlString, auth) =
case parseURI urlString of
Nothing -> throwIO (userError $ "Failed to parse the proxy URL: " ++ urlString)
Just url -> pure (url, auth)
getUrl :: IO URI
getUrl =
let (urlOnly, queryParams) = break ((==) '?') urlString
in
case parseURI urlOnly of
Nothing ->
case (parseURI $ "https://" ++ urlOnly) of
Nothing -> throwIO (userError $ "Failed to parse URL: " ++ urlString)
Just url -> pure $ url { uriQuery = queryParams }
Just url ->
if (not (uriScheme url `elem` ["http:", "https:"]))
then throwIO (userError $ "Only http or https are allowed in URL but given: " ++ uriScheme url)
else pure $ url { uriQuery = queryParams }
getOutputPath :: IO FilePath
getOutputPath = do
f <- if (null outputFilename)
then throwIO (userError $ "Output filename is empty.")
else if (not (isValid outputFilename))
then throwIO (userError $ "Output filename is not valid: " ++ outputFilename ++ "\n. The 'filepath' package has a 'makeValid' function which may be useful.")
else pure outputFilename
if (takeDirectory f /= ".")
then throwIO (userError $ "Output filename must be just a file name without any directories, instead got: " ++ outputFilename)
else do
d <- do
absoluteDirectory <- canonicalizePath directory
exists <- doesDirectoryExist absoluteDirectory
if (not exists)
then throwIO (userError $ "Output directory does not exist: " ++ directory)
else do
perms <- getPermissions absoluteDirectory
if (not (writable perms))
then throwIO (userError $ "Output directory does not have write permissions: " ++ directory)
else pure absoluteDirectory
let outputPath = d </> f
opExists <- doesFileExist outputPath
if (opExists && not (_overwrite overwrite))
then throwIO (userError $ "The output file already exists: " ++ outputPath)
else pure outputPath
runCurlDownload :: URI -> Maybe (URI, Maybe ProxyAuth) -> String -> FilePath -> IO (Either String (Maybe Int))
runCurlDownload url proxyInfo queryParams outputPath = do
downloadSh <- shScript
let args =
[downloadSh, show url, show queryParams, outputPath, show userAgent] ++
(case proxyInfo of
Nothing -> []
Just (proxyUrl, Nothing) -> [show proxyUrl]
Just (proxyUrl, Just (Basic (user,pass))) -> [show proxyUrl, user ++ ":" ++ pass, "basic"]
Just (proxyUrl, Just (Digest (user,pass))) -> [show proxyUrl, user ++ ":" ++ pass, "digest"])
(exitCode,stdout,stderr) <- readProcessWithExitCode "sh" args ""
case exitCode of
ExitSuccess -> do
if (not (null stdout))
then case readMay stdout of
Nothing -> throwIO (userError $ "Expecting a number, got: " ++ stdout)
Just res -> pure (Right (Just res))
else pure (Right Nothing)
ExitFailure errCode -> do
pure $ Left $ show errCode ++
(if (not (null stderr))
then ":" ++ stderr
else "")
runPowershellDownload :: URI -> Maybe (URI, Maybe ProxyAuth) -> String -> FilePath -> IO String
runPowershellDownload url proxyInfo queryParams outputPath = do
downloadWin <- powershellScript
let args =
[ "-ExecutionPolicy", "bypass"
, "-NonInteractive"
, "-NoProfile"
, "-File", downloadWin
, "-url" , show url
, "-outputPath" , outputPath
, "-userAgent", userAgent
] ++
(if (not (null queryParams))
then [ "-queryParams" , queryParams ]
else []) ++
(case proxyInfo of
Nothing -> []
Just (proxyUrl, Nothing) -> ["-proxy", show proxyUrl]
Just (proxyUrl, Just (Basic (user,pass))) -> [ "-proxy", show proxyUrl, "-user", user, "-pass", pass, "-auth", "basic" ]
Just (proxyUrl, Just (Digest (user,pass))) -> [ "-proxy", show proxyUrl, "-user", user, "-pass", pass, "-auth", "digest" ])
(_,stdout,_) <- readProcessWithExitCode "powershell.exe" args ""
pure stdout