{- | Types involved in the implementation of the backend for a Tahoe-LAFS
 storage server.
-}
module Tahoe.Storage.Backend where

import Control.Exception (
    Exception,
 )
import Data.Aeson (
    FromJSON (..),
    FromJSONKey (..),
    ToJSON (..),
    Value (String),
    object,
    withObject,
    withText,
    (.:),
    (.=),
 )
import Data.ByteArray (constEq)
import qualified Data.ByteString as B
import qualified "base64-bytestring" Data.ByteString.Base64 as Base64
import Data.Hashable (Hashable (hashWithSalt))
import Data.Map.Merge.Strict (merge, preserveMissing, zipWithMatched)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text.Encoding as T
import GHC.Generics (
    Generic,
 )
import Network.HTTP.Types (
    ByteRanges,
 )

-- | A human-readable description of the backend software in use.
type ApplicationVersion = B.ByteString

-- | Give certain operational details about this storage server.
data Version1Parameters = Version1Parameters
    { Version1Parameters -> Size
maximumImmutableShareSize :: Size
    , Version1Parameters -> Size
maximumMutableShareSize :: Size
    , Version1Parameters -> Size
availableSpace :: Size
    }
    deriving (Int -> Version1Parameters -> ShowS
[Version1Parameters] -> ShowS
Version1Parameters -> String
(Int -> Version1Parameters -> ShowS)
-> (Version1Parameters -> String)
-> ([Version1Parameters] -> ShowS)
-> Show Version1Parameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version1Parameters] -> ShowS
$cshowList :: [Version1Parameters] -> ShowS
show :: Version1Parameters -> String
$cshow :: Version1Parameters -> String
showsPrec :: Int -> Version1Parameters -> ShowS
$cshowsPrec :: Int -> Version1Parameters -> ShowS
Show, Version1Parameters -> Version1Parameters -> Bool
(Version1Parameters -> Version1Parameters -> Bool)
-> (Version1Parameters -> Version1Parameters -> Bool)
-> Eq Version1Parameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version1Parameters -> Version1Parameters -> Bool
$c/= :: Version1Parameters -> Version1Parameters -> Bool
== :: Version1Parameters -> Version1Parameters -> Bool
$c== :: Version1Parameters -> Version1Parameters -> Bool
Eq, (forall x. Version1Parameters -> Rep Version1Parameters x)
-> (forall x. Rep Version1Parameters x -> Version1Parameters)
-> Generic Version1Parameters
forall x. Rep Version1Parameters x -> Version1Parameters
forall x. Version1Parameters -> Rep Version1Parameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version1Parameters x -> Version1Parameters
$cfrom :: forall x. Version1Parameters -> Rep Version1Parameters x
Generic)

-- | Carry a version string and operational parameters.
data Version = Version
    { Version -> Version1Parameters
parameters :: Version1Parameters
    , Version -> ApplicationVersion
applicationVersion :: ApplicationVersion
    }
    deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)

-- | The number of bytes in some data.
type Size = Integer

{- | A position in some data identified by a number of bytes into that data
 from the beginning.
-}
type Offset = Integer

{- | Some ranges of data, possibly.  Nothing conventionally refers to the
 entire data.
-}
type QueryRange = Maybe ByteRanges

{- | An opaque identifier for a single storage area.  Multiple storage objects
 may exist at one storage index if they have different share numbers.  TODO:
 This should probably be ByteString instead.
-}
type StorageIndex = String

-- | Some data.
type ShareData = B.ByteString

{- | The identifier of a distinct storage object, unique within the context of
 a particular storage index.  In practice, values are in the range [0..255]
 (endpoints included).
-}
newtype ShareNumber = ShareNumber Integer
    deriving
        ( Int -> ShareNumber -> ShowS
[ShareNumber] -> ShowS
ShareNumber -> String
(Int -> ShareNumber -> ShowS)
-> (ShareNumber -> String)
-> ([ShareNumber] -> ShowS)
-> Show ShareNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShareNumber] -> ShowS
$cshowList :: [ShareNumber] -> ShowS
show :: ShareNumber -> String
$cshow :: ShareNumber -> String
showsPrec :: Int -> ShareNumber -> ShowS
$cshowsPrec :: Int -> ShareNumber -> ShowS
Show
        , ShareNumber -> ShareNumber -> Bool
(ShareNumber -> ShareNumber -> Bool)
-> (ShareNumber -> ShareNumber -> Bool) -> Eq ShareNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShareNumber -> ShareNumber -> Bool
$c/= :: ShareNumber -> ShareNumber -> Bool
== :: ShareNumber -> ShareNumber -> Bool
$c== :: ShareNumber -> ShareNumber -> Bool
Eq
        , Eq ShareNumber
Eq ShareNumber
-> (ShareNumber -> ShareNumber -> Ordering)
-> (ShareNumber -> ShareNumber -> Bool)
-> (ShareNumber -> ShareNumber -> Bool)
-> (ShareNumber -> ShareNumber -> Bool)
-> (ShareNumber -> ShareNumber -> Bool)
-> (ShareNumber -> ShareNumber -> ShareNumber)
-> (ShareNumber -> ShareNumber -> ShareNumber)
-> Ord ShareNumber
ShareNumber -> ShareNumber -> Bool
ShareNumber -> ShareNumber -> Ordering
ShareNumber -> ShareNumber -> ShareNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShareNumber -> ShareNumber -> ShareNumber
$cmin :: ShareNumber -> ShareNumber -> ShareNumber
max :: ShareNumber -> ShareNumber -> ShareNumber
$cmax :: ShareNumber -> ShareNumber -> ShareNumber
>= :: ShareNumber -> ShareNumber -> Bool
$c>= :: ShareNumber -> ShareNumber -> Bool
> :: ShareNumber -> ShareNumber -> Bool
$c> :: ShareNumber -> ShareNumber -> Bool
<= :: ShareNumber -> ShareNumber -> Bool
$c<= :: ShareNumber -> ShareNumber -> Bool
< :: ShareNumber -> ShareNumber -> Bool
$c< :: ShareNumber -> ShareNumber -> Bool
compare :: ShareNumber -> ShareNumber -> Ordering
$ccompare :: ShareNumber -> ShareNumber -> Ordering
$cp1Ord :: Eq ShareNumber
Ord
        , (forall x. ShareNumber -> Rep ShareNumber x)
