{-# LANGUAGE DataKinds #-}
module TahoeLAFS.Storage.Backend (
Backend (..),
ImmutableShareAlreadyWritten (ImmutableShareAlreadyWritten),
writeMutableShare,
) where
import Control.Exception (
Exception,
throw,
)
import Data.Map.Strict (
fromList,
)
import qualified Data.Set as Set
import Network.HTTP.Types (
ByteRanges,
)
import TahoeLAFS.Storage.API (
AllocateBuckets,
AllocationResult,
CBOR,
CBORSet (..),
CorruptionDetails,
LeaseSecret,
Offset,
QueryRange,
ReadResult,
ReadTestWriteResult (..),
ReadTestWriteVectors (..),
ShareData,
ShareNumber,
Size,
SlotSecrets,
StorageIndex,
TestWriteVectors (..),
Version,
WriteVector (..),
)
data ImmutableShareAlreadyWritten = ImmutableShareAlreadyWritten
deriving (Int -> ImmutableShareAlreadyWritten -> ShowS
[ImmutableShareAlreadyWritten] -> ShowS
ImmutableShareAlreadyWritten -> String
(Int -> ImmutableShareAlreadyWritten -> ShowS)
-> (ImmutableShareAlreadyWritten -> String)
-> ([ImmutableShareAlreadyWritten] -> ShowS)
-> Show ImmutableShareAlreadyWritten
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImmutableShareAlreadyWritten] -> ShowS
$cshowList :: [ImmutableShareAlreadyWritten] -> ShowS
show :: ImmutableShareAlreadyWritten -> String
$cshow :: ImmutableShareAlreadyWritten -> String
showsPrec :: Int -> ImmutableShareAlreadyWritten -> ShowS
$cshowsPrec :: Int -> ImmutableShareAlreadyWritten -> ShowS
Show)
instance Exception ImmutableShareAlreadyWritten
class Backend b where
version :: b -> IO Version
renewLease :: b -> StorageIndex -> [LeaseSecret] -> IO ()
createImmutableStorageIndex :: b -> StorageIndex -> AllocateBuckets -> IO AllocationResult
writeImmutableShare :: b -> StorageIndex -> ShareNumber -> ShareData -> Maybe ByteRanges -> IO ()
adviseCorruptImmutableShare :: b -> StorageIndex -> ShareNumber -> CorruptionDetails -> IO ()
getImmutableShareNumbers :: b -> StorageIndex -> IO (CBORSet ShareNumber)
readImmutableShare :: b -> StorageIndex -> ShareNumber -> QueryRange -> IO ShareData
createMutableStorageIndex :: b -> StorageIndex -> AllocateBuckets -> IO AllocationResult
readvAndTestvAndWritev :: b -> StorageIndex -> ReadTestWriteVectors -> IO ReadTestWriteResult
readMutableShare :: b -> StorageIndex -> ShareNumber -> QueryRange -> IO ShareData
getMutableShareNumbers :: b -> StorageIndex -> IO (CBORSet ShareNumber)
adviseCorruptMutableShare :: b -> StorageIndex -> ShareNumber -> CorruptionDetails -> IO ()
writeMutableShare ::
Backend b =>
b ->
SlotSecrets ->
StorageIndex ->
ShareNumber ->
ShareData ->
Maybe ByteRanges ->
IO ()
writeMutableShare :: b
-> SlotSecrets
-> String
-> ShareNumber
-> ShareData
-> Maybe ByteRanges
-> IO ()
writeMutableShare b
b SlotSecrets
secrets String
storageIndex ShareNumber
shareNumber ShareData
shareData Maybe ByteRanges
Nothing = do
let testWriteVectors :: Map ShareNumber TestWriteVectors
testWriteVectors =
[(ShareNumber, TestWriteVectors)]
-> Map ShareNumber TestWriteVectors
forall k a. Ord k => [(k, a)] -> Map k a
fromList
[
( ShareNumber
shareNumber
, TestWriteVectors :: [TestVector] -> [WriteVector] -> TestWriteVectors
TestWriteVectors
{ test :: [TestVector]
test = []
, write :: [WriteVector]
write =
[ WriteVector :: Offset -> ShareData -> WriteVector
WriteVector
{ writeOffset :: Offset
writeOffset = Offset
0
, shareData :: ShareData
shareData = ShareData
shareData
}
]
}
)
]
let vectors :: ReadTestWriteVectors
vectors =
ReadTestWriteVectors :: SlotSecrets
-> Map ShareNumber TestWriteVectors
-> [ReadVector]
-> ReadTestWriteVectors
ReadTestWriteVectors
{ secrets :: SlotSecrets
secrets = SlotSecrets
secrets
, testWriteVectors :: Map ShareNumber TestWriteVectors
testWriteVectors = Map ShareNumber TestWriteVectors
testWriteVectors
, readVector :: [ReadVector]
readVector = [ReadVector]
forall a. Monoid a => a
mempty
}
ReadTestWriteResult
result <- b -> String -> ReadTestWriteVectors -> IO ReadTestWriteResult
forall b.
Backend b =>
b -> String -> ReadTestWriteVectors -> IO ReadTestWriteResult
readvAndTestvAndWritev b
b String
storageIndex ReadTestWriteVectors
vectors
if ReadTestWriteResult -> Bool
success ReadTestWriteResult
result
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else WriteRefused -> IO ()
forall a e. Exception e => e -> a
throw WriteRefused
WriteRefused
writeMutableShare b
_ SlotSecrets
_ String
_ ShareNumber
_ ShareData
_ Maybe ByteRanges
_ = String -> IO ()
forall a. HasCallStack => String -> a
error String
"writeMutableShare got bad input"
data WriteRefused = WriteRefused deriving (Int -> WriteRefused -> ShowS
[WriteRefused] -> ShowS
WriteRefused -> String
(Int -> WriteRefused -> ShowS)
-> (WriteRefused -> String)
-> ([WriteRefused] -> ShowS)
-> Show WriteRefused
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteRefused] -> ShowS
$cshowList :: [WriteRefused] -> ShowS
show :: WriteRefused -> String
$cshow :: WriteRefused -> String
showsPrec :: Int -> WriteRefused -> ShowS
$cshowsPrec :: Int -> WriteRefused -> ShowS
Show, WriteRefused -> WriteRefused -> Bool
(WriteRefused -> WriteRefused -> Bool)
-> (WriteRefused -> WriteRefused -> Bool) -> Eq WriteRefused
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteRefused -> WriteRefused -> Bool
$c/= :: WriteRefused -> WriteRefused -> Bool
== :: WriteRefused -> WriteRefused -> Bool
$c== :: WriteRefused -> WriteRefused -> Bool
Eq)
instance Exception WriteRefused