make remote-daemon able to send and receive objects over tor

Each worker thread needs to run in the Annex monad, but the
remote-daemon's liftAnnex can only run 1 action at a time. Used
Annex.Concurrent to deal with that.

P2P.Annex is incomplete as of yet.

1 files changed, 36 insertions, 0 deletions

diff --git a/P2P/Annex.hs b/P2P/Annex.hs
new file mode 100644
index 000000000..ad4b458dd
--- /dev/null
+++ b/P2P/Annex.hs
@@ -0,0 +1,36 @@
+{- P2P protocol, Annex implementation
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE RankNTypes, FlexibleContexts #-}
+
+module P2P.Annex
+	( RunEnv(..)
+	, runFullProto
+	) where
+
+import Annex.Common
+import Annex.Content
+import P2P.Protocol
+import P2P.IO
+
+import Control.Monad.Free
+
+-- Full interpreter for Proto, that can receive and send objects.
+runFullProto :: RunEnv -> Proto a -> Annex (Maybe a)
+runFullProto runenv = go
+  where
+	go :: RunProto Annex
+	go (Pure v) = pure (Just v)
+	go (Free (Net n)) = runNet runenv go n
+	go (Free (Local l)) = runLocal runenv go l
+
+runLocal :: RunEnv -> RunProto Annex -> LocalF (Proto a) -> Annex (Maybe a)
+runLocal runenv runner f = case f of
+	TmpContentSize k next -> do
+		tmp <- fromRepo $ gitAnnexTmpObjectLocation k
+		size <- liftIO $ catchDefaultIO 0 $ getFileSize tmp
+		runner (next (Len size))