-> (forall x. Rep ShareNumber x -> ShareNumber)
-> Generic ShareNumber
forall x. Rep ShareNumber x -> ShareNumber
forall x. ShareNumber -> Rep ShareNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShareNumber x -> ShareNumber
$cfrom :: forall x. ShareNumber -> Rep ShareNumber x
Generic
        )
    deriving newtype
        ( [ShareNumber] -> Encoding
[ShareNumber] -> Value
ShareNumber -> Encoding
ShareNumber -> Value
(ShareNumber -> Value)
-> (ShareNumber -> Encoding)
-> ([ShareNumber] -> Value)
-> ([ShareNumber] -> Encoding)
-> ToJSON ShareNumber
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ShareNumber] -> Encoding
$ctoEncodingList :: [ShareNumber] -> Encoding
toJSONList :: [ShareNumber] -> Value
$ctoJSONList :: [ShareNumber] -> Value
toEncoding :: ShareNumber -> Encoding
$ctoEncoding :: ShareNumber -> Encoding
toJSON :: ShareNumber -> Value
$ctoJSON :: ShareNumber -> Value
ToJSON
        , Value -> Parser [ShareNumber]
Value -> Parser ShareNumber
(Value -> Parser ShareNumber)
-> (Value -> Parser [ShareNumber]) -> FromJSON ShareNumber
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ShareNumber]
$cparseJSONList :: Value -> Parser [ShareNumber]
parseJSON :: Value -> Parser ShareNumber
$cparseJSON :: Value -> Parser ShareNumber
FromJSON
        , FromJSONKeyFunction [ShareNumber]
FromJSONKeyFunction ShareNumber
FromJSONKeyFunction ShareNumber
-> FromJSONKeyFunction [ShareNumber] -> FromJSONKey ShareNumber
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ShareNumber]
$cfromJSONKeyList :: FromJSONKeyFunction [ShareNumber]
fromJSONKey :: FromJSONKeyFunction ShareNumber
$cfromJSONKey :: FromJSONKeyFunction ShareNumber
FromJSONKey
        )

instance Hashable ShareNumber where
    hashWithSalt :: Int -> ShareNumber -> Int
hashWithSalt Int
i (ShareNumber Size
num) = Int -> Size -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i Size
num

{- | A new type for which we can define our own CBOR serialisation rules.  The
 cborg library provides a Serialise instance for Set which is not compatible
 with the representation required by Tahoe-LAFS.
-}
newtype CBORSet a = CBORSet
    { CBORSet a -> Set a
getCBORSet :: Set.Set a
    }
    deriving newtype ([CBORSet a] -> Encoding
[CBORSet a] -> Value
CBORSet a -> Encoding
CBORSet a -> Value
(CBORSet a -> Value)
-> (CBORSet a -> Encoding)
-> ([CBORSet a] -> Value)
-> ([CBORSet a] -> Encoding)
-> ToJSON (CBORSet a)
forall a. ToJSON a => [CBORSet a] -> Encoding
forall a. ToJSON a => [CBORSet a] -> Value
forall a. ToJSON a => CBORSet a -> Encoding
forall a. ToJSON a => CBORSet a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CBORSet a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [CBORSet a] -> Encoding
toJSONList :: [CBORSet a] -> Value
$ctoJSONList :: forall a. ToJSON a => [CBORSet a] -> Value
toEncoding :: CBORSet a -> Encoding
$ctoEncoding :: forall a. ToJSON a => CBORSet a -> Encoding
toJSON :: CBORSet a -> Value
$ctoJSON :: forall a. ToJSON a => CBORSet a -> Value
ToJSON, Value -> Parser [CBORSet a]
Value -> Parser (CBORSet a)
(Value -> Parser (CBORSet a))
-> (Value -> Parser [CBORSet a]) -> FromJSON (CBORSet a)
forall a. (Ord a, FromJSON a) => Value -> Parser [CBORSet a]
forall a. (Ord a, FromJSON a) => Value -> Parser (CBORSet a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CBORSet a]
$cparseJSONList :: forall a. (Ord a, FromJSON a) => Value -> Parser [CBORSet a]
parseJSON :: Value -> Parser (CBORSet a)
$cparseJSON :: forall a. (Ord a, FromJSON a) => Value -> Parser (CBORSet a)
FromJSON, Int -> CBORSet a -> ShowS
[CBORSet a] -> ShowS
CBORSet a -> String
(Int -> CBORSet a -> ShowS)
-> (CBORSet a -> String)
-> ([CBORSet a] -> ShowS)
-> Show (CBORSet a)
forall a. Show a => Int -> CBORSet a -> ShowS
forall a. Show a => [CBORSet a] -> ShowS
forall a. Show a => CBORSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CBORSet a] -> ShowS
$cshowList :: forall a. Show a => [CBORSet a] -> ShowS
show :: CBORSet a -> String
$cshow :: forall a. Show a => CBORSet a -> String
showsPrec :: Int -> CBORSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CBORSet a -> ShowS
Show, CBORSet a -> CBORSet a -> Bool
(CBORSet a -> CBORSet a -> Bool)
-> (CBORSet a -> CBORSet a -> Bool) -> Eq (CBORSet a)
forall a. Eq a => CBORSet a -> CBORSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CBORSet a -> CBORSet a -> Bool
$c/= :: forall a. Eq a => CBORSet a -> CBORSet a -> Bool
== :: CBORSet a -> CBORSet a -> Bool
$c== :: forall a. Eq a => CBORSet a -> CBORSet a -> Bool
Eq)

-- | Describe a client-detected incidence of data corruption.
newtype CorruptionDetails = CorruptionDetails
    { CorruptionDetails -> String
reason :: String
    }
    deriving (Int -> CorruptionDetails -> ShowS
[CorruptionDetails] -> ShowS
CorruptionDetails -> String
(Int -> CorruptionDetails -> ShowS)
-> (CorruptionDetails -> String)
-> ([CorruptionDetails] -> ShowS)
-> Show CorruptionDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CorruptionDetails] -> ShowS
$cshowList :: [CorruptionDetails] -> ShowS
show :: CorruptionDetails -> String
$cshow :: CorruptionDetails -> String
showsPrec :: Int -> CorruptionDetails -> ShowS
$cshowsPrec :: Int -> CorruptionDetails -> ShowS
Show, CorruptionDetails -> CorruptionDetails -> Bool
(CorruptionDetails -> CorruptionDetails -> Bool)
-> (CorruptionDetails -> CorruptionDetails -> Bool)
-> Eq CorruptionDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CorruptionDetails -> CorruptionDetails -> Bool
$c/= :: CorruptionDetails -> CorruptionDetails -> Bool
== :: CorruptionDetails -> CorruptionDetails -> Bool
$c== :: CorruptionDetails -> CorruptionDetails -> Bool
Eq, (forall x. CorruptionDetails -> Rep CorruptionDetails x)
-> (forall x. Rep CorruptionDetails x -> CorruptionDetails)
-> Generic CorruptionDetails
forall x. Rep CorruptionDetails x -> CorruptionDetails
forall x. CorruptionDetails -> Rep CorruptionDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CorruptionDetails x -> CorruptionDetails
$cfrom :: forall x. CorruptionDetails -> Rep CorruptionDetails x
Generic)

{- | A secret shared between a client and this storage server for the purpose
 of authorizing certain operations related to immutable uploads.
-}
newtype UploadSecret = UploadSecret B.ByteString

