cleanups

diff --git a/CmdLine/GitRemoteTorAnnex.hs b/CmdLine/GitRemoteTorAnnex.hs
index 72211c995c219e2aba7c01929930f3e07c3e9f1f..517ce7c82e2cb8fe920f3f420ad43218164018e7 100644 (file)
--- a/CmdLine/GitRemoteTorAnnex.hs
+++ b/CmdLine/GitRemoteTorAnnex.hs
@@ -66,7 +66,7 @@ connectService address port service = do
                        , runIhdl = h
                        , runOhdl = h
                        }
-               runNetProtoHandle runenv $ do
+               liftIO $ runNetProto runenv $ do
                        v <- auth myuuid authtoken
                        case v of
                                Just _theiruuid -> connect service stdin stdout

diff --git a/P2P/IO.hs b/P2P/IO.hs
index ac7c3e46377a3894b740f6834aa4f45de1be254c..6a834c6597508d5c8a1fbfbda68c5eb634663eb4 100644 (file)
--- a/P2P/IO.hs
+++ b/P2P/IO.hs
@@ -1,4 +1,4 @@
-{- P2P protocol, partial IO implementation
+{- P2P protocol, IO implementation
  -
  - Copyright 2016 Joey Hess <id@joeyh.name>
  -
@@ -9,8 +9,8 @@
 
 module P2P.IO
        ( RunEnv(..)
-       , runNetProtoHandle
-       , runNetHandle
+       , runNetProto
+       , runNet
        ) where
 
 import P2P.Protocol
@@ -42,21 +42,25 @@ data RunEnv = RunEnv
        , runOhdl :: Handle
        }
 
--- Interpreter of Proto that communicates with a peer over a Handle.
+-- Purposefully incomplete interpreter of Proto.
 --
--- No Local actions will be run; if the interpreter reaches any,
+-- This only runs Net actions. No Local actions will be run
+-- (those need the Annex monad) -- if the interpreter reaches any,
 -- it returns Nothing.
-runNetProtoHandle :: (MonadIO m, MonadMask m) => RunEnv -> Proto a -> m (Maybe a)
-runNetProtoHandle runenv = go
+runNetProto :: RunEnv -> Proto a -> IO (Maybe a)
+runNetProto runenv = go
   where
-       go :: RunProto m
+       go :: RunProto IO
        go (Pure v) = pure (Just v)
-       go (Free (Net n)) = runNetHandle runenv go n
+       go (Free (Net n)) = runNet runenv go n
        go (Free (Local _)) = return Nothing
 
--- Interprater of Net that communicates with a peer over a Handle.
-runNetHandle :: (MonadIO m, MonadMask m) => RunEnv -> RunProto m -> NetF (Proto a) -> m (Maybe a)
-runNetHandle runenv runner f = case f of
+-- Interprater of the Net part of Proto.
+--
+-- An interpreter of Proto has to be provided, to handle the rest of Proto
+-- actions.
+runNet :: (MonadIO m, MonadMask m) => RunEnv -> RunProto m -> NetF (Proto a) -> m (Maybe a)
+runNet runenv runner f = case f of
        SendMessage m next -> do
                v <- liftIO $ tryIO $ do
                        hPutStrLn (runOhdl runenv) (unwords (formatMessage m))
@@ -101,10 +105,9 @@ runNetHandle runenv runner f = case f of
                        Just () -> runner next
   where
        -- This is only used for running Net actions when relaying,
-       -- so it's ok to use runNetProtoHandle, despite it not supporting
+       -- so it's ok to use runNetProto, despite it not supporting
        -- all Proto actions.
-       runnerio :: RunProto IO
-       runnerio = runNetProtoHandle runenv
+       runnerio = runNetProto runenv
 
 runRelay :: RunProto IO -> RelayHandle -> RelayHandle -> IO (Maybe ExitCode)
 runRelay runner (RelayHandle hout) (RelayHandle hin) = bracket setup cleanup go

diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index 381949af1bc97694f00053df788e89bf753ffba7..444e08f0e9f1157f73ec72a27ed00303dbddba88 100644 (file)
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@@ -174,38 +174,6 @@ type Local = Free LocalF
 $(makeFree ''NetF)
 $(makeFree ''LocalF)
 
--- | Running Proto actions purely, to see what they do.
-runPure :: Show r => Proto r -> [Message] -> [(String, Maybe Message)]
-runPure (Pure r) _ = [("result: " ++ show r, Nothing)]
-runPure (Free (Net n)) ms = runNet n ms
-runPure (Free (Local n)) ms = runLocal n ms
-
-runNet :: Show r => NetF (Proto r) -> [Message] -> [(String, Maybe Message)]
-runNet (SendMessage m next) ms = (">",  Just m):runPure next ms
-runNet (ReceiveMessage _) [] = [("not enough Messages provided", Nothing)]
-runNet (ReceiveMessage next) (m:ms) = ("<", Just m):runPure (next m) ms
-runNet (SendBytes _ _ next) ms = ("> bytes", Nothing):runPure next ms
-runNet (ReceiveBytes _ next) ms = ("< bytes", Nothing):runPure (next L.empty) ms
-runNet (CheckAuthToken _ _ next) ms = runPure (next True) ms
-runNet (Relay _ _ next) ms = runPure (next ExitSuccess) ms
-runNet (RelayService _ next) ms = runPure next ms
-
-runLocal :: Show r => LocalF (Proto r) -> [Message] -> [(String, Maybe Message)]
-runLocal (KeyFileSize _ next) ms = runPure (next (Len 100)) ms
-runLocal (ReadKeyFile _ _ next) ms = runPure (next L.empty) ms
-runLocal (WriteKeyFile _ _ _ _ next) ms = runPure (next True) ms
-runLocal (SetPresent _ _ next) ms = runPure next ms
-runLocal (CheckContentPresent _ next) ms = runPure (next False) ms
-runLocal (RemoveKeyFile _ next) ms = runPure (next True) ms
-runLocal (TryLockContent _ p next) ms = runPure (p True >> next) ms
-
-protoDump :: [(String, Maybe Message)] -> String
-protoDump = unlines . map protoDump'
-
-protoDump' :: (String, Maybe Message) -> String
-protoDump' (s, Nothing) = s
-protoDump' (s, Just m) = s ++ " " ++ unwords (Proto.formatMessage m)
-
 auth :: UUID -> AuthToken -> Proto (Maybe UUID)
 auth myuuid t = do
        net $ sendMessage (AUTH myuuid t)

diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs
index 172948d37f2193814b521505405dc44859b13108..75b1a79230df856d397f8ce2f5bd68432a029382 100644 (file)
--- a/RemoteDaemon/Transport/Tor.hs
+++ b/RemoteDaemon/Transport/Tor.hs
@@ -84,5 +84,5 @@ serveClient th u r q = bracket setup cleanup go
                        , runIhdl = h
                        , runOhdl = h
                        }
-               void $ runNetProtoHandle runenv (serve u)
+               void $ runNetProto runenv (serve u)
                debugM "remotedaemon" "done with TOR connection"