diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index b899710acbc6f52e8ea1a17067af5e5db6a529d5..b2b394fbc42459c39b9eeba03661f6f342e634e6 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -1,21 +1,14 @@
module Tahoe.Download (DownloadError (..), download) where
-import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as LB
import Data.Either (rights)
import qualified Data.Map.Strict as Map
-
--- import qualified Data.Set as Set
-import Data.Word (Word8)
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
import Tahoe.CHK.Capability (Reader (..), Verifier (..))
-import Tahoe.CHK.Server (StorageServerAnnouncement (..), StorageServerID)
-import Tahoe.CHK.Types (StorageIndex)
-
-newtype ShareNum = ShareNum Word8 deriving (Eq, Ord, Show)
-
--- {- | A map from share numbers to servers where the corresponding shares have
--- recently been observed.
--- -}
--- type ShareMap = Map.Map ShareNum (Set.Set StorageServerID)
+import Tahoe.CHK.Server (StorageServer (..), StorageServerAnnouncement (..), StorageServerID, URL)
+import Tahoe.CHK.Types (ShareNum, StorageIndex)
{- | An unrecoverable problem arose while attempting to download and/or read
some application data.
@@ -25,6 +18,12 @@ data DownloadError
NoConfiguredServers
| -- | Across all of the configured servers, none were actually connectable.
NoReachableServers
+ | -- | Across all of the configured servers, fewer than the required
+ -- number of shares were found.
+ NotEnoughShares
+ { notEnoughSharesNeeded :: Int
+ , notEnoughSharesFound :: Int
+ }
deriving (Eq, Ord, Show)
{- | Recover the application data associated with a given capability from the
@@ -36,21 +35,32 @@ download ::
Map.Map StorageServerID StorageServerAnnouncement ->
-- | The read capability for the application data.
Reader ->
+ -- | Get functions for interacting with a server given its URL.
+ (URL -> IO (Maybe StorageServer)) ->
-- | Either a description of how the recovery failed or the recovered
-- application data.
- IO (Either DownloadError ByteString)
-download servers Reader{verifier = Verifier{..}} =
+ IO (Either DownloadError LB.ByteString)
+download servers Reader{verifier = Verifier{..}} openServer =
case Map.toList servers of
[] -> pure . Left $ NoConfiguredServers
serverList -> do
-- Ask each server for all shares it has.
- discovered <- rights <$> mapM discoverOnce serverList
- case discovered of
- [] -> pure $ Left NoReachableServers
- _ -> pure $ Right ""
+ discovered <- rights <$> mapM discoverOnce serverList :: IO [(StorageServerID, Set.Set ShareNum)]
+ if null discovered
+ then pure $ Left NoReachableServers
+ else
+ if (fromIntegral required >=) . countShares $ discovered
+ then pure $ Left NotEnoughShares{notEnoughSharesNeeded = fromIntegral required, notEnoughSharesFound = countShares discovered}
+ else pure . Right . LB.fromStrict . encodeUtf8 . T.pack . show $ discovered
where
+ -- Figure the total number of shares reported by all of the servers we
+ -- asked.
+ countShares = sum . map (Set.size . snd)
+
+ -- Ask one server which shares it has related to the storage index in
+ -- question.
discoverOnce (sid, sann) = do
- sharenums <- discoverShares storageIndex sann
+ sharenums <- discoverShares storageIndex sann openServer
pure $ case sharenums of
Left e -> Left e
Right shnums -> Right (sid, shnums)
@@ -61,6 +71,7 @@ download servers Reader{verifier = Verifier{..}} =
data DiscoverError
= -- | An announcement did not include a location for a connection attempt.
StorageServerLocationUnknown
+ | StorageServerUnreachable
deriving (Eq, Ord, Show)
-- | Identify which servers claim to have some data at some index.
@@ -71,9 +82,16 @@ discoverShares ::
-- have the data because local configuration suggests the data might have
-- been uploaded to them in the past.
StorageServerAnnouncement ->
+ -- | A function to connect to a server.
+ (URL -> IO (Maybe StorageServer)) ->
-- | The share numbers the server claims to have.
- IO (Either DiscoverError [ShareNum])
-discoverShares _storageIndex ann
- | isNothing $ storageServerAnnouncementFURL ann =
- pure $ Left StorageServerLocationUnknown
- | otherwise = pure $ Right []
+ IO (Either DiscoverError (Set.Set ShareNum))
+discoverShares storageIndex ann openServer =
+ case storageServerAnnouncementFURL ann of
+ Nothing -> pure $ Left StorageServerLocationUnknown
+ Just url -> do
+ server <- openServer url
+ case server of
+ Nothing -> pure $ Left StorageServerUnreachable
+ Just StorageServer{storageServerGetBuckets} ->
+ Right <$> storageServerGetBuckets storageIndex
diff --git a/test/Spec.hs b/test/Spec.hs
index 450c9bc88b01ae4ede47b7c1bf8b39669a886bb7..42c875383dbcc729d0713e72d834fc502d351578 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -7,8 +7,9 @@ import qualified Data.Map.Strict as Map
import Data.Word (Word16)
import System.IO (hSetEncoding, stderr, stdout, utf8)
import Tahoe.CHK.Capability (Reader (..), Verifier (..))
-import Tahoe.CHK.Server (StorageServerAnnouncement (..))
+import Tahoe.CHK.Server (StorageServer (..), StorageServerAnnouncement (..))
import Tahoe.Download (DownloadError (..), download)
+import Tahoe.Server (memoryStorageServer)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)
@@ -19,7 +20,7 @@ tests =
[ testCase "no configured servers" $ do
-- If there are no servers then we can't possibly get enough
-- shares to recover the application data.
- result <- liftIO $ download mempty (trivialCap 1 1)
+ result <- liftIO $ download mempty (trivialCap 1 1) noServers
assertEqual
"download should fail with no servers"
(Left NoConfiguredServers)
@@ -27,7 +28,7 @@ tests =
, testCase "no reachable servers" $ do
-- If we can't contact any configured server then we can't
-- possibly get enough shares to recover the application data.
- let servers =
+ let anns =
Map.fromList
[
( "v0-abc123"
@@ -39,12 +40,48 @@ tests =
)
]
- result <- liftIO $ download servers (trivialCap 1 1)
+ result <- liftIO $ download anns (trivialCap 1 1) noServers
assertEqual
"download should fail with no reachable servers"
(Left NoReachableServers)
result
+ , testCase "not enough shares" $ do
+ -- If we can't recover enough shares from the configured servers
+ -- then we can't possibly get enough shares to recover the
+ -- application data.
+ let anns =
+ Map.fromList
+ [
+ ( "v0-abc123"
+ , StorageServerAnnouncement
+ { storageServerAnnouncementFURL = Just "somewhere"
+ , storageServerAnnouncementNick = Just "abc123"
+ , storageServerAnnouncementPermutationSeed = Nothing
+ }
+ )
+ ]
+ cap = trivialCap 3 3
+
+ -- Two shares exist.
+ server <- memoryStorageServer
+ storageServerWrite server (storageIndex . verifier $ cap) 0 0 "Hello world"
+ storageServerWrite server (storageIndex . verifier $ cap) 1 0 "Hello world"
+
+ -- Make the server reachable.
+ let openServer furl =
+ if furl == "somewhere"
+ then pure . pure $ server
+ else pure Nothing
+
+ -- Try to download the cap which requires three shares to reconstruct.
+ result <- liftIO $ download anns cap openServer
+ assertEqual
+ "download should fail with not enough shares"
+ (Left NotEnoughShares{notEnoughSharesNeeded = 3, notEnoughSharesFound = 2})
+ result
]
+ where
+ noServers _ = pure Nothing
trivialCap :: Word16 -> Word16 -> Reader
trivialCap required total = Reader{..}