Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

76 lines (64 sloc) 2.66 kb
module Fetch(downloadTarball,downloadFileVerify) where
import Prelude hiding (catch)
import Network.HTTP (ConnError(..),Request(..),simpleHTTP
import Network.URI (URI,uriPath,parseURI)
import Text.Regex (Regex,mkRegex,matchRegex)
import System.GPG
import Control.Monad.Error
import System.Directory
import System.FilePath
import Data.Typeable
import Error
import Action
filenameRegex :: Regex
filenameRegex = mkRegex "^.*?/([^/]*?)"
uriToFileName :: URI -> Maybe FilePath
uriToFileName uri = maybe Nothing (\x->Just (head x)) (matchRegex filenameRegex (uriPath uri))
downloadURI :: FilePath -- ^ a directory to store the file
-> URI -- ^ the url
-> HPAction FilePath -- ^ the path of the downloaded file
downloadURI path uri = do
fileName <- maybe (throwError $ InvalidTarballURL (show uri) "URL doesn't contain a filename") return (uriToFileName uri)
httpResult <- liftIO $ simpleHTTP request
Response {rspCode=code,rspBody=body,rspReason=reason} <- either (\x->throwError $ DownloadFailed (show uri) "Connection failed") return httpResult
if code==(2,0,0) then (do
let writePath=path </> fileName
liftIO $ writeFile writePath body
return writePath) else throwError $ DownloadFailed (show uri) ("Code "++show code++":"++reason)
request = Request
downloadFileVerify ::
FilePath -> -- ^ the directory to store the files
String -> -- ^ the url of the tarball
String -> -- ^ the url of the signature
HPAction (FilePath,FilePath) -- ^ the tarballs and signatures path
downloadFileVerify path url sigurl = do
tarballPath <- downloadTarball path url
sigPath <- downloadSig path sigurl `catchError` (\x->liftIO (removeFile tarballPath) >> throwError x)
verified <- liftIO $ verifyFile stdOptions tarballPath sigPath
if verified then return (tarballPath,sigPath) else (do
liftIO $ removeFile tarballPath
liftIO $ removeFile sigPath
throwError $ VerificationFailed url sigurl)
downloadTarball ::
FilePath ->
String ->
HPAction FilePath
downloadTarball dir url = download dir url InvalidTarballURL
downloadSig ::
FilePath ->
String ->
HPAction FilePath
downloadSig dir url = download dir url InvalidSignatureURL
download :: FilePath -- ^ the folder to store the file in
-> String -- ^ the url
-> (String -> String -> HackPortError) -- ^ a function to construct an error
-> HPAction FilePath -- ^ the resulting file's path
download dir url errFunc = do
parsedURL <- maybe (throwError $ errFunc url "Parsing failed") return (parseURI url)
downloadURI dir parsedURL
Jump to Line
Something went wrong with that request. Please try again.