{-# LANGUAGE TypeFamilies #-}

{- | A high-level interface to downloading share data as bytes from storage
 servers.
-}
module Tahoe.Download (
    LookupServer,
    DownloadError (..),
    DirectoryDownloadError (..),
    LookupError (..),
    DiscoverError (..),
    discoverShares,
    download,
    downloadDirectory,
    announcementToImmutableStorageServer,
    announcementToMutableStorageServer,
    getShareNumbers,
) where

import Control.Concurrent.Async (mapConcurrently)
import Control.Exception (Exception (displayException), SomeException, try)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Bifunctor (Bifunctor (first, second))
import Data.Binary (Word16)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Either (partitionEithers, rights)
import Data.List (foldl')
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Tahoe.Announcement (StorageServerAnnouncement)
import Tahoe.CHK.Server (StorageServer (..), StorageServerID)
import Tahoe.CHK.Types (ShareNum, StorageIndex)
import Tahoe.Directory (Directory, DirectoryCapability (DirectoryCapability))
import qualified Tahoe.Directory as Directory
import Tahoe.Download.Internal.Capability
import Tahoe.Download.Internal.Client
import Tahoe.Download.Internal.Immutable
import Tahoe.Download.Internal.Mutable

-- | Partially describe one share download.
type DownloadTask = (ShareNum, StorageServer)

-- | A downloaded share
type DownloadedShare = (ShareNum, LB.ByteString)

{- | Recover the application data associated with a given capability from the
 given servers, if possible.
-}
download ::
    -- To download, we require a capability for which there is a Readable
    -- instance because are also going to decrypt the ciphertext.  A different
    -- download interface that skips decryption could settle for a capability
    -- with a Verifiable instance.  We also require that the Verifier type for
    -- the read capability has a Verifiable instance because Verifiable is
    -- what gives us the ability to locate the shares.  If we located
    -- separately from decrypting this might be simpler.
    (MonadIO m, Readable readCap, Verifiable v, Verifier readCap ~ v) =>
    -- | 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.
    readCap ->
    -- | Get functions for interacting with a server given its URL.
    LookupServer IO ->
    -- | Either a description of how the recovery failed or the recovered
    -- application data.
    m (Either DownloadError LB.ByteString)
download :: Map StorageServerID StorageServerAnnouncement
-> readCap
-> LookupServer IO
-> m (Either DownloadError ByteString)
download Map StorageServerID StorageServerAnnouncement
servers readCap
cap LookupServer IO
lookupServer = do
    String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' (String
"Downloading: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> StorageIndex -> String
forall a. Show a => a -> String
show (v -> StorageIndex
forall v. Verifiable v => v -> StorageIndex
getStorageIndex (v -> StorageIndex) -> v -> StorageIndex
forall a b. (a -> b) -> a -> b
$ readCap -> Verifier readCap
forall r. Readable r => r -> Verifier r
getVerifiable readCap
cap))
    let verifier :: Verifier readCap
verifier = readCap -> Verifier readCap
forall r. Readable r => r -> Verifier r
getVerifiable readCap
cap
    let storageIndex :: StorageIndex
storageIndex = v -> StorageIndex
forall v. Verifiable v => v -> StorageIndex
getStorageIndex v
Verifier readCap
verifier
    -- TODO: If getRequiredTotal fails on the first storage server, we may
    -- need to try more.  If it fails for all of them, we need to represent
    -- the failure coherently.
    Either [LookupError] (Int, Int)
someParam <- IO (Either [LookupError] (Int, Int))
-> m (Either [LookupError] (Int, Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [LookupError] (Int, Int))
 -> m (Either [LookupError] (Int, Int)))
-> IO (Either [LookupError] (Int, Int))
-> m (Either [LookupError] (Int, Int))
forall a b. (a -> b) -> a -> b
$ LookupServer IO
-> (StorageServer -> IO (Maybe (Int, Int)))
-> [StorageServerAnnouncement]
-> IO (Either [LookupError] (Int, Int))
forall (m :: * -> *) a b c d.
Monad m =>
(a -> m (Either b c))
-> (c -> m (Maybe d)) -> [a] -> m (Either [b] d)
firstRightM LookupServer IO
lookupServer (v -> StorageServer -> IO (Maybe (Int, Int))
forall v (m :: * -> *).
(Verifiable v, MonadIO m) =>
v -> StorageServer -> m (Maybe (Int, Int))
getRequiredTotal v
Verifier readCap
verifier) (Map StorageServerID StorageServerAnnouncement
-> [StorageServerAnnouncement]
forall k a. Map k a -> [a]
Map.elems Map StorageServerID StorageServerAnnouncement
servers)
    case Either [LookupError] (Int, Int)
someParam of
        Left [LookupError]
errs -> Either DownloadError ByteString
-> m (Either DownloadError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DownloadError ByteString
 -> m (Either DownloadError ByteString))
-> (DownloadError -> Either DownloadError ByteString)
-> DownloadError
-> m (Either DownloadError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DownloadError -> Either DownloadError ByteString
forall a b. a -> Either a b
Left (DownloadError -> m (Either DownloadError ByteString))
-> DownloadError -> m (Either DownloadError ByteString)
forall a b. (a -> b) -> a -> b
$ if Map StorageServerID StorageServerAnnouncement
servers Map StorageServerID StorageServerAnnouncement
-> Map StorageServerID StorageServerAnnouncement -> Bool
forall a. Eq a => a -> a -> Bool
== Map StorageServerID StorageServerAnnouncement
forall a. Monoid a => a
mempty then DownloadError
NoConfiguredServers else [DiscoverError] -> DownloadError
NoReachableServers (LookupError -> DiscoverError
StorageServerUnreachable (LookupError -> DiscoverError) -> [LookupError] -> [DiscoverError]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LookupError]
errs)
        Right (Int
required, Int
_) -> do
            Either DownloadError [(StorageServer, Set ShareNum)]
locationE <- IO (Either DownloadError [(StorageServer, Set ShareNum)])
-> m (Either DownloadError [(StorageServer, Set ShareNum)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DownloadError [(StorageServer, Set ShareNum)])
 -> m (Either DownloadError [(StorageServer, Set ShareNum)]))
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
-> m (Either DownloadError [(StorageServer, Set ShareNum)])
forall a b. (a -> b) -> a -> b
$ Map StorageServerID StorageServerAnnouncement
-> LookupServer IO
-> StorageIndex
-> Word16
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
locateShares Map StorageServerID StorageServerAnnouncement
servers LookupServer IO
lookupServer StorageIndex
storageIndex (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
required)
            String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Finished locating shares"
            case Either DownloadError [(StorageServer, Set ShareNum)]
locationE of
                Left DownloadError
err -> do
                    String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Got an error locating shares"
                    Either DownloadError ByteString
-> m (Either DownloadError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DownloadError ByteString
 -> m (Either DownloadError ByteString))
-> Either DownloadError ByteString
-> m (Either DownloadError ByteString)
forall a b. (a -> b) -> a -> b
$ DownloadError -> Either DownloadError ByteString
forall a b. a -> Either a b
Left DownloadError
err
                Right [(StorageServer, Set ShareNum)]
discovered -> do
                    String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Found some shares, fetching them"
                    -- XXX note shares can contain failures
                    [DownloadedShare]
shares <- IO [DownloadedShare] -> m [DownloadedShare]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DownloadedShare] -> m [DownloadedShare])
-> IO [DownloadedShare] -> m [DownloadedShare]
forall a b. (a -> b) -> a -> b
$ StorageIndex -> [DownloadTask] -> IO [DownloadedShare]
executeDownloadTasks StorageIndex
storageIndex ((StorageServer, Set ShareNum) -> [DownloadTask]
forall k v. Ord k => (v, Set k) -> [(k, v)]
makeDownloadTasks ((StorageServer, Set ShareNum) -> [DownloadTask])
-> [(StorageServer, Set ShareNum)] -> [DownloadTask]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(StorageServer, Set ShareNum)]
discovered)
                    String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Fetched the shares, decoding them"
                    Either DownloadError ByteString