instance Eq UploadSecret where
    (UploadSecret ApplicationVersion
left) == :: UploadSecret -> UploadSecret -> Bool
== (UploadSecret ApplicationVersion
right) = ApplicationVersion -> ApplicationVersion -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
constEq ApplicationVersion
left ApplicationVersion
right

{- | A secret shared between an SSK write capability holder and this storage
 server for the purpose of authorizing write operations on a mutable object.
-}
newtype WriteEnablerSecret = WriteEnablerSecret B.ByteString

instance Eq WriteEnablerSecret where
    (WriteEnablerSecret ApplicationVersion
left) == :: WriteEnablerSecret -> WriteEnablerSecret -> Bool
== (WriteEnablerSecret ApplicationVersion
right) = ApplicationVersion -> ApplicationVersion -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
constEq ApplicationVersion
left ApplicationVersion
right

-- | Describe tests, reads, and writes to perform on a mutable object.
data ReadTestWriteVectors = ReadTestWriteVectors
    { ReadTestWriteVectors -> Map ShareNumber TestWriteVectors
testWriteVectors :: Map.Map ShareNumber TestWriteVectors
    , ReadTestWriteVectors -> [ReadVector]
readVector :: [ReadVector]
    }
    deriving (Int -> ReadTestWriteVectors -> ShowS
[ReadTestWriteVectors] -> ShowS
ReadTestWriteVectors -> String
(Int -> ReadTestWriteVectors -> ShowS)
-> (ReadTestWriteVectors -> String)
-> ([ReadTestWriteVectors] -> ShowS)
-> Show ReadTestWriteVectors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadTestWriteVectors] -> ShowS
$cshowList :: [ReadTestWriteVectors] -> ShowS
show :: ReadTestWriteVectors -> String
$cshow :: ReadTestWriteVectors -> String
showsPrec :: Int -> ReadTestWriteVectors -> ShowS
$cshowsPrec :: Int -> ReadTestWriteVectors -> ShowS
Show, ReadTestWriteVectors -> ReadTestWriteVectors -> Bool
(ReadTestWriteVectors -> ReadTestWriteVectors -> Bool)
-> (ReadTestWriteVectors -> ReadTestWriteVectors -> Bool)
-> Eq ReadTestWriteVectors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadTestWriteVectors -> ReadTestWriteVectors -> Bool
$c/= :: ReadTestWriteVectors -> ReadTestWriteVectors -> Bool
== :: ReadTestWriteVectors -> ReadTestWriteVectors -> Bool
$c== :: ReadTestWriteVectors -> ReadTestWriteVectors -> Bool
Eq, (forall x. ReadTestWriteVectors -> Rep ReadTestWriteVectors x)
-> (forall x. Rep ReadTestWriteVectors x -> ReadTestWriteVectors)
-> Generic ReadTestWriteVectors
forall x. Rep ReadTestWriteVectors x -> ReadTestWriteVectors
forall x. ReadTestWriteVectors -> Rep ReadTestWriteVectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadTestWriteVectors x -> ReadTestWriteVectors
$cfrom :: forall x. ReadTestWriteVectors -> Rep ReadTestWriteVectors x
Generic)

-- | Describe tests and writes to perform on a mutable object.
data TestWriteVectors = TestWriteVectors
    { TestWriteVectors -> [TestVector]
test :: [TestVector]
    , TestWriteVectors -> [WriteVector]
write :: [WriteVector]
    , -- | If given, truncate or extend the object to the given size.  If
      -- necessary, fill new space with NUL.
      TestWriteVectors -> Maybe Size
newLength :: Maybe Integer
    }
    deriving (Int -> TestWriteVectors -> ShowS
[TestWriteVectors] -> ShowS
TestWriteVectors -> String
(Int -> TestWriteVectors -> ShowS)
-> (TestWriteVectors -> String)
-> ([TestWriteVectors] -> ShowS)
-> Show TestWriteVectors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestWriteVectors] -> ShowS
$cshowList :: [TestWriteVectors] -> ShowS
show :: TestWriteVectors -> String
$cshow :: TestWriteVectors -> String
showsPrec :: Int -> TestWriteVectors -> ShowS
$cshowsPrec :: Int -> TestWriteVectors -> ShowS
Show, TestWriteVectors -> TestWriteVectors -> Bool
(TestWriteVectors -> TestWriteVectors -> Bool)
-> (TestWriteVectors -> TestWriteVectors -> Bool)
-> Eq TestWriteVectors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestWriteVectors -> TestWriteVectors -> Bool
$c/= :: TestWriteVectors -> TestWriteVectors -> Bool
== :: TestWriteVectors -> TestWriteVectors -> Bool
$c== :: TestWriteVectors -> TestWriteVectors -> Bool
Eq, (forall x. TestWriteVectors -> Rep TestWriteVectors x)
-> (forall x. Rep TestWriteVectors x -> TestWriteVectors)
-> Generic TestWriteVectors
forall x. Rep TestWriteVectors x -> TestWriteVectors
forall x. TestWriteVectors -> Rep TestWriteVectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestWriteVectors x -> TestWriteVectors
$cfrom :: forall x. TestWriteVectors -> Rep TestWriteVectors x
Generic, [TestWriteVectors] -> Encoding
[TestWriteVectors] -> Value
TestWriteVectors -> Encoding
TestWriteVectors -> Value
(TestWriteVectors -> Value)
-> (TestWriteVectors -> Encoding)
-> ([TestWriteVectors] -> Value)
-> ([TestWriteVectors] -> Encoding)
-> ToJSON TestWriteVectors
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TestWriteVectors] -> Encoding
$ctoEncodingList :: [TestWriteVectors] -> Encoding
toJSONList :: [TestWriteVectors] -> Value
$ctoJSONList :: [TestWriteVectors] -> Value
toEncoding :: TestWriteVectors -> Encoding
$ctoEncoding :: TestWriteVectors -> Encoding
toJSON :: TestWriteVectors -> Value
$ctoJSON :: TestWriteVectors -> Value
ToJSON, Value -> Parser [TestWriteVectors]
Value -> Parser TestWriteVectors
(Value -> Parser TestWriteVectors)
-> (Value -> Parser [TestWriteVectors])
-> FromJSON TestWriteVectors
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TestWriteVectors]
$cparseJSONList :: Value -> Parser [TestWriteVectors]
parseJSON :: Value -> Parser TestWriteVectors
$cparseJSON :: Value -> Parser TestWriteVectors
FromJSON)

