diff --git a/test/NullServer.hs b/test/NullServer.hs deleted file mode 100644 index 4f5d8b69f88ec72ab9bb92e24e0c19f5638ee5aa..0000000000000000000000000000000000000000 --- a/test/NullServer.hs +++ /dev/null @@ -1,109 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module NullServer where - -import Data.ByteString.Base64 ( - encodeBase64, - ) -import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe) -import qualified Data.Set as Set - -import Tahoe.CHK.Types ( - Offset, - ShareNum, - StorageIndex, - StorageServer (..), - ) - -import Data.IORef ( - IORef, - modifyIORef', - newIORef, - readIORef, - ) - -import System.Directory ( - createDirectoryIfMissing, - ) -import System.FilePath ( - takeDirectory, - ) - -import qualified Data.ByteString as BS -import qualified Data.Text as T -import System.IO ( - IOMode (..), - SeekMode (..), - hSeek, - withFile, - ) - -import Control.Exception ( - Exception, - throwIO, - ) - -nullStorageServer :: StorageServer -nullStorageServer = - StorageServer - { storageServerID = "null-server" - , storageServerWrite = \_index _sharenum _offset _data -> return () - , storageServerRead = \_index _sharenum -> throwIO IThrewYourDataAway - , storageServerGetBuckets = \_index -> return mempty - } - -data ReadError = IThrewYourDataAway deriving (Show) -instance Exception ReadError - -directoryServer :: FilePath -> StorageServer -directoryServer p = - StorageServer - { storageServerID = T.pack p - , storageServerWrite = \index sharenum offset sharedata -> do - let path = sharePath p (T.unpack $ encodeBase64 index) sharenum - createDirectoryIfMissing True (takeDirectory path) - withFile path ReadWriteMode $ \f -> do - hSeek f AbsoluteSeek offset - BS.hPut f sharedata - , storageServerRead = \index sharenum -> - withFile (sharePath p (T.unpack $ encodeBase64 index) sharenum) ReadMode BS.hGetContents - , storageServerGetBuckets = \_index -> return mempty - } - where - sharePath p' index sharenum = p' <> "/" <> index <> "/" <> show sharenum - -memoryStorageServer :: IO StorageServer -memoryStorageServer = do - shares :: IORef (M.Map (StorageIndex, ShareNum) BS.ByteString) <- newIORef mempty - - let storageServerID = "memory" - - storageServerWrite index sharenum offset sharedata = - modifyIORef' shares $ M.alter (appendBytes offset sharedata) (index, sharenum) - - appendBytes :: Offset -> BS.ByteString -> Maybe BS.ByteString -> Maybe BS.ByteString - appendBytes 0 sharedata Nothing = Just sharedata - appendBytes n _sharedata Nothing = - error $ - "memoryStorageServer appendBytes requires append-only usage; 0 bytes written but offset is " - <> show n - appendBytes n sharedata (Just existing) - | fromIntegral (BS.length existing) /= n = - error $ - "memoryStorageServer appendBytes requires append-only usage; " - <> show (BS.length existing) - <> " bytes written but offset is " - <> show n - | otherwise = Just (existing <> sharedata) - - storageServerRead :: StorageIndex -> ShareNum -> IO BS.ByteString - storageServerRead index sharenum = - fromMaybe "" . M.lookup (index, sharenum) <$> readIORef shares - - storageServerGetBuckets :: StorageIndex -> IO (Set.Set ShareNum) - storageServerGetBuckets index = - Set.fromList . map snd . filter ((== index) . fst) . M.keys <$> readIORef shares - - pure $ StorageServer{..}