s <- IO (Either DownloadError ByteString)
-> m (Either DownloadError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DownloadError ByteString)
 -> m (Either DownloadError ByteString))
-> IO (Either DownloadError ByteString)
-> m (Either DownloadError ByteString)
forall a b. (a -> b) -> a -> b
$ readCap
-> [DownloadedShare] -> Int -> IO (Either DownloadError ByteString)
forall readCap v.
(Readable readCap, Verifiable v, v ~ Verifier readCap) =>
readCap
-> [DownloadedShare] -> Int -> IO (Either DownloadError ByteString)
decodeShares readCap
cap [DownloadedShare]
shares Int
required
                    String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Decoded them"
                    Either DownloadError ByteString
-> m (Either DownloadError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either DownloadError ByteString
s

{- | Apply a monadic operation to each element of a list and another monadic
 operation values in the resulting Rights.  If all of the results are Lefts or
 Nothings, return a list of the values in the Lefts.  Otherwise, return the
 *first* Right.
-}
firstRightM :: Monad m => (a -> m (Either b c)) -> (c -> m (Maybe d)) -> [a] -> m (Either [b] d)
firstRightM :: (a -> m (Either b c))
-> (c -> m (Maybe d)) -> [a] -> m (Either [b] d)
firstRightM a -> m (Either b c)
_ c -> m (Maybe d)
_ [] = Either [b] d -> m (Either [b] d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [b] d -> m (Either [b] d))
-> Either [b] d -> m (Either [b] d)
forall a b. (a -> b) -> a -> b
$ [b] -> Either [b] d
forall a b. a -> Either a b
Left []
firstRightM a -> m (Either b c)
f c -> m (Maybe d)
op (a
x : [a]
xs) = do
    Either b c
s <- a -> m (Either b c)
f a
x
    case Either b c
s of
        Left b
bs -> ([b] -> [b]) -> Either [b] d -> Either [b] d
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (b
bs b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) (Either [b] d -> Either [b] d)
-> m (Either [b] d) -> m (Either [b] d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either [b] d)
recurse
        Right c
ss -> do
            Maybe d
r <- c -> m (Maybe d)
op c
ss
            case Maybe d
r of
                Maybe d
Nothing -> m (Either [b] d)
recurse
                Just d
d -> Either [b] d -> m (Either [b] d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [b] d -> m (Either [b] d))
-> Either [b] d -> m (Either [b] d)
forall a b. (a -> b) -> a -> b
$ d -> Either [b] d
forall a b. b -> Either a b
Right d
d
  where
    recurse :: m (Either [b] d)
recurse = (a -> m (Either b c))
-> (c -> m (Maybe d)) -> [a] -> m (Either [b] d)
forall (m :: * -> *) a b c d.
Monad m =>
(a -> m (Either b c))
-> (c -> m (Maybe d)) -> [a] -> m (Either [b] d)
firstRightM a -> m (Either b c)
f c -> m (Maybe d)
op [a]
xs

{- | Execute each download task sequentially and return only the successful
 results.
-}
executeDownloadTasks ::
    -- | The storage index of the shares to download.
    StorageIndex ->
    -- | The downloads to attempt.
    [DownloadTask] ->
    -- | The results of all successful downloads.
    IO [DownloadedShare]
executeDownloadTasks :: StorageIndex -> [DownloadTask] -> IO [DownloadedShare]
executeDownloadTasks StorageIndex
storageIndex [DownloadTask]
tasks = do
    [(ShareNum, Either DownloadError ByteString)]
downloadResults <- (DownloadTask -> IO (ShareNum, Either DownloadError ByteString))
-> [DownloadTask]
-> IO [(ShareNum, Either DownloadError ByteString)]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently (StorageIndex
-> DownloadTask -> IO (ShareNum, Either DownloadError ByteString)
downloadShare StorageIndex
storageIndex) [DownloadTask]
tasks
    [DownloadedShare] -> IO [DownloadedShare]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DownloadedShare] -> IO [DownloadedShare])
