diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs index f82b072316e2333f646fb1846970cc908c1ce09e..a7529a8a5095e53d2d0306a3844ea17e0b860643 100644 --- a/src/Tahoe/Download.hs +++ b/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 - 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 + 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 + decodeShare r onlyDecoded {- | Figure the total number of distinct shares reported by all of the servers we asked. diff --git a/src/Tahoe/Download/Internal/Client.hs b/src/Tahoe/Download/Internal/Client.hs index c7e9767c190cb18e572658f8e971bf9b638afa37..fd6afe68e46181f82a75b7727b10eb82bd490b1f 100644 --- a/src/Tahoe/Download/Internal/Client.hs +++ b/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?