summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-07-27 00:30:04 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-07-27 00:30:04 -0400
commitc46eba94f69151ded37988efd7e3375d327faef3 (patch)
tree90d69a2eecde684e1010e99604055df1741e5acf /Remote
parent07eb1e676829a20cb7bcc73a219f51b76daa4b3f (diff)
better Preparer interface
This will allow things like WebDAV to opean a single persistent connection and reuse it for all the chunked data. The crazy types allow for some nice code reuse.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Directory.hs16
-rw-r--r--Remote/Directory/LegacyChunked.hs8
-rw-r--r--Remote/Helper/ChunkedEncryptable.hs46
3 files changed, 41 insertions, 29 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 2ebf608cb..cb7553fe2 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types #-}
module Remote.Directory (remote) where
@@ -106,11 +107,10 @@ tmpDir d k = addTrailingPathSeparator $ d </> "tmp" </> keyFile k
{- Check if there is enough free disk space in the remote's directory to
- store the key. Note that the unencrypted key size is checked. -}
-prepareStore :: FilePath -> ChunkConfig -> PrepareStorer
-prepareStore d chunkconfig k = ifM (checkDiskSpace (Just d) k 0)
- ( return $ Just (store d chunkconfig)
- , return Nothing
- )
+prepareStore :: FilePath -> ChunkConfig -> Preparer Storer
+prepareStore d chunkconfig = checkPrepare
+ (\k -> checkDiskSpace (Just d) k 0)
+ (store d chunkconfig)
store :: FilePath -> ChunkConfig -> Storer
store d chunkconfig k b p = do
@@ -135,9 +135,9 @@ store d chunkconfig k b p = do
mapM_ preventWrite =<< dirContents dest
preventWrite dest
-retrieve :: FilePath -> ChunkConfig -> PrepareRetriever
-retrieve d (LegacyChunks _) basek = Legacy.retrieve locations d basek
-retrieve d _ _ = return $ Just $ \k -> L.readFile =<< getLocation d k
+retrieve :: FilePath -> ChunkConfig -> Preparer Retriever
+retrieve d (LegacyChunks _) = Legacy.retrieve locations d
+retrieve d _ = simplyPrepare $ \k -> L.readFile =<< getLocation d k
retrieveCheap :: FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool
-- no cheap retrieval possible for chunks
diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs
index df6d94d04..c7b8ad52c 100644
--- a/Remote/Directory/LegacyChunked.hs
+++ b/Remote/Directory/LegacyChunked.hs
@@ -7,6 +7,8 @@
- Licensed under the GNU GPL version 3 or higher.
-}
+{-# LANGUAGE Rank2Types #-}
+
module Remote.Directory.LegacyChunked where
import qualified Data.ByteString.Lazy as L
@@ -88,13 +90,13 @@ store chunksize finalizer k b p = storeHelper finalizer k $ \dests ->
- Done very innefficiently, by writing to a temp file.
- :/ This is legacy code..
-}
-retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> PrepareRetriever
-retrieve locations d basek = do
+retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> Preparer Retriever
+retrieve locations d basek a = do
showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."
tmpdir <- fromRepo $ gitAnnexTmpMiscDir
createAnnexDirectory tmpdir
let tmp = tmpdir </> keyFile basek ++ ".directorylegacy.tmp"
- return $ Just $ \k -> do
+ a $ Just $ \k -> do
void $ withStoredFiles d locations k $ \fs -> do
forM_ fs $
S.appendFile tmp <=< S.readFile
diff --git a/Remote/Helper/ChunkedEncryptable.hs b/Remote/Helper/ChunkedEncryptable.hs
index cfa92406e..ac8917851 100644
--- a/Remote/Helper/ChunkedEncryptable.hs
+++ b/Remote/Helper/ChunkedEncryptable.hs
@@ -5,12 +5,15 @@
- Licensed under the GNU GPL version 3 or higher.
-}
+{-# LANGUAGE Rank2Types #-}
+
module Remote.Helper.ChunkedEncryptable (
- chunkedEncryptableRemote,
- PrepareStorer,
+ Preparer,
+ simplyPrepare,
+ checkPrepare,
Storer,
- PrepareRetriever,
Retriever,
+ chunkedEncryptableRemote,
storeKeyDummy,
retreiveKeyFileDummy,
module X
@@ -28,18 +31,23 @@ import Remote.Helper.Encryptable as X
import Annex.Content
import Annex.Exception
--- Prepares to store a Key, and returns a Storer action if possible.
--- May throw exceptions.
-type PrepareStorer = Key -> Annex (Maybe Storer)
+-- 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
--- Prepares to retrieve a Key, and returns a Retriever action if possible.
--- May throw exceptions.
-type PrepareRetriever = Key -> Annex (Maybe Retriever)
-
-- 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
@@ -48,8 +56,8 @@ type Retriever = Key -> IO L.ByteString
-}
chunkedEncryptableRemote
:: RemoteConfig
- -> PrepareStorer
- -> PrepareRetriever
+ -> Preparer Storer
+ -> Preparer Retriever
-> Remote
-> Remote
chunkedEncryptableRemote c preparestorer prepareretriever r = encr
@@ -74,13 +82,14 @@ chunkedEncryptableRemote c preparestorer prepareretriever r = encr
safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
-- chunk, then encrypt, then feed to the storer
- storeKeyGen k p enc = safely $
- maybe (return False) go =<< preparestorer k
+ storeKeyGen k p enc =
+ safely $ preparestorer k $ safely . go
where
- go storer = sendAnnex k rollback $ \src ->
+ 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'
@@ -90,13 +99,14 @@ chunkedEncryptableRemote c preparestorer prepareretriever r = encr
storer (enck k') encb p'
-- call retriever to get chunks; decrypt them; stream to dest file
- retrieveKeyFileGen k dest p enc = safely $
- maybe (return False) go =<< prepareretriever k
+ retrieveKeyFileGen k dest p enc =
+ safely $ prepareretriever k $ safely . go
where
- go retriever = metered (Just p) k $ \p' ->
+ go (Just retriever) = metered (Just p) k $ \p' ->
bracketIO (openBinaryFile dest WriteMode) hClose $ \h ->
retrieveChunks retriever (uuid r) chunkconfig enck k p' $
sink h
+ go Nothing = return False
sink h p' b = do
let write = meteredWrite p' h
case enc of