-> ([Either DownloadError DownloadedShare] -> [DownloadedShare])
-> [Either DownloadError DownloadedShare]
-> IO [DownloadedShare]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either DownloadError DownloadedShare] -> [DownloadedShare]
forall a b. [Either a b] -> [b]
rights ([Either DownloadError DownloadedShare] -> IO [DownloadedShare])
-> [Either DownloadError DownloadedShare] -> IO [DownloadedShare]
forall a b. (a -> b) -> a -> b
$ (ShareNum, Either DownloadError ByteString)
-> Either DownloadError DownloadedShare
forall (f :: * -> *) t t. Functor f => (t, f t) -> f (t, t)
inject ((ShareNum, Either DownloadError ByteString)
 -> Either DownloadError DownloadedShare)
-> [(ShareNum, Either DownloadError ByteString)]
-> [Either DownloadError DownloadedShare]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ShareNum, Either DownloadError ByteString)]
downloadResults
  where
    inject :: (t, f t) -> f (t, t)
inject (t
a, f t
b) = (t
a,) (t -> (t, t)) -> f t -> f (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f t
b

-- | Find out which servers claim to have shares related to a given storage index.
locateShares ::
    -- | Information about the servers from which to consider downloading shares
    -- representing the application data.
    Map.Map StorageServerID StorageServerAnnouncement ->
    -- | Get functions for interacting with a server given its URL.
    LookupServer IO ->
    -- | The storage index about which to retrieve information.
    B.ByteString ->
    -- | The number of shares we need to locate.  If we cannot find at least
    -- this many shares the result will be an error.
    Word16 ->
    -- | Either an error or a guide to where shares are placed.
    IO (Either DownloadError [(StorageServer, Set.Set ShareNum)])
locateShares :: Map StorageServerID StorageServerAnnouncement
-> LookupServer IO
-> StorageIndex
-> Word16
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
locateShares Map StorageServerID StorageServerAnnouncement
servers LookupServer IO
lookupServer StorageIndex
storageIndex Word16
required =
    case Map StorageServerID StorageServerAnnouncement
-> [(StorageServerID, StorageServerAnnouncement)]
forall k a. Map k a -> [(k, a)]
Map.toList Map StorageServerID StorageServerAnnouncement
servers of
        [] -> Either DownloadError [(StorageServer, Set ShareNum)]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DownloadError [(StorageServer, Set ShareNum)]
 -> IO (Either DownloadError [(StorageServer, Set ShareNum)]))
