diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs index 108142053a039f9fc631b8ee750e41f6b6100922..77f701aab1baf9ce0770a7feb77ad14a8db73380 100644 --- a/src/Tahoe/Download.hs +++ b/src/Tahoe/Download.hs @@ -11,34 +11,25 @@ module Tahoe.Download ( announcementToStorageServer, ) where -import Control.Exception (Exception (displayException), SomeException, throwIO, try) +import Control.Exception (Exception (displayException), SomeException, try) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Bifunctor (Bifunctor (first, second)) import Data.Binary (Word16, decodeOrFail) import qualified Data.ByteString as B -import Data.ByteString.Base32 (encodeBase32Unpadded) -import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Lazy as LB import Data.Either (partitionEithers, rights) import Data.List (foldl') import qualified Data.Map.Strict as Map import qualified Data.Set as Set -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) -import Network.Connection (TLSSettings (TLSSettingsSimple)) -import Network.HTTP.Client (Manager, ManagerSettings (managerModifyRequest), Request (requestHeaders)) -import Network.HTTP.Client.TLS (mkManagerSettings, newTlsManagerWith) import Network.URI (URI (..), URIAuth (..)) -import Servant.Client (Scheme (Https), mkClientEnv, runClientM) -import Servant.Client.Core (BaseUrl (BaseUrl, baseUrlHost, baseUrlPath, baseUrlPort, baseUrlScheme)) import Tahoe.Announcement (StorageServerAnnouncement, greatBlackSwampURIs) import qualified Tahoe.CHK import Tahoe.CHK.Capability (Reader (..), Verifier (..)) import qualified Tahoe.CHK.Encrypt import Tahoe.CHK.Server (StorageServer (..), StorageServerID) import Tahoe.CHK.Types (ShareNum, StorageIndex) -import TahoeLAFS.Storage.API (CBORSet (..), ShareNumber (ShareNumber)) -import TahoeLAFS.Storage.Client (getImmutableShareNumbers, readImmutableShare) +import Tahoe.Download.Internal.Client +import Tahoe.Download.Internal.Immutable import Text.Read (readMaybe) print' :: MonadIO m => String -> m () diff --git a/src/Tahoe/Download/Internal/Client.hs b/src/Tahoe/Download/Internal/Client.hs index ee1e96656e04c11c3e2c039f72caf54534b1b9cf..4cccaa3eea81d5d229592e8c144e520948c1df5a 100644 --- a/src/Tahoe/Download/Internal/Client.hs +++ b/src/Tahoe/Download/Internal/Client.hs @@ -1,5 +1,15 @@ module Tahoe.Download.Internal.Client where +import Control.Monad.IO.Class +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.Text as T +import Data.Text.Encoding +import Network.Connection +import Network.HTTP.Client +import Network.HTTP.Client.TLS +import Servant.Client + -- | Make an HTTPS URL. https :: String -> Int -> BaseUrl https host port = diff --git a/src/Tahoe/Download/Internal/Immutable.hs b/src/Tahoe/Download/Internal/Immutable.hs index 1d9714fbcac4228ea674bc3fb2b191eabe0ceb0b..02a1153c2f92f0f074497c30c46e1be267ec5d00 100644 --- a/src/Tahoe/Download/Internal/Immutable.hs +++ b/src/Tahoe/Download/Internal/Immutable.hs @@ -1,11 +1,15 @@ module Tahoe.Download.Internal.Immutable where -import Control.Exception (SomeException (SomeException)) +import Control.Exception +import Data.ByteString.Base32 import qualified Data.Set as Set import qualified Data.Text as T import Network.HTTP.Client (Manager) -import Tahoe.CHK.Server (StorageServer (StorageServer)) +import Servant.Client +import Tahoe.CHK.Server (StorageServer (..)) +import Tahoe.Download.Internal.Client import TahoeLAFS.Storage.API (CBORSet (CBORSet), ShareNumber (ShareNumber)) +import TahoeLAFS.Storage.Client {- | Create a StorageServer that will speak Great Black Swamp using the given manager to the server at the given host/port. @@ -24,27 +28,20 @@ wrapGreatBlackSwamp manager host realPort = 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 + Left (_ :: SomeException) -> do 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!!