diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index 91f851e9552e642e22f95ff7302117b99db3f8cb..55d94812799652b049f842e20ddb2ec960849430 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -1,4 +1,4 @@
-module Tahoe.Download (DownloadError (..), download) where
+module Tahoe.Download (LookupServer, DownloadError (..), discoverOnce, download) where
import Data.Binary (decodeOrFail)
import qualified Data.ByteString.Lazy as LB
@@ -23,11 +23,17 @@ data DownloadError
| -- | Across all of the configured servers, fewer than the required
-- number of shares were found. XXX Could split this into the different
-- cases - did not locate enough shares, did not download enough shares,
- -- did not decode enough shares, did not verify enough shares
+ -- did not verify enough shares
NotEnoughShares
{ notEnoughSharesNeeded :: Int
, notEnoughSharesFound :: Int
}
+ | -- | Across all of the shares that we could download, fewer than the
+ -- required number could actually be decoded.
+ NotEnoughDecodedShares
+ { notEnoughDecodedSharesNeeded :: Int
+ , notEnoughDecodedSharesFound :: Int
+ }
| ShareDecodingFailed
| -- | An attempt was made to download a share but no servers were given for
-- the download.
@@ -43,6 +49,12 @@ data DiscoverError
| StorageServerUnreachable
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!
+type LookupServer = URL -> Maybe StorageServer
+
{- | Recover the application data associated with a given capability from the
given servers, if possible.
-}
@@ -53,20 +65,20 @@ download ::
-- | The read capability for the application data.
Reader ->
-- | Get functions for interacting with a server given its URL.
- (URL -> IO (Maybe StorageServer)) ->
+ LookupServer ->
-- | Either a description of how the recovery failed or the recovered
-- application data.
IO (Either DownloadError LB.ByteString)
-download servers cap@Reader{readKey, verifier = Verifier{..}} openServer =
+download servers cap@Reader{readKey, verifier = Verifier{..}} lookupServer =
case Map.toList servers of
[] -> pure . Left $ NoConfiguredServers
serverList -> do
-- Ask each server for all shares it has.
- discovered <- rights <$> mapM discoverOnce serverList :: IO [(StorageServer, Set.Set ShareNum)]
+ discovered <- rights <$> mapM (discoverOnce lookupServer storageIndex) serverList :: IO [(StorageServer, Set.Set ShareNum)]
if null discovered
then pure $ Left NoReachableServers
else
- if (fromIntegral required >=) . countDistinctShares $ discovered
+ 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".
@@ -79,29 +91,32 @@ download servers cap@Reader{readKey, verifier = Verifier{..}} openServer =
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 NotEnoughShares{notEnoughSharesNeeded = fromIntegral required, notEnoughSharesFound = length onlyDecoded}
+ then pure $ Left NotEnoughDecodedShares{notEnoughDecodedSharesNeeded = fromIntegral required, notEnoughDecodedSharesFound = length onlyDecoded}
else do
ciphertext <- Tahoe.CHK.decode cap onlyDecoded
case ciphertext of
Nothing -> pure $ Left ShareDecodingFailed
Just ct ->
pure . Right $ Tahoe.CHK.Encrypt.decrypt readKey ct
- where
- -- Figure the total number of distinct shares reported by all of the servers we
- -- asked.
- countDistinctShares = Set.size . foldl' Set.union mempty . map snd
- -- Ask one server which shares it has related to the storage index in
- -- question.
- discoverOnce (_sid, sann) = do
- case storageServerAnnouncementFURL sann of
- Nothing -> pure $ Left StorageServerLocationUnknown
- Just url -> do
- server <- openServer url
- case server of
- Nothing -> pure $ Left StorageServerUnreachable
- Just ss@StorageServer{storageServerGetBuckets} ->
- Right . (ss,) <$> storageServerGetBuckets storageIndex
+{- | Figure the total number of distinct shares reported by all of the servers
+ we asked.
+-}
+countDistinctShares :: Ord b => [(a, Set.Set b)] -> Int
+countDistinctShares = Set.size . foldl' Set.union mempty . map snd
+
+-- Ask one server which shares it has related to the storage index in
+-- question.
+discoverOnce :: LookupServer -> StorageIndex -> (StorageServerID, StorageServerAnnouncement) -> IO (Either DiscoverError (StorageServer, Set.Set ShareNum))
+discoverOnce lookupServer storageIndex (_sid, sann) = do
+ case storageServerAnnouncementFURL sann of
+ Nothing -> pure $ Left StorageServerLocationUnknown
+ Just url -> do
+ let server = lookupServer url
+ case server of
+ Nothing -> pure $ Left StorageServerUnreachable
+ Just ss@StorageServer{storageServerGetBuckets} ->
+ Right . (ss,) <$> storageServerGetBuckets storageIndex
{- | Invert the mapping implied by the list of two tuples so that the servers
that claim to have a certain share can easily be retrieved.
@@ -125,4 +140,9 @@ downloadShare ::
-- download.
IO (ShareNum, Either DownloadError LB.ByteString)
downloadShare _ shareNum [] = pure (shareNum, Left NoServers)
-downloadShare _ shareNum _ = pure (shareNum, Right "")
+downloadShare storageIndex shareNum (s : _) = do
+ -- TODO: There might be more servers. We could try them if this fails.
+ -- On the other hand, we might get bytes but we don't verify them here so
+ -- we might also need retry logic up a level or two from here.
+ shareBytes <- storageServerRead s storageIndex shareNum
+ pure (shareNum, Right $ LB.fromStrict shareBytes)
diff --git a/test/Spec.hs b/test/Spec.hs
index fac9ffe160b82ca222b37a3fe42a9a5bfa0840ab..0c4afeaf07810e2ac11f73864103d5079996e16d 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -10,6 +10,7 @@ import Data.ByteString.Base32 (encodeBase32Unpadded)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
+import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word16)
import Generators (genParameters)
@@ -23,7 +24,7 @@ import qualified Tahoe.CHK.Encrypt
import Tahoe.CHK.Server (StorageServer (..), StorageServerAnnouncement (..), StorageServerID)
import Tahoe.CHK.Types (Parameters (..))
import Tahoe.CHK.Upload (getConvergentKey)
-import Tahoe.Download (DownloadError (..), download)
+import Tahoe.Download (DownloadError (..), LookupServer, download)
import Tahoe.Server (memoryStorageServer)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)
@@ -89,8 +90,8 @@ tests =
-- Make the server reachable.
let openServer furl =
if furl == "somewhere"
- then pure . pure $ server
- else pure Nothing
+ then pure server
+ else Nothing
-- Try to download the cap which requires three shares to reconstruct.
result <- liftIO $ download anns cap openServer
@@ -136,7 +137,7 @@ tests =
-- Make the server reachable.
let openServer furl =
- pure $ case furl of
+ case furl of
"somewhere" -> pure somewhere
"elsewhere" -> pure elsewhere
_ -> Nothing
@@ -188,19 +189,27 @@ tests =
-- Distribute the shares.
liftIO $ placeShares cap (Binary.encode <$> shares) perServerShareCount servers 0
+ let serverMap = Map.fromList $ zip (Set.toList serverIDs') servers
+ lookupServer = someServers serverMap
+ serverAnnouncements = Map.fromSet makeAnn serverIDs'
+
+ -- discovered <- liftIO $ mapM (discoverOnce lookupServer . storageIndex . verifier $ cap) (Map.toList serverAnnouncements)
+ -- liftIO $ print (rights discovered)
+
-- Recover the plaintext from the servers.
- result <- liftIO $ download (Map.fromSet makeAnn serverIDs') cap (someServers $ Map.fromList $ zip (encodeUtf8 <$> Set.toList serverIDs') servers)
+ result <- liftIO $ download serverAnnouncements cap lookupServer
diff (Right plaintext) (==) result
]
where
-- A server lookup function that always fails.
- noServers _ = pure Nothing
+ noServers _ = Nothing
-- A server lookup function that finds servers already present in a Map.
- someServers servers = pure . flip Map.lookup servers . parseURL
+ someServers :: Map.Map StorageServerID StorageServer -> LookupServer
+ someServers servers = flip Map.lookup servers . parseURL
where
-- Exactly match the nonsense makeAnn spits out
- parseURL = B.take 2 . B.drop 5 . encodeUtf8
+ parseURL = T.take 2 . T.drop 5
--- PHILOSOFY
-- We wish that share numbers were an opaque type instead of a
@@ -218,7 +227,7 @@ tests =
-- write the right number of shares to this server
zipWithM_
(\shnum share -> storageServerWrite s (storageIndex . verifier $ cap) shnum 0 share)
- [fromIntegral n ..]
+ [fromIntegral sharesSoFar ..]
(BL.toStrict <$> take n shares)
-- recurse to write the rest
placeShares cap (drop n shares) ns ss (sharesSoFar + n)