summaryrefslogtreecommitdiff
path: root/Remote/Web.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-07-04 19:31:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-07-04 19:33:11 -0400
commit5c69ac14eb47e284ab4f4dec44ed6ab3581d416f (patch)
tree74edda6e54f71a61176e5487e36ebe3198a13825 /Remote/Web.hs
parent71c783bf24f2aa4ab911d8279081bcad08951ece (diff)
Drop the dependency on the haskell curl bindings, use regular haskell HTTP.
Diffstat (limited to 'Remote/Web.hs')
-rw-r--r--Remote/Web.hs29
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