generalize download and decodeShares, begin capability typeclass

src/Tahoe/Download.hs

@@ -12,6 +12,7 @@ module Tahoe.Download (
     discoverShares,
     download,
     announcementToImmutableStorageServer,
+    getShareNumbers,
 ) where
 
 import Control.Exception (Exception (displayException), SomeException, try)
@@ -30,6 +31,7 @@ import Tahoe.CHK.Capability (Reader (..), Verifier (..))
 import qualified Tahoe.CHK.Capability as CHK
 import qualified Tahoe.CHK.Encrypt
 import Tahoe.CHK.Server (StorageServer (..), StorageServerID)
+import qualified Tahoe.CHK.Share
 import Tahoe.CHK.Types (ShareNum, StorageIndex)
 import Tahoe.Download.Internal.Client
 import Tahoe.Download.Internal.Immutable
@@ -60,10 +62,11 @@ download ::
     -- application data.
     m (Either DownloadError LB.ByteString)
 download servers cap lookupServer = do
-    print' ("Going to download: " <> show storageIndex)
+    print' ("Going to download: " <> show (getStorageIndex $ getVerifiable cap))
     let verifier = getVerifiable cap
     let storageIndex = getStorageIndex verifier
-    (required, _) <- getRequiredTotal ss verifier
+    ss <- firstStorageServer (Map.elems servers) lookupServer
+    (required, _) <- getRequiredTotal verifier ss
     locationE <- locateShares servers lookupServer storageIndex (fromIntegral required)
     print' "Finished locating shares"
     case locationE of
@@ -75,43 +78,59 @@ download servers cap lookupServer = do
             -- XXX note shares can contain failures
             shares <- executeDownloadTasks storageIndex (makeDownloadTasks =<< discovered)
             print' "Fetched the shares, decoding them"
-            s <- decodeShares cap shares
+            s <- decodeShares cap shares required
             print' "Decoded them"
             pure s
 
--- fetchRequiredTotal :: [StorageServerAnnouncement] -> (StorageServerAnnouncement -> IO (Either LookupError StorageServer) -> (StorageServer -> IO (Int, Int)) -> IO (Int, Int)
--- fetchRequiredTotal locations f = _
-
-firstStorageServer :: [StorageServerAnnouncement] -> (StorageServerAnnouncement -> IO (Either LookupError StorageServer)) -> IO [StorageServer]
+-- We also need "first successful share"!
+firstStorageServer :: Monad m => [StorageServerAnnouncement] -> LookupServer m -> m StorageServer
 firstStorageServer servers finder = do
     responses <- mapM finder servers
-    pure $ take 1 $ rights responses
+    pure $ head $ take 1 $ rights responses -- XXX don't do this at home kids, head isn't safe
 
 {-
   getShareNumbers :: server -> storageIndex -> IO [ShareNumber]
-  for mutables, that's getMutableShareNumbers
+  for mutables, getMutableShareNumbers
   getEncodingParameters :: Capability -> StorageServer -> IO (n,k)
   it's pure for CHK (immutables), but must be requested from the server for mutables
   this returns the FEC encoding values so you know when to stop fetching shares
   getStorageIndex :: Capability -> StorageIndex
   -}
 class Verifiable v where
-    getShareNumbers :: v -> StorageServer -> IO (Set.Set ShareNum)
-    getRequiredTotal :: v -> StorageServer -> IO (Int, Int)
+    getShareNumbers :: MonadIO m => v -> StorageServer -> m (Set.Set ShareNum)
+    getRequiredTotal :: MonadIO m => v -> StorageServer -> m (Int, Int)
     getStorageIndex :: v -> StorageIndex
 
 instance Verifiable CHK.Verifier where
-    getShareNumbers v s = storageServerGetBuckets s (storageIndex v)
+    getShareNumbers v s = liftIO $ storageServerGetBuckets s (storageIndex v)
     getStorageIndex Verifier{storageIndex} = storageIndex
 
     -- CHK is pure, we don't have to ask the StorageServer
     getRequiredTotal Verifier{required, total} _ = pure (fromIntegral required, fromIntegral total)
 
-class Verifiable v => Readable r v | r -> v where
+class (Verifiable v) => Readable r v | r -> v where
     getVerifiable :: r -> v
+    decodeShare :: MonadIO m => r -> [(Int, WhichShare)] -> m (Either DownloadError LB.ByteString)
 
+-- Might want to split the two functions below out of decodeShare
+-- shareToCipherText :: Share ->
+-- cipherTextToPlainText
 instance Readable CHK.Reader CHK.Verifier where
     getVerifiable = verifier
+    decodeShare r shareList = do
+        cipherText <- liftIO $ Tahoe.CHK.decode r (second unWhich <$> shareList)
+        case cipherText of
+            Nothing -> pure $ Left ShareDecodingFailed
+            Just ct ->
+                pure . Right $ Tahoe.CHK.Encrypt.decrypt (readKey r) ct
+
+data WhichShare = CHK {unWhich :: Tahoe.CHK.Share.Share} -- \| SDMF SDMF.Share
+
+bytesToShare :: LB.ByteString -> Either DeserializeError WhichShare
+bytesToShare bytes = do
+    case decodeOrFail bytes of
+        Left _ -> Left UnknownDeserializeError
+        Right (_, _, r) -> Right $ CHK r
 
 {- | Execute each download task sequentially and return only the successful
  results.
@@ -166,26 +185,21 @@ locateShares servers lookupServer storageIndex required =
  decode them and decrypt the contents of possible.
 -}
 decodeShares ::
-    MonadIO m =>
+    (MonadIO m, Readable r v) =>
     -- | The read capability which allows the contents to be decrypted.
-    Reader ->
+    r ->
     -- | The results of downloading the shares.
     [Share] ->
+    Int ->
     m (Either DownloadError LB.ByteString)
-decodeShares cap@Reader{readKey, verifier = Verifier{..}} shares =
+decodeShares r shares required = do
     -- Filter down to shares we actually got.
-    let fewerShares = second decodeOrFail <$> shares
-        onlyDecoded = (\(sharenum, Right (_, _, share)) -> (fromIntegral sharenum, share)) <$> fewerShares
-     in if length onlyDecoded < fromIntegral required
+    let fewerShares :: [(ShareNum, Either DeserializeError WhichShare)] = second bytesToShare <$> shares
+        onlyDecoded = rights $ (\(a, b) -> (fromIntegral a,) <$> b) <$> fewerShares
+    if length onlyDecoded < required
         then pure $ Left NotEnoughDecodedShares{notEnoughDecodedSharesNeeded = fromIntegral required, notEnoughDecodedSharesFound = length onlyDecoded}
         else do
-                print' "Interpreted shares, decoding them"
-                ciphertext <- liftIO $ Tahoe.CHK.decode cap onlyDecoded
-                print' "Decoded them, might decrypt them"
-                case ciphertext of
-                    Nothing -> pure $ Left ShareDecodingFailed
-                    Just ct ->
-                        pure . Right $ Tahoe.CHK.Encrypt.decrypt readKey ct
+            decodeShare r onlyDecoded
 
 {- | Figure the total number of distinct shares reported by all of the servers
  we asked.

src/Tahoe/Download/Internal/Client.hs

@@ -117,3 +117,5 @@ data LookupError
     | -- | The structure of the server's URI was unparseable.
       AnnouncementStructureUnmatched
     deriving (Eq, Ord, Show)
+
+data DeserializeError = UnknownDeserializeError -- add more later?