-> (DownloadError
    -> Either DownloadError [(StorageServer, Set ShareNum)])
-> DownloadError
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DownloadError
-> Either DownloadError [(StorageServer, Set ShareNum)]
forall a b. a -> Either a b
Left (DownloadError
 -> IO (Either DownloadError [(StorageServer, Set ShareNum)]))
-> DownloadError
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall a b. (a -> b) -> a -> b
$ DownloadError
NoConfiguredServers
        [(StorageServerID, StorageServerAnnouncement)]
serverList -> do
            String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Discovering shares"
            -- Ask each server for all shares it has.
            ( [DiscoverError]
problems :: [DiscoverError]
                , [(StorageServer, Set ShareNum)]
discovered :: [(StorageServer, Set.Set ShareNum)]
                ) <-
                [Either DiscoverError (StorageServer, Set ShareNum)]
-> ([DiscoverError], [(StorageServer, Set ShareNum)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either DiscoverError (StorageServer, Set ShareNum)]
 -> ([DiscoverError], [(StorageServer, Set ShareNum)]))
-> IO [Either DiscoverError (StorageServer, Set ShareNum)]
-> IO ([DiscoverError], [(StorageServer, Set ShareNum)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((StorageServerID, StorageServerAnnouncement)
 -> IO (Either DiscoverError (StorageServer, Set ShareNum)))
-> [(StorageServerID, StorageServerAnnouncement)]
-> IO [Either DiscoverError (StorageServer, Set ShareNum)]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently (LookupServer IO
-> StorageIndex
-> (StorageServerID, StorageServerAnnouncement)
-> IO (Either DiscoverError (StorageServer, Set ShareNum))
discoverShares LookupServer IO
lookupServer StorageIndex
storageIndex) [(StorageServerID, StorageServerAnnouncement)]
serverList
            if [(StorageServer, Set ShareNum)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(StorageServer, Set ShareNum)]
discovered
                then Either DownloadError [(StorageServer, Set ShareNum)]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DownloadError [(StorageServer, Set ShareNum)]
 -> IO (Either DownloadError [(StorageServer, Set ShareNum)]))
-> ([DiscoverError]
    -> Either DownloadError [(StorageServer, Set ShareNum)])
-> [DiscoverError]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DownloadError
-> Either DownloadError [(StorageServer, Set ShareNum)]
forall a b. a -> Either a b
Left (DownloadError
 -> Either DownloadError [(StorageServer, Set ShareNum)])
-> ([DiscoverError] -> DownloadError)
-> [DiscoverError]
-> Either DownloadError [(StorageServer, Set ShareNum)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DiscoverError] -> DownloadError
NoReachableServers ([DiscoverError]
 -> IO (Either DownloadError [(StorageServer, Set ShareNum)]))
-> [DiscoverError]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall a b. (a -> b) -> a -> b
$ [DiscoverError]
problems
                else
                    if (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
required Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) (Int -> Bool)
-> ([(StorageServer, Set ShareNum)] -> Int)
-> [(StorageServer, Set ShareNum)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(StorageServer, Set ShareNum)] -> Int
forall b a. Ord b => [(a, Set b)] -> Int
countDistinctShares ([(StorageServer, Set ShareNum)] -> Bool)
-> [(StorageServer, Set ShareNum)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(StorageServer, Set ShareNum)]
discovered
                        then Either DownloadError [(StorageServer, Set ShareNum)]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DownloadError [(StorageServer, Set ShareNum)]
 -> IO (Either DownloadError [(StorageServer, Set ShareNum)]))
