From 8a33f25569354f2f8ae9e5e48dfdf0e6df6f9272 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Mon, 8 May 2023 13:20:28 -0400
Subject: [PATCH] some comment improvements and other very minimal changes
---
src/Tahoe/Download.hs | 31 ++++++++++++++++++++++++-------
1 file changed, 24 insertions(+), 7 deletions(-)
diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index 7cf8f16..48b8cd3 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -263,12 +263,19 @@ downloadShare storageIndex shareNum (s : _) = do
print' "Downloaded it"
pure (shareNum, LB.fromStrict <$> massaged)
+-- | There was a problem while trying to look up a server from its announcement.
data LookupError
- = URIParseError StorageServerAnnouncement
- | PortParseError String
- | AnnouncementStructureUnmatched
+ = -- | The server's announced URI was unparseable.
+ URIParseError StorageServerAnnouncement
+ | -- | The port integer in the server's URI was unparseable.
+ PortParseError String
+ | -- | The structure of the server's URI was unparseable.
+ AnnouncementStructureUnmatched
deriving (Eq, Ord, Show)
+{- | Interpret the location in an announcement as a Tahoe-LAFS fURL pointed at
+ a Great Black Swamp server.
+-}
announcementToStorageServer :: MonadIO m => StorageServerAnnouncement -> m (Either LookupError StorageServer)
announcementToStorageServer ann =
case greatBlackSwampURIs ann of
@@ -281,7 +288,7 @@ makeServer
{ uriScheme = "pb:"
, uriAuthority = Just URIAuth{uriUserInfo = tubid, uriRegName = host, uriPort = (':' : port)}
, uriPath = ('/' : swissnum)
- , uriFragment = "" -- Where's the #v=1 ???
+ , uriFragment = "" -- It's a fURL, not a NURL, so there's no fragment.
} =
case readMaybe port of
Nothing -> pure . Left . PortParseError $ port
@@ -290,12 +297,15 @@ makeServer
manager <- liftIO $ newGBSManager tubid swissnum
print' "Made it"
- pure $ wrapGreatBlackSwamp manager host realPort
+ pure . Right $ wrapGreatBlackSwamp manager host realPort
makeServer _ = pure . Left $ AnnouncementStructureUnmatched
-wrapGreatBlackSwamp :: Manager -> [Char] -> Int -> Either a StorageServer
+{- | Create a StorageServer that will speak Great Black Swamp using the given
+ manager to the server at the given host/port.
+-}
+wrapGreatBlackSwamp :: Manager -> [Char] -> Int -> StorageServer
wrapGreatBlackSwamp manager host realPort =
- Right $ StorageServer{..}
+ StorageServer{..}
where
baseUrl = https host realPort
env = mkClientEnv manager baseUrl
@@ -332,6 +342,7 @@ wrapGreatBlackSwamp manager host realPort =
throwIO err
Right (CBORSet s) -> pure $ Set.map (\(ShareNumber i) -> fromIntegral i) s -- XXX fromIntegral aaaaaaaa!!
+-- | Make an HTTPS URL.
https :: String -> Int -> BaseUrl
https host port =
BaseUrl
@@ -341,6 +352,11 @@ https host port =
, baseUrlPath = ""
}
+{- | Make an HTTPS manager for the given SPKI hash and swissnum.
+
+ The SPKI hash is _not_ used to authenticate the server! See
+ https://whetstone.private.storage/privatestorage/tahoe-great-black-swamp/-/issues/27
+-}
managerSettingsForService :: T.Text -> T.Text -> ManagerSettings
managerSettingsForService _ swissnum =
(mkManagerSettings tlsSettings sockSettings){managerModifyRequest = pure . authorize}
@@ -359,6 +375,7 @@ managerSettingsForService _ swissnum =
requestHeaders req
}
+-- | Make a manager suitable for use with a Great Black Swamp server.
newGBSManager ::
MonadIO m =>
[Char] ->
--
GitLab