1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
-----------------------------------------------------------------------------
-- | Separate module for HTTP actions, using a proxy server if one exists
-----------------------------------------------------------------------------
module Distribution.Client.HttpUtils (
DownloadResult(..),
downloadURI,
getHTTP,
cabalBrowse,
proxy,
isOldHackageURI
) where
import Network.HTTP
( Request (..), Response (..), RequestMethod (..)
, Header(..), HeaderName(..), lookupHeader )
import Network.HTTP.Proxy ( Proxy(..), fetchProxy)
import Network.URI
( URI (..), URIAuth (..) )
import Network.Browser
( BrowserAction, browse
, setOutHandler, setErrHandler, setProxy, setAuthorityGen, request)
import Network.Stream
( Result, ConnError(..) )
import Control.Monad
( liftM )
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Data.ByteString.Lazy (ByteString)
import qualified Paths_cabal_install (version)
import Distribution.Verbosity (Verbosity)
import Distribution.Simple.Utils
( die, info, warn, debug, notice
, copyFileVerbose, writeFileAtomic )
import Distribution.System
( buildOS, buildArch )
import Distribution.Text
( display )
import Data.Char ( isSpace )
import qualified System.FilePath.Posix as FilePath.Posix
( splitDirectories )
import System.FilePath
( (<.>) )
import System.Directory
( doesFileExist )
data DownloadResult = FileAlreadyInCache | FileDownloaded FilePath deriving (Eq)
-- Trim
trim :: String -> String
trim = f . f
where f = reverse . dropWhile isSpace
-- |Get the local proxy settings
--TODO: print info message when we're using a proxy based on verbosity
proxy :: Verbosity -> IO Proxy
proxy _verbosity = do
p <- fetchProxy True
-- Handle empty proxy strings
return $ case p of
Proxy uri auth ->
let uri' = trim uri in
if uri' == "" then NoProxy else Proxy uri' auth
_ -> p
mkRequest :: URI
-> Maybe String -- ^ Optional etag to be set in the If-None-Match HTTP header.
-> Request ByteString
mkRequest uri etag = Request{ rqURI = uri
, rqMethod = GET
, rqHeaders = Header HdrUserAgent userAgent : ifNoneMatchHdr
, rqBody = ByteString.empty }
where userAgent = concat [ "cabal-install/", display Paths_cabal_install.version
, " (", display buildOS, "; ", display buildArch, ")"
]
ifNoneMatchHdr = maybe [] (\t -> [Header HdrIfNoneMatch t]) etag
-- |Carry out a GET request, using the local proxy settings
getHTTP :: Verbosity
-> URI
-> Maybe String -- ^ Optional etag to check if we already have the latest file.
-> IO (Result (Response ByteString))
getHTTP verbosity uri etag = liftM (\(_, resp) -> Right resp) $
cabalBrowse verbosity (return ()) (request (mkRequest uri etag))
cabalBrowse :: Verbosity
-> BrowserAction s ()
-> BrowserAction s a
-> IO a
cabalBrowse verbosity auth act = do
p <- proxy verbosity
browse $ do
setProxy p
setErrHandler (warn verbosity . ("http error: "++))
setOutHandler (debug verbosity)
auth
setAuthorityGen (\_ _ -> return Nothing)
act
downloadURI :: Verbosity
-> URI -- ^ What to download
-> FilePath -- ^ Where to put it
-> IO DownloadResult
downloadURI verbosity uri path | uriScheme uri == "file:" = do
copyFileVerbose verbosity (uriPath uri) path
return (FileDownloaded path)
-- Can we store the hash of the file so we can safely return path when the
-- hash matches to avoid unnecessary computation?
downloadURI verbosity uri path = do
let etagPath = path <.> "etag"
targetExists <- doesFileExist path
etagPathExists <- doesFileExist etagPath
-- In rare cases the target file doesn't exist, but the etag does.
etag <- if targetExists && etagPathExists
then liftM Just $ readFile etagPath
else return Nothing
result <- getHTTP verbosity uri etag
let result' = case result of
Left err -> Left err
Right rsp -> case rspCode rsp of
(2,0,0) -> Right rsp
(3,0,4) -> Right rsp
(a,b,c) -> Left err
where
err = ErrorMisc $ "Error HTTP code: "
++ concatMap show [a,b,c]
-- Only write the etag if we get a 200 response code.
-- A 304 still sends us an etag header.
case result' of
Left _ -> return ()
Right rsp -> case rspCode rsp of
(2,0,0) -> case lookupHeader HdrETag (rspHeaders rsp) of
Nothing -> return ()
Just newEtag -> writeFile etagPath newEtag
(_,_,_) -> return ()
case result' of
Left err -> die $ "Failed to download " ++ show uri ++ " : " ++ show err
Right rsp -> case rspCode rsp of
(2,0,0) -> do
info verbosity ("Downloaded to " ++ path)
writeFileAtomic path $ rspBody rsp
return (FileDownloaded path)
(3,0,4) -> do
notice verbosity "Skipping download: Local and remote files match."
return FileAlreadyInCache
(_,_,_) -> return (FileDownloaded path)
--FIXME: check the content-length header matches the body length.
--TODO: stream the download into the file rather than buffering the whole
-- thing in memory.
-- Utility function for legacy support.
isOldHackageURI :: URI -> Bool
isOldHackageURI uri
= case uriAuthority uri of
Just (URIAuth {uriRegName = "hackage.haskell.org"}) ->
FilePath.Posix.splitDirectories (uriPath uri) == ["/","packages","archive"]
_ -> False
|
