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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
{- Remotes that support both chunking and encryption.
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE Rank2Types #-}
module Remote.Helper.ChunkedEncryptable (
Preparer,
simplyPrepare,
checkPrepare,
Storer,
Retriever,
chunkedEncryptableRemote,
storeKeyDummy,
retreiveKeyFileDummy,
module X
) where
import qualified Data.ByteString.Lazy as L
import Common.Annex
import Types.Remote
import Crypto
import Config.Cost
import Utility.Metered
import Remote.Helper.Chunked as X
import Remote.Helper.Encryptable as X
import Annex.Content
import Annex.Exception
-- Prepares for and then runs an action that will act on a Key,
-- passing it a helper when the preparation is successful.
type Preparer helper = forall a. Key -> (Maybe helper -> Annex a) -> Annex a
simplyPrepare :: helper -> Preparer helper
simplyPrepare helper _ a = a $ Just helper
checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper
checkPrepare checker helper k a = ifM (checker k)
( a (Just helper)
, a Nothing
)
-- Stores a Key, which may be encrypted and/or a chunk key.
-- May throw exceptions.
type Storer = Key -> L.ByteString -> MeterUpdate -> IO Bool
-- Retrieves a Key, which may be encrypted and/or a chunk key.
-- Throws exception if key is not present, or remote is not accessible.
type Retriever = Key -> IO L.ByteString
{- Modifies a base Remote to support both chunking and encryption.
-}
chunkedEncryptableRemote
:: RemoteConfig
-> Preparer Storer
-> Preparer Retriever
-> Remote
-> Remote
chunkedEncryptableRemote c preparestorer prepareretriever r = encr
where
encr = r
{ storeKey = \k _f p -> cip >>= storeKeyGen k p
, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
, retrieveKeyFileCheap = \k d -> cip >>= maybe
(retrieveKeyFileCheap r k d)
(\_ -> return False)
, removeKey = \k -> cip >>= removeKeyGen k
, hasKey = \k -> cip >>= hasKeyGen k
, cost = maybe
(cost r)
(const $ cost r + encryptedRemoteCostAdj)
(extractCipher c)
}
cip = cipherKey c
chunkconfig = chunkConfig c
gpgopts = getGpgEncParams encr
safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
-- chunk, then encrypt, then feed to the storer
storeKeyGen k p enc =
safely $ preparestorer k $ safely . go
where
go (Just storer) = sendAnnex k rollback $ \src ->
metered (Just p) k $ \p' ->
storeChunks (uuid r) chunkconfig k src p' $
storechunk storer
go Nothing = return False
rollback = void $ removeKey encr k
storechunk storer k' b p' = case enc of
Nothing -> storer k' b p'
Just (cipher, enck) ->
encrypt gpgopts cipher (feedBytes b) $
readBytes $ \encb ->
storer (enck k') encb p'
-- call retriever to get chunks; decrypt them; stream to dest file
retrieveKeyFileGen k dest p enc =
safely $ prepareretriever k $ safely . go
where
go (Just retriever) = metered (Just p) k $ \p' ->
retrieveChunks retriever (uuid r) chunkconfig enck k dest p' sink
go Nothing = return False
sink h p' b = do
let write = meteredWrite p' h
case enc of
Nothing -> write b
Just (cipher, _) ->
decrypt cipher (feedBytes b) $
readBytes write
enck = maybe id snd enc
removeKeyGen k enc = removeChunks remover (uuid r) chunkconfig enck k
where
enck = maybe id snd enc
remover = removeKey r
hasKeyGen k enc = hasKeyChunks checker (uuid r) chunkconfig enck k
where
enck = maybe id snd enc
checker = hasKey r
{- The base Remote that is provided to chunkedEncryptableRemote
- needs to have storeKey and retreiveKeyFile methods, but they are
- never actually used (since chunkedEncryptableRemote replaces
- them). Here are some dummy ones.
-}
storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
storeKeyDummy _ _ _ = return False
retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
retreiveKeyFileDummy _ _ _ _ = return False
|
