Immutable.hs

module Tahoe.Download.Internal.Immutable where

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 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.
-}
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
        res <- runClientM clientm env
        case res of
            Left err -> do
                throwIO err
            Right bs -> pure bs

    storageServerGetBuckets storageIndex = do
        let clientm = getImmutableShareNumbers (toBase32 storageIndex)
        r <- try $ runClientM clientm env
        case r of
            Left (_ :: SomeException) -> do
                pure mempty
            Right res -> do
                case res of
                    Left err -> do
                        throwIO err
                    Right (CBORSet s) -> pure $ Set.map (\(ShareNumber i) -> fromIntegral i) s -- XXX fromIntegral aaaaaaaa!!