diff --git a/CHANGELOG.md b/CHANGELOG.md index 5600cc9d19af375d545283a115a888c7162c3222..70ee44bba3095f597016b6ca4f7a6ddf8be2a5a0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for gbs-downloader +## 0.2.0.0 -- YYYY-MM-DD + +* The download APIs now only send requests to a storage server after that + storage server is authenticated using information from the NURL. + ## 0.1.0.0 -- 2023-08-17 * First version. Released on an unsuspecting world. diff --git a/README.md b/README.md index 56fb22350bd927d34024a37b78004851baa5ad4b..2d547696975d630829003c0601ec09f79a289fc9 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ It aims for bit-for-bit compatibility with the original Python implementation. ### What is the current state? * It can download immutable and mutable shares from Great Black Swamp storage servers. - * It *does not* cryptographically verify the identity of servers it communicates with. + * It cryptographically verifies the identity of servers it communicates with. * It can interpret, decode, and decrypt the data for CHK- and SDMF-encoded shares to recover the plaintext. ## Why does it exist? diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal index dbd75c32991b7f7827721dda8b969f0e1a36df33..ee59009836230a852db53248c9e5bcaf2cc84042 100644 --- a/gbs-downloader.cabal +++ b/gbs-downloader.cabal @@ -123,7 +123,7 @@ library , servant-client-core >=0.16 && <0.21 , tahoe-chk >=0.2 && <0.3 , tahoe-directory >=0.1 && <0.2 - , tahoe-great-black-swamp >=0.3 && <0.4 + , tahoe-great-black-swamp >=0.3.1 && <0.4 , tahoe-ssk >=0.3 && <0.4 , text >=1.2.3.1 && <1.3 , yaml >=0.11.5.0 && <0.11.9.0 || >=0.11.9.0.0 && <0.12 diff --git a/src/Tahoe/Download/Internal/Client.hs b/src/Tahoe/Download/Internal/Client.hs index 43cc02e6b609319c18f36804146f77d35e005e52..76865c23dd8f5b030bcaa95d60cb7f7a4ac6e746 100644 --- a/src/Tahoe/Download/Internal/Client.hs +++ b/src/Tahoe/Download/Internal/Client.hs @@ -15,13 +15,14 @@ import Network.Connection import Network.HTTP.Client (Manager, ManagerSettings (managerModifyRequest), Request (requestHeaders)) import Network.HTTP.Client.TLS import Network.HTTP.Types (ByteRange) +import Network.URI (uriToString) import Servant.Client import Tahoe.Announcement import Tahoe.CHK.Server ( StorageServer (..), ) import TahoeLAFS.Storage.API (CBORSet (CBORSet), ShareNumber (ShareNumber)) -import Text.Read (readMaybe) +import TahoeLAFS.Storage.Client (NURL, parseNURL, runGBS) -- | Make an HTTPS URL. https :: String -> Int -> BaseUrl @@ -138,12 +139,10 @@ type ReadShare = String -> ShareNumber -> Maybe [ByteRange] -> ClientM B.ByteStr {- | Create a StorageServer that will speak Great Black Swamp using the given manager to the server at the given host/port. -} -mkWrapper :: GetShareNumbers -> ReadShare -> Manager -> [Char] -> Int -> StorageServer -mkWrapper getShareNumbers readShare manager host realPort = +mkWrapper :: GetShareNumbers -> ReadShare -> NURL -> StorageServer +mkWrapper getShareNumbers readShare nurl = StorageServer{..} where - baseUrl = https host realPort - env = mkClientEnv manager baseUrl toBase32 = T.unpack . T.toLower . encodeBase32Unpadded storageServerID = undefined @@ -152,7 +151,7 @@ mkWrapper getShareNumbers readShare manager host realPort = storageServerRead storageIndex shareNum = do let clientm = readShare (toBase32 storageIndex) (ShareNumber $ fromIntegral shareNum) Nothing - res <- runClientM clientm env + res <- runGBS nurl clientm case res of Left err -> do throwIO err @@ -160,7 +159,7 @@ mkWrapper getShareNumbers readShare manager host realPort = storageServerGetBuckets storageIndex = do let clientm = getShareNumbers (toBase32 storageIndex) - r <- try $ runClientM clientm env + r <- try $ runGBS nurl clientm case r of Left (_ :: SomeException) -> do pure mempty @@ -174,22 +173,10 @@ mkWrapper getShareNumbers readShare manager host realPort = on the server at the given URI. -} makeServer :: MonadIO m => GetShareNumbers -> ReadShare -> URI -> m (Either LookupError StorageServer) -makeServer - getShareNumbers - readShare - URI - { uriScheme = "pb:" - , uriAuthority = Just URIAuth{uriUserInfo = tubid, uriRegName = host, uriPort = (':' : port)} - , uriPath = ('/' : swissnum) - , uriFragment = "" -- It's a fURL, not a NURL, so there's no fragment. - } = - case readMaybe port of - Nothing -> pure . Left . PortParseError $ port - Just realPort -> do - manager <- liftIO $ newGBSManager tubid swissnum - - pure . Right $ mkWrapper getShareNumbers readShare manager host realPort -makeServer _ _ _ = pure . Left $ AnnouncementStructureUnmatched +makeServer getShareNumbers readShare uri = + pure $ case parseNURL (T.pack $ uriToString id uri "") of + Nothing -> Left AnnouncementStructureUnmatched + Just nurl -> Right $ mkWrapper getShareNumbers readShare nurl announcementToStorageServer :: MonadIO m => GetShareNumbers -> ReadShare -> StorageServerAnnouncement -> m (Either LookupError StorageServer) announcementToStorageServer getShareNumbers readShare ann =