diff --git a/cabal.project b/cabal.project
index 55be17a13a683db9dd1f7743b243c5f56a0f587a..74d6d74c4c8e7165997b6a65734cc6d03234a490 100644
--- a/cabal.project
+++ b/cabal.project
@@ -10,4 +10,4 @@ package zlib
-- fixes build failures when the underlying zlib is not in the
-- traditional location but is discoverable with pkg-config. It might
-- break non-pkg-config platforms.
- flags: +pkg-config
+ -- flags: +pkg-config
diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal
index 0312e51907c814bf571180adc41e61977864d352..ba2597aa1d6bdb02aadeb79eb14fd2a3f267a66b 100644
--- a/gbs-downloader.cabal
+++ b/gbs-downloader.cabal
@@ -81,6 +81,8 @@ library
exposed-modules:
Tahoe.Announcement
Tahoe.Download
+ Tahoe.Download.Internal.Client
+ Tahoe.Download.Internal.Immutable
-- Modules included in this library but not exported.
-- other-modules:
diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index e957769e353efa3528787c2106cd7b91f9b67d4d..108142053a039f9fc631b8ee750e41f6b6100922 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -294,90 +294,3 @@ makeServer
pure . Right $ wrapGreatBlackSwamp manager host realPort
makeServer _ = pure . Left $ AnnouncementStructureUnmatched
-
-{- | 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 =
- StorageServer{..}
- where
- baseUrl = https host realPort
- env = mkClientEnv manager baseUrl
- toBase32 = T.unpack . T.toLower . encodeBase32Unpadded
-
- storageServerID = undefined
-
- storageServerWrite = undefined
-
- storageServerRead storageIndex shareNum = do
- let clientm = readImmutableShare (toBase32 storageIndex) (ShareNumber $ fromIntegral shareNum) Nothing
- print' "Going to read from a server"
- res <- runClientM clientm env
- print' "Did it"
- case res of
- Left err -> do
- print' "Going to throw a damn IO error"
- throwIO err
- Right bs -> pure bs
-
- storageServerGetBuckets storageIndex = do
- let clientm = getImmutableShareNumbers (toBase32 storageIndex)
- print' "Going to get share numbers"
- r <- try $ runClientM clientm env
- case r of
- Left (err :: SomeException) -> do
- print' $ "A PROBLEM ARISES " <> show err
- pure mempty
- Right res -> do
- print' "Got the share numbers"
- case res of
- Left err -> do
- print' "Going to throw another IO error!!"
- 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
- { baseUrlScheme = Https
- , baseUrlHost = host
- , baseUrlPort = 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}
- where
- tlsSettings = TLSSettingsSimple True True True
- sockSettings = Nothing
- swissnumBytes = encodeUtf8 swissnum
- swissnumBase64 = Base64.encode swissnumBytes
- headerCompleteBytes = B.concat ["Tahoe-LAFS ", swissnumBase64]
- authorize req =
- req
- { requestHeaders =
- ( "Authorization"
- , headerCompleteBytes
- ) :
- requestHeaders req
- }
-
--- | Make a manager suitable for use with a Great Black Swamp server.
-newGBSManager ::
- MonadIO m =>
- [Char] ->
- String ->
- m Manager
-newGBSManager tubid swissnum =
- newTlsManagerWith $
- managerSettingsForService
- (T.pack . init $ tubid)
- (T.pack swissnum)
diff --git a/src/Tahoe/Download/Internal/Client.hs b/src/Tahoe/Download/Internal/Client.hs
new file mode 100644
index 0000000000000000000000000000000000000000..ee1e96656e04c11c3e2c039f72caf54534b1b9cf
--- /dev/null
+++ b/src/Tahoe/Download/Internal/Client.hs
@@ -0,0 +1,46 @@
+module Tahoe.Download.Internal.Client where
+
+-- | Make an HTTPS URL.
+https :: String -> Int -> BaseUrl
+https host port =
+ BaseUrl
+ { baseUrlScheme = Https
+ , baseUrlHost = host
+ , baseUrlPort = 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}
+ where
+ tlsSettings = TLSSettingsSimple True True True
+ sockSettings = Nothing
+ swissnumBytes = encodeUtf8 swissnum
+ swissnumBase64 = Base64.encode swissnumBytes
+ headerCompleteBytes = B.concat ["Tahoe-LAFS ", swissnumBase64]
+ authorize req =
+ req
+ { requestHeaders =
+ ( "Authorization"
+ , headerCompleteBytes
+ ) :
+ requestHeaders req
+ }
+
+-- | Make a manager suitable for use with a Great Black Swamp server.
+newGBSManager ::
+ MonadIO m =>
+ [Char] ->
+ String ->
+ m Manager
+newGBSManager tubid swissnum =
+ newTlsManagerWith $
+ managerSettingsForService
+ (T.pack . init $ tubid)
+ (T.pack swissnum)
diff --git a/src/Tahoe/Download/Internal/Immutable.hs b/src/Tahoe/Download/Internal/Immutable.hs
new file mode 100644
index 0000000000000000000000000000000000000000..1d9714fbcac4228ea674bc3fb2b191eabe0ceb0b
--- /dev/null
+++ b/src/Tahoe/Download/Internal/Immutable.hs
@@ -0,0 +1,50 @@
+module Tahoe.Download.Internal.Immutable where
+
+import Control.Exception (SomeException (SomeException))
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import Network.HTTP.Client (Manager)
+import Tahoe.CHK.Server (StorageServer (StorageServer))
+import TahoeLAFS.Storage.API (CBORSet (CBORSet), ShareNumber (ShareNumber))
+
+{- | 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 =
+ StorageServer{..}
+ where
+ baseUrl = https host realPort
+ env = mkClientEnv manager baseUrl
+ toBase32 = T.unpack . T.toLower . encodeBase32Unpadded
+
+ storageServerID = undefined
+
+ storageServerWrite = undefined
+
+ storageServerRead storageIndex shareNum = do
+ let clientm = readImmutableShare (toBase32 storageIndex) (ShareNumber $ fromIntegral shareNum) Nothing
+ print' "Going to read from a server"
+ res <- runClientM clientm env
+ print' "Did it"
+ case res of
+ Left err -> do
+ print' "Going to throw a damn IO error"
+ throwIO err
+ Right bs -> pure bs
+
+ storageServerGetBuckets storageIndex = do
+ let clientm = getImmutableShareNumbers (toBase32 storageIndex)
+ print' "Going to get share numbers"
+ r <- try $ runClientM clientm env
+ case r of
+ Left (err :: SomeException) -> do
+ print' $ "A PROBLEM ARISES " <> show err
+ pure mempty
+ Right res -> do
+ print' "Got the share numbers"
+ case res of
+ Left err -> do
+ print' "Going to throw another IO error!!"
+ throwIO err
+ Right (CBORSet s) -> pure $ Set.map (\(ShareNumber i) -> fromIntegral i) s -- XXX fromIntegral aaaaaaaa!!