Get some more of the pieces working well together

Also sketch out a demo program

app/Main.hs

 module Main where
 
+-- import Data.Aeson
+import qualified Data.ByteString as B
+import Data.Text
+import Data.Yaml (decodeEither')
+import System.Environment (getArgs)
+import Tahoe.CHK.Capability
+import Tahoe.Download (download, gbsURLToStorageServer)
+import Text.Megaparsec (parse)
+
 main :: IO ()
 main = do
-    putStrLn "Hello, Haskell!"
+    [announcementPath, readCap] <- getArgs
+    -- Load server announcements
+    announcementsBytes <- B.readFile announcementPath
+
+    -- XXX announcementsBytes is not quite the right shape for `Map
+    -- StorageServerID StorageServerAnnouncement` - need to massage it a
+    -- little bit somehow?
+    -- let Just yaml = decodeEither' announcementBytes :: Either ParseException (Maybe Value)
+    let Right announcements = decodeEither' announcementsBytes
+
+    -- Accept & parse read capability
+    let Right (CHKReader cap) = parse pCapability "<argv>" (Data.Text.pack readCap)
+
+    -- Download the shares
+    -- Decode them
+    Right plaintext <- download announcements cap gbsURLToStorageServer
+
+    -- Show the result
+    print ("Your plaintext:" :: Data.Text.Text)
+    print plaintext

gbs-downloader.cabal

@@ -122,8 +122,14 @@ executable gbs-download
 
   -- Other library packages from which modules are imported.
   build-depends:
+    , aeson
     , base            ^>=4.14.3.0
+    , bytestring
     , gbs-downloader
+    , megaparsec
+    , tahoe-chk
+    , text
+    , yaml
 
   -- Directories containing source files.
   hs-source-dirs:   app

src/Tahoe/Download.hs

 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {- | A high-level interface to downloading share data as bytes from storage
  servers.
@@ -79,28 +80,29 @@ data DiscoverError
 -- Tor-based route to the server.  In this case we might need to launch a Tor
 -- daemon or connect to a running Tor daemon or at least set up a new Tor
 -- circuit.  All of which require I/O.  But we can always refactor later!
-type LookupServer = URL -> Maybe StorageServer
+type LookupServer m = URL -> m (Maybe StorageServer)
 
 {- | Recover the application data associated with a given capability from the
  given servers, if possible.
 -}
 download ::
+    MonadIO m =>
     -- | 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.
-    LookupServer ->
+    LookupServer m ->
     -- | Either a description of how the recovery failed or the recovered
     -- application data.
-    IO (Either DownloadError LB.ByteString)
+    m (Either DownloadError LB.ByteString)
 download servers cap@Reader{readKey, verifier = Verifier{..}} lookupServer =
     case Map.toList servers of
         [] -> pure . Left $ NoConfiguredServers
         serverList -> do
             -- Ask each server for all shares it has.
-            discovered <- rights <$> mapM (discoverShares lookupServer storageIndex) serverList :: IO [(StorageServer, Set.Set ShareNum)]
+            (discovered :: [(StorageServer, Set.Set ShareNum)]) <- rights <$> mapM (discoverShares lookupServer storageIndex) serverList
             if null discovered
                 then pure $ Left NoReachableServers
                 else
@@ -119,7 +121,7 @@ download servers cap@Reader{readKey, verifier = Verifier{..}} lookupServer =
                             if length onlyDecoded < fromIntegral required
                                 then pure $ Left NotEnoughDecodedShares{notEnoughDecodedSharesNeeded = fromIntegral required, notEnoughDecodedSharesFound = length onlyDecoded}
                                 else do
-                                    ciphertext <- Tahoe.CHK.decode cap onlyDecoded
+                                    ciphertext <- liftIO $ Tahoe.CHK.decode cap onlyDecoded
                                     case ciphertext of
                                         Nothing -> pure $ Left ShareDecodingFailed
                                         Just ct ->
@@ -134,16 +136,21 @@ countDistinctShares = Set.size . foldl' Set.union mempty . map snd
 {- | Ask one server which shares it has related to the storage index in
  question.
 -}
-discoverShares :: LookupServer -> StorageIndex -> (StorageServerID, StorageServerAnnouncement) -> IO (Either DiscoverError (StorageServer, Set.Set ShareNum))
+discoverShares ::
+    MonadIO m =>
+    LookupServer m ->
+    StorageIndex ->
+    (StorageServerID, StorageServerAnnouncement) ->
+    m (Either DiscoverError (StorageServer, Set.Set ShareNum))
 discoverShares lookupServer storageIndex (_sid, sann) = do
     case storageServerAnnouncementFURL sann of
         Nothing -> pure $ Left StorageServerLocationUnknown
         Just url -> do
-            let server = lookupServer url
+            server <- lookupServer url
             case server of
                 Nothing -> pure $ Left StorageServerUnreachable
                 Just ss@StorageServer{storageServerGetBuckets} ->
-                    Right . (ss,) <$> storageServerGetBuckets storageIndex
+                    liftIO $ 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.
@@ -154,6 +161,7 @@ makeShareMap locations =
 
 -- | Download the bytes of a share from one (or more!) of the given servers.
 downloadShare ::
+    MonadIO m =>
     -- | The storage index of the share to download.
     StorageIndex ->
     -- | The number of the share to download.
@@ -165,13 +173,13 @@ downloadShare ::
     [StorageServer] ->
     -- | The bytes of the share or some error that was encountered during
     -- download.
-    IO (ShareNum, Either DownloadError LB.ByteString)
+    m (ShareNum, Either DownloadError LB.ByteString)
 downloadShare _ shareNum [] = pure (shareNum, Left NoServers)
 downloadShare storageIndex shareNum (s : _) = do
     -- TODO: There might be more servers.  We could try them if this fails.
     -- On the other hand, we might get bytes but we don't verify them here so
     -- we might also need retry logic up a level or two from here.
-    shareBytes <- storageServerRead s storageIndex shareNum
+    shareBytes <- liftIO $ storageServerRead s storageIndex shareNum
     pure (shareNum, Right $ LB.fromStrict shareBytes)
 
 gbsURLToStorageServer :: MonadIO m => T.Text -> m (Maybe StorageServer)

test/Spec.hs

@@ -90,8 +90,8 @@ tests =
             -- Make the server reachable.
             let openServer furl =
                     if furl == "somewhere"
-                        then pure server
-                        else Nothing
+                        then pure . pure $ server
+                        else pure Nothing
 
             -- Try to download the cap which requires three shares to reconstruct.
             result <- liftIO $ download anns cap openServer
@@ -138,9 +138,9 @@ tests =
             -- Make the server reachable.
             let openServer furl =
                     case furl of
-                        "somewhere" -> pure somewhere
-                        "elsewhere" -> pure elsewhere
-                        _ -> Nothing
+                        "somewhere" -> pure . pure $ somewhere
+                        "elsewhere" -> pure . pure $ elsewhere
+                        _ -> pure Nothing
 
             -- Try to download the cap which requires three shares to reconstruct.
             result <- liftIO $ download anns cap openServer
@@ -221,11 +221,11 @@ tests =
         ]
   where
     -- A server lookup function that always fails.
-    noServers _ = Nothing
+    noServers _ = pure Nothing
 
     -- A server lookup function that finds servers already present in a Map.
-    someServers :: Map.Map StorageServerID StorageServer -> LookupServer
-    someServers servers = flip Map.lookup servers . parseURL
+    someServers :: Applicative m => Map.Map StorageServerID StorageServer -> LookupServer m
+    someServers servers = pure . flip Map.lookup servers . parseURL
       where
         -- Exactly match the nonsense makeAnn spits out
         parseURL = T.take 2 . T.drop 5