refactoring

This commit is contained in:
Joey Hess 2024-06-11 10:20:11 -04:00
parent 501d65eeab
commit 92c83a417f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 32 additions and 20 deletions

View file

@ -62,13 +62,16 @@ performProxy clientuuid servermode remote = do
clientside <- ClientSide clientside <- ClientSide
<$> liftIO (mkRunState $ Serving clientuuid Nothing) <$> liftIO (mkRunState $ Serving clientuuid Nothing)
<*> pure (stdioP2PConnection Nothing) <*> pure (stdioP2PConnection Nothing)
getClientProtocolVersion clienterrhandler remote clientside $ \case getClientProtocolVersion remote clientside
Nothing -> done (withclientversion clientside)
Just (clientmaxversion, othermsg) -> clienterrhandler
connectremote clientmaxversion $ \remoteside ->
proxy clienterrhandler done servermode
clientside remoteside othermsg
where where
withclientversion clientside (Just (clientmaxversion, othermsg)) =
connectremote clientmaxversion $ \remoteside ->
proxy done servermode clientside remoteside
othermsg clienterrhandler
withclientversion _ Nothing = done
-- FIXME: Support special remotes and non-ssh git remotes. -- FIXME: Support special remotes and non-ssh git remotes.
connectremote clientmaxversion cont = connectremote clientmaxversion cont =
openP2PSshConnection' remote clientmaxversion >>= \case openP2PSshConnection' remote clientmaxversion >>= \case

View file

@ -17,6 +17,13 @@ import qualified Remote
data ClientSide = ClientSide RunState P2PConnection data ClientSide = ClientSide RunState P2PConnection
data RemoteSide = RemoteSide RunState P2PConnection data RemoteSide = RemoteSide RunState P2PConnection
{- Type of function that takes a client error handler, which is
- used to handle a ProtoFailure when receiving a message
- from the client.
-}
type ClientErrorHandled m r =
(forall t. ((t -> m r) -> m (Either ProtoFailure t) -> m r)) -> m r
{- This is the first thing run when proxying with a client. Most clients {- This is the first thing run when proxying with a client. Most clients
- will send a VERSION message, although version 0 clients will not and - will send a VERSION message, although version 0 clients will not and
- will send some other message. - will send some other message.
@ -26,17 +33,18 @@ data RemoteSide = RemoteSide RunState P2PConnection
- brought up yet. - brought up yet.
-} -}
getClientProtocolVersion getClientProtocolVersion
:: (forall t. ((t -> Annex r) -> Annex (Either ProtoFailure t) -> Annex r)) :: Remote
-> Remote
-> ClientSide -> ClientSide
-> (Maybe (ProtocolVersion, Maybe Message) -> Annex r) -> (Maybe (ProtocolVersion, Maybe Message) -> Annex r)
-> Annex r -> ClientErrorHandled Annex r
getClientProtocolVersion clienterrhandler remote (ClientSide clientrunst clientconn) cont = getClientProtocolVersion remote (ClientSide clientrunst clientconn) cont clienterrhandler =
clienterrhandler cont $ clienterrhandler cont $
liftIO $ runNetProto clientrunst clientconn $ liftIO $ runNetProto clientrunst clientconn $
getClientProtocolVersion' remote getClientProtocolVersion' remote
getClientProtocolVersion' :: Remote -> Proto (Maybe (ProtocolVersion, Maybe Message)) getClientProtocolVersion'
:: Remote
-> Proto (Maybe (ProtocolVersion, Maybe Message))
getClientProtocolVersion' remote = do getClientProtocolVersion' remote = do
net $ sendMessage (AUTH_SUCCESS (Remote.uuid remote)) net $ sendMessage (AUTH_SUCCESS (Remote.uuid remote))
msg <- net receiveMessage msg <- net receiveMessage
@ -54,21 +62,19 @@ getClientProtocolVersion' remote = do
(Just (defaultProtocolVersion, Just othermsg)) (Just (defaultProtocolVersion, Just othermsg))
{- Proxy between the client and the remote. This picks up after {- Proxy between the client and the remote. This picks up after
- getClientProtocolVersion, and after the connection to - getClientProtocolVersion, after the connection to the remote has
- the remote has been made, and the protocol version negotiated with the - been made, and the protocol version negotiated with the remote.
- remote.
-} -}
proxy proxy
:: (forall t. ((t -> Annex r) -> Annex (Either ProtoFailure t) -> Annex r)) :: Annex r
-> Annex r
-> ServerMode -> ServerMode
-> ClientSide -> ClientSide
-> RemoteSide -> RemoteSide
-> Maybe Message -> Maybe Message
-- ^ non-VERSION message that was received from the client and has -- ^ non-VERSION message that was received from the client when
-- not been responded to yet -- negotiating protocol version, and has not been responded to yet
-> Annex r -> ClientErrorHandled Annex r
proxy clienterrhandler endsuccess servermode (ClientSide clientrunst clientconn) (RemoteSide remoterunst remoteconn) othermessage = do proxy endsuccess servermode clientside remoteside othermessage clienterrhandler = do
case othermessage of case othermessage of
Just message -> clientmessage (Just message) Just message -> clientmessage (Just message)
Nothing -> do Nothing -> do
@ -80,6 +86,9 @@ proxy clienterrhandler endsuccess servermode (ClientSide clientrunst clientconn)
toclient $ net $ sendMessage toclient $ net $ sendMessage
(VERSION proxyprotocolversion) (VERSION proxyprotocolversion)
where where
ClientSide clientrunst clientconn = clientside
RemoteSide remoterunst remoteconn = remoteside
toremote = liftIO . runNetProto remoterunst remoteconn toremote = liftIO . runNetProto remoterunst remoteconn
toclient = liftIO . runNetProto clientrunst clientconn toclient = liftIO . runNetProto clientrunst clientconn