summaryrefslogtreecommitdiff
path: root/Utility/Url.hs
blob: 6ddeecc14f6a1065d02d4ee13f8046653c228122 (plain)
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
{- Url downloading.
 -
 - Copyright 2011 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Utility.Url (
	exists,
	download,
	get
) where

import Control.Applicative
import Control.Monad.State (liftIO)
import qualified Network.Browser as Browser
import Network.HTTP
import Network.URI

import Types
import Messages
import Utility.SafeCommand
import Utility

type URLString = String

{- Checks that an url exists and could be successfully downloaded. -}
exists :: URLString -> IO Bool
exists url =
	case parseURI url of
		Nothing -> return False
		Just u -> do
			r <- request u HEAD
			case rspCode r of
				(2,_,_) -> return True
				_ -> return False

{- Used to download large files, such as the contents of keys.
 - Uses wget or curl program for its progress bar. (Wget has a better one,
 - so is preferred.) -}
download :: URLString -> FilePath -> Annex Bool
download url file = do
	showOutput -- make way for program's progress bar
	e <- liftIO $ inPath "wget"
	if e
		then
			liftIO $ boolSystem "wget"
				[Params "-c -O", File file, File url]
		else
			-- Uses the -# progress display, because the normal
			-- one is very confusing when resuming, showing
			-- the remainder to download as the whole file,
			-- and not indicating how much percent was
			-- downloaded before the resume.
			liftIO $ boolSystem "curl" 
				[Params "-L -C - -# -o", File file, File url]

{- Downloads a small file. -}
get :: URLString -> IO String
get url =
	case parseURI url of
		Nothing -> error "url parse error"
		Just u -> do
			r <- request u GET
			case rspCode r of
				(2,_,_) -> return $ rspBody r
				_ -> error $ rspReason r

{- Makes a http request of an url. For example, HEAD can be used to
 - check if the url exists, or GET used to get the url content (best for
 - small urls). -}
request :: URI -> RequestMethod -> IO (Response String)
request url requesttype = Browser.browse $ do
	Browser.setErrHandler ignore
	Browser.setOutHandler ignore
	Browser.setAllowRedirects True
	snd <$> Browser.request (mkRequest requesttype url :: Request_String)
	where
		ignore = const $ return ()