authentication is implemented

just need to make Command.P2PHttp generate a GetServerMode from options

P2P/Http.hs

@@ -161,6 +161,7 @@ type CheckPresentAPI
 	:> ClientUUID Required
 	:> ServerUUID Required
 	:> BypassUUIDs
+	:> AuthHeader
 	:> Post '[JSON] CheckPresentResult
 
 serveCheckPresent
@@ -171,9 +172,11 @@ serveCheckPresent
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> Maybe Auth
 	-> Handler CheckPresentResult
-serveCheckPresent st apiver (B64Key k) cu su bypass = do
-	res <- withP2PConnection apiver st cu su bypass $ \runst conn ->
+serveCheckPresent st apiver (B64Key k) cu su bypass auth = do
+	res <- withP2PConnection apiver st cu su bypass auth ReadAction
+		$ \runst conn ->
 			liftIO $ runNetProto runst conn $ checkPresent k
 	case res of
 		Right (Right b) -> return (CheckPresentResult b)
@@ -186,6 +189,7 @@ clientCheckPresent'
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> Maybe Auth
 	-> ClientM CheckPresentResult
 clientCheckPresent' (ProtocolVersion ver) = case ver of
 	3 -> v3 V3
@@ -204,9 +208,10 @@ clientCheckPresent
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> Maybe Auth
 	-> IO Bool
-clientCheckPresent clientenv protover key cu su bypass = do
-	let cli = clientCheckPresent' protover key cu su bypass
+clientCheckPresent clientenv protover key cu su bypass auth = do
+	let cli = clientCheckPresent' protover key cu su bypass auth
 	withClientM cli clientenv $ \case
 		Left err -> throwM err
 		Right (CheckPresentResult res) -> return res
@@ -216,6 +221,7 @@ type RemoveAPI result
 	:> ClientUUID Required
 	:> ServerUUID Required
 	:> BypassUUIDs
+	:> AuthHeader
 	:> Post '[JSON] result
 	
 serveRemove
@@ -227,6 +233,7 @@ serveRemove
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> Maybe Auth
 	-> Handler t
 serveRemove = undefined
 
@@ -236,12 +243,13 @@ clientRemove
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> Maybe Auth
 	-> ClientM RemoveResultPlus
-clientRemove (ProtocolVersion ver) k cu su bypass = case ver of
-	3 -> v3 V3 k cu su bypass
-	2 -> v2 V2 k cu su bypass
-	1 -> plus <$> v1 V1 k cu su bypass
-	0 -> plus <$> v0 V0 k cu su bypass
+clientRemove (ProtocolVersion ver) k cu su bypass auth = case ver of
+	3 -> v3 V3 k cu su bypass auth
+	2 -> v2 V2 k cu su bypass auth
+	1 -> plus <$> v1 V1 k cu su bypass auth
+	0 -> plus <$> v0 V0 k cu su bypass auth
 	_ -> error "unsupported protocol version"
   where
 	_ :<|> _ :<|> _ :<|> _ :<|>

P2P/Http/State.hs

@@ -36,6 +36,9 @@ mkP2PHttpServerState acquireconn getservermode = P2PHttpServerState
 	<*> pure getservermode
 	<*> newTMVarIO mempty
 
+data ActionClass = ReadAction | WriteAction | RemoveAction
+	deriving (Eq)
+
 withP2PConnection
 	:: APIVersion v
 	=> v
@@ -43,10 +46,20 @@ withP2PConnection
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> Maybe Auth
+	-> ActionClass
 	-> (RunState -> P2PConnection -> Handler a)
 	-> Handler a
-withP2PConnection apiver st cu su bypass connaction = do
-	liftIO (acquireP2PConnection st cp) >>= \case
+withP2PConnection apiver st cu su bypass auth actionclass connaction =
+	case (getServerMode st auth, actionclass) of
+		(Just P2P.ServeReadWrite, _) -> go P2P.ServeReadWrite
+		(Just P2P.ServeAppendOnly, RemoveAction) -> throwError err403
+		(Just P2P.ServeAppendOnly, _) -> go P2P.ServeAppendOnly
+		(Just P2P.ServeReadOnly, ReadAction) -> go P2P.ServeReadOnly
+		(Just P2P.ServeReadOnly, _) -> throwError err403
+		(Nothing, _) -> throwError err401
+  where
+	go servermode = liftIO (acquireP2PConnection st cp) >>= \case
 		Left (ConnectionFailed err) -> 
 			throwError err502 { errBody = encodeBL err }
 		Left TooManyConnections ->
@@ -60,10 +73,11 @@ withP2PConnection apiver st cu su bypass connaction = do
 			, connectionServerUUID = fromB64UUID su
 			, connectionClientUUID = fromB64UUID cu
 			, connectionBypass = map fromB64UUID bypass
-		, connectionServerMode = P2P.ServeReadWrite -- XXX auth
+			, connectionServerMode = servermode
 			}
 
-type GetServerMode = IsSecure -> Maybe BasicAuthData -> Maybe P2P.ServerMode
+-- Nothing when the server is not allowed to serve any requests.
+type GetServerMode = Maybe Auth -> Maybe P2P.ServerMode
 
 data ConnectionParams = ConnectionParams
 	{ connectionProtocolVersion :: P2P.ProtocolVersion

doc/design/p2p_protocol_over_http/draft1.mdwn

@@ -26,6 +26,9 @@ it will fail with 401 Unauthorized.
 Authentication is done using HTTP basic auth. The realm to use when
 authenticating is "git-annex".
 
+When authentication is successful but does not allow a request to be
+performed, it will fail with 403 Forbidden.
+
 Note that HTTP basic auth is not encrypted so is only secure when used
 over HTTPS.