refactoring

diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs
index 685d6a57474728d7f511a806182499b6c51a2c2d..1c9e1bf97b61ae504b6234f3fa13265b23f3ac7e 100644 (file)
--- a/Command/P2PStdIO.hs
+++ b/Command/P2PStdIO.hs
@@ -62,13 +62,16 @@ performProxy clientuuid servermode remote = do
        clientside <- ClientSide
                <$> liftIO (mkRunState $ Serving clientuuid Nothing)
                <*> pure (stdioP2PConnection Nothing)
-       getClientProtocolVersion clienterrhandler remote clientside $ \case
-               Nothing -> done
-               Just (clientmaxversion, othermsg) ->
-                       connectremote clientmaxversion $ \remoteside ->
-                               proxy clienterrhandler done servermode
-                                       clientside remoteside othermsg
+       getClientProtocolVersion remote clientside 
+               (withclientversion clientside)
+               clienterrhandler
   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.
        connectremote clientmaxversion cont = 
                openP2PSshConnection' remote clientmaxversion >>= \case

diff --git a/P2P/Proxy.hs b/P2P/Proxy.hs
index 92db9a4c7a3d10e0168b10870aced93821965716..cb5c33c9bed1c2685d4a3f20f42ea5a4f042c58d 100644 (file)
--- a/P2P/Proxy.hs
+++ b/P2P/Proxy.hs
@@ -17,6 +17,13 @@ import qualified Remote
 data ClientSide = ClientSide 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
  - will send a VERSION message, although version 0 clients will not and
  - will send some other message.
@@ -26,17 +33,18 @@ data RemoteSide = RemoteSide RunState P2PConnection
  - brought up yet.
  -}
 getClientProtocolVersion 
-       :: (forall t. ((t -> Annex r) -> Annex (Either ProtoFailure t) -> Annex r))
-       -> Remote 
+       :: Remote 
        -> ClientSide
        -> (Maybe (ProtocolVersion, Maybe Message) -> Annex r)
-       -> Annex r
-getClientProtocolVersion clienterrhandler remote (ClientSide clientrunst clientconn) cont =
+       -> ClientErrorHandled Annex r
+getClientProtocolVersion remote (ClientSide clientrunst clientconn) cont clienterrhandler =
        clienterrhandler cont $
                liftIO $ runNetProto clientrunst clientconn $
                        getClientProtocolVersion' remote
 
-getClientProtocolVersion' :: Remote -> Proto (Maybe (ProtocolVersion, Maybe Message))
+getClientProtocolVersion'
+       :: Remote
+       -> Proto (Maybe (ProtocolVersion, Maybe Message))
 getClientProtocolVersion' remote = do
        net $ sendMessage (AUTH_SUCCESS (Remote.uuid remote))
        msg <- net receiveMessage
@@ -54,21 +62,19 @@ getClientProtocolVersion' remote = do
                        (Just (defaultProtocolVersion, Just othermsg))
 
 {- Proxy between the client and the remote. This picks up after
- - getClientProtocolVersion, and after the connection to
- - the remote has been made, and the protocol version negotiated with the
- - remote.
+ - getClientProtocolVersion, after the connection to the remote has
+ - been made, and the protocol version negotiated with the remote.
  -}
 proxy 
-       :: (forall t. ((t -> Annex r) -> Annex (Either ProtoFailure t) -> Annex r))
-       -> Annex r
+       :: Annex r
        -> ServerMode
        -> ClientSide
        -> RemoteSide
        -> Maybe Message
-       -- ^ non-VERSION message that was received from the client and has
-       -- not been responded to yet
-       -> Annex r
-proxy clienterrhandler endsuccess servermode (ClientSide clientrunst clientconn) (RemoteSide remoterunst remoteconn) othermessage = do
+       -- ^ non-VERSION message that was received from the client when
+       -- negotiating protocol version, and has not been responded to yet
+       -> ClientErrorHandled Annex r
+proxy endsuccess servermode clientside remoteside othermessage clienterrhandler = do
        case othermessage of
                Just message -> clientmessage (Just message)
                Nothing -> do
@@ -80,6 +86,9 @@ proxy clienterrhandler endsuccess servermode (ClientSide clientrunst clientconn)
                                toclient $ net $ sendMessage 
                                        (VERSION proxyprotocolversion)
   where
+       ClientSide clientrunst clientconn = clientside
+       RemoteSide remoterunst remoteconn = remoteside
+       
        toremote = liftIO . runNetProto remoterunst remoteconn
        toclient = liftIO . runNetProto clientrunst clientconn