-- | Describe a single test to perform on a mutable object.
data TestVector = TestVector
    { TestVector -> Size
testOffset :: Offset
    , TestVector -> Size
testSize :: Size
    , TestVector -> TestOperator
operator :: TestOperator
    , TestVector -> ApplicationVersion
specimen :: ShareData
    }
    deriving (Int -> TestVector -> ShowS
[TestVector] -> ShowS
TestVector -> String
(Int -> TestVector -> ShowS)
-> (TestVector -> String)
-> ([TestVector] -> ShowS)
-> Show TestVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestVector] -> ShowS
$cshowList :: [TestVector] -> ShowS
show :: TestVector -> String
$cshow :: TestVector -> String
showsPrec :: Int -> TestVector -> ShowS
$cshowsPrec :: Int -> TestVector -> ShowS
Show, TestVector -> TestVector -> Bool
(TestVector -> TestVector -> Bool)
-> (TestVector -> TestVector -> Bool) -> Eq TestVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestVector -> TestVector -> Bool
$c/= :: TestVector -> TestVector -> Bool
== :: TestVector -> TestVector -> Bool
$c== :: TestVector -> TestVector -> Bool
Eq, (forall x. TestVector -> Rep TestVector x)
-> (forall x. Rep TestVector x -> TestVector) -> Generic TestVector
forall x. Rep TestVector x -> TestVector
forall x. TestVector -> Rep TestVector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestVector x -> TestVector
$cfrom :: forall x. TestVector -> Rep TestVector x
Generic)

-- | Describe a single write to perform on a mutable object.
data WriteVector = WriteVector
    { WriteVector -> Size
writeOffset :: Offset
    , WriteVector -> ApplicationVersion
shareData :: ShareData
    }
    deriving (Int -> WriteVector -> ShowS
[WriteVector] -> ShowS
WriteVector -> String
(Int -> WriteVector -> ShowS)
-> (WriteVector -> String)
-> ([WriteVector] -> ShowS)
-> Show WriteVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteVector] -> ShowS
$cshowList :: [WriteVector] -> ShowS
show :: WriteVector -> String
$cshow :: WriteVector -> String
showsPrec :: Int -> WriteVector -> ShowS
$cshowsPrec :: Int -> WriteVector -> ShowS
Show, WriteVector -> WriteVector -> Bool
(WriteVector -> WriteVector -> Bool)
-> (WriteVector -> WriteVector -> Bool) -> Eq WriteVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteVector -> WriteVector -> Bool
$c/= :: WriteVector -> WriteVector -> Bool
== :: WriteVector -> WriteVector -> Bool
$c== :: WriteVector -> WriteVector -> Bool
Eq, (forall x. WriteVector -> Rep WriteVector x)
-> (forall x. Rep WriteVector x -> WriteVector)
-> Generic WriteVector
forall x. Rep WriteVector x -> WriteVector
forall x. WriteVector -> Rep WriteVector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WriteVector x -> WriteVector
$cfrom :: forall x. WriteVector -> Rep WriteVector x
Generic)

-- | Describe one read to perform on an immutable object.
data ReadVector = ReadVector
    { ReadVector -> Size
offset :: Offset
    , ReadVector -> Size
readSize :: Size
    }
    deriving (Int -> ReadVector -> ShowS
[ReadVector] -> ShowS
ReadVector -> String
(Int -> ReadVector -> ShowS)
-> (ReadVector -> String)
-> ([ReadVector] -> ShowS)
-> Show ReadVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadVector] -> ShowS
$cshowList :: [ReadVector] -> ShowS
show :: ReadVector -> String
$cshow :: ReadVector -> String
showsPrec :: Int -> ReadVector -> ShowS
$cshowsPrec :: Int -> ReadVector -> ShowS
Show, ReadVector -> ReadVector -> Bool
(ReadVector -> ReadVector -> Bool)
-> (ReadVector -> ReadVector -> Bool) -> Eq ReadVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadVector -> ReadVector -> Bool
$c/= :: ReadVector -> ReadVector -> Bool
== :: ReadVector -> ReadVector -> Bool
$c== :: ReadVector -> ReadVector -> Bool
Eq, (forall x. ReadVector -> Rep ReadVector x)
-> (forall x. Rep ReadVector x -> ReadVector) -> Generic ReadVector
forall x. Rep ReadVector x -> ReadVector
forall x. ReadVector -> Rep ReadVector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadVector x -> ReadVector
$cfrom :: forall x. ReadVector -> Rep ReadVector x
Generic)

{- | The result of a request to read and/or write some data from/to some
 shares.
-}
data ReadTestWriteResult = ReadTestWriteResult
    { ReadTestWriteResult -> Bool
success :: Bool
    , ReadTestWriteResult -> ReadResult
readData :: ReadResult
    }
    deriving (Int -> ReadTestWriteResult -> ShowS
[ReadTestWriteResult] -> ShowS
ReadTestWriteResult -> String
(Int -> ReadTestWriteResult -> ShowS)
-> (ReadTestWriteResult -> String)
-> ([ReadTestWriteResult] -> ShowS)
-> Show ReadTestWriteResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadTestWriteResult] -> ShowS
$cshowList :: [ReadTestWriteResult] -> ShowS
show :: ReadTestWriteResult -> String
$cshow :: ReadTestWriteResult -> String
showsPrec :: Int -> ReadTestWriteResult -> ShowS
$cshowsPrec :: Int -> ReadTestWriteResult -> ShowS
Show, ReadTestWriteResult -> ReadTestWriteResult -> Bool
(ReadTestWriteResult -> ReadTestWriteResult -> Bool)
-> (ReadTestWriteResult -> ReadTestWriteResult -> Bool)
-> Eq ReadTestWriteResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadTestWriteResult -> ReadTestWriteResult -> Bool
$c/= :: ReadTestWriteResult -> ReadTestWriteResult -> Bool
== :: ReadTestWriteResult -> ReadTestWriteResult -> Bool
$c== :: ReadTestWriteResult -> ReadTestWriteResult -> Bool
Eq, (forall x. ReadTestWriteResult -> Rep ReadTestWriteResult x)
-> (forall x. Rep ReadTestWriteResult x -> ReadTestWriteResult)
-> Generic ReadTestWriteResult
forall x. Rep ReadTestWriteResult x -> ReadTestWriteResult
forall x. ReadTestWriteResult -> Rep ReadTestWriteResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadTestWriteResult x -> ReadTestWriteResult
$cfrom :: forall x. ReadTestWriteResult -> Rep ReadTestWriteResult x
Generic)

-- | The result of a request to read some data from some shares.
type ReadResult = Map.Map ShareNumber [ShareData]

instance Semigroup TestWriteVectors where
    (TestWriteVectors [TestVector]
testL [WriteVector]
writeL Maybe Size
_) <> :: TestWriteVectors -> TestWriteVectors -> TestWriteVectors
<> (TestWriteVectors [TestVector]
testR [WriteVector]
writeR Maybe Size
newLengthR) =
        [TestVector] -> [WriteVector] -> Maybe Size -> TestWriteVectors
