aboutsummaryrefslogtreecommitdiff
path: root/P2P
diff options
context:
space:
mode:
Diffstat (limited to 'P2P')
-rw-r--r--P2P/Annex.hs36
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))