Skip to content
Snippets Groups Projects
Download.hs 2.96 KiB
Newer Older
  • Learn to ignore specific revisions
  • module Tahoe.Download (DownloadError (..), download) where
    
    import Data.ByteString.Lazy (ByteString)
    
    import Data.Either (rights)
    import qualified Data.Map.Strict as Map
    
    -- import qualified Data.Set as Set
    import Data.Word (Word8)
    import Tahoe.CHK.Capability (Reader (..), Verifier (..))
    import Tahoe.CHK.Server (StorageServerAnnouncement (..), StorageServerID)
    import Tahoe.CHK.Types (StorageIndex)
    
    newtype ShareNum = ShareNum Word8 deriving (Eq, Ord, Show)
    
    -- {- | A map from share numbers to servers where the corresponding shares have
    --  recently been observed.
    -- -}
    -- type ShareMap = Map.Map ShareNum (Set.Set StorageServerID)
    
    
    {- | 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
    
        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.
    
        -- | Either a description of how the recovery failed or the recovered
        -- application data.
    
        IO (Either DownloadError ByteString)
    
    download servers Reader{verifier = Verifier{..}} =
        case Map.toList servers of
            [] -> pure . Left $ NoConfiguredServers
            serverList -> do
                -- Ask each server for all shares it has.
                discovered <- rights <$> mapM discoverOnce serverList
                case discovered of
                    [] -> pure $ Left NoReachableServers
                    _ -> pure $ Right ""
      where
        discoverOnce (sid, sann) = do
            sharenums <- discoverShares storageIndex sann
            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
        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 ->
        -- | The share numbers the server claims to have.
        IO (Either DiscoverError [ShareNum])
    discoverShares _storageIndex ann
    
    Jean-Paul Calderone's avatar
    Jean-Paul Calderone committed
        | isNothing $ storageServerAnnouncementFURL ann =
    
            pure $ Left StorageServerLocationUnknown
        | otherwise = pure $ Right []