diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index b4fb3c92fd1b7e081252d189c4a377285b66c7f1..08f305d9ddf81ef2f36cfb20044af86fe156bb64 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -16,7 +16,8 @@ module Tahoe.Download (
import Control.Exception (throwIO)
import Control.Monad.IO.Class (MonadIO (liftIO))
-import Data.Binary (decodeOrFail)
+import Data.Binary (Word16, decodeOrFail)
+import qualified Data.ByteString as B
import Data.ByteString.Base32 (encodeBase32Unpadded)
import Data.ByteString.Base64 (encodeBase64)
import qualified Data.ByteString.Lazy as LB
@@ -83,10 +84,9 @@ data DiscoverError
| StorageServerUnreachable LookupError
deriving (Eq, Ord, Show)
--- TODO The result might need to be in IO in case the URL indicates a
--- Tor-based route to the server. In this case we might need to launch a Tor
--- daemon or connect to a running Tor daemon or at least set up a new Tor
--- circuit. All of which require I/O. But we can always refactor later!
+{- | The type of a function that can produce a concrete StorageServer from
+ that server's announcement.
+-}
type LookupServer m = StorageServerAnnouncement -> m (Either LookupError StorageServer)
{- | Recover the application data associated with a given capability from the
@@ -104,7 +104,31 @@ download ::
-- | Either a description of how the recovery failed or the recovered
-- application data.
m (Either DownloadError LB.ByteString)
-download servers cap@Reader{readKey, verifier = Verifier{..}} lookupServer =
+download servers cap@Reader{verifier = Verifier{..}} lookupServer = do
+ locationE <- locateShares servers lookupServer storageIndex required
+ case locationE of
+ Left err -> pure $ Left err
+ Right discovered -> do
+ -- XXX note shares can contain failures
+ shares <- fetchShares storageIndex discovered
+ decodeShares cap shares
+
+-- | Find out which servers claim to have shares related to a given storage index.
+locateShares ::
+ MonadIO m =>
+ -- | Information about the servers from which to consider downloading shares
+ -- representing the application data.
+ Map.Map StorageServerID StorageServerAnnouncement ->
+ -- | Get functions for interacting with a server given its URL.
+ LookupServer m ->
+ -- | The storage index about which to retrieve information.
+ B.ByteString ->
+ -- | The number of shares we need to locate. If we cannot find at least
+ -- this many shares the result will be an error.
+ Word16 ->
+ -- | Either an error or a guide to where shares are placed.
+ m (Either DownloadError [(StorageServer, Set.Set ShareNum)])
+locateShares servers lookupServer storageIndex required =
case Map.toList servers of
[] -> pure . Left $ NoConfiguredServers
serverList -> do
@@ -118,24 +142,46 @@ download servers cap@Reader{readKey, verifier = Verifier{..}} lookupServer =
else
if (fromIntegral required >) . countDistinctShares $ discovered
then pure $ Left NotEnoughShares{notEnoughSharesNeeded = fromIntegral required, notEnoughSharesFound = countDistinctShares discovered}
- else do
- -- XXX up to here is probably "locateShares". now we move in to "fetchShares".
- let sharemap = makeShareMap discovered
- -- XXX note shares can contain failures
- shares <- mapM (uncurry $ downloadShare storageIndex) (Map.toList sharemap)
- -- XXX That was brief. Probably missing some complexity. now we move on to "decodeShares".
- -- Filter down to shares we actually got.
- let someShares = filter (isRight . snd) shares
- fewerShares = filter (isRight . snd) $ (\(sharenum, Right bs) -> (sharenum, decodeOrFail bs)) <$> someShares
- onlyDecoded = (\(sharenum, Right (_, _, share)) -> (fromIntegral sharenum, share)) <$> fewerShares
- if length onlyDecoded < fromIntegral required
- then pure $ Left NotEnoughDecodedShares{notEnoughDecodedSharesNeeded = fromIntegral required, notEnoughDecodedSharesFound = length onlyDecoded}
- else do
- ciphertext <- liftIO $ Tahoe.CHK.decode cap onlyDecoded
- case ciphertext of
- Nothing -> pure $ Left ShareDecodingFailed
- Just ct ->
- pure . Right $ Tahoe.CHK.Encrypt.decrypt readKey ct
+ else pure $ Right discovered
+
+{- | Given a guide to where shares for a given storage index are placed,
+ download them.
+-}
+fetchShares ::
+ MonadIO m =>
+ -- | The storage index of the shares to download.
+ B.ByteString ->
+ -- | The guide to where shares are placed.
+ [(StorageServer, Set.Set ShareNum)] ->
+ m [(ShareNum, Either DownloadError LB.ByteString)]
+fetchShares storageIndex discovered =
+ mapM (uncurry $ downloadShare storageIndex) (Map.toList sharemap)
+ where
+ sharemap = makeShareMap discovered
+
+{- | Given the results of downloading shares related to a given capability,
+ decode them and decrypt the contents of possible.
+-}
+decodeShares ::
+ MonadIO m =>
+ -- | The read capability which allows the contents to be decrypted.
+ Reader ->
+ -- | The results of downloading the shares.
+ [(ShareNum, Either DownloadError LB.ByteString)] ->
+ m (Either DownloadError LB.ByteString)
+decodeShares cap@Reader{readKey, verifier = Verifier{..}} shares =
+ -- Filter down to shares we actually got.
+ let someShares = filter (isRight . snd) shares
+ fewerShares = filter (isRight . snd) $ (\(sharenum, Right bs) -> (sharenum, decodeOrFail bs)) <$> someShares
+ onlyDecoded = (\(sharenum, Right (_, _, share)) -> (fromIntegral sharenum, share)) <$> fewerShares
+ in if length onlyDecoded < fromIntegral required
+ then pure $ Left NotEnoughDecodedShares{notEnoughDecodedSharesNeeded = fromIntegral required, notEnoughDecodedSharesFound = length onlyDecoded}
+ else do
+ ciphertext <- liftIO $ Tahoe.CHK.decode cap onlyDecoded
+ case ciphertext of
+ Nothing -> pure $ Left ShareDecodingFailed
+ Just ct ->
+ pure . Right $ Tahoe.CHK.Encrypt.decrypt readKey ct
{- | Figure the total number of distinct shares reported by all of the servers
we asked.