Newer
Older
module Tahoe.Download (DownloadError (..), download) where
import qualified Data.ByteString.Lazy as LB
import Data.Either (rights)
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 >=) . countShares $ discovered
then pure $ Left NotEnoughShares{notEnoughSharesNeeded = fromIntegral required, notEnoughSharesFound = countShares discovered}
else pure . Right . LB.fromStrict . encodeUtf8 . T.pack . show $ discovered
where
-- Figure the total number of shares reported by all of the servers we
-- asked.
countShares = sum . map (Set.size . 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