avoid repeatedly parsing the proxy log

diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs
index b69287078f4bc89ce49692d45364977a76fd51c1..854ce289e22eb4574099c989edd6543688c170b5 100644 (file)
--- a/Annex/Proxy.hs
+++ b/Annex/Proxy.hs
@@ -245,24 +245,23 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv = go
 {- Check if this repository can proxy for a specified remote uuid,
  - and if so enable proxying for it. -}
 checkCanProxy :: UUID -> UUID -> Annex Bool
-checkCanProxy remoteuuid ouruuid = checkCanProxy' remoteuuid ouruuid >>= \case
-       Right v -> do
-               Annex.changeState $ \st -> st { Annex.proxyremote = Just v }
-               return True
-       Left Nothing -> return False
-       Left (Just err) -> giveup err
+checkCanProxy remoteuuid ouruuid = do
+       ourproxies <- M.lookup ouruuid <$> getProxies
+       checkCanProxy' ourproxies remoteuuid >>= \case
+               Right v -> do
+                       Annex.changeState $ \st -> st { Annex.proxyremote = Just v }
+                       return True
+               Left Nothing -> return False
+               Left (Just err) -> giveup err
 
-checkCanProxy' :: UUID -> UUID -> Annex (Either (Maybe String) (Either ClusterUUID Remote))
-checkCanProxy' remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case
-       Nothing -> return (Left Nothing)
-       -- This repository has (or had) proxying enabled. So it's
-       -- ok to display error messages that talk about proxies.
-       Just proxies ->
-               case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of
-                       [] -> notconfigured
-                       ps -> case mkClusterUUID remoteuuid of
-                               Just cu -> proxyforcluster cu
-                               Nothing -> proxyfor ps
+checkCanProxy' :: Maybe (S.Set Proxy) -> UUID -> Annex (Either (Maybe String) (Either ClusterUUID Remote))
+checkCanProxy' Nothing _ = return (Left Nothing)
+checkCanProxy' (Just proxies) remoteuuid =
+       case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of
+               [] -> notconfigured
+               ps -> case mkClusterUUID remoteuuid of
+                       Just cu -> proxyforcluster cu
+                       Nothing -> proxyfor ps
   where
        -- This repository may have multiple remotes that access the same
        -- repository. Proxy for the lowest cost one that is configured to

diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index 6877cea7d3046e0a6e926a5ad6f079f5d7cad2b4..36f6d6ce690c227a3e3b6273a99dbb0004bb7e40 100644 (file)
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -30,6 +30,7 @@ import Types.Cluster
 import CmdLine.Action (startConcurrency)
 import Utility.ThreadScheduler
 import Utility.HumanTime
+import Logs.Proxy
 import Annex.Proxy
 import Annex.Cluster
 import qualified P2P.Proxy as Proxy
@@ -188,12 +189,13 @@ withP2PConnections
 withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do
        enableInteractiveBranchAccess
        myuuid <- getUUID
+       myproxies <- M.lookup myuuid <$> getProxies
        reqv <- liftIO newEmptyTMVarIO
        relv <- liftIO newEmptyTMVarIO
        endv <- liftIO newEmptyTMVarIO
        proxypool <- liftIO $ newTMVarIO (0, mempty)
        asyncservicer <- liftIO $ async $
-               servicer myuuid proxypool reqv relv endv
+               servicer myuuid myproxies proxypool reqv relv endv
        let endit = do
                liftIO $ atomically $ putTMVar endv ()
                liftIO $ wait asyncservicer
@@ -204,7 +206,7 @@ withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do
                atomically $ putTMVar reqv (connparams, respvar)
                atomically $ takeTMVar respvar
 
-       servicer myuuid proxypool reqv relv endv = do
+       servicer myuuid myproxies proxypool reqv relv endv = do
                reqrel <- liftIO $
                        atomically $ 
                                (Right <$> takeTMVar reqv)
@@ -214,25 +216,25 @@ withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do
                                (Left . Left <$> takeTMVar endv)
                case reqrel of
                        Right (connparams, respvar) -> do
-                               servicereq myuuid proxypool relv connparams
+                               servicereq myuuid myproxies proxypool relv connparams
                                        >>= atomically . putTMVar respvar
-                               servicer myuuid proxypool reqv relv endv
+                               servicer myuuid myproxies proxypool reqv relv endv
                        Left (Right releaseconn) -> do
                                releaseconn
-                               servicer myuuid proxypool reqv relv endv
+                               servicer myuuid myproxies proxypool reqv relv endv
                        Left (Left ()) -> return ()
        
-       servicereq myuuid proxypool relv connparams
+       servicereq myuuid myproxies proxypool relv connparams
                | connectionServerUUID connparams == myuuid =
                        localConnection relv connparams workerpool
                | otherwise =
                        atomically (getProxyConnectionPool proxypool connparams) >>= \case
                                Just conn -> proxyConnection proxyconnectionpoolsize relv connparams workerpool proxypool conn
-                               Nothing -> checkcanproxy myuuid proxypool relv connparams
+                               Nothing -> checkcanproxy myproxies proxypool relv connparams
 
-       checkcanproxy myuuid proxypool relv connparams = 
+       checkcanproxy myproxies proxypool relv connparams = 
                inAnnexWorker' workerpool
-                       (checkCanProxy' (connectionServerUUID connparams) myuuid)
+                       (checkCanProxy' myproxies (connectionServerUUID connparams))
                >>= \case
                        Right (Left reason) -> return $ Left $
                                ConnectionFailed $ 

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 8dbb8e1388a5a6617741f7f296b05dfcc3a37270..f94c65490a26213f9596ea2ee7c18197594071e2 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -28,9 +28,6 @@ Planned schedule of work:
 
 ## work notes
 
-* getProxies reads the proxy log every time, which is unncessarily slow.
-  memoize
-
 * An interrupted PUT to cluster that has a node that is a special remote
   over http leaves open the connection to the cluster, so the next request
   opens another one.