Merge remote-tracking branch 'origin/main' into 8.download-sdmf

flake.nix

@@ -84,8 +84,13 @@
               # headers and stuff.
               export PKG_CONFIG_PATH=${pkgs.lib.makeSearchPath "lib/pkgconfig" [pkgs.zlib.dev]}
 
+              # Get (or update if we have one) a package database so cabal can
+              # solve our dependencies.
               cabal update hackage.haskell.org
-              cabal run tests
+
+              # Configure with tests enable, build the tests (if necessary),
+              # and run the default test suite.
+              cabal run --enable-tests tests
             '';
           }
         }/bin/cabal-build-and-test";

src/Tahoe/Download.hs

@@ -13,13 +13,13 @@ module Tahoe.Download (
 
 import Control.Exception (Exception (displayException), SomeException, throwIO, try)
 import Control.Monad.IO.Class (MonadIO (liftIO))
-import Data.Bifunctor (Bifunctor (first))
+import Data.Bifunctor (Bifunctor (first, second))
 import Data.Binary (Word16, decodeOrFail)
 import qualified Data.ByteString as B
 import Data.ByteString.Base32 (encodeBase32Unpadded)
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Lazy as LB
-import Data.Either (isRight, partitionEithers)
+import Data.Either (partitionEithers, rights)
 import Data.List (foldl')
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -45,6 +45,12 @@ print' :: MonadIO m => String -> m ()
 -- print' = liftIO . print
 print' = const $ pure ()
 
+-- | Partially describe one share download.
+type DownloadTask = (ShareNum, StorageServer)
+
+-- | A downloaded share
+type Share = (ShareNum, LB.ByteString)
+
 {- | An unrecoverable problem arose while attempting to download and/or read
  some application data.
 -}
@@ -120,12 +126,29 @@ download servers cap@Reader{verifier = Verifier{..}} lookupServer = do
         Right discovered -> do
             print' "Found some shares, fetching them"
             -- XXX note shares can contain failures
-            shares <- fetchShares storageIndex discovered
+            shares <- executeDownloadTasks storageIndex (makeDownloadTasks =<< discovered)
             print' "Fetched the shares, decoding them"
             s <- decodeShares cap shares
             print' "Decoded them"
             pure s
 
+{- | Execute each download task sequentially and return only the successful
+ results.
+-}
+executeDownloadTasks ::
+    MonadIO m =>
+    -- | The storage index of the shares to download.
+    StorageIndex ->
+    -- | The downloads to attempt.
+    [DownloadTask] ->
+    -- | The results of all successful downloads.
+    m [Share]
+executeDownloadTasks storageIndex tasks = do
+    downloadResults <- mapM (downloadShare storageIndex) tasks
+    pure . rights $ inject <$> downloadResults
+  where
+    inject (a, b) = (a,) <$> b
+
 -- | Find out which servers claim to have shares related to a given storage index.
 locateShares ::
     MonadIO m =>
@@ -158,24 +181,6 @@ locateShares servers lookupServer storageIndex required =
                         then pure $ Left NotEnoughShares{notEnoughSharesNeeded = fromIntegral required, notEnoughSharesFound = countDistinctShares discovered}
                         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 = do
-    print' "Fetching shares"
-    s <- mapM (uncurry $ downloadShare storageIndex) (Map.toList sharemap)
-    print' "Fetched shares"
-    pure s
-  where
-    sharemap = makeShareMap discovered
-
 {- | Given the results of downloading shares related to a given capability,
  decode them and decrypt the contents of possible.
 -}
@@ -184,12 +189,11 @@ decodeShares ::
     -- | The read capability which allows the contents to be decrypted.
     Reader ->
     -- | The results of downloading the shares.
-    [(ShareNum, Either DownloadError LB.ByteString)] ->
+    [Share] ->
     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
+    let fewerShares = second decodeOrFail <$> shares
         onlyDecoded = (\(sharenum, Right (_, _, share)) -> (fromIntegral sharenum, share)) <$> fewerShares
      in if length onlyDecoded < fromIntegral required
             then pure $ Left NotEnoughDecodedShares{notEnoughDecodedSharesNeeded = fromIntegral required, notEnoughDecodedSharesFound = length onlyDecoded}
@@ -230,33 +234,24 @@ discoverShares lookupServer storageIndex (_sid, sann) = do
             print' $ "Got them " <> show massaged
             pure $ (ss,) <$> massaged
 
-{- | 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.
+{- | Expand a one-to-many mapping into a list of pairs with each of the "many"
+   values as the first element and the corresponding "one" value as the second
+   element.
 -}
-makeShareMap :: Ord k => [(v, Set.Set k)] -> Map.Map k [v]
-makeShareMap locations =
-    foldl' (Map.unionWith (<>)) mempty ((\(k, v) -> Map.fromSet (const [k]) v) <$> locations)
+makeDownloadTasks :: Ord k => (v, Set.Set k) -> [(k, v)]
+makeDownloadTasks (v, ks) = zip (Set.toList ks) (repeat v)
 
 -- | Download the bytes of a share from one (or more!) of the given servers.
 downloadShare ::
     MonadIO m =>
     -- | The storage index of the share to download.
     StorageIndex ->
-    -- | The number of the share to download.
-    ShareNum ->
-    -- | The servers which we have a reasonable belief could hold a copy of the
-    -- share.  It is common for there to be only one server holding each share
-    -- but nothing *prevents* multiple servers from having one.  In this case we
-    -- could download the share from both of them, perhaps.
-    [StorageServer] ->
+    -- | Addressing information about the share to download.
+    DownloadTask ->
     -- | The bytes of the share or some error that was encountered during
     -- download.
     m (ShareNum, Either DownloadError LB.ByteString)
-downloadShare _ shareNum [] = pure (shareNum, Left NoServers)
-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.
+downloadShare storageIndex (shareNum, s) = do
     print' $ "Going to download " <> show storageIndex <> " " <> show shareNum
     shareBytes <- liftIO $ try (storageServerRead s storageIndex shareNum)
     let massaged = first (ShareDownloadError . (displayException :: SomeException -> String)) shareBytes