diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index 9674409b0741aed145690fe24fadec5b1e3d9700..f82b072316e2333f646fb1846970cc908c1ce09e 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
 {- | A high-level interface to downloading share data as bytes from storage
  servers.
 -}
@@ -24,6 +27,7 @@ import qualified Data.Set as Set
 import Tahoe.Announcement (StorageServerAnnouncement)
 import qualified Tahoe.CHK
 import Tahoe.CHK.Capability (Reader (..), Verifier (..))
+import qualified Tahoe.CHK.Capability as CHK
 import qualified Tahoe.CHK.Encrypt
 import Tahoe.CHK.Server (StorageServer (..), StorageServerID)
 import Tahoe.CHK.Types (ShareNum, StorageIndex)
@@ -44,20 +48,23 @@ type Share = (ShareNum, LB.ByteString)
  given servers, if possible.
 -}
 download ::
-    MonadIO m =>
+    (MonadIO m, Verifiable v, Readable r 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.
-    Reader ->
+    r ->
     -- | Get functions for interacting with a server given its URL.
     LookupServer m ->
     -- | Either a description of how the recovery failed or the recovered
     -- application data.
     m (Either DownloadError LB.ByteString)
-download servers cap@Reader{verifier = Verifier{..}} lookupServer = do
+download servers cap lookupServer = do
     print' ("Going to download: " <> show storageIndex)
-    locationE <- locateShares servers lookupServer storageIndex required
+    let verifier = getVerifiable cap
+    let storageIndex = getStorageIndex verifier
+    (required, _) <- getRequiredTotal ss verifier
+    locationE <- locateShares servers lookupServer storageIndex (fromIntegral required)
     print' "Finished locating shares"
     case locationE of
         Left err -> do
@@ -72,6 +79,40 @@ download servers cap@Reader{verifier = Verifier{..}} lookupServer = do
             print' "Decoded them"
             pure s
 
+-- fetchRequiredTotal :: [StorageServerAnnouncement] -> (StorageServerAnnouncement -> IO (Either LookupError StorageServer) -> (StorageServer -> IO (Int, Int)) -> IO (Int, Int)
+-- fetchRequiredTotal locations f = _
+
+firstStorageServer :: [StorageServerAnnouncement] -> (StorageServerAnnouncement -> IO (Either LookupError StorageServer)) -> IO [StorageServer]
+firstStorageServer servers finder = do
+    responses <- mapM finder servers
+    pure $ take 1 $ rights responses
+
+{-
+  getShareNumbers :: server -> storageIndex -> IO [ShareNumber]
+  for mutables, that's getMutableShareNumbers
+  getEncodingParameters :: Capability -> StorageServer -> IO (n,k)
+  it's pure for CHK (immutables), but must be requested from the server for mutables
+  this returns the FEC encoding values so you know when to stop fetching shares
+  getStorageIndex :: Capability -> StorageIndex
+  -}
+class Verifiable v where
+    getShareNumbers :: v -> StorageServer -> IO (Set.Set ShareNum)
+    getRequiredTotal :: v -> StorageServer -> IO (Int, Int)
+    getStorageIndex :: v -> StorageIndex
+
+instance Verifiable CHK.Verifier where
+    getShareNumbers v s = storageServerGetBuckets s (storageIndex v)
+    getStorageIndex Verifier{storageIndex} = storageIndex
+
+    -- CHK is pure, we don't have to ask the StorageServer
+    getRequiredTotal Verifier{required, total} _ = pure (fromIntegral required, fromIntegral total)
+
+class Verifiable v => Readable r v | r -> v where
+    getVerifiable :: r -> v
+
+instance Readable CHK.Reader CHK.Verifier where
+    getVerifiable = verifier
+
 {- | Execute each download task sequentially and return only the successful
  results.
 -}