TestWriteVectors ([TestVector]
testL [TestVector] -> [TestVector] -> [TestVector]
forall a. Semigroup a => a -> a -> a
<> [TestVector]
testR) ([WriteVector]
writeL [WriteVector] -> [WriteVector] -> [WriteVector]
forall a. Semigroup a => a -> a -> a
<> [WriteVector]
writeR) Maybe Size
newLengthR

instance Monoid TestWriteVectors where
    mempty :: TestWriteVectors
mempty = [TestVector] -> [WriteVector] -> Maybe Size -> TestWriteVectors
TestWriteVectors [TestVector]
forall a. Monoid a => a
mempty [WriteVector]
forall a. Monoid a => a
mempty Maybe Size
forall a. Maybe a
Nothing

instance Monoid ReadTestWriteVectors where
    mempty :: ReadTestWriteVectors
mempty = Map ShareNumber TestWriteVectors
-> [ReadVector] -> ReadTestWriteVectors
ReadTestWriteVectors Map ShareNumber TestWriteVectors
forall a. Monoid a => a
mempty []

instance Semigroup ReadTestWriteVectors where
    (ReadTestWriteVectors Map ShareNumber TestWriteVectors
wv0 [ReadVector]
rv0) <> :: ReadTestWriteVectors
-> ReadTestWriteVectors -> ReadTestWriteVectors
<> (ReadTestWriteVectors Map ShareNumber TestWriteVectors
wv1 [ReadVector]
rv1) =
        Map ShareNumber TestWriteVectors
-> [ReadVector] -> ReadTestWriteVectors
ReadTestWriteVectors (SimpleWhenMissing ShareNumber TestWriteVectors TestWriteVectors
-> SimpleWhenMissing ShareNumber TestWriteVectors TestWriteVectors
-> SimpleWhenMatched
     ShareNumber TestWriteVectors TestWriteVectors TestWriteVectors
-> Map ShareNumber TestWriteVectors
-> Map ShareNumber TestWriteVectors
-> Map ShareNumber TestWriteVectors
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge SimpleWhenMissing ShareNumber TestWriteVectors TestWriteVectors
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing SimpleWhenMissing ShareNumber TestWriteVectors TestWriteVectors
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing ((ShareNumber
 -> TestWriteVectors -> TestWriteVectors -> TestWriteVectors)
-> SimpleWhenMatched
     ShareNumber TestWriteVectors TestWriteVectors TestWriteVectors
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched ((ShareNumber
  -> TestWriteVectors -> TestWriteVectors -> TestWriteVectors)
 -> SimpleWhenMatched
      ShareNumber TestWriteVectors TestWriteVectors TestWriteVectors)
-> (ShareNumber
    -> TestWriteVectors -> TestWriteVectors -> TestWriteVectors)
-> SimpleWhenMatched
     ShareNumber TestWriteVectors TestWriteVectors TestWriteVectors
forall a b. (a -> b) -> a -> b
$ \ShareNumber
_ TestWriteVectors
l TestWriteVectors
r -> TestWriteVectors
l TestWriteVectors -> TestWriteVectors -> TestWriteVectors
forall a. Semigroup a => a -> a -> a
<> TestWriteVectors
r) Map ShareNumber TestWriteVectors
wv0 Map ShareNumber TestWriteVectors
wv1) ([ReadVector]
rv0 [ReadVector] -> [ReadVector] -> [ReadVector]
forall a. Semigroup a => a -> a -> a
<> [ReadVector]
rv1)

{- | Create a ReadTestWriteVectors which performs one read at the given offset
 of the given size.
-}
readv :: Offset -> Size -> ReadTestWriteVectors
readv :: Size -> Size -> ReadTestWriteVectors
readv Size
offset Size
size = ReadTestWriteVectors
forall a. Monoid a => a
mempty{readVector :: [ReadVector]
readVector = [Size -> Size -> ReadVector
ReadVector Size
offset Size
size]}

{- | Create a ReadTestWriteVectors which performs one write on the given share
 number at the given offset.
-}
writev :: ShareNumber -> Offset -> ShareData -> ReadTestWriteVectors
writev :: ShareNumber -> Size -> ApplicationVersion -> ReadTestWriteVectors
writev ShareNumber
shareNum Size
offset ApplicationVersion
bytes = ReadTestWriteVectors
forall a. Monoid a => a
mempty{testWriteVectors :: Map ShareNumber TestWriteVectors
testWriteVectors = ShareNumber -> TestWriteVectors -> Map ShareNumber TestWriteVectors
forall k a. k -> a -> Map k a
Map.singleton ShareNumber
shareNum (TestWriteVectors
forall a. Monoid a => a
mempty{write :: [WriteVector]
write = [Size -> ApplicationVersion -> WriteVector
WriteVector Size
offset ApplicationVersion
bytes]})}

{- | Create a ReadTestWriteVectors which performs one test on the given share
 number using the given specimen.
-}
testv :: ShareNumber -> Offset -> ShareData -> ReadTestWriteVectors
testv :: ShareNumber -> Size -> ApplicationVersion -> ReadTestWriteVectors
testv ShareNumber
shareNum Size
offset ApplicationVersion
specimen =
    ReadTestWriteVectors
forall a. Monoid a => a
mempty
        { testWriteVectors :: Map ShareNumber TestWriteVectors
testWriteVectors = ShareNumber -> TestWriteVectors -> Map ShareNumber TestWriteVectors
forall k a. k -> a -> Map k a
Map.singleton ShareNumber
shareNum (TestWriteVectors
forall a. Monoid a => a
mempty{test :: [TestVector]
test = [Size -> Size -> TestOperator -> ApplicationVersion -> TestVector
TestVector Size
offset (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ ApplicationVersion -> Int
B.length ApplicationVersion
specimen) TestOperator
Eq ApplicationVersion
specimen]})
        }

-- | Describe some allocations for immutable objects requested by a client.
data AllocateBuckets = AllocateBuckets
    { AllocateBuckets -> [ShareNumber]
shareNumbers :: [ShareNumber]
    , AllocateBuckets -> Size
allocatedSize :: Size
    }
    deriving (Int -> AllocateBuckets -> ShowS
[AllocateBuckets] -> ShowS
AllocateBuckets -> String
(Int -> AllocateBuckets -> ShowS)
-> (AllocateBuckets -> String)
-> ([AllocateBuckets] -> ShowS)
-> Show AllocateBuckets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocateBuckets] -> ShowS
$cshowList :: [AllocateBuckets] -> ShowS
show :: AllocateBuckets -> String
$cshow :: AllocateBuckets -> String
showsPrec :: Int -> AllocateBuckets -> ShowS
$cshowsPrec :: Int -> AllocateBuckets -> ShowS
Show, AllocateBuckets -> AllocateBuckets -> Bool
(AllocateBuckets -> AllocateBuckets -> Bool)
-> (AllocateBuckets -> AllocateBuckets -> Bool)
-> Eq AllocateBuckets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocateBuckets -> AllocateBuckets -> Bool
$c/= :: AllocateBuckets -> AllocateBuckets -> Bool
== :: AllocateBuckets -> AllocateBuckets -> Bool
$c== :: AllocateBuckets -> AllocateBuckets -> Bool
Eq, (forall x. AllocateBuckets -> Rep AllocateBuckets x)
-> (forall x. Rep AllocateBuckets x -> AllocateBuckets)
-> Generic AllocateBuckets
forall x. Rep AllocateBuckets x -> AllocateBuckets
forall x. AllocateBuckets -> Rep AllocateBuckets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllocateBuckets x -> AllocateBuckets
$cfrom :: forall x. AllocateBuckets -> Rep AllocateBuckets x
Generic)

