diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal
index 1bfed99021e858773ed0c84632dbf20ae3abbd2c..3f4350fa8bfb7decda8d7c5139168c7aaa0f1fbf 100644
--- a/gbs-downloader.cabal
+++ b/gbs-downloader.cabal
@@ -148,6 +148,7 @@ test-suite gbs-downloader-test
build-depends:
, base ^>=4.14.3.0
, bytestring
+ , containers
, crypto-api
, gbs-downloader
, hedgehog
diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index 25d438f60c65bae5f424b91e85c4735bd32504a7..11e1105a86b2275857314dcba39260f1d9f39c40 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -1,9 +1,21 @@
module Tahoe.Download (DownloadError (..), download) where
import Data.ByteString.Lazy (ByteString)
-import Data.Map.Strict (Map)
-import Tahoe.CHK.Capability (Reader)
-import Tahoe.CHK.Server (StorageServerAnnouncement, StorageServerID)
+import Data.Either (rights)
+import qualified Data.Map.Strict as Map
+
+-- import qualified Data.Set as Set
+import Data.Word (Word8)
+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)
{- | An unrecoverable problem arose while attempting to download and/or read
some application data.
@@ -11,11 +23,57 @@ import Tahoe.CHK.Server (StorageServerAnnouncement, StorageServerID)
data DownloadError
= -- | The configuration included no candidate servers from which to download.
NoConfiguredServers
+ | -- | Across all of the configured servers, none were actually connectable.
+ NoReachableServers
deriving (Eq, Ord, Show)
+{- | Recover the application data associated with a given capability from the
+ given servers, if possible.
+-}
download ::
- Map StorageServerID StorageServerAnnouncement ->
+ -- | Information about the servers from which to consider downloading shares
+ -- representing the application data.
+ Map.Map StorageServerID StorageServerAnnouncement ->
+ -- | The read capability for the application data.
Reader ->
+ -- | Either a description of how the recovery failed or the recovered
+ -- application data.
IO (Either DownloadError ByteString)
-download servers cap
- | mempty == servers = pure . Left $ NoConfiguredServers
+download servers Reader{verifier = Verifier{..}} =
+ 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 ""
+ where
+ discoverOnce (sid, sann) = do
+ sharenums <- discoverShares storageIndex sann
+ pure $ case sharenums of
+ Left e -> Left e
+ Right shnums -> Right (sid, shnums)
+
+{- | An problem arose while attempting to discover the shares held on a
+ particular server.
+-}
+data DiscoverError
+ = -- | An announcement did not include a location for a connection attempt.
+ StorageServerLocationUnknown
+ deriving (Eq, Ord, Show)
+
+-- | Identify which servers claim to have some data at some index.
+discoverShares ::
+ -- | The storage index at which to look for data.
+ StorageIndex ->
+ -- | A server which could possibly have the data. It "could possibly"
+ -- have the data because local configuration suggests the data might have
+ -- been uploaded to them in the past.
+ StorageServerAnnouncement ->
+ -- | The share numbers the server claims to have.
+ IO (Either DiscoverError [ShareNum])
+discoverShares _storageIndex ann
+ | Nothing == storageServerAnnouncementFURL ann =
+ pure $ Left StorageServerLocationUnknown
+ | otherwise = pure $ Right []
diff --git a/test/Spec.hs b/test/Spec.hs
index b3132b7347c79265ca90ca9b840fda67c6a5bfcb..956850d568905c1965be19b8227068e3a568ff90 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -3,8 +3,11 @@ module Main where
import Control.Monad.IO.Class (liftIO)
import Crypto.Classes (buildKey)
import qualified Data.ByteString as B
+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.Download (DownloadError (..))
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)
@@ -18,21 +21,42 @@ tests =
[ testCase "no configured servers" $ do
-- If there are no servers then we can't possibly get enough
-- shares to recover the application data.
- let Just readKey = buildKey $ B.replicate 32 0x00
- storageIndex = B.replicate 32 0x00
- fingerprint = B.replicate 32 0x00
- required = 1
- total = 1
- size = 1234
- verifier = Verifier{..}
- cap = Reader{..}
- result <- liftIO $ download mempty cap
+ result <- liftIO $ download mempty (trivialCap 1 1)
assertEqual
"download should fail with no servers"
(Left NoConfiguredServers)
result
+ , 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 =
+ Map.fromList
+ [
+ ( "v0-abc123"
+ , StorageServerAnnouncement
+ { storageServerAnnouncementFURL = Nothing
+ , storageServerAnnouncementNick = Just "unreachable"
+ , storageServerAnnouncementPermutationSeed = Nothing
+ }
+ )
+ ]
+
+ result <- liftIO $ download servers (trivialCap 1 1)
+ assertEqual
+ "download should fail with no reachable servers"
+ (Left NoReachableServers)
+ result
]
+trivialCap :: Word16 -> Word16 -> Reader
+trivialCap required total = Reader{..}
+ where
+ Just readKey = buildKey $ B.replicate 32 0x00
+ storageIndex = B.replicate 32 0x00
+ fingerprint = B.replicate 32 0x00
+ size = 1234
+ verifier = Verifier{..}
+
main :: IO ()
main = do
-- Hedgehog writes some non-ASCII and the whole test process will die if