{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Tahoe.CHK.Upload (
UploadResult (uploadResultReadCap, uploadResultExistingShares, uploadResultShareMap),
Uploadable (..),
Parameters (Parameters),
defaultParameters,
filesystemUploadable,
filesystemUploadableWithConvergence,
filesystemUploadableRandomConvergence,
memoryUploadableWithConvergence,
getConvergentKey,
upload,
store,
prettyFormatSharemap,
adjustSegmentSize,
encryptAndEncode,
) where
import Control.Monad.Conc.Class (
modifyIORefCAS,
)
import Data.Maybe (
fromJust,
)
import Data.List (
intersperse,
)
import Data.IORef (
newIORef,
)
import qualified Data.Binary as Binary
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Text (
Text,
intercalate,
pack,
)
import qualified Data.Text as Text
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Tahoe.CHK.Capability as Cap
import System.IO (
IOMode (ReadMode),
hFileSize,
hSetBinaryMode,
openBinaryFile,
openFile,
)
import Crypto.Cipher.AES (AES128)
import Crypto.Cipher.Types (BlockCipher, Cipher (cipherInit, cipherKeySize), KeySizeSpecifier (..))
import "cryptonite" Crypto.Random (getRandomBytes)
import Tahoe.CHK.Cipher (Key)
import Tahoe.CHK.Crypto (
convergenceEncryptionHashLazy,
storageIndexHash,
)
import Tahoe.CHK.Server (
ShareMap,
StorageServer (..),
)
import Tahoe.CHK.Types (
Parameters (Parameters),
ShareNum,
Size,
StorageIndex,
)
import Tahoe.Util (nextMultipleOf)
import Crypto.Error (maybeCryptoError)
import Data.Tuple.Extra (thd3)
import Tahoe.CHK (
encode,
)
import Tahoe.CHK.Encrypt (encryptLazy)
data Uploadable = Uploadable
{ Uploadable -> Key AES128
uploadableKey :: Key AES128
, Uploadable -> Size
uploadableSize :: Size
, Uploadable -> Parameters
uploadableParameters :: Parameters
, Uploadable -> Size -> IO ByteString
uploadableReadCleartext :: Integer -> IO B.ByteString
}
data UploadResult = UploadResult
{ UploadResult -> Reader
uploadResultReadCap :: Cap.Reader
, UploadResult -> Size
uploadResultExistingShares :: Integer
, UploadResult -> ShareMap
uploadResultShareMap :: ShareMap
}
deriving (Int -> UploadResult -> ShowS
[UploadResult] -> ShowS
UploadResult -> String
(Int -> UploadResult -> ShowS)
-> (UploadResult -> String)
-> ([UploadResult] -> ShowS)
-> Show UploadResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadResult] -> ShowS
$cshowList :: [UploadResult] -> ShowS
show :: UploadResult -> String
$cshow :: UploadResult -> String
showsPrec :: Int -> UploadResult -> ShowS
$cshowsPrec :: Int -> UploadResult -> ShowS
Show)
locateAllShareholders :: StorageIndex -> [StorageServer] -> IO ShareMap
locateAllShareholders :: ByteString -> [StorageServer] -> IO ShareMap
locateAllShareholders ByteString
storageIndex [StorageServer]
servers =
(Set StorageServer -> Set StorageServer -> Set StorageServer)
-> [ShareMap] -> ShareMap
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set StorageServer -> Set StorageServer -> Set StorageServer
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([ShareMap] -> ShareMap) -> IO [ShareMap] -> IO ShareMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorageServer -> IO ShareMap) -> [StorageServer] -> IO [ShareMap]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM StorageServer -> IO ShareMap
getBuckets [StorageServer]
servers
where
getBuckets :: StorageServer -> IO ShareMap
getBuckets :: StorageServer -> IO ShareMap
getBuckets StorageServer
s = do
Set Int
buckets <- StorageServer -> ByteString -> IO (Set Int)
storageServerGetBuckets StorageServer
s ByteString
storageIndex
ShareMap -> IO ShareMap
forall (m :: * -> *) a. Monad m => a -> m a
return (ShareMap -> IO ShareMap) -> ShareMap -> IO ShareMap
forall a b. (a -> b) -> a -> b
$ (Int -> Set StorageServer) -> Set Int -> ShareMap
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set StorageServer -> Int -> Set StorageServer
forall a b. a -> b -> a
const (Set StorageServer -> Int -> Set StorageServer)
-> Set StorageServer -> Int -> Set StorageServer
forall a b. (a -> b) -> a -> b
$ StorageServer -> Set StorageServer
forall a. a -> Set a
Set.singleton StorageServer
s) Set Int
buckets
planSharePlacement :: Parameters -> StorageIndex -> ShareMap -> [StorageServer] -> ShareMap
planSharePlacement :: Parameters -> ByteString -> ShareMap -> [StorageServer] -> ShareMap
planSharePlacement (Parameters Size
_ Total
total Int
_ Total
_) ByteString
_storageIndex ShareMap
_currentShares [StorageServer]
servers =
[(Int, Set StorageServer)] -> ShareMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Int
shareNum, StorageServer -> Set StorageServer
forall a. a -> Set a
Set.singleton StorageServer
server)
| (Int
shareNum, StorageServer
server) <- [Int] -> [StorageServer] -> [(Int, StorageServer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. (Total -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Total
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ([StorageServer] -> [StorageServer]
forall a. [a] -> [a]
cycle [StorageServer]
servers)
]
uploadImmutableShares ::
StorageIndex ->
[(ShareNum, StorageServer, BL.ByteString)] ->
IO ()
uploadImmutableShares :: ByteString -> [(Int, StorageServer, ByteString)] -> IO ()
uploadImmutableShares ByteString
storageIndex [(Int, StorageServer, ByteString)]
uploads =
Size -> IO ()
uploadChunks Size
0
where
chunkSize :: Size
chunkSize = Size
1024 Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
1024
uploadChunks :: Size -> IO ()
uploadChunks Size
offset = do
Bool
res <- Size -> ByteString -> Size -> IO Bool
uploadChunk Size
chunkSize ByteString
storageIndex Size
offset
if Bool
res
then Size -> IO ()
uploadChunks (Size
offset Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
chunkSize)
else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
uploadChunk ::
Integer ->
StorageIndex ->
Integer ->
IO Bool
uploadChunk :: Size -> ByteString -> Size -> IO Bool
uploadChunk Size
size ByteString
storageIndex' Size
offset =
if (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString
"" ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/=) [ByteString]
chunks
then ((Int, StorageServer, ByteString) -> IO ())
-> [(Int, StorageServer, ByteString)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Size -> ByteString -> (Int, StorageServer, ByteString) -> IO ()
uploadOneChunk Size
offset ByteString
storageIndex') [(Int, StorageServer, ByteString)]
uploads IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
where
chunks :: [ByteString]
chunks = ((Int, StorageServer, ByteString) -> ByteString)
-> [(Int, StorageServer, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int64 -> ByteString -> ByteString
BL.take (Size -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size) (ByteString -> ByteString)
-> ((Int, StorageServer, ByteString) -> ByteString)
-> (Int, StorageServer, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
BL.drop (Size -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
offset) (ByteString -> ByteString)
-> ((Int, StorageServer, ByteString) -> ByteString)
-> (Int, StorageServer, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, StorageServer, ByteString) -> ByteString
forall a b c. (a, b, c) -> c
thd3) [(Int, StorageServer, ByteString)]
uploads
uploadOneChunk :: Size -> ByteString -> (Int, StorageServer, ByteString) -> IO ()
uploadOneChunk Size
offset ByteString
storageIndex' (Int
shareNum, StorageServer
server, ByteString
shareData) =
StorageServer -> ByteString -> Int -> Size -> ByteString -> IO ()
storageServerWrite StorageServer
server ByteString
storageIndex' Int
shareNum Size
offset (ByteString -> ByteString
BL.toStrict ByteString
shareData)
store ::
[StorageServer] ->
Uploadable ->
IO UploadResult
store :: [StorageServer] -> Uploadable -> IO UploadResult
store [StorageServer]
servers uploadable :: Uploadable
uploadable@(Uploadable Key AES128
key Size
_ Parameters
params Size -> IO ByteString
_) =
Uploadable -> IO ([ByteString], Reader)
encryptAndEncode Uploadable
uploadable IO ([ByteString], Reader)
-> (([ByteString], Reader) -> IO UploadResult) -> IO UploadResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [StorageServer]
-> Key AES128
-> Parameters
-> ([ByteString], Reader)
-> IO UploadResult
upload [StorageServer]
servers Key AES128
key Parameters
params
encryptAndEncode ::
Uploadable ->
IO ([BL.ByteString], Cap.Reader)
encryptAndEncode :: Uploadable -> IO ([ByteString], Reader)
encryptAndEncode (Uploadable Key AES128
readKey Size
_ Parameters
params Size -> IO ByteString
read') = do
ByteString
plaintext <- (Size -> IO ByteString) -> IO ByteString
readAll Size -> IO ByteString
read'
let ciphertext :: ByteString
ciphertext = Key AES128 -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
encryptLazy Key AES128
readKey ByteString
plaintext
([Share]
shares, Reader
cap) <- Key AES128 -> Parameters -> ByteString -> IO ([Share], Reader)
encode Key AES128
readKey Parameters
params ByteString
ciphertext
([ByteString], Reader) -> IO ([ByteString], Reader)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Share -> ByteString) -> [Share] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Share -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode [Share]
shares, Reader
cap)
where
readAll :: (Integer -> IO B.ByteString) -> IO BL.ByteString
readAll :: (Size -> IO ByteString) -> IO ByteString
readAll Size -> IO ByteString
f = do
ByteString
bs <- ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> IO ByteString
f (Size
1024 Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
32)
if ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
""
then ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""
else (ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Size -> IO ByteString) -> IO ByteString
readAll Size -> IO ByteString
f
upload ::
[StorageServer] ->
Key AES128 ->
Parameters ->
([BL.ByteString], Cap.Reader) ->
IO UploadResult
upload :: [StorageServer]
-> Key AES128
-> Parameters
-> ([ByteString], Reader)
-> IO UploadResult
upload [StorageServer]
servers Key AES128
key Parameters
params ([ByteString], Reader)
encoded = do
ShareMap
existingShares <- ByteString -> [StorageServer] -> IO ShareMap
locateAllShareholders ByteString
storageIndex [StorageServer]
servers
let targets :: ShareMap
targets = Parameters -> ShareMap -> ShareMap
targetServers Parameters
params ShareMap
existingShares
let ([ByteString]
streams, Reader
cap) = ([ByteString], Reader)
encoded
ByteString -> [(Int, StorageServer, ByteString)] -> IO ()
uploadImmutableShares ByteString
storageIndex (ShareMap -> [ByteString] -> [(Int, StorageServer, ByteString)]
uploads ShareMap
targets [ByteString]
streams)
UploadResult -> IO UploadResult
forall (m :: * -> *) a. Monad m => a -> m a
return (UploadResult -> IO UploadResult)
-> UploadResult -> IO UploadResult
forall a b. (a -> b) -> a -> b
$
UploadResult :: Reader -> Size -> ShareMap -> UploadResult
UploadResult
{ uploadResultReadCap :: Reader
uploadResultReadCap = Reader
cap
, uploadResultExistingShares :: Size
uploadResultExistingShares = Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ ShareMap -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShareMap
existingShares
, uploadResultShareMap :: ShareMap
uploadResultShareMap = ShareMap
targets
}
where
storageIndex :: StorageIndex
storageIndex :: ByteString
storageIndex = Key AES128 -> ByteString
storageIndexHash Key AES128
key
targetServers :: Parameters -> ShareMap -> ShareMap
targetServers :: Parameters -> ShareMap -> ShareMap
targetServers Parameters
parameters ShareMap
existingShares = Parameters -> ByteString -> ShareMap -> [StorageServer] -> ShareMap
planSharePlacement Parameters
parameters ByteString
storageIndex ShareMap
existingShares [StorageServer]
servers
uploads ::
ShareMap ->
[BL.ByteString] ->
[(ShareNum, StorageServer, BL.ByteString)]
uploads :: ShareMap -> [ByteString] -> [(Int, StorageServer, ByteString)]
uploads ShareMap
goal [ByteString]
shareDatav = (Int
-> Set StorageServer
-> [(Int, StorageServer, ByteString)]
-> [(Int, StorageServer, ByteString)])
-> [(Int, StorageServer, ByteString)]
-> ShareMap
-> [(Int, StorageServer, ByteString)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey ([ByteString]
-> Int
-> Set StorageServer
-> [(Int, StorageServer, ByteString)]
-> [(Int, StorageServer, ByteString)]
makeUpload [ByteString]
shareDatav) [] ShareMap
goal
where
makeUpload ::
[BL.ByteString] ->
ShareNum ->
Set.Set StorageServer ->
[(ShareNum, StorageServer, BL.ByteString)] ->
[(ShareNum, StorageServer, BL.ByteString)]
makeUpload :: [ByteString]
-> Int
-> Set StorageServer
-> [(Int, StorageServer, ByteString)]
-> [(Int, StorageServer, ByteString)]
makeUpload [ByteString]
shareDatav' Int
num Set StorageServer
servers' [(Int, StorageServer, ByteString)]
soFar =
[ ( Int
num
, StorageServer
server
, [ByteString]
shareDatav' [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num
)
| StorageServer
server <- Set StorageServer -> [StorageServer]
forall a. Set a -> [a]
Set.elems Set StorageServer
servers'
]
[(Int, StorageServer, ByteString)]
-> [(Int, StorageServer, ByteString)]
-> [(Int, StorageServer, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(Int, StorageServer, ByteString)]
soFar
defaultParameters :: Parameters
defaultParameters :: Parameters
defaultParameters = Size -> Total -> Int -> Total -> Parameters
Parameters (Size
128 Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
1024) Total
10 Int
7 Total
3
adjustSegmentSize :: Parameters -> Size -> Parameters
adjustSegmentSize :: Parameters -> Size -> Parameters
adjustSegmentSize (Parameters Size
segmentSize Total
total Int
happy Total
required) Size
dataSize =
Size -> Total -> Int -> Total -> Parameters
Parameters (Size -> Size
effectiveSegmentSize Size
dataSize) Total
total Int
happy Total
required
where
effectiveSegmentSize :: Size -> Size
effectiveSegmentSize =
Total -> Size -> Size
forall m v. (Integral m, Integral v) => m -> v -> v
nextMultipleOf Total
required (Size -> Size) -> (Size -> Size) -> Size -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Size -> Size
forall a. Ord a => a -> a -> a
min Size
segmentSize
filesystemUploadable :: Key AES128 -> FilePath -> Parameters -> IO Uploadable
filesystemUploadable :: Key AES128 -> String -> Parameters -> IO Uploadable
filesystemUploadable Key AES128
key String
path Parameters
params = do
Handle
fhandle <- String -> IOMode -> IO Handle
openBinaryFile String
path IOMode
ReadMode
Size
fsize <- Handle -> IO Size
hFileSize Handle
fhandle
Uploadable -> IO Uploadable
forall (m :: * -> *) a. Monad m => a -> m a
return (Uploadable -> IO Uploadable) -> Uploadable -> IO Uploadable
forall a b. (a -> b) -> a -> b
$
Uploadable :: Key AES128
-> Size -> Parameters -> (Size -> IO ByteString) -> Uploadable
Uploadable
{ uploadableKey :: Key AES128
uploadableKey = Key AES128
key
, uploadableSize :: Size
uploadableSize = Size
fsize
, uploadableParameters :: Parameters
uploadableParameters = Parameters -> Size -> Parameters
adjustSegmentSize Parameters
params Size
fsize
,
uploadableReadCleartext :: Size -> IO ByteString
uploadableReadCleartext = Handle -> Int -> IO ByteString
B.hGet Handle
fhandle (Int -> IO ByteString) -> (Size -> Int) -> Size -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
}
filesystemUploadableWithConvergence :: B.ByteString -> FilePath -> Parameters -> IO Uploadable
filesystemUploadableWithConvergence :: ByteString -> String -> Parameters -> IO Uploadable
filesystemUploadableWithConvergence ByteString
secret String
uploadablePath Parameters
params = do
Handle
uploadableHandle <- String -> IOMode -> IO Handle
openFile String
uploadablePath IOMode
ReadMode
Handle -> Bool -> IO ()
hSetBinaryMode Handle
uploadableHandle Bool
True
Size
size <- Handle -> IO Size
hFileSize Handle
uploadableHandle
ByteString
content <- Handle -> IO ByteString
BL.hGetContents Handle
uploadableHandle
ByteString -> Size -> ByteString -> Parameters -> IO Uploadable
memoryUploadableWithConvergence ByteString
secret Size
size ByteString
content Parameters
params
memoryUploadableWithConvergence :: B.ByteString -> Integer -> BL.ByteString -> Parameters -> IO Uploadable
memoryUploadableWithConvergence :: ByteString -> Size -> ByteString -> Parameters -> IO Uploadable
memoryUploadableWithConvergence ByteString
secret Size
size ByteString
content Parameters
params =
let key :: Key AES128
key = ByteString -> Parameters -> ByteString -> Key AES128
getConvergentKey ByteString
secret (Parameters -> Size -> Parameters
adjustSegmentSize Parameters
params Size
size) ByteString
content
in Key AES128 -> Size -> ByteString -> Parameters -> IO Uploadable
memoryUploadable Key AES128
key Size
size ByteString
content Parameters
params
memoryUploadable :: Key AES128 -> Integer -> BL.ByteString -> Parameters -> IO Uploadable
memoryUploadable :: Key AES128 -> Size -> ByteString -> Parameters -> IO Uploadable
memoryUploadable Key AES128
key Size
size ByteString
content Parameters
params =
let makeReader :: BL.ByteString -> IO (Integer -> IO BL.ByteString)
makeReader :: ByteString -> IO (Size -> IO ByteString)
makeReader ByteString
allContent =
let cas :: Int64 -> ByteString -> (ByteString, ByteString)
cas Int64
len ByteString
content' = (Int64 -> ByteString -> ByteString
BL.drop Int64
len ByteString
content', Int64 -> ByteString -> ByteString
BL.take Int64
len ByteString
content')
in do
IORef ByteString
contentRef <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
allContent
(Size -> IO ByteString) -> IO (Size -> IO ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Size -> IO ByteString) -> IO (Size -> IO ByteString))
-> (Size -> IO ByteString) -> IO (Size -> IO ByteString)
forall a b. (a -> b) -> a -> b
$ (IORef IO ByteString
-> (ByteString -> (ByteString, ByteString)) -> IO ByteString
forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
modifyIORefCAS IORef ByteString
IORef IO ByteString
contentRef ((ByteString -> (ByteString, ByteString)) -> IO ByteString)
-> (Int64 -> ByteString -> (ByteString, ByteString))
-> Int64
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> (ByteString, ByteString)
cas) (Int64 -> IO ByteString)
-> (Size -> Int64) -> Size -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
in do
Size -> IO ByteString
reader <- ByteString -> IO (Size -> IO ByteString)
makeReader ByteString
content
Uploadable -> IO Uploadable
forall (m :: * -> *) a. Monad m => a -> m a
return (Uploadable -> IO Uploadable) -> Uploadable -> IO Uploadable
forall a b. (a -> b) -> a -> b
$
Uploadable :: Key AES128
-> Size -> Parameters -> (Size -> IO ByteString) -> Uploadable
Uploadable
{ uploadableKey :: Key AES128
uploadableKey = Key AES128
key
, uploadableSize :: Size
uploadableSize = Size
size
, uploadableParameters :: Parameters
uploadableParameters = Parameters -> Size -> Parameters
adjustSegmentSize Parameters
params Size
size
,
uploadableReadCleartext :: Size -> IO ByteString
uploadableReadCleartext = (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO ByteString -> IO ByteString)
-> (Size -> IO ByteString) -> Size -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> IO ByteString
reader
}
getConvergentKey :: B.ByteString -> Parameters -> BL.ByteString -> Key AES128
getConvergentKey :: ByteString -> Parameters -> ByteString -> Key AES128
getConvergentKey ByteString
secret Parameters
params ByteString
content =
Maybe (Key AES128) -> Key AES128
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Key AES128) -> Key AES128)
-> (ByteString -> Maybe (Key AES128)) -> ByteString -> Key AES128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (Key AES128) -> Maybe (Key AES128)
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable (Key AES128) -> Maybe (Key AES128))
-> (ByteString -> CryptoFailable (Key AES128))
-> ByteString
-> Maybe (Key AES128)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable (Key AES128)
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit (ByteString -> Key AES128) -> ByteString -> Key AES128
forall a b. (a -> b) -> a -> b
$ ByteString -> Parameters -> ByteString -> ByteString
convergenceEncryptionHashLazy ByteString
secret Parameters
params ByteString
content
buildKeyIO :: forall cipher. BlockCipher cipher => IO (Key cipher)
buildKeyIO :: IO (Key cipher)
buildKeyIO = do
ScrubbedBytes
keyBytes <- Int -> IO ScrubbedBytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes @IO @ScrubbedBytes Int
keySize
Key cipher -> IO (Key cipher)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key cipher -> IO (Key cipher))
-> (ScrubbedBytes -> Key cipher)
-> ScrubbedBytes
-> IO (Key cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Key cipher) -> Key cipher
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Key cipher) -> Key cipher)
-> (ScrubbedBytes -> Maybe (Key cipher))
-> ScrubbedBytes
-> Key cipher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (Key cipher) -> Maybe (Key cipher)
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable (Key cipher) -> Maybe (Key cipher))
-> (ScrubbedBytes -> CryptoFailable (Key cipher))
-> ScrubbedBytes
-> Maybe (Key cipher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> CryptoFailable (Key cipher)
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit (ScrubbedBytes -> IO (Key cipher))
-> ScrubbedBytes -> IO (Key cipher)
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes
keyBytes
where
keySize :: Int
keySize = case cipher -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
cipherKeySize @cipher cipher
forall a. HasCallStack => a
undefined of
KeySizeRange Int
_ Int
high -> Int
high
KeySizeEnum [] -> String -> Int
forall a. HasCallStack => String -> a
error String
"no key sizes!"
KeySizeEnum (Int
s : [Int]
_) -> Int
s
KeySizeFixed Int
s -> Int
s
filesystemUploadableRandomConvergence :: FilePath -> Parameters -> IO Uploadable
filesystemUploadableRandomConvergence :: String -> Parameters -> IO Uploadable
filesystemUploadableRandomConvergence String
path Parameters
params = do
Key AES128
key <- IO (Key AES128)
forall cipher. BlockCipher cipher => IO (Key cipher)
buildKeyIO :: IO (Key AES128)
Key AES128 -> String -> Parameters -> IO Uploadable
filesystemUploadable Key AES128
key String
path Parameters
params
prettyFormatSharemap :: ShareMap -> Text
prettyFormatSharemap :: ShareMap -> Text
prettyFormatSharemap ShareMap
sharemap =
Text -> [Text] -> Text
intercalate
Text
"\n"
[ [Text] -> Text
Text.concat [Text
"\t", (Int, Set StorageServer) -> Text
showElem (Int, Set StorageServer)
elem']
| (Int, Set StorageServer)
elem' <- ShareMap -> [(Int, Set StorageServer)]
forall k a. Map k a -> [(k, a)]
Map.toList ShareMap
sharemap
]
where
showElem :: (ShareNum, Set.Set StorageServer) -> Text
showElem :: (Int, Set StorageServer) -> Text
showElem (Int
shareNum, Set StorageServer
servers) =
[Text] -> Text
Text.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
[ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
shareNum
, Text
":"
]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
", " ((StorageServer -> Text) -> [StorageServer] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map StorageServer -> Text
storageServerID (Set StorageServer -> [StorageServer]
forall a. Set a -> [a]
Set.toList Set StorageServer
servers))