{- | Describe the server's willingness to allocate space for some immutable
 objects.
-}
data AllocationResult = AllocationResult
    { AllocationResult -> [ShareNumber]
alreadyHave :: [ShareNumber]
    , AllocationResult -> [ShareNumber]
allocated :: [ShareNumber]
    }
    deriving (Int -> AllocationResult -> ShowS
[AllocationResult] -> ShowS
AllocationResult -> String
(Int -> AllocationResult -> ShowS)
-> (AllocationResult -> String)
-> ([AllocationResult] -> ShowS)
-> Show AllocationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocationResult] -> ShowS
$cshowList :: [AllocationResult] -> ShowS
show :: AllocationResult -> String
$cshow :: AllocationResult -> String
showsPrec :: Int -> AllocationResult -> ShowS
$cshowsPrec :: Int -> AllocationResult -> ShowS
Show, AllocationResult -> AllocationResult -> Bool
(AllocationResult -> AllocationResult -> Bool)
-> (AllocationResult -> AllocationResult -> Bool)
-> Eq AllocationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocationResult -> AllocationResult -> Bool
$c/= :: AllocationResult -> AllocationResult -> Bool
== :: AllocationResult -> AllocationResult -> Bool
$c== :: AllocationResult -> AllocationResult -> Bool
Eq, (forall x. AllocationResult -> Rep AllocationResult x)
-> (forall x. Rep AllocationResult x -> AllocationResult)
-> Generic AllocationResult
forall x. Rep AllocationResult x -> AllocationResult
forall x. AllocationResult -> Rep AllocationResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllocationResult x -> AllocationResult
$cfrom :: forall x. AllocationResult -> Rep AllocationResult x
Generic)

instance Semigroup AllocationResult where
    AllocationResult [ShareNumber]
xa [ShareNumber]
ya <> :: AllocationResult -> AllocationResult -> AllocationResult
<> AllocationResult [ShareNumber]
xb [ShareNumber]
yb = [ShareNumber] -> [ShareNumber] -> AllocationResult
AllocationResult ([ShareNumber]
xa [ShareNumber] -> [ShareNumber] -> [ShareNumber]
forall a. Semigroup a => a -> a -> a
<> [ShareNumber]
xb) ([ShareNumber]
ya [ShareNumber] -> [ShareNumber] -> [ShareNumber]
forall a. Semigroup a => a -> a -> a
<> [ShareNumber]
yb)

instance Monoid AllocationResult where
    mempty :: AllocationResult
mempty = [ShareNumber] -> [ShareNumber] -> AllocationResult
AllocationResult [ShareNumber]
forall a. Monoid a => a
mempty [ShareNumber]
forall a. Monoid a => a
mempty

{- | One of several kinds of shared secrets for authorizing a client to
 perform various operations.
-}
data LeaseSecret = Renew B.ByteString | Cancel B.ByteString | Upload UploadSecret | Write WriteEnablerSecret

-- XXX Most of these operators have been removed from the spec.
data TestOperator
    = Lt
    | Le
    | Eq
    | Ne
    | Ge
    | Gt
    deriving (Int -> TestOperator -> ShowS
[TestOperator] -> ShowS
TestOperator -> String
(Int -> TestOperator -> ShowS)
-> (TestOperator -> String)
-> ([TestOperator] -> ShowS)
-> Show TestOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestOperator] -> ShowS
$cshowList :: [TestOperator] -> ShowS
show :: TestOperator -> String
$cshow :: TestOperator -> String
showsPrec :: Int -> TestOperator -> ShowS
$cshowsPrec :: Int -> TestOperator -> ShowS
Show, TestOperator -> TestOperator -> Bool
(TestOperator -> TestOperator -> Bool)
-> (TestOperator -> TestOperator -> Bool) -> Eq TestOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestOperator -> TestOperator -> Bool
$c/= :: TestOperator -> TestOperator -> Bool
== :: TestOperator -> TestOperator -> Bool
$c== :: TestOperator -> TestOperator -> Bool
Eq, (forall x. TestOperator -> Rep TestOperator x)
-> (forall x. Rep TestOperator x -> TestOperator)
-> Generic TestOperator
forall x. Rep TestOperator x -> TestOperator
forall x. TestOperator -> Rep TestOperator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestOperator x -> TestOperator
$cfrom :: forall x. TestOperator -> Rep TestOperator x
Generic, [TestOperator] -> Encoding
[TestOperator] -> Value
TestOperator -> Encoding
TestOperator -> Value
(TestOperator -> Value)
-> (TestOperator -> Encoding)
-> ([TestOperator] -> Value)
-> ([TestOperator] -> Encoding)
-> ToJSON TestOperator
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TestOperator] -> Encoding
$ctoEncodingList :: [TestOperator] -> Encoding
toJSONList :: [TestOperator] -> Value
$ctoJSONList :: [TestOperator] -> Value
toEncoding :: TestOperator -> Encoding
$ctoEncoding :: TestOperator -> Encoding
toJSON :: TestOperator -> Value
$ctoJSON :: TestOperator -> Value
ToJSON, Value -> Parser [TestOperator]
Value -> Parser TestOperator
(Value -> Parser TestOperator)
-> (Value -> Parser [TestOperator]) -> FromJSON TestOperator
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TestOperator]
$cparseJSONList :: Value -> Parser [TestOperator]
parseJSON :: Value -> Parser TestOperator
$cparseJSON :: Value -> Parser TestOperator
FromJSON)

-- | A ByteString wrapper which can have its own serialization semantics.
newtype Base64 = Base64 {Base64 -> ApplicationVersion
unBase64 :: B.ByteString}

-- | Serialize a ByteString by encoding with Base64.
instance ToJSON Base64 where
    toJSON :: Base64 -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Base64 -> Text) -> Base64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationVersion -> Text
T.decodeLatin1 (ApplicationVersion -> Text)
-> (Base64 -> ApplicationVersion) -> Base64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationVersion -> ApplicationVersion
Base64.encode (ApplicationVersion -> ApplicationVersion)
-> (Base64 -> ApplicationVersion) -> Base64 -> ApplicationVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ApplicationVersion
unBase64

