a little bit of the download logic itself

somehow I forgot to write the test for this bit first
too exciting to actually be implementing a downloader I suppose

gbs-downloader.cabal

@@ -66,6 +66,7 @@ common language
     NamedFieldPuns
     OverloadedStrings
     RecordWildCards
+    TupleSections
 
 library
   -- Import common warning flags.
@@ -85,6 +86,7 @@ library
   -- Other library packages from which modules are imported.
   build-depends:
     , base                     ^>=4.14.3.0
+    , binary
     , bytestring
     , containers
     , tahoe-chk

src/Tahoe/Download.hs

 module Tahoe.Download (DownloadError (..), download) where
 
+import Data.Binary (decodeOrFail)
 import qualified Data.ByteString.Lazy as LB
-import Data.Either (rights)
+import Data.Either (isRight, rights)
 import Data.List (foldl')
 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 qualified Tahoe.CHK
 import Tahoe.CHK.Capability (Reader (..), Verifier (..))
+import qualified Tahoe.CHK.Encrypt
 import Tahoe.CHK.Server (StorageServer (..), StorageServerAnnouncement (..), StorageServerID, URL)
 import Tahoe.CHK.Types (ShareNum, StorageIndex)
 
@@ -20,11 +21,23 @@ data DownloadError
     | -- | 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.
+      -- 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
       NotEnoughShares
         { notEnoughSharesNeeded :: Int
         , notEnoughSharesFound :: Int
         }
+    | ShareDecodingFailed
+    deriving (Eq, Ord, Show)
+
+{- | 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
+    | StorageServerUnreachable
     deriving (Eq, Ord, Show)
 
 {- | Recover the application data associated with a given capability from the
@@ -41,18 +54,35 @@ download ::
     -- | Either a description of how the recovery failed or the recovered
     -- application data.
     IO (Either DownloadError LB.ByteString)
-download servers Reader{verifier = Verifier{..}} openServer =
+download servers cap@Reader{readKey, 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 :: IO [(StorageServerID, Set.Set ShareNum)]
+            discovered <- rights <$> mapM discoverOnce serverList :: IO [(StorageServer, Set.Set ShareNum)]
             if null discovered
                 then pure $ Left NoReachableServers
                 else
                     if (fromIntegral required >=) . countDistinctShares $ discovered
                         then pure $ Left NotEnoughShares{notEnoughSharesNeeded = fromIntegral required, notEnoughSharesFound = countDistinctShares discovered}
-                        else pure . Right . LB.fromStrict . encodeUtf8 . T.pack . show $ discovered
+                        else do
+                            -- XXX up to here is probably "locateShares".  now we move in to "fetchShares".
+                            let sharemap = makeShareMap discovered
+                            -- XXX note shares can contain failures
+                            shares <- mapM (uncurry $ downloadShare storageIndex) (Map.toList sharemap)
+                            -- XXX That was brief.  Probably missing some complexity.  now we move on to "decodeShares".
+                            -- Filter down to shares we actually got.
+                            let someShares = filter (isRight . snd) shares
+                                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}
+                                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.
@@ -60,39 +90,35 @@ download servers Reader{verifier = Verifier{..}} openServer =
 
     -- Ask one server which shares it has related to the storage index in
     -- question.
-    discoverOnce (sid, sann) = do
-        sharenums <- discoverShares storageIndex sann openServer
-        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
-    | StorageServerUnreachable
-    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 ->
-    -- | A function to connect to a server.
-    (URL -> IO (Maybe StorageServer)) ->
-    -- | The share numbers the server claims to have.
-    IO (Either DiscoverError (Set.Set ShareNum))
-discoverShares storageIndex ann openServer =
-    case storageServerAnnouncementFURL ann of
+    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 StorageServer{storageServerGetBuckets} ->
-                    Right <$> storageServerGetBuckets storageIndex
+                    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.
+-}
+makeShareMap :: Ord k => [(v, Set.Set k)] -> Map.Map k [v]
+makeShareMap locations =
+    foldl' (Map.unionWith (<>)) mempty ((\(k, v) -> Map.fromSet (\_ -> [k]) v) <$> locations)
+
+-- | Download the bytes of a share from one (or more!) of the given servers.
+downloadShare ::
+    -- | 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] ->
+    -- | The bytes of the share or some error that was encountered during
+    -- download.
+    IO (ShareNum, Either DownloadError LB.ByteString)
+downloadShare = undefined

test/Spec.hs

@@ -128,6 +128,16 @@ tests =
                 "download should fail with not enough shares"
                 (Left NotEnoughShares{notEnoughSharesNeeded = 3, notEnoughSharesFound = 2})
                 result
+        , testCase "success" $ do
+            -- If we can recover enough distinct, decodeable shares from the
+            -- configured servers then we can recover the application data.
+            --
+            -- XXX Start writing here.  Probably make this a property test
+            -- that generates lots of configurations where it should be
+            -- possible to recover the data (have all the shares, have enough
+            -- of the shares, spread them across many servers, concentrate
+            -- them on one or a few, etc)
+            pure ()
         ]
   where
     noServers _ = pure Nothing