blob: ad4b458dd8aee1adf7a836d0cfb3ba83a3cfb1f7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
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))
|