diff options
author | Joey Hess <joey@kitenet.net> | 2011-07-04 19:31:45 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-07-04 19:33:11 -0400 |
commit | 5c69ac14eb47e284ab4f4dec44ed6ab3581d416f (patch) | |
tree | 74edda6e54f71a61176e5487e36ebe3198a13825 /Remote/Web.hs | |
parent | 71c783bf24f2aa4ab911d8279081bcad08951ece (diff) |
Drop the dependency on the haskell curl bindings, use regular haskell HTTP.
Diffstat (limited to 'Remote/Web.hs')
-rw-r--r-- | Remote/Web.hs | 29 |
1 files changed, 18 insertions, 11 deletions
diff --git a/Remote/Web.hs b/Remote/Web.hs index 71591b7aa..d3d140d73 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -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 |