refactoring
This commit is contained in:
parent
501d65eeab
commit
92c83a417f
2 changed files with 32 additions and 20 deletions
|
@ -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
|
||||||
|
|
37
P2P/Proxy.hs
37
P2P/Proxy.hs
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue