Newer
Older
module Tahoe.Download (DownloadError (..), download) where
import qualified Data.ByteString.Lazy as LB
import Data.Either (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 Tahoe.CHK.Capability (Reader (..), Verifier (..))
import Tahoe.CHK.Server (StorageServer (..), StorageServerAnnouncement (..), StorageServerID, URL)
import Tahoe.CHK.Types (ShareNum, StorageIndex)
{- | An unrecoverable problem arose while attempting to download and/or read
some application data.
-}
data DownloadError
= -- | The configuration included no candidate servers from which to download.
NoConfiguredServers
| -- | 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.
NotEnoughShares
{ notEnoughSharesNeeded :: Int
, notEnoughSharesFound :: Int
}
{- | Recover the application data associated with a given capability from the
given servers, if possible.
-}
-- | 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.
-- | Get functions for interacting with a server given its URL.
(URL -> IO (Maybe StorageServer)) ->
-- | Either a description of how the recovery failed or the recovered
-- application data.
IO (Either DownloadError LB.ByteString)
download servers Reader{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)]
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
where
-- Figure the total number of distinct shares reported by all of the servers we
countDistinctShares = Set.size . foldl' Set.union mempty . map snd
-- 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
Nothing -> pure $ Left StorageServerLocationUnknown
Just url -> do
server <- openServer url
case server of
Nothing -> pure $ Left StorageServerUnreachable
Just StorageServer{storageServerGetBuckets} ->
Right <$> storageServerGetBuckets storageIndex