-- | Deserialize a ByteString which has been encoded with Base64.
instance FromJSON Base64 where
    parseJSON :: Value -> Parser Base64
parseJSON =
        String -> (Text -> Parser Base64) -> Value -> Parser Base64
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText
            String
"Base64-encoded ByteString"
            ( \Text
bs ->
                case ApplicationVersion -> Either String ApplicationVersion
Base64.decode (ApplicationVersion -> Either String ApplicationVersion)
-> ApplicationVersion -> Either String ApplicationVersion
forall a b. (a -> b) -> a -> b
$ Text -> ApplicationVersion
T.encodeUtf8 Text
bs of
                    Left String
err -> String -> Parser Base64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Base64 decoding failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err)
                    Right ApplicationVersion
bytes -> Base64 -> Parser Base64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64 -> Parser Base64) -> Base64 -> Parser Base64
forall a b. (a -> b) -> a -> b
$ ApplicationVersion -> Base64
Base64 ApplicationVersion
bytes
            )

-- | Serialize to the JSON as specified by the specification.
instance ToJSON TestVector where
    toJSON :: TestVector -> Value
toJSON (TestVector{Size
ApplicationVersion
TestOperator
specimen :: ApplicationVersion
operator :: TestOperator
testSize :: Size
testOffset :: Size
specimen :: TestVector -> ApplicationVersion
operator :: TestVector -> TestOperator
testSize :: TestVector -> Size
testOffset :: TestVector -> Size
..}) =
        [Pair] -> Value
object [Key
"offset" Key -> Size -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Size
testOffset, Key
"size" Key -> Size -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Size
testSize, Key
"specimen" Key -> Base64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApplicationVersion -> Base64
Base64 ApplicationVersion
specimen]

-- | Deserialize from JSON as specified by the specification.
instance FromJSON TestVector where
    parseJSON :: Value -> Parser TestVector
parseJSON = String
-> (Object -> Parser TestVector) -> Value -> Parser TestVector
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TestVector" ((Object -> Parser TestVector) -> Value -> Parser TestVector)
-> (Object -> Parser TestVector) -> Value -> Parser TestVector
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Size -> Size -> TestOperator -> ApplicationVersion -> TestVector
TestVector (Size -> Size -> TestOperator -> ApplicationVersion -> TestVector)
-> Parser Size
-> Parser
     (Size -> TestOperator -> ApplicationVersion -> TestVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Size
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"offset" Parser (Size -> TestOperator -> ApplicationVersion -> TestVector)
-> Parser Size
-> Parser (TestOperator -> ApplicationVersion -> TestVector)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Size
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size" Parser (TestOperator -> ApplicationVersion -> TestVector)
-> Parser TestOperator -> Parser (ApplicationVersion -> TestVector)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TestOperator -> Parser TestOperator
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestOperator
Eq Parser (ApplicationVersion -> TestVector)
-> Parser ApplicationVersion -> Parser TestVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Base64 -> ApplicationVersion
unBase64 (Base64 -> ApplicationVersion)
-> Parser Base64 -> Parser ApplicationVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Base64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"specimen")

-- | Serialize to the JSON as specified by the specification.
instance ToJSON WriteVector where
    toJSON :: WriteVector -> Value
toJSON (WriteVector{Size
ApplicationVersion
shareData :: ApplicationVersion
writeOffset :: Size
shareData :: WriteVector -> ApplicationVersion
writeOffset :: WriteVector -> Size
..}) =
        [Pair] -> Value
object [Key
"offset" Key -> Size -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Size
writeOffset, Key
"data" Key -> Base64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApplicationVersion -> Base64
Base64 ApplicationVersion
shareData]

-- | Deserialize from JSON as specified by the specification.
instance FromJSON WriteVector where
    parseJSON :: Value -> Parser WriteVector
parseJSON = String
-> (Object -> Parser WriteVector) -> Value -> Parser WriteVector
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WriteVector" ((Object -> Parser WriteVector) -> Value -> Parser WriteVector)
-> (Object -> Parser WriteVector) -> Value -> Parser WriteVector
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Size -> ApplicationVersion -> WriteVector
WriteVector (Size -> ApplicationVersion -> WriteVector)
-> Parser Size -> Parser (ApplicationVersion -> WriteVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Size
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"offset" Parser (ApplicationVersion -> WriteVector)
-> Parser ApplicationVersion -> Parser WriteVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Base64 -> ApplicationVersion
unBase64 (Base64 -> ApplicationVersion)
-> Parser Base64 -> Parser ApplicationVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Base64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data")

{- | Exceptional cases which might be encounted by various backend for
 operations related to immutable shares.
-}
data WriteImmutableError
    = -- | Used to reject an immutable allocate or upload with no upload secret.
      MissingUploadSecret
    | -- | Used to reject an immutable upload with an incorrect upload secret.
      IncorrectUploadSecret
    | -- | Used to reject an immutable allocate of a size that does not match
      -- existing shares with the same storage index.
      ShareSizeMismatch
    | -- | Used to reject an immutable allocate of a size greater than the
      -- maximum allowed by the server.
      MaximumShareSizeExceeded
        { WriteImmutableError -> Size
maximumShareSizeExceededLimit :: Integer
        , WriteImmutableError -> Size
maximumShareSizeExceededGiven :: Integer
        }
    | -- | Used to reject an immutable write to a share that is already
      -- completely written.
      ImmutableShareAlreadyWritten
    | -- | Used to reject an immutable write to a share which has not been
      -- allocated.
      ShareNotAllocated
    | -- | Used to reject an immutable write that overlaps with data that has
      -- already been written.
      ConflictingWrite
    deriving (Eq WriteImmutableError
Eq WriteImmutableError
-> (WriteImmutableError -> WriteImmutableError -> Ordering)
-> (WriteImmutableError -> WriteImmutableError -> Bool)
-> (WriteImmutableError -> WriteImmutableError -> Bool)
-> (WriteImmutableError -> WriteImmutableError -> Bool)
-> (WriteImmutableError -> WriteImmutableError -> Bool)
-> (WriteImmutableError
    -> WriteImmutableError -> WriteImmutableError)
-> (WriteImmutableError
    -> WriteImmutableError -> WriteImmutableError)
-> Ord WriteImmutableError
WriteImmutableError -> WriteImmutableError -> Bool
WriteImmutableError -> WriteImmutableError -> Ordering
WriteImmutableError -> WriteImmutableError -> WriteImmutableError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WriteImmutableError -> WriteImmutableError -> WriteImmutableError
$cmin :: WriteImmutableError -> WriteImmutableError -> WriteImmutableError
max :: WriteImmutableError -> WriteImmutableError -> WriteImmutableError
$cmax :: WriteImmutableError -> WriteImmutableError -> WriteImmutableError
>= :: WriteImmutableError -> WriteImmutableError -> Bool
$c>= :: WriteImmutableError -> WriteImmutableError -> Bool
> :: WriteImmutableError -> WriteImmutableError -> Bool
$c> :: WriteImmutableError -> WriteImmutableError -> Bool
<= :: WriteImmutableError -> WriteImmutableError -> Bool
$c<= :: WriteImmutableError -> WriteImmutableError -> Bool
< :: WriteImmutableError -> WriteImmutableError -> Bool
$c< :: WriteImmutableError -> WriteImmutableError -> Bool
compare :: WriteImmutableError -> WriteImmutableError -> Ordering
$ccompare :: WriteImmutableError -> WriteImmutableError -> Ordering
$cp1Ord :: Eq WriteImmutableError
Ord, WriteImmutableError -> WriteImmutableError -> Bool
(WriteImmutableError -> WriteImmutableError -> Bool)
-> (WriteImmutableError -> WriteImmutableError -> Bool)
-> Eq WriteImmutableError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteImmutableError -> WriteImmutableError -> Bool
$c/= :: WriteImmutableError -> WriteImmutableError -> Bool
== :: WriteImmutableError -> WriteImmutableError -> Bool
$c== :: WriteImmutableError -> WriteImmutableError -> Bool
Eq, Int -> WriteImmutableError -> ShowS
[WriteImmutableError] -> ShowS
WriteImmutableError -> String
(Int -> WriteImmutableError -> ShowS)
-> (WriteImmutableError -> String)
-> ([WriteImmutableError] -> ShowS)
-> Show WriteImmutableError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteImmutableError] -> ShowS
$cshowList :: [WriteImmutableError] -> ShowS
show :: WriteImmutableError -> String
$cshow :: WriteImmutableError -> String
showsPrec :: Int -> WriteImmutableError -> ShowS
$cshowsPrec :: Int -> WriteImmutableError -> ShowS
Show)