-> Either DownloadError [(StorageServer, Set ShareNum)]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall a b. (a -> b) -> a -> b
$ DownloadError
-> Either DownloadError [(StorageServer, Set ShareNum)]
forall a b. a -> Either a b
Left NotEnoughShares :: Int -> Int -> DownloadError
NotEnoughShares{notEnoughSharesNeeded :: Int
notEnoughSharesNeeded = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
required, notEnoughSharesFound :: Int
notEnoughSharesFound = [(StorageServer, Set ShareNum)] -> Int
forall b a. Ord b => [(a, Set b)] -> Int
countDistinctShares [(StorageServer, Set ShareNum)]
discovered}
                        else Either DownloadError [(StorageServer, Set ShareNum)]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DownloadError [(StorageServer, Set ShareNum)]
 -> IO (Either DownloadError [(StorageServer, Set ShareNum)]))
-> Either DownloadError [(StorageServer, Set ShareNum)]
-> IO (Either DownloadError [(StorageServer, Set ShareNum)])
forall a b. (a -> b) -> a -> b
$ [(StorageServer, Set ShareNum)]
-> Either DownloadError [(StorageServer, Set ShareNum)]
forall a b. b -> Either a b
Right [(StorageServer, Set ShareNum)]
discovered

{- | Given the results of downloading shares related to a given capability,
 decode them and decrypt the contents of possible.
-}
decodeShares ::
    (Readable readCap, Verifiable v, v ~ Verifier readCap) =>
    -- | The read capability which allows the contents to be decrypted.
    readCap ->
    -- | The results of downloading the shares.
    [DownloadedShare] ->
    Int ->
    IO (Either DownloadError LB.ByteString)
decodeShares :: readCap
-> [DownloadedShare] -> Int -> IO (Either DownloadError ByteString)
decodeShares readCap
r [DownloadedShare]
shares Int
required = do
    -- Filter down to shares we actually got.
    let fewerShares :: [(ShareNum, Either (ByteString, ByteOffset, String) (ShareT v))]
fewerShares = (ByteString -> Either (ByteString, ByteOffset, String) (ShareT v))
-> DownloadedShare
-> (ShareNum, Either (ByteString, ByteOffset, String) (ShareT v))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (v
-> ByteString -> Either (ByteString, ByteOffset, String) (ShareT v)
forall v.
Verifiable v =>
v
-> ByteString -> Either (ByteString, ByteOffset, String) (ShareT v)
deserializeShare (readCap -> Verifier readCap
forall r. Readable r => r -> Verifier r
getVerifiable readCap
r)) (DownloadedShare
 -> (ShareNum, Either (ByteString, ByteOffset, String) (ShareT v)))
-> [DownloadedShare]
-> [(ShareNum, Either (ByteString, ByteOffset, String) (ShareT v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DownloadedShare]
shares
        onlyDecoded :: [(Int, ShareT v)]
onlyDecoded = [Either (ByteString, ByteOffset, String) (Int, ShareT v)]
-> [(Int, ShareT v)]
forall a b. [Either a b] -> [b]
rights ([Either (ByteString, ByteOffset, String) (Int, ShareT v)]
 -> [(Int, ShareT v)])
-> [Either (ByteString, ByteOffset, String) (Int, ShareT v)]
-> [(Int, ShareT v)]
forall a b. (a -> b) -> a -> b
$ (\(ShareNum
a, Either (ByteString, ByteOffset, String) (ShareT v)
b) -> (ShareNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ShareNum
a,) (ShareT v -> (Int, ShareT v))
-> Either (ByteString, ByteOffset, String) (ShareT v)
-> Either (ByteString, ByteOffset, String) (Int, ShareT v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (ByteString, ByteOffset, String) (ShareT v)
b) ((ShareNum, Either (ByteString, ByteOffset, String) (ShareT v))
 -> Either (ByteString, ByteOffset, String) (Int, ShareT v))
-> [(ShareNum, Either (ByteString, ByteOffset, String) (ShareT v))]
-> [Either (ByteString, ByteOffset, String) (Int, ShareT v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ShareNum, Either (ByteString, ByteOffset, String) (ShareT v))]
fewerShares
    if [(Int, ShareT v)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, ShareT v)]
onlyDecoded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
required
        then Either DownloadError ByteString
-> IO (Either DownloadError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DownloadError ByteString
 -> IO (Either DownloadError ByteString))
-> Either DownloadError ByteString
-> IO (Either DownloadError ByteString)
forall a b. (a -> b) -> a -> b
$ DownloadError -> Either DownloadError ByteString
forall a b. a -> Either a b
Left NotEnoughDecodedShares :: Int -> Int -> DownloadError
NotEnoughDecodedShares{notEnoughDecodedSharesNeeded :: Int
notEnoughDecodedSharesNeeded = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
required, notEnoughDecodedSharesFound :: Int
notEnoughDecodedSharesFound = [(Int, ShareT v)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, ShareT v)]
onlyDecoded}
        else do
            readCap
-> [(Int, ShareT (Verifier readCap))]
-> IO (Either DownloadError ByteString)
forall r (m :: * -> *).
(Readable r, MonadIO m) =>
r
-> [(Int, ShareT (Verifier r))]
-> m (Either DownloadError ByteString)
decodeShare readCap
r [(Int, ShareT v)]
[(Int, ShareT (Verifier readCap))]
onlyDecoded

{- | Figure the total number of distinct shares reported by all of the servers
 we asked.
-}
countDistinctShares :: Ord b => [(a, Set.Set b)] -> Int
countDistinctShares :: [(a, Set b)] -> Int
countDistinctShares = Set b -> Int
forall a. Set a -> Int
Set.size (Set b -> Int) -> ([(a, Set b)] -> Set b) -> [(a, Set b)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set b -> Set b -> Set b) -> Set b -> [Set b] -> Set b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set b
forall a. Monoid a => a
mempty ([Set b] -> Set b)
-> ([(a, Set b)] -> [Set b]) -> [(a, Set b)] -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Set b) -> Set b) -> [(a, Set b)] -> [Set b]
forall a b. (a -> b) -> [a] -> [b]
map (a, Set b) -> Set b
forall a b. (a, b) -> b
snd

