cleanups

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

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

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)

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"