implement serveRemove and send WWW-Authenticate header on auth failure

Command/P2PHttp.hs

@@ -67,7 +67,12 @@ optParser _ = Options
 		)
 
 seek :: Options -> CommandSeek
-seek o = startConcurrency commandStages $
+seek o = startConcurrency commandStages $ do
+	-- XXX remove this
+	when (isNothing (portOption o)) $ do
+		liftIO $ putStrLn "test begins"
+		testCheckPresent
+		giveup "TEST DONE" 
 	withLocalP2PConnections $ \acquireconn -> liftIO $ do
 		authenv <- getAuthEnv
 		st <- mkP2PHttpServerState acquireconn $

P2P/Http.hs

@@ -21,7 +21,7 @@ module P2P.Http (
 import Annex.Common
 import P2P.Http.Types
 import P2P.Http.State
-import P2P.Protocol hiding (Offset, Bypass)
+import P2P.Protocol hiding (Offset, Bypass, auth)
 import P2P.IO
 
 import Servant
@@ -181,9 +181,8 @@ serveCheckPresent st apiver (B64Key k) cu su bypass sec auth = do
 		$ \runst conn ->
 			liftIO $ runNetProto runst conn $ checkPresent k
 	case res of
-		Right (Right b) -> return (CheckPresentResult b)
-		Right (Left err) -> throwError $ err500 { errBody = encodeBL err }
-		Left err -> throwError $ err500 { errBody = encodeBL (describeProtoFailure err) }
+		Right b -> return (CheckPresentResult b)
+		Left err -> throwError $ err500 { errBody = encodeBL err }
 
 clientCheckPresent
 	:: ClientEnv
@@ -214,6 +213,7 @@ type RemoveAPI result
 	:> ClientUUID Required
 	:> ServerUUID Required
 	:> BypassUUIDs
+	:> IsSecure
 	:> AuthHeader
 	:> Post '[JSON] result
 	
@@ -226,9 +226,18 @@ serveRemove
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> IsSecure
 	-> Maybe Auth
 	-> Handler t
-serveRemove = undefined
+serveRemove st resultmangle apiver (B64Key k) cu su bypass sec auth = do
+	res <- withP2PConnection apiver st cu su bypass sec auth RemoveAction
+		$ \runst conn ->
+			liftIO $ runNetProto runst conn $ remove Nothing k
+	case res of
+		(Right b, plus) -> return $ resultmangle $ 
+			RemoveResultPlus b (map B64UUID (fromMaybe [] plus))
+		(Left err, _) -> throwError $
+			err500 { errBody = encodeBL err }
 
 clientRemove
 	:: ProtocolVersion

P2P/Http/State.hs

@@ -8,6 +8,7 @@
  -}
 
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module P2P.Http.State where
 
@@ -49,7 +50,7 @@ withP2PConnection
 	-> IsSecure
 	-> Maybe Auth
 	-> ActionClass
-	-> (RunState -> P2PConnection -> Handler a)
+	-> (RunState -> P2PConnection -> Handler (Either ProtoFailure a))
 	-> Handler a
 withP2PConnection apiver st cu su bypass sec auth actionclass connaction =
 	case (getServerMode st sec auth, actionclass) of
@@ -58,7 +59,7 @@ withP2PConnection apiver st cu su bypass sec auth actionclass connaction =
 		(Just P2P.ServeAppendOnly, _) -> go P2P.ServeAppendOnly
 		(Just P2P.ServeReadOnly, ReadAction) -> go P2P.ServeReadOnly
 		(Just P2P.ServeReadOnly, _) -> throwError err403
-		(Nothing, _) -> throwError err401
+		(Nothing, _) -> throwError basicAuthRequired
   where
 	go servermode = liftIO (acquireP2PConnection st cp) >>= \case
 		Left (ConnectionFailed err) -> 
@@ -66,7 +67,7 @@ withP2PConnection apiver st cu su bypass sec auth actionclass connaction =
 		Left TooManyConnections ->
 			throwError err503
 		Right (runst, conn, releaseconn) ->
-			connaction runst conn
+			connaction' runst conn
 				`finally` liftIO releaseconn
 	  where
 		cp = ConnectionParams
@@ -77,6 +78,17 @@ withP2PConnection apiver st cu su bypass sec auth actionclass connaction =
 			, connectionServerMode = servermode
 			}
 	
+	connaction' runst conn = connaction runst conn >>= \case
+		Right r -> return r
+		Left err -> throwError $
+			err500 { errBody = encodeBL (describeProtoFailure err) }
+
+basicAuthRequired :: ServerError
+basicAuthRequired = err401 { errHeaders = [(h, v)] }
+  where
+	h = "WWW-Authenticate"
+	v = "Basic realm=\"git-annex\", charset=\"UTF-8\""
+
 -- Nothing when the server is not allowed to serve any requests.
 type GetServerMode = IsSecure -> Maybe Auth -> Maybe P2P.ServerMode
 

doc/design/p2p_protocol_over_http/draft1.mdwn

@@ -24,7 +24,7 @@ configuration of the HTTP server. When a request needs authentication,
 it will fail with 401 Unauthorized.
 
 Authentication is done using HTTP basic auth. The realm to use when
-authenticating is "git-annex".
+authenticating is "git-annex". The charset is UTF-8.
 
 When authentication is successful but does not allow a request to be
 performed, it will fail with 403 Forbidden.