handle the trivial failure case where no servers have location info

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

src/Tahoe/Download.hs

 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 []

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