{- | Ask one server which shares it has related to the storage index in
 question.
-}
discoverShares ::
    LookupServer IO ->
    StorageIndex ->
    (StorageServerID, StorageServerAnnouncement) ->
    IO (Either DiscoverError (StorageServer, Set.Set ShareNum))
discoverShares :: LookupServer IO
-> StorageIndex
-> (StorageServerID, StorageServerAnnouncement)
-> IO (Either DiscoverError (StorageServer, Set ShareNum))
discoverShares LookupServer IO
lookupServer StorageIndex
storageIndex (StorageServerID
_sid, StorageServerAnnouncement
sann) = do
    String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Looking up server from announcement"
    Either LookupError StorageServer
server <- LookupServer IO
lookupServer StorageServerAnnouncement
sann
    String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Looked it up"
    case Either LookupError StorageServer
server of
        Left LookupError
e -> Either DiscoverError (StorageServer, Set ShareNum)
-> IO (Either DiscoverError (StorageServer, Set ShareNum))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DiscoverError (StorageServer, Set ShareNum)
 -> IO (Either DiscoverError (StorageServer, Set ShareNum)))
-> (LookupError
    -> Either DiscoverError (StorageServer, Set ShareNum))
-> LookupError
-> IO (Either DiscoverError (StorageServer, Set ShareNum))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscoverError -> Either DiscoverError (StorageServer, Set ShareNum)
forall a b. a -> Either a b
Left (DiscoverError
 -> Either DiscoverError (StorageServer, Set ShareNum))
-> (LookupError -> DiscoverError)
-> LookupError
-> Either DiscoverError (StorageServer, Set ShareNum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LookupError -> DiscoverError
StorageServerUnreachable (LookupError
 -> IO (Either DiscoverError (StorageServer, Set ShareNum)))
-> LookupError
-> IO (Either DiscoverError (StorageServer, Set ShareNum))
forall a b. (a -> b) -> a -> b
$ LookupError
e
        Right ss :: StorageServer
ss@StorageServer{StorageIndex -> IO (Set ShareNum)
storageServerGetBuckets :: StorageServer -> StorageIndex -> IO (Set ShareNum)
storageServerGetBuckets :: StorageIndex -> IO (Set ShareNum)
storageServerGetBuckets} -> do
            String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Getting buckets for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> StorageIndex -> String
forall a. Show a => a -> String
show StorageIndex
storageIndex
            Either SomeException (Set ShareNum)
buckets <- IO (Set ShareNum) -> IO (Either SomeException (Set ShareNum))
forall e a. Exception e => IO a -> IO (Either e a)
try (StorageIndex -> IO (Set ShareNum)
storageServerGetBuckets StorageIndex
storageIndex)
            let massaged :: Either DiscoverError (Set ShareNum)
massaged = (SomeException -> DiscoverError)
-> Either SomeException (Set ShareNum)
-> Either DiscoverError (Set ShareNum)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> DiscoverError
StorageServerCommunicationError (String -> DiscoverError)
-> (SomeException -> String) -> SomeException -> DiscoverError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> String
forall e. Exception e => e -> String
displayException :: SomeException -> String)) Either SomeException (Set ShareNum)
buckets
            String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Got them " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Either DiscoverError (Set ShareNum) -> String
