Download.hs

module Tahoe.Download (DownloadError (..), download) where

import Data.Binary (decodeOrFail)
import qualified Data.ByteString.Lazy as LB
import Data.Either (isRight, rights)
import Data.List (foldl')
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Tahoe.CHK
import Tahoe.CHK.Capability (Reader (..), Verifier (..))
import qualified Tahoe.CHK.Encrypt
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. XXX Could split this into the different
      -- cases - did not locate enough shares, did not download enough shares,
      -- did not decode enough shares, did not verify enough shares
      NotEnoughShares
        { notEnoughSharesNeeded :: Int
        , notEnoughSharesFound :: Int
        }
    | ShareDecodingFailed
    | -- | An attempt was made to download a share but no servers were given for
      -- the download.
      NoServers
    deriving (Eq, Ord, Show)

{- | 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)

{- | 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.
    Reader ->
    -- | 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 cap@Reader{readKey, 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 [(StorageServer, 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 do
                            -- XXX up to here is probably "locateShares".  now we move in to "fetchShares".
                            let sharemap = makeShareMap discovered
                            -- XXX note shares can contain failures
                            shares <- mapM (uncurry $ downloadShare storageIndex) (Map.toList sharemap)
                            -- XXX That was brief.  Probably missing some complexity.  now we move on to "decodeShares".
                            -- Filter down to shares we actually got.
                            let someShares = filter (isRight . snd) shares
                                fewerShares = filter (isRight . snd) $ (\(sharenum, Right bs) -> (sharenum, decodeOrFail bs)) <$> someShares
                                onlyDecoded = (\(sharenum, Right (_, _, share)) -> (fromIntegral sharenum, share)) <$> fewerShares
                            if length onlyDecoded < fromIntegral required
                                then pure $ Left NotEnoughShares{notEnoughSharesNeeded = fromIntegral required, notEnoughSharesFound = length onlyDecoded}
                                else do
                                    ciphertext <- Tahoe.CHK.decode cap onlyDecoded
                                    case ciphertext of
                                        Nothing -> pure $ Left ShareDecodingFailed
                                        Just ct ->
                                            pure . Right $ Tahoe.CHK.Encrypt.decrypt readKey ct
  where
    -- Figure the total number of distinct shares reported by all of the servers we
    -- asked.
    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
        case storageServerAnnouncementFURL sann of
            Nothing -> pure $ Left StorageServerLocationUnknown
            Just url -> do
                server <- openServer url
                case server of
                    Nothing -> pure $ Left StorageServerUnreachable
                    Just ss@StorageServer{storageServerGetBuckets} ->
                        Right . (ss,) <$> storageServerGetBuckets storageIndex

{- | Invert the mapping implied by the list of two tuples so that the servers
 that claim to have a certain share can easily be retrieved.
-}
makeShareMap :: Ord k => [(v, Set.Set k)] -> Map.Map k [v]
makeShareMap locations =
    foldl' (Map.unionWith (<>)) mempty ((\(k, v) -> Map.fromSet (const [k]) v) <$> locations)

-- | Download the bytes of a share from one (or more!) of the given servers.
downloadShare ::
    -- | The storage index of the share to download.
    StorageIndex ->
    -- | The number of the share to download.
    ShareNum ->
    -- | The servers which we have a reasonable belief could hold a copy of the
    -- share.  It is common for there to be only one server holding each share
    -- but nothing *prevents* multiple servers from having one.  In this case we
    -- could download the share from both of them, perhaps.
    [StorageServer] ->
    -- | The bytes of the share or some error that was encountered during
    -- download.
    IO (ShareNum, Either DownloadError LB.ByteString)
downloadShare _ shareNum [] = pure (shareNum, Left NoServers)
downloadShare _ shareNum _ = pure (shareNum, Right "")