Drop the dependency on the haskell curl bindings, use regular haskell HTTP.

This commit is contained in:
Joey Hess 2011-07-04 19:31:45 -04:00
parent 71c783bf24
commit 5c69ac14eb
7 changed files with 25 additions and 15 deletions

View file

@ -14,10 +14,9 @@ module Remote.Web (
import Control.Monad.State (liftIO)
import Control.Exception
import System.FilePath
import Network.Curl.Easy
import Network.Curl.Opts
import Network.Curl.Types
import Network.Curl.Code
import Network.Browser
import Network.HTTP
import Network.URI
import Types
import Types.Remote
@ -31,6 +30,8 @@ import PresenceLog
import LocationLog
import Locations
type URLString = String
remote :: RemoteType Annex
remote = RemoteType {
typename = "web",
@ -111,13 +112,19 @@ checkKey' (u:us) = do
urlexists :: URLString -> IO Bool
urlexists url = do
curl <- initialize
_ <- setopt curl (CurlURL url)
_ <- setopt curl (CurlNoBody True)
_ <- setopt curl (CurlFailOnError True)
_ <- setopt curl (CurlFollowLocation True)
res <- perform curl
return $ res == CurlOK
case parseURI url of
Nothing -> return False
Just u -> do
(_, r) <- Network.Browser.browse $ do
setErrHandler ignore
setOutHandler ignore
setAllowRedirects True
request (mkRequest HEAD u :: Request_String)
case rspCode r of
(2,_,_) -> return True
_ -> return False
where
ignore = const $ return ()
download :: [URLString] -> FilePath -> Annex Bool
download [] _ = return False