Skip to content
Snippets Groups Projects
Immutable.hs 1.91 KiB
Newer Older
  • Learn to ignore specific revisions
  • 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!!