authentication is implemented

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

diff --git a/P2P/Http.hs b/P2P/Http.hs
index ff91e6e2840fa4d749166a1d48198dc18a638c98..ff477e3f7eecaa37b4672138f1b9c319443dcd14 100644 (file)
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -161,6 +161,7 @@ type CheckPresentAPI
        :> ClientUUID Required
        :> ServerUUID Required
        :> BypassUUIDs
+       :> AuthHeader
        :> Post '[JSON] CheckPresentResult
 
 serveCheckPresent
@@ -171,10 +172,12 @@ 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 ->
-               liftIO $ runNetProto runst conn $ checkPresent k
+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)
                Right (Left err) -> throwError $ err500 { errBody = encodeBL err }
@@ -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
        _ :<|> _ :<|> _ :<|> _ :<|>

diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index c076e91505d604d942c7385967390cef6f247a73..0ab28250dedf49f35d11aa15a5d64afb445a0125 100644 (file)
--- a/P2P/Http/State.hs
+++ b/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 ->
@@ -54,16 +67,17 @@ withP2PConnection apiver st cu su bypass connaction = do
                Right (runst, conn, releaseconn) ->
                        connaction runst conn
                                `finally` liftIO releaseconn
-  where
-       cp = ConnectionParams
-               { connectionProtocolVersion = protocolVersion apiver
-               , connectionServerUUID = fromB64UUID su
-               , connectionClientUUID = fromB64UUID cu
-               , connectionBypass = map fromB64UUID bypass
-               , connectionServerMode = P2P.ServeReadWrite -- XXX auth
-               }
-
-type GetServerMode = IsSecure -> Maybe BasicAuthData -> Maybe P2P.ServerMode
+         where
+               cp = ConnectionParams
+                       { connectionProtocolVersion = protocolVersion apiver
+                       , connectionServerUUID = fromB64UUID su
+                       , connectionClientUUID = fromB64UUID cu
+                       , connectionBypass = map fromB64UUID bypass
+                       , connectionServerMode = 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

diff --git a/doc/design/p2p_protocol_over_http/draft1.mdwn b/doc/design/p2p_protocol_over_http/draft1.mdwn
index 24dccea7c010dd02561d769a3f864b4d24d0c683..41332d2f461f3307f38390b2c0b1a4200b23ffb1 100644 (file)
--- a/doc/design/p2p_protocol_over_http/draft1.mdwn
+++ b/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.