split out generic url stuff into a helper library from Remote.Web
This commit is contained in:
parent
07f2e7ee72
commit
4545a0e78c
3 changed files with 77 additions and 34 deletions
66
Remote/Helper/Url.hs
Normal file
66
Remote/Helper/Url.hs
Normal file
|
@ -0,0 +1,66 @@
|
|||
{- Url downloading for remotes.
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Remote.Helper.Url (
|
||||
exists,
|
||||
download,
|
||||
get
|
||||
) where
|
||||
|
||||
import Control.Monad (liftM)
|
||||
import Control.Monad.State (liftIO)
|
||||
import qualified Network.Browser as Browser
|
||||
import Network.HTTP
|
||||
import Network.URI
|
||||
|
||||
import Types
|
||||
import Messages
|
||||
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 curl program for its progress bar. -}
|
||||
download :: URLString -> FilePath -> Annex Bool
|
||||
download url file = do
|
||||
showOutput -- make way for curl progress bar
|
||||
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
|
||||
liftM snd $ Browser.request
|
||||
(mkRequest requesttype url :: Request_String)
|
||||
where
|
||||
ignore = const $ return ()
|
Loading…
Add table
Add a link
Reference in a new issue