forall a. Show a => a -> String
show Either DiscoverError (Set ShareNum)
massaged
            Either DiscoverError (StorageServer, Set ShareNum)
-> IO (Either DiscoverError (StorageServer, Set ShareNum))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DiscoverError (StorageServer, Set ShareNum)
 -> IO (Either DiscoverError (StorageServer, Set ShareNum)))
-> Either DiscoverError (StorageServer, Set ShareNum)
-> IO (Either DiscoverError (StorageServer, Set ShareNum))
forall a b. (a -> b) -> a -> b
$ (StorageServer
ss,) (Set ShareNum -> (StorageServer, Set ShareNum))
-> Either DiscoverError (Set ShareNum)
-> Either DiscoverError (StorageServer, Set ShareNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DiscoverError (Set ShareNum)
massaged

{- | Expand a one-to-many mapping into a list of pairs with each of the "many"
   values as the first element and the corresponding "one" value as the second
   element.
-}
makeDownloadTasks :: Ord k => (v, Set.Set k) -> [(k, v)]
makeDownloadTasks :: (v, Set k) -> [(k, v)]
makeDownloadTasks (v
v, Set k
ks) = [k] -> [v] -> [(k, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set k -> [k]
forall a. Set a -> [a]
Set.toList Set k
ks) (v -> [v]
forall a. a -> [a]
repeat v
v)

-- | Download the bytes of a share from one (or more!) of the given servers.
downloadShare ::
    -- | The storage index of the share to download.
    StorageIndex ->
    -- | Addressing information about the share to download.
    DownloadTask ->
    -- | The bytes of the share or some error that was encountered during
    -- download.
    IO (ShareNum, Either DownloadError LB.ByteString)
downloadShare :: StorageIndex
-> DownloadTask -> IO (ShareNum, Either DownloadError ByteString)
downloadShare StorageIndex
storageIndex (ShareNum
shareNum, StorageServer
s) = do
    String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Going to download " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> StorageIndex -> String
forall a. Show a => a -> String
show StorageIndex
storageIndex String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ShareNum -> String
forall a. Show a => a -> String
show ShareNum
shareNum
    Either SomeException StorageIndex
shareBytes <- IO StorageIndex -> IO (Either SomeException StorageIndex)
forall e a. Exception e => IO a -> IO (Either e a)
try (StorageServer -> StorageIndex -> ShareNum -> IO StorageIndex
storageServerRead StorageServer
s StorageIndex
storageIndex ShareNum
shareNum)
    let massaged :: Either DownloadError StorageIndex
massaged = (SomeException -> DownloadError)
-> Either SomeException StorageIndex
-> Either DownloadError StorageIndex
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> DownloadError
ShareDownloadError (String -> DownloadError)
-> (SomeException -> String) -> SomeException -> DownloadError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> String
forall e. Exception e => e -> String
displayException :: SomeException -> String)) Either SomeException StorageIndex
shareBytes
    String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
print' String
"Downloaded it"
    (ShareNum, Either DownloadError ByteString)
-> IO (ShareNum, Either DownloadError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShareNum
shareNum, StorageIndex -> ByteString
LB.fromStrict (StorageIndex -> ByteString)
-> Either DownloadError StorageIndex
-> Either DownloadError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DownloadError StorageIndex
massaged)

{- | Download the data associated with a directory capability and interpret it
 as a collection of entries.
-}
downloadDirectory ::
    (MonadIO m, Readable readCap, Verifiable v, Verifier readCap ~ v) =>
    -- | 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.
    DirectoryCapability readCap ->
    -- | Get functions for interacting with a server given its URL.
    LookupServer IO ->
    -- | Either a description of how the recovery failed or the recovered
    -- application data.
    m (Either DirectoryDownloadError Directory)
downloadDirectory :: Map StorageServerID StorageServerAnnouncement
-> DirectoryCapability readCap
-> LookupServer IO
-> m (Either DirectoryDownloadError Directory)
downloadDirectory Map StorageServerID StorageServerAnnouncement
anns (DirectoryCapability readCap
cap) LookupServer IO
lookupServer = do
    Either DownloadError ByteString
bs <- Map StorageServerID StorageServerAnnouncement
-> readCap
-> LookupServer IO
-> m (Either DownloadError ByteString)
forall (m :: * -> *) readCap v.
(MonadIO m, Readable readCap, Verifiable v,
 Verifier readCap ~ v) =>