instance Exception WriteImmutableError

{- | Exceptional cases which might be encounted by various backend for
 operations related to mutable shares.
-}
data WriteMutableError
    = -- | Used to reject a mutable write with no write enabler secret.
      MissingWriteEnablerSecret
    | -- | Used to reject a mutable write with an incorrect write enabler secret.
      IncorrectWriteEnablerSecret
    deriving (Eq WriteMutableError
Eq WriteMutableError
-> (WriteMutableError -> WriteMutableError -> Ordering)
-> (WriteMutableError -> WriteMutableError -> Bool)
-> (WriteMutableError -> WriteMutableError -> Bool)
-> (WriteMutableError -> WriteMutableError -> Bool)
-> (WriteMutableError -> WriteMutableError -> Bool)
-> (WriteMutableError -> WriteMutableError -> WriteMutableError)
-> (WriteMutableError -> WriteMutableError -> WriteMutableError)
-> Ord WriteMutableError
WriteMutableError -> WriteMutableError -> Bool
WriteMutableError -> WriteMutableError -> Ordering
WriteMutableError -> WriteMutableError -> WriteMutableError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WriteMutableError -> WriteMutableError -> WriteMutableError
$cmin :: WriteMutableError -> WriteMutableError -> WriteMutableError
max :: WriteMutableError -> WriteMutableError -> WriteMutableError
$cmax :: WriteMutableError -> WriteMutableError -> WriteMutableError
>= :: WriteMutableError -> WriteMutableError -> Bool
$c>= :: WriteMutableError -> WriteMutableError -> Bool
> :: WriteMutableError -> WriteMutableError -> Bool
$c> :: WriteMutableError -> WriteMutableError -> Bool
<= :: WriteMutableError -> WriteMutableError -> Bool
$c<= :: WriteMutableError -> WriteMutableError -> Bool
< :: WriteMutableError -> WriteMutableError -> Bool
$c< :: WriteMutableError -> WriteMutableError -> Bool
compare :: WriteMutableError -> WriteMutableError -> Ordering
$ccompare :: WriteMutableError -> WriteMutableError -> Ordering
$cp1Ord :: Eq WriteMutableError
Ord, WriteMutableError -> WriteMutableError -> Bool
(WriteMutableError -> WriteMutableError -> Bool)
-> (WriteMutableError -> WriteMutableError -> Bool)
-> Eq WriteMutableError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteMutableError -> WriteMutableError -> Bool
$c/= :: WriteMutableError -> WriteMutableError -> Bool
== :: WriteMutableError -> WriteMutableError -> Bool
$c== :: WriteMutableError -> WriteMutableError -> Bool
Eq, Int -> WriteMutableError -> ShowS
[WriteMutableError] -> ShowS
WriteMutableError -> String
(Int -> WriteMutableError -> ShowS)
-> (WriteMutableError -> String)
-> ([WriteMutableError] -> ShowS)
-> Show WriteMutableError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteMutableError] -> ShowS
$cshowList :: [WriteMutableError] -> ShowS
show :: WriteMutableError -> String
$cshow :: WriteMutableError -> String
showsPrec :: Int -> WriteMutableError -> ShowS
$cshowsPrec :: Int -> WriteMutableError -> ShowS
Show)

instance Exception WriteMutableError

class Backend b where
    version :: b -> IO Version

    -- | Update the lease expiration time on the shares associated with the
    -- given storage index.
    renewLease :: b -> StorageIndex -> [LeaseSecret] -> IO ()

    createImmutableStorageIndex :: b -> StorageIndex -> Maybe [LeaseSecret] -> AllocateBuckets -> IO AllocationResult

    -- May throw ImmutableShareAlreadyWritten
    -- XXX Return should indicate what remains to be written
    writeImmutableShare :: b -> StorageIndex -> ShareNumber -> Maybe [LeaseSecret] -> ShareData -> Maybe ByteRanges -> IO ()
    abortImmutableUpload :: b -> StorageIndex -> ShareNumber -> Maybe [LeaseSecret] -> IO ()
    adviseCorruptImmutableShare :: b -> StorageIndex -> ShareNumber -> CorruptionDetails -> IO ()
    getImmutableShareNumbers :: b -> StorageIndex -> IO (CBORSet ShareNumber)
    readImmutableShare :: b -> StorageIndex -> ShareNumber -> QueryRange -> IO ShareData

    -- | Read some ranges of all shares held and/or, if test conditions are
    -- met, overwrite some ranges of some shares.
    readvAndTestvAndWritev ::
        b ->
        -- | The storage index at which to operate.
        StorageIndex ->
        -- | A shared secret which the backend can use to authorize the writes.
        WriteEnablerSecret ->
        -- | The reads, tests, and writes to perform.
        ReadTestWriteVectors ->
        IO ReadTestWriteResult

    readMutableShare :: b -> StorageIndex -> ShareNumber -> QueryRange -> IO ShareData
    getMutableShareNumbers :: b -> StorageIndex -> IO (CBORSet ShareNumber)
    adviseCorruptMutableShare :: b -> StorageIndex -> ShareNumber -> CorruptionDetails -> IO ()