Skip to content
Snippets Groups Projects
Download.hs 4.17 KiB
Newer Older
  • Learn to ignore specific revisions
  • module Tahoe.Download (DownloadError (..), download) where
    
    
    import qualified Data.ByteString.Lazy as LB
    
    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
            }
    
        deriving (Eq, Ord, Show)
    
    
    {- | Recover the application data associated with a given capability from the
     given servers, if possible.
    -}
    
    download ::
    
        -- | 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
    
        -- 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.
    
            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