Map StorageServerID StorageServerAnnouncement
-> readCap
-> LookupServer IO
-> m (Either DownloadError ByteString)
download Map StorageServerID StorageServerAnnouncement
anns readCap
cap LookupServer IO
lookupServer
    Either DirectoryDownloadError Directory
-> m (Either DirectoryDownloadError Directory)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DirectoryDownloadError Directory
 -> m (Either DirectoryDownloadError Directory))
-> Either DirectoryDownloadError Directory
-> m (Either DirectoryDownloadError Directory)
forall a b. (a -> b) -> a -> b
$ do
        ByteString
bs' <- (DownloadError -> DirectoryDownloadError)
-> Either DownloadError ByteString
-> Either DirectoryDownloadError ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DownloadError -> DirectoryDownloadError
UnderlyingDownloadError Either DownloadError ByteString
bs
        (ParseErrorBundle StorageIndex Void -> DirectoryDownloadError)
-> Either (ParseErrorBundle StorageIndex Void) Directory
-> Either DirectoryDownloadError Directory
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (DirectoryDownloadError
-> ParseErrorBundle StorageIndex Void -> DirectoryDownloadError
forall a b. a -> b -> a
const DirectoryDownloadError
DecodingError) (Either (ParseErrorBundle StorageIndex Void) Directory
 -> Either DirectoryDownloadError Directory)
-> Either (ParseErrorBundle StorageIndex Void) Directory
-> Either DirectoryDownloadError Directory
forall a b. (a -> b) -> a -> b
$ StorageIndex
-> Either (ParseErrorBundle StorageIndex Void) Directory
Directory.parse (ByteString -> StorageIndex
LB.toStrict ByteString
bs')

data DirectoryDownloadError
    = UnderlyingDownloadError DownloadError
    | DecodingError
    deriving (Eq DirectoryDownloadError
Eq DirectoryDownloadError
-> (DirectoryDownloadError -> DirectoryDownloadError -> Ordering)
-> (DirectoryDownloadError -> DirectoryDownloadError -> Bool)
-> (DirectoryDownloadError -> DirectoryDownloadError -> Bool)
-> (DirectoryDownloadError -> DirectoryDownloadError -> Bool)
-> (DirectoryDownloadError -> DirectoryDownloadError -> Bool)
-> (DirectoryDownloadError
    -> DirectoryDownloadError -> DirectoryDownloadError)
-> (DirectoryDownloadError
    -> DirectoryDownloadError -> DirectoryDownloadError)
-> Ord DirectoryDownloadError
DirectoryDownloadError -> DirectoryDownloadError -> Bool
DirectoryDownloadError -> DirectoryDownloadError -> Ordering
DirectoryDownloadError
-> DirectoryDownloadError -> DirectoryDownloadError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DirectoryDownloadError
-> DirectoryDownloadError -> DirectoryDownloadError
$cmin :: DirectoryDownloadError
-> DirectoryDownloadError -> DirectoryDownloadError
max :: DirectoryDownloadError
-> DirectoryDownloadError -> DirectoryDownloadError
$cmax :: DirectoryDownloadError
-> DirectoryDownloadError -> DirectoryDownloadError
>= :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
$c>= :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
> :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
$c> :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
<= :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
$c<= :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
< :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
$c< :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
compare :: DirectoryDownloadError -> DirectoryDownloadError -> Ordering
$ccompare :: DirectoryDownloadError -> DirectoryDownloadError -> Ordering
$cp1Ord :: Eq DirectoryDownloadError
Ord, DirectoryDownloadError -> DirectoryDownloadError -> Bool
(DirectoryDownloadError -> DirectoryDownloadError -> Bool)
-> (DirectoryDownloadError -> DirectoryDownloadError -> Bool)
-> Eq DirectoryDownloadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
$c/= :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
== :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
$c== :: DirectoryDownloadError -> DirectoryDownloadError -> Bool
Eq, Int -> DirectoryDownloadError -> String -> String
[DirectoryDownloadError] -> String -> String
DirectoryDownloadError -> String
(Int -> DirectoryDownloadError -> String -> String)
-> (DirectoryDownloadError -> String)
-> ([DirectoryDownloadError] -> String -> String)
-> Show DirectoryDownloadError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DirectoryDownloadError] -> String -> String
$cshowList :: [DirectoryDownloadError] -> String -> String
show :: DirectoryDownloadError -> String
$cshow :: DirectoryDownloadError -> String
showsPrec :: Int -> DirectoryDownloadError -> String -> String
$cshowsPrec :: Int -> DirectoryDownloadError -> String -> String
Show)