{-# LANGUAGE DataKinds #-}
-- https://artyom.me/aeson#records-and-json-generics
{-# LANGUAGE DeriveAnyClass #-}
-- https://artyom.me/aeson#records-and-json-generics
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
-- Supports derivations for ShareNumber
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeOperators #-}

module TahoeLAFS.Storage.API (
    Version (..),
    Size,
    Offset,
    StorageIndex,
    ShareNumber (ShareNumber),
    shareNumber,
    toInteger,
    ShareData,
    ApplicationVersion,
    Version1Parameters (..),
    AllocateBuckets (..),
    AllocationResult (..),
    TestWriteVectors (..),
    WriteVector (..),
    ReadTestWriteVectors (..),
    ReadTestWriteResult (..),
    ReadVector (..),
    QueryRange,
    TestVector (..),
    ReadResult,
    CorruptionDetails (..),
    TestOperator (..),
    StorageAPI,
    LeaseSecret (..),
    UploadSecret (..),
    WriteEnablerSecret (..),
    isUploadSecret,
    api,
    renewSecretLength,
    writeEnablerSecretLength,
    leaseRenewSecretLength,
    leaseCancelSecretLength,
    CBOR,
    CBORSet (..),
    readv,
    writev,
    testv,
) where

import Codec.CBOR.Encoding (encodeBytes)
import Codec.Serialise.Class
import Codec.Serialise.Decoding (decodeListLen)
import qualified Codec.Serialise.Decoding as CSD
import qualified Codec.Serialise.Encoding as CSE
import Control.Monad
import Data.Aeson (
    FromJSON (..),
    FromJSONKey (..),
    ToJSON (..),
    ToJSONKey (..),
    camelTo2,
    defaultOptions,
    fieldLabelModifier,
    genericParseJSON,
    genericToJSON,
 )
import Data.Aeson.Types (
    Options,
    toJSONKeyText,
 )
import Data.Bifunctor (Bifunctor (bimap))
import Data.ByteArray (constEq)
import qualified Data.ByteString as B
import qualified "base64-bytestring" Data.ByteString.Base64 as Base64
import qualified Data.Map as Map
import Data.Map.Merge.Strict (merge, preserveMissing, zipWithMatched)
import Data.Map.Strict (
    Map,
 )
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Encoding (
    decodeUtf8',
 )
import GHC.Generics (
    Generic,
 )
import Network.HTTP.Types (
    ByteRanges,
    parseByteRanges,
    renderByteRanges,
 )
import Servant (
    Capture,
    Get,
    Header,
    JSON,
    OctetStream,
    Post,
    PostCreated,
    Proxy (Proxy),
    Put,
    ReqBody,
    StdMethod (PATCH),
    Verb,
    (:<|>),
    (:>),
 )
import TahoeLAFS.Internal.ServantUtil (
    CBOR,
 )
import Text.Read (
    readMaybe,
 )
import Web.HttpApiData (
    FromHttpApiData (..),
    ToHttpApiData (..),
 )
import Prelude hiding (
    toInteger,
 )

tahoeJSONOptions :: Options
tahoeJSONOptions :: Options
tahoeJSONOptions =
    Options
defaultOptions
        { fieldLabelModifier :: String -> String
fieldLabelModifier = Char -> String -> String
camelTo2 Char
'-'
        }

-- The expected lengths of the secrets represented as opaque byte strings.
-- I haven't checked that these values are correct according to Tahoe-LAFS.
renewSecretLength :: Num a => a
renewSecretLength :: a
renewSecretLength = a
32
writeEnablerSecretLength :: Num a => a
writeEnablerSecretLength :: a
writeEnablerSecretLength = a
32
leaseRenewSecretLength :: Num a => a
leaseRenewSecretLength :: a
leaseRenewSecretLength = a
32
leaseCancelSecretLength :: Num a => a
leaseCancelSecretLength :: a
leaseCancelSecretLength = a
32

type ApplicationVersion = B.ByteString
type Size = Integer
type Offset = Integer
type QueryRange = Maybe ByteRanges

-- TODO These should probably all be byte strings instead.
type StorageIndex = String
type ShareData = B.ByteString

newtype ShareNumber = ShareNumber Integer
    deriving
        ( Int -> ShareNumber -> String -> String
[ShareNumber] -> String -> String
ShareNumber -> String
(Int -> ShareNumber -> String -> String)
-> (ShareNumber -> String)
-> ([ShareNumber] -> String -> String)
-> Show ShareNumber
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ShareNumber] -> String -> String
$cshowList :: [ShareNumber] -> String -> String
show :: ShareNumber -> String
$cshow :: ShareNumber -> String
showsPrec :: Int -> ShareNumber -> String -> String
$cshowsPrec :: Int -> ShareNumber -> String -> String
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
        )

{- | 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 -> String -> String
[CBORSet a] -> String -> String
CBORSet a -> String
(Int -> CBORSet a -> String -> String)
-> (CBORSet a -> String)
-> ([CBORSet a] -> String -> String)
-> Show (CBORSet a)
forall a. Show a => Int -> CBORSet a -> String -> String
forall a. Show a => [CBORSet a] -> String -> String
forall a. Show a => CBORSet a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CBORSet a] -> String -> String
$cshowList :: forall a. Show a => [CBORSet a] -> String -> String
show :: CBORSet a -> String
$cshow :: forall a. Show a => CBORSet a -> String
showsPrec :: Int -> CBORSet a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> CBORSet a -> String -> String
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)

-- | Encode a CBORSet using a CBOR "set" tag and a determinate length list.
encodeCBORSet :: (Serialise a) => CBORSet a -> CSE.Encoding
encodeCBORSet :: CBORSet a -> Encoding
encodeCBORSet (CBORSet Set a
theSet) =
    Word -> Encoding
CSE.encodeTag Word
258
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CSE.encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Set a -> Int
forall a. Set a -> Int
Set.size Set a
theSet) -- XXX don't trust fromIntegral
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (a -> Encoding -> Encoding) -> Encoding -> Set a -> Encoding
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr (\a
x Encoding
r -> a -> Encoding
forall a. Serialise a => a -> Encoding
encode a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
forall a. Monoid a => a
mempty Set a
theSet

-- | Decode a determinate length list with a CBOR "set" tag.
decodeCBORSet :: (Serialise a, Ord a) => CSD.Decoder s (CBORSet a)
decodeCBORSet :: Decoder s (CBORSet a)
decodeCBORSet = do
    Word
tag <- Decoder s Word
forall s. Decoder s Word
CSD.decodeTag
    if Word
tag Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
258
        then String -> Decoder s (CBORSet a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (CBORSet a))
-> String -> Decoder s (CBORSet a)
forall a b. (a -> b) -> a -> b
$ String
"expected set tag (258), found " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag
        else do
            Int
listLength <- Decoder s Int
forall s. Decoder s Int
decodeListLen
            Set a -> CBORSet a
forall a. Set a -> CBORSet a
CBORSet (Set a -> CBORSet a) -> ([a] -> Set a) -> [a] -> CBORSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> CBORSet a) -> Decoder s [a] -> Decoder s (CBORSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Decoder s a -> Decoder s [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
listLength Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | Define serialisation for CBORSets in a way that is compatible with GBS.
instance (Serialise a, Ord a) => Serialise (CBORSet a) where
    encode :: CBORSet a -> Encoding
encode = CBORSet a -> Encoding
forall a. Serialise a => CBORSet a -> Encoding
encodeCBORSet
    decode :: Decoder s (CBORSet a)
decode = Decoder s (CBORSet a)
forall a s. (Serialise a, Ord a) => Decoder s (CBORSet a)
decodeCBORSet

instance Serialise ShareNumber where
    decode :: Decoder s ShareNumber
decode = Decoder s ShareNumber
forall s. Decoder s ShareNumber
decodeShareNumber
    encode :: ShareNumber -> Encoding
encode = ShareNumber -> Encoding
encodeShareNumber

encodeShareNumber :: ShareNumber -> CSE.Encoding
encodeShareNumber :: ShareNumber -> Encoding
encodeShareNumber (ShareNumber Integer
i) = Integer -> Encoding
CSE.encodeInteger Integer
i

decodeShareNumber :: CSD.Decoder s ShareNumber
decodeShareNumber :: Decoder s ShareNumber
decodeShareNumber = Integer -> ShareNumber
ShareNumber (Integer -> ShareNumber)
-> Decoder s Integer -> Decoder s ShareNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
CSD.decodeInteger

instance ToHttpApiData ShareNumber where
    toQueryParam :: ShareNumber -> Text
toQueryParam = String -> Text
T.pack (String -> Text) -> (ShareNumber -> String) -> ShareNumber -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String)
-> (ShareNumber -> Integer) -> ShareNumber -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareNumber -> Integer
toInteger

instance FromHttpApiData ShareNumber where
    parseUrlPiece :: Text -> Either Text ShareNumber
parseUrlPiece Text
t =
        case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer) -> String -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
            Maybe Integer
Nothing -> Text -> Either Text ShareNumber
forall a b. a -> Either a b
Left Text
"failed to parse"
            Just Integer
i -> case Integer -> Maybe ShareNumber
shareNumber Integer
i of
                Maybe ShareNumber
Nothing -> Text -> Either Text ShareNumber
forall a b. a -> Either a b
Left Text
"number out of bounds"
                Just ShareNumber
s -> ShareNumber -> Either Text ShareNumber
forall a b. b -> Either a b
Right ShareNumber
s
    parseQueryParam :: Text -> Either Text ShareNumber
parseQueryParam = Text -> Either Text ShareNumber
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece
    parseHeader :: ByteString -> Either Text ShareNumber
parseHeader ByteString
bs =
        case Text -> Either Text ShareNumber
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece (Text -> Either Text ShareNumber)
-> Either UnicodeException Text
-> Either UnicodeException (Either Text ShareNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bs of
            Left UnicodeException
err ->
                Text -> Either Text ShareNumber
forall a b. a -> Either a b
Left (Text -> Either Text ShareNumber)
-> Text -> Either Text ShareNumber
forall a b. (a -> b) -> a -> b
$
                    [Text] -> Text
T.concat
                        [ Text
"FromHttpApiData ShareNumber instance failed to decode number from header: "
                        , String -> Text
T.pack (String -> Text)
-> (UnicodeException -> String) -> UnicodeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> String
forall a. Show a => a -> String
show (UnicodeException -> Text) -> UnicodeException -> Text
forall a b. (a -> b) -> a -> b
$ UnicodeException
err
                        ]
            Right Either Text ShareNumber
sn -> Either Text ShareNumber
sn

instance ToJSONKey ShareNumber where
    toJSONKey :: ToJSONKeyFunction ShareNumber
toJSONKey = (ShareNumber -> Text) -> ToJSONKeyFunction ShareNumber
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
T.pack (String -> Text) -> (ShareNumber -> String) -> ShareNumber -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareNumber -> String
forall a. Show a => a -> String
show)

shareNumber :: Integer -> Maybe ShareNumber
shareNumber :: Integer -> Maybe ShareNumber
shareNumber Integer
n =
    if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
        then Maybe ShareNumber
forall a. Maybe a
Nothing
        else ShareNumber -> Maybe ShareNumber
forall a. a -> Maybe a
Just (ShareNumber -> Maybe ShareNumber)
-> ShareNumber -> Maybe ShareNumber
forall a b. (a -> b) -> a -> b
$ Integer -> ShareNumber
ShareNumber Integer
n

toInteger :: ShareNumber -> Integer
toInteger :: ShareNumber -> Integer
toInteger (ShareNumber Integer
i) = Integer
i

data Version1Parameters = Version1Parameters
    { Version1Parameters -> Integer
maximumImmutableShareSize :: Size
    , Version1Parameters -> Integer
maximumMutableShareSize :: Size
    , Version1Parameters -> Integer
availableSpace :: Size
    }
    deriving (Int -> Version1Parameters -> String -> String
[Version1Parameters] -> String -> String
Version1Parameters -> String
(Int -> Version1Parameters -> String -> String)
-> (Version1Parameters -> String)
-> ([Version1Parameters] -> String -> String)
-> Show Version1Parameters
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Version1Parameters] -> String -> String
$cshowList :: [Version1Parameters] -> String -> String
show :: Version1Parameters -> String
$cshow :: Version1Parameters -> String
showsPrec :: Int -> Version1Parameters -> String -> String
$cshowsPrec :: Int -> Version1Parameters -> String -> String
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)

encodeVersion1Parameters :: Version1Parameters -> CSE.Encoding
encodeVersion1Parameters :: Version1Parameters -> Encoding
encodeVersion1Parameters Version1Parameters{Integer
availableSpace :: Integer
maximumMutableShareSize :: Integer
maximumImmutableShareSize :: Integer
availableSpace :: Version1Parameters -> Integer
maximumMutableShareSize :: Version1Parameters -> Integer
maximumImmutableShareSize :: Version1Parameters -> Integer
..} =
    Word -> Encoding
CSE.encodeMapLen Word
3 -- three rings for the elven kings
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CSE.encodeBytes ByteString
"maximum-immutable-share-size"
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
CSE.encodeInteger Integer
maximumImmutableShareSize
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CSE.encodeBytes ByteString
"maximum-mutable-share-size"
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
CSE.encodeInteger Integer
maximumMutableShareSize
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CSE.encodeBytes ByteString
"available-space"
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
CSE.encodeInteger Integer
availableSpace

decodeMap :: (Ord k, Serialise k, Serialise v) => CSD.Decoder s (Map k v)
decodeMap :: Decoder s (Map k v)
decodeMap = do
    Maybe Int
lenM <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
CSD.decodeMapLenOrIndef
    case Maybe Int
lenM of
        Maybe Int
Nothing -> [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Decoder s [(k, v)] -> Decoder s (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [(k, v)]
forall s. Decoder s [(k, v)]
decodeMapIndef
        Just Int
len -> [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Decoder s [(k, v)] -> Decoder s (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Decoder s [(k, v)]
forall t a b s.
(Eq t, Num t, Serialise a, Serialise b) =>
t -> Decoder s [(a, b)]
decodeMapOfLen Int
len
  where
    decodeMapIndef :: Decoder s [(k, v)]
decodeMapIndef = do
        Bool
atTheEnd <- Decoder s Bool
forall s. Decoder s Bool
CSD.decodeBreakOr
        if Bool
atTheEnd
            then [(k, v)] -> Decoder s [(k, v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            else do
                k
k <- Decoder s k
forall a s. Serialise a => Decoder s a
decode
                v
v <- Decoder s v
forall a s. Serialise a => Decoder s a
decode
                ((k
k, v
v) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:) ([(k, v)] -> [(k, v)]) -> Decoder s [(k, v)] -> Decoder s [(k, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [(k, v)]
decodeMapIndef

    decodeMapOfLen :: t -> Decoder s [(a, b)]
decodeMapOfLen t
0 = [(a, b)] -> Decoder s [(a, b)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    decodeMapOfLen t
n = do
        a
k <- Decoder s a
forall a s. Serialise a => Decoder s a
decode
        b
v <- Decoder s b
forall a s. Serialise a => Decoder s a
decode
        ((a
k, b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:) ([(a, b)] -> [(a, b)]) -> Decoder s [(a, b)] -> Decoder s [(a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Decoder s [(a, b)]
decodeMapOfLen (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)

decodeVersion1Parameters :: CSD.Decoder s Version1Parameters
decodeVersion1Parameters :: Decoder s Version1Parameters
decodeVersion1Parameters = do
    Map ByteString Integer
m <- Decoder s (Map ByteString Integer)
forall k v s.
(Ord k, Serialise k, Serialise v) =>
Decoder s (Map k v)
decodeMap
    case (Map ByteString Integer -> Int
forall k a. Map k a -> Int
Map.size Map ByteString Integer
m, (ByteString -> Maybe Integer) -> [ByteString] -> [Maybe Integer]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Map ByteString Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map ByteString Integer
m) [ByteString]
keys) of
        (Int
3, [Just Integer
availableSpace, Just Integer
maximumImmutableShareSize, Just Integer
maximumMutableShareSize]) ->
            Version1Parameters -> Decoder s Version1Parameters
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version1Parameters :: Integer -> Integer -> Integer -> Version1Parameters
Version1Parameters{Integer
maximumMutableShareSize :: Integer
maximumImmutableShareSize :: Integer
availableSpace :: Integer
availableSpace :: Integer
maximumMutableShareSize :: Integer
maximumImmutableShareSize :: Integer
..}
        (Int, [Maybe Integer])
_ -> String -> Decoder s Version1Parameters
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid encoding of Version1Parameters"
  where
    keys :: [ByteString]
keys = [ByteString
"available-space", ByteString
"maximum-immutable-share-size", ByteString
"maximum-mutable-share-size"] :: [B.ByteString]

instance Serialise Version1Parameters where
    encode :: Version1Parameters -> Encoding
encode = Version1Parameters -> Encoding
encodeVersion1Parameters
    decode :: Decoder s Version1Parameters
decode = Decoder s Version1Parameters
forall s. Decoder s Version1Parameters
decodeVersion1Parameters

instance ToJSON Version1Parameters where
    toJSON :: Version1Parameters -> Value
toJSON = Options -> Version1Parameters -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON Version1Parameters where
    parseJSON :: Value -> Parser Version1Parameters
parseJSON = Options -> Value -> Parser Version1Parameters
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

data Version = Version
    { Version -> Version1Parameters
parameters :: Version1Parameters
    , Version -> ByteString
applicationVersion :: ApplicationVersion
    }
    deriving (Int -> Version -> String -> String
[Version] -> String -> String
Version -> String
(Int -> Version -> String -> String)
-> (Version -> String)
-> ([Version] -> String -> String)
-> Show Version
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Version] -> String -> String
$cshowList :: [Version] -> String -> String
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> String -> String
$cshowsPrec :: Int -> Version -> String -> String
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)

encodeApplicationVersion :: ApplicationVersion -> CSE.Encoding
encodeApplicationVersion :: ByteString -> Encoding
encodeApplicationVersion = ByteString -> Encoding
CSE.encodeBytes

decodeApplicationVersion :: CSD.Decoder s ApplicationVersion
decodeApplicationVersion :: Decoder s ByteString
decodeApplicationVersion = Decoder s ByteString
forall s. Decoder s ByteString
CSD.decodeBytes

encodeVersion :: Version -> CSE.Encoding
encodeVersion :: Version -> Encoding
encodeVersion Version{ByteString
Version1Parameters
applicationVersion :: ByteString
parameters :: Version1Parameters
applicationVersion :: Version -> ByteString
parameters :: Version -> Version1Parameters
..} =
    Word -> Encoding
CSE.encodeMapLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes ByteString
"http://allmydata.org/tahoe/protocols/storage/v1"
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version1Parameters -> Encoding
encodeVersion1Parameters Version1Parameters
parameters
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes ByteString
"application-version"
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeApplicationVersion ByteString
applicationVersion

decodeVersion :: CSD.Decoder s Version
decodeVersion :: Decoder s Version
decodeVersion = do
    Int
mapLen <- Decoder s Int
forall s. Decoder s Int
CSD.decodeMapLen
    case Int
mapLen of
        Int
2 -> do
            -- Take care to handle either order of fields in the map.
            ByteString
k1 <- Decoder s ByteString
forall s. Decoder s ByteString
CSD.decodeBytes
            case ByteString
k1 of
                ByteString
"http://allmydata.org/tahoe/protocols/storage/v1" -> do
                    Version1Parameters
parameters <- Decoder s Version1Parameters
forall s. Decoder s Version1Parameters
decodeVersion1Parameters
                    ByteString
k2 <- Decoder s ByteString
forall s. Decoder s ByteString
CSD.decodeBytes
                    case ByteString
k2 of
                        ByteString
"application-version" -> do
                            ByteString
applicationVersion <- Decoder s ByteString
forall s. Decoder s ByteString
decodeApplicationVersion
                            Version -> Decoder s Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version :: Version1Parameters -> ByteString -> Version
Version{ByteString
Version1Parameters
applicationVersion :: ByteString
parameters :: Version1Parameters
applicationVersion :: ByteString
parameters :: Version1Parameters
..}
                        ByteString
_ -> String -> Decoder s Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeVersion got bad input"
                ByteString
"application-version" -> do
                    ByteString
applicationVersion <- Decoder s ByteString
forall s. Decoder s ByteString
decodeApplicationVersion
                    ByteString
k2 <- Decoder s ByteString
forall s. Decoder s ByteString
CSD.decodeBytes
                    case ByteString
k2 of
                        ByteString
"http://allmydata.org/tahoe/protocols/storage/v1" -> do
                            Version1Parameters
parameters <- Decoder s Version1Parameters
forall s. Decoder s Version1Parameters
decodeVersion1Parameters
                            Version -> Decoder s Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version :: Version1Parameters -> ByteString -> Version
Version{ByteString
Version1Parameters
parameters :: Version1Parameters
applicationVersion :: ByteString
applicationVersion :: ByteString
parameters :: Version1Parameters
..}
                        ByteString
_ -> String -> Decoder s Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeVersion got bad input"
                ByteString
_ -> String -> Decoder s Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeVersion got bad input"
        Int
_ -> String -> Decoder s Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeVersion got bad input"

instance Serialise Version where
    encode :: Version -> Encoding
encode = Version -> Encoding
encodeVersion
    decode :: Decoder s Version
decode = Decoder s Version
forall s. Decoder s Version
decodeVersion

instance ToJSON Version where
    toJSON :: Version -> Value
toJSON = Options -> Version -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON Version where
    parseJSON :: Value -> Parser Version
parseJSON = Options -> Value -> Parser Version
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

data AllocateBuckets = AllocateBuckets
    { AllocateBuckets -> [ShareNumber]
shareNumbers :: [ShareNumber]
    , AllocateBuckets -> Integer
allocatedSize :: Size
    }
    deriving (Int -> AllocateBuckets -> String -> String
[AllocateBuckets] -> String -> String
AllocateBuckets -> String
(Int -> AllocateBuckets -> String -> String)
-> (AllocateBuckets -> String)
-> ([AllocateBuckets] -> String -> String)
-> Show AllocateBuckets
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AllocateBuckets] -> String -> String
$cshowList :: [AllocateBuckets] -> String -> String
show :: AllocateBuckets -> String
$cshow :: AllocateBuckets -> String
showsPrec :: Int -> AllocateBuckets -> String -> String
$cshowsPrec :: Int -> AllocateBuckets -> String -> String
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise AllocateBuckets

instance ToJSON AllocateBuckets where
    toJSON :: AllocateBuckets -> Value
toJSON = Options -> AllocateBuckets -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON AllocateBuckets where
    parseJSON :: Value -> Parser AllocateBuckets
parseJSON = Options -> Value -> Parser AllocateBuckets
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

data AllocationResult = AllocationResult
    { AllocationResult -> [ShareNumber]
alreadyHave :: [ShareNumber]
    , AllocationResult -> [ShareNumber]
allocated :: [ShareNumber]
    }
    deriving (Int -> AllocationResult -> String -> String
[AllocationResult] -> String -> String
AllocationResult -> String
(Int -> AllocationResult -> String -> String)
-> (AllocationResult -> String)
-> ([AllocationResult] -> String -> String)
-> Show AllocationResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AllocationResult] -> String -> String
$cshowList :: [AllocationResult] -> String -> String
show :: AllocationResult -> String
$cshow :: AllocationResult -> String
showsPrec :: Int -> AllocationResult -> String -> String
$cshowsPrec :: Int -> AllocationResult -> String -> String
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise AllocationResult

instance ToJSON AllocationResult where
    toJSON :: AllocationResult -> Value
toJSON = Options -> AllocationResult -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON AllocationResult where
    parseJSON :: Value -> Parser AllocationResult
parseJSON = Options -> Value -> Parser AllocationResult
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

newtype CorruptionDetails = CorruptionDetails
    { CorruptionDetails -> String
reason :: String
    }
    deriving (Int -> CorruptionDetails -> String -> String
[CorruptionDetails] -> String -> String
CorruptionDetails -> String
(Int -> CorruptionDetails -> String -> String)
-> (CorruptionDetails -> String)
-> ([CorruptionDetails] -> String -> String)
-> Show CorruptionDetails
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CorruptionDetails] -> String -> String
$cshowList :: [CorruptionDetails] -> String -> String
show :: CorruptionDetails -> String
$cshow :: CorruptionDetails -> String
showsPrec :: Int -> CorruptionDetails -> String -> String
$cshowsPrec :: Int -> CorruptionDetails -> String -> String
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise CorruptionDetails

instance ToJSON CorruptionDetails where
    toJSON :: CorruptionDetails -> Value
toJSON = Options -> CorruptionDetails -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON CorruptionDetails where
    parseJSON :: Value -> Parser CorruptionDetails
parseJSON = Options -> Value -> Parser CorruptionDetails
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

instance FromHttpApiData ByteRanges where
    parseHeader :: ByteString -> Either Text ByteRanges
parseHeader ByteString
bs =
        case ByteString -> Maybe ByteRanges
parseByteRanges ByteString
bs of
            Maybe ByteRanges
Nothing -> Text -> Either Text ByteRanges
forall a b. a -> Either a b
Left Text
"parse failed"
            Just ByteRanges
br -> ByteRanges -> Either Text ByteRanges
forall a b. b -> Either a b
Right ByteRanges
br

    parseUrlPiece :: Text -> Either Text ByteRanges
parseUrlPiece Text
_ = Text -> Either Text ByteRanges
forall a b. a -> Either a b
Left Text
"Cannot parse ByteRanges from URL piece"
    parseQueryParam :: Text -> Either Text ByteRanges
parseQueryParam Text
_ = Text -> Either Text ByteRanges
forall a b. a -> Either a b
Left Text
"Cannot parse ByteRanges from query params"

instance ToHttpApiData ByteRanges where
    toHeader :: ByteRanges -> ByteString
toHeader = ByteRanges -> ByteString
renderByteRanges

    toUrlPiece :: ByteRanges -> Text
toUrlPiece ByteRanges
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot serialize ByteRanges to URL piece"
    toQueryParam :: ByteRanges -> Text
toQueryParam ByteRanges
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot serialize ByteRanges to query params"

newtype UploadSecret = UploadSecret B.ByteString
newtype WriteEnablerSecret = WriteEnablerSecret B.ByteString

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

data LeaseSecret = Renew B.ByteString | Cancel B.ByteString | Upload UploadSecret | Write WriteEnablerSecret

isUploadSecret :: LeaseSecret -> Bool
isUploadSecret :: LeaseSecret -> Bool
isUploadSecret (Upload UploadSecret
_) = Bool
True
isUploadSecret LeaseSecret
_ = Bool
False

instance FromHttpApiData LeaseSecret where
    parseHeader :: ByteString -> Either Text LeaseSecret
parseHeader ByteString
bs =
        do
            let [ByteString
key, ByteString
val] = Word8 -> ByteString -> [ByteString]
B.split Word8
32 ByteString
bs
            case ByteString
key of
                ByteString
"lease-renew-secret" -> (String -> Text)
-> (ByteString -> LeaseSecret)
-> Either String ByteString
-> Either Text LeaseSecret
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack ByteString -> LeaseSecret
Renew (Either String ByteString -> Either Text LeaseSecret)
-> Either String ByteString -> Either Text LeaseSecret
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Base64.decode ByteString
val
                ByteString
"lease-cancel-secret" -> (String -> Text)
-> (ByteString -> LeaseSecret)
-> Either String ByteString
-> Either Text LeaseSecret
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack ByteString -> LeaseSecret
Cancel (Either String ByteString -> Either Text LeaseSecret)
-> Either String ByteString -> Either Text LeaseSecret
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Base64.decode ByteString
val
                ByteString
"upload-secret" -> (String -> Text)
-> (ByteString -> LeaseSecret)
-> Either String ByteString
-> Either Text LeaseSecret
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack (UploadSecret -> LeaseSecret
Upload (UploadSecret -> LeaseSecret)
-> (ByteString -> UploadSecret) -> ByteString -> LeaseSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UploadSecret
UploadSecret) (Either String ByteString -> Either Text LeaseSecret)
-> Either String ByteString -> Either Text LeaseSecret
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Base64.decode ByteString
val
                ByteString
"write-enabler" -> (String -> Text)
-> (ByteString -> LeaseSecret)
-> Either String ByteString
-> Either Text LeaseSecret
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack (WriteEnablerSecret -> LeaseSecret
Write (WriteEnablerSecret -> LeaseSecret)
-> (ByteString -> WriteEnablerSecret) -> ByteString -> LeaseSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> WriteEnablerSecret
WriteEnablerSecret) (Either String ByteString -> Either Text LeaseSecret)
-> Either String ByteString -> Either Text LeaseSecret
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Base64.decode ByteString
val
                ByteString
_ -> Text -> Either Text LeaseSecret
forall a b. a -> Either a b
Left (Text -> Either Text LeaseSecret)
-> Text -> Either Text LeaseSecret
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"Cannot interpret secret: ", String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
key]

    parseUrlPiece :: Text -> Either Text LeaseSecret
parseUrlPiece Text
_ = Text -> Either Text LeaseSecret
forall a b. a -> Either a b
Left Text
"Cannot parse LeaseSecret from URL piece"
    parseQueryParam :: Text -> Either Text LeaseSecret
parseQueryParam Text
_ = Text -> Either Text LeaseSecret
forall a b. a -> Either a b
Left Text
"Cannot parse LeaseSecret from query params"

instance FromHttpApiData [LeaseSecret] where
    -- XXX Consider whitespace?
    parseHeader :: ByteString -> Either Text [LeaseSecret]
parseHeader =
        (ByteString -> Either Text LeaseSecret)
-> [ByteString] -> Either Text [LeaseSecret]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Either Text LeaseSecret
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader ([ByteString] -> Either Text [LeaseSecret])
-> (ByteString -> [ByteString])
-> ByteString
-> Either Text [LeaseSecret]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
B.split (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
',')

    parseUrlPiece :: Text -> Either Text [LeaseSecret]
parseUrlPiece Text
_ = Text -> Either Text [LeaseSecret]
forall a b. a -> Either a b
Left Text
"Cannot parse [LeaseSecret] from URL piece"
    parseQueryParam :: Text -> Either Text [LeaseSecret]
parseQueryParam Text
_ = Text -> Either Text [LeaseSecret]
forall a b. a -> Either a b
Left Text
"Cannot parse [LeaseSecret] from query params"

instance ToHttpApiData LeaseSecret where
    toHeader :: LeaseSecret -> ByteString
toHeader (Renew ByteString
bs) = ByteString
"lease-renew-secret " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
Base64.encode ByteString
bs
    toHeader (Cancel ByteString
bs) = ByteString
"lease-cancel-secret " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
Base64.encode ByteString
bs
    toHeader (Upload (UploadSecret ByteString
bs)) = ByteString
"lease-cancel-secret " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
Base64.encode ByteString
bs
    toHeader (Write (WriteEnablerSecret ByteString
bs)) = ByteString
"write-enabler " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
Base64.encode ByteString
bs

    toUrlPiece :: LeaseSecret -> Text
toUrlPiece LeaseSecret
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot serialize LeaseSecret to URL piece"
    toQueryParam :: LeaseSecret -> Text
toQueryParam LeaseSecret
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot serialize LeaseSecret to query params"

instance ToHttpApiData [LeaseSecret] where
    toHeader :: [LeaseSecret] -> ByteString
toHeader = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," ([ByteString] -> ByteString)
-> ([LeaseSecret] -> [ByteString]) -> [LeaseSecret] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LeaseSecret -> ByteString) -> [LeaseSecret] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map LeaseSecret -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader
    toUrlPiece :: [LeaseSecret] -> Text
toUrlPiece [LeaseSecret]
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot serialize [LeaseSecret] to URL piece"
    toQueryParam :: [LeaseSecret] -> Text
toQueryParam [LeaseSecret]
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot serialize [LeaseSecret] to query params"

-- Request authorization information
type Authz = Header "X-Tahoe-Authorization" [LeaseSecret]

-- GET .../version
-- Retrieve information about the server version and behavior
type GetVersion = "version" :> Get '[CBOR, JSON] Version

-- PUT .../lease/:storage_index
type RenewLease = "lease" :> Capture "storage_index" StorageIndex :> Authz :> Get '[CBOR, JSON] ()

-- POST .../immutable/:storage_index
-- Initialize a new immutable storage index
type CreateImmutableStorageIndex = "immutable" :> Capture "storage_index" StorageIndex :> Authz :> ReqBody '[CBOR, JSON] AllocateBuckets :> PostCreated '[CBOR, JSON] AllocationResult

--
-- PATCH .../immutable/:storage_index/:share_number
-- Write data for an immutable share to an allocated storage index
--
-- Note this accepts JSON to facilitate code generation by servant-py.  This
-- is total nonsense and supplying JSON here will almost certainly break.
-- At some point hopefully we'll fix servant-py to not need this and then
-- fix the signature here.
type WriteImmutableShareData = "immutable" :> Capture "storage_index" StorageIndex :> Capture "share_number" ShareNumber :> Authz :> ReqBody '[OctetStream, JSON] ShareData :> Header "Content-Range" ByteRanges :> Verb 'PATCH 201 '[CBOR, JSON] ()

-- PUT .../immutable/:storage_index/:share_number/unstableSort
-- Cancel an incomplete immutable share upload.
type AbortImmutableUpload = "immutable" :> Capture "storage_index" StorageIndex :> Capture "share_number" ShareNumber :> "abort" :> Authz :> Put '[JSON] ()

-- POST .../immutable/:storage_index/:share_number/corrupt
-- Advise the server of a corrupt share data
type AdviseCorrupt = Capture "storage_index" StorageIndex :> Capture "share_number" ShareNumber :> "corrupt" :> ReqBody '[CBOR, JSON] CorruptionDetails :> Post '[CBOR, JSON] ()

-- GET .../{mutable,immutable}/storage_index/shares
-- Retrieve the share numbers available for a storage index
type GetShareNumbers = Capture "storage_index" StorageIndex :> "shares" :> Get '[CBOR, JSON] (CBORSet ShareNumber)

--
-- GET .../v1/immutable/<storage_index:storage_index>/<int(signed=False):share_number>"
-- Read from an immutable storage index, possibly from multiple shares, possibly limited to certain ranges
type ReadImmutableShareData = "immutable" :> Capture "storage_index" StorageIndex :> Capture "share_number" ShareNumber :> Header "Content-Range" ByteRanges :> Get '[OctetStream, JSON] ShareData

-- POST .../v1/mutable/:storage_index/read-test-write
-- General purpose read-test-and-write operation.
type ReadTestWrite = "mutable" :> Capture "storage_index" StorageIndex :> "read-test-write" :> Authz :> ReqBody '[CBOR, JSON] ReadTestWriteVectors :> Post '[CBOR, JSON] ReadTestWriteResult

-- GET /v1/mutable/:storage_index/:share_number
-- Read from a mutable storage index
type ReadMutableShareData = "mutable" :> Capture "storage_index" StorageIndex :> Capture "share_number" ShareNumber :> Header "Content-Range" ByteRanges :> Get '[OctetStream, JSON] ShareData

type StorageAPI =
    "storage"
        :> "v1"
        :> ( GetVersion
                :<|> RenewLease
                -- Immutables
                :<|> CreateImmutableStorageIndex
                :<|> WriteImmutableShareData
                :<|> AbortImmutableUpload
                :<|> ReadImmutableShareData
                :<|> "immutable" :> GetShareNumbers
                :<|> "immutable" :> AdviseCorrupt
                -- Mutables
                :<|> ReadTestWrite
                :<|> ReadMutableShareData
                :<|> "mutable" :> GetShareNumbers
                :<|> "mutable" :> AdviseCorrupt
           )

type ReadResult = Map ShareNumber [ShareData]

data ReadTestWriteResult = ReadTestWriteResult
    { ReadTestWriteResult -> Bool
success :: Bool
    , ReadTestWriteResult -> ReadResult
readData :: ReadResult
    }
    deriving (Int -> ReadTestWriteResult -> String -> String
[ReadTestWriteResult] -> String -> String
ReadTestWriteResult -> String
(Int -> ReadTestWriteResult -> String -> String)
-> (ReadTestWriteResult -> String)
-> ([ReadTestWriteResult] -> String -> String)
-> Show ReadTestWriteResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ReadTestWriteResult] -> String -> String
$cshowList :: [ReadTestWriteResult] -> String -> String
show :: ReadTestWriteResult -> String
$cshow :: ReadTestWriteResult -> String
showsPrec :: Int -> ReadTestWriteResult -> String -> String
$cshowsPrec :: Int -> ReadTestWriteResult -> String -> String
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise ReadTestWriteResult

instance ToJSON ReadTestWriteResult where
    toJSON :: ReadTestWriteResult -> Value
toJSON = Options -> ReadTestWriteResult -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON ReadTestWriteResult where
    parseJSON :: Value -> Parser ReadTestWriteResult
parseJSON = Options -> Value -> Parser ReadTestWriteResult
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

data ReadTestWriteVectors = ReadTestWriteVectors
    { ReadTestWriteVectors -> Map ShareNumber TestWriteVectors
testWriteVectors :: Map ShareNumber TestWriteVectors
    , ReadTestWriteVectors -> [ReadVector]
readVector :: [ReadVector]
    }
    deriving (Int -> ReadTestWriteVectors -> String -> String
[ReadTestWriteVectors] -> String -> String
ReadTestWriteVectors -> String
(Int -> ReadTestWriteVectors -> String -> String)
-> (ReadTestWriteVectors -> String)
-> ([ReadTestWriteVectors] -> String -> String)
-> Show ReadTestWriteVectors
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ReadTestWriteVectors] -> String -> String
$cshowList :: [ReadTestWriteVectors] -> String -> String
show :: ReadTestWriteVectors -> String
$cshow :: ReadTestWriteVectors -> String
showsPrec :: Int -> ReadTestWriteVectors -> String -> String
$cshowsPrec :: Int -> ReadTestWriteVectors -> String -> String
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise ReadTestWriteVectors

instance ToJSON ReadTestWriteVectors where
    toJSON :: ReadTestWriteVectors -> Value
toJSON = Options -> ReadTestWriteVectors -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON ReadTestWriteVectors where
    parseJSON :: Value -> Parser ReadTestWriteVectors
parseJSON = Options -> Value -> Parser ReadTestWriteVectors
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

data ReadVector = ReadVector
    { ReadVector -> Integer
offset :: Offset
    , ReadVector -> Integer
readSize :: Size
    }
    deriving (Int -> ReadVector -> String -> String
[ReadVector] -> String -> String
ReadVector -> String
(Int -> ReadVector -> String -> String)
-> (ReadVector -> String)
-> ([ReadVector] -> String -> String)
-> Show ReadVector
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ReadVector] -> String -> String
$cshowList :: [ReadVector] -> String -> String
show :: ReadVector -> String
$cshow :: ReadVector -> String
showsPrec :: Int -> ReadVector -> String -> String
$cshowsPrec :: Int -> ReadVector -> String -> String
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise ReadVector

instance ToJSON ReadVector where
    toJSON :: ReadVector -> Value
toJSON = Options -> ReadVector -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
tahoeJSONOptions

instance FromJSON ReadVector where
    parseJSON :: Value -> Parser ReadVector
parseJSON = Options -> Value -> Parser ReadVector
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
tahoeJSONOptions

data TestWriteVectors = TestWriteVectors
    { TestWriteVectors -> [TestVector]
test :: [TestVector]
    , TestWriteVectors -> [WriteVector]
write :: [WriteVector]
    , TestWriteVectors -> Maybe Integer
newLength :: Maybe Integer
    }
    deriving (Int -> TestWriteVectors -> String -> String
[TestWriteVectors] -> String -> String
TestWriteVectors -> String
(Int -> TestWriteVectors -> String -> String)
-> (TestWriteVectors -> String)
-> ([TestWriteVectors] -> String -> String)
-> Show TestWriteVectors
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestWriteVectors] -> String -> String
$cshowList :: [TestWriteVectors] -> String -> String
show :: TestWriteVectors -> String
$cshow :: TestWriteVectors -> String
showsPrec :: Int -> TestWriteVectors -> String -> String
$cshowsPrec :: Int -> TestWriteVectors -> String -> String
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)

instance Semigroup TestWriteVectors where
    (TestWriteVectors [TestVector]
testL [WriteVector]
writeL Maybe Integer
_) <> :: TestWriteVectors -> TestWriteVectors -> TestWriteVectors
<> (TestWriteVectors [TestVector]
testR [WriteVector]
writeR Maybe Integer
newLengthR) =
        [TestVector] -> [WriteVector] -> Maybe Integer -> 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 Integer
newLengthR

instance Monoid TestWriteVectors where
    mempty :: TestWriteVectors
mempty = [TestVector] -> [WriteVector] -> Maybe Integer -> TestWriteVectors
TestWriteVectors [TestVector]
forall a. Monoid a => a
mempty [WriteVector]
forall a. Monoid a => a
mempty Maybe Integer
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise TestWriteVectors

readv :: Offset -> Size -> ReadTestWriteVectors
readv :: Integer -> Integer -> ReadTestWriteVectors
readv Integer
offset Integer
size = ReadTestWriteVectors
forall a. Monoid a => a
mempty{readVector :: [ReadVector]
readVector = [Integer -> Integer -> ReadVector
ReadVector Integer
offset Integer
size]}

writev :: ShareNumber -> Offset -> ShareData -> ReadTestWriteVectors
writev :: ShareNumber -> Integer -> ByteString -> ReadTestWriteVectors
writev ShareNumber
shareNum Integer
offset ByteString
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 = [Integer -> ByteString -> WriteVector
WriteVector Integer
offset ByteString
bytes]})}

testv :: ShareNumber -> Offset -> ShareData -> ReadTestWriteVectors
testv :: ShareNumber -> Integer -> ByteString -> ReadTestWriteVectors
testv ShareNumber
shareNum Integer
offset ByteString
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 = [Integer -> Integer -> TestOperator -> ByteString -> TestVector
TestVector Integer
offset (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
specimen) TestOperator
Eq ByteString
specimen]})
        }

-- XXX Most of these operators have been removed from the spec.
data TestOperator
    = Lt
    | Le
    | Eq
    | Ne
    | Ge
    | Gt
    deriving (Int -> TestOperator -> String -> String
[TestOperator] -> String -> String
TestOperator -> String
(Int -> TestOperator -> String -> String)
-> (TestOperator -> String)
-> ([TestOperator] -> String -> String)
-> Show TestOperator
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestOperator] -> String -> String
$cshowList :: [TestOperator] -> String -> String
show :: TestOperator -> String
$cshow :: TestOperator -> String
showsPrec :: Int -> TestOperator -> String -> String
$cshowsPrec :: Int -> TestOperator -> String -> String
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)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise TestOperator

data TestVector = TestVector
    { TestVector -> Integer
testOffset :: Offset
    , TestVector -> Integer
testSize :: Size
    , TestVector -> TestOperator
operator :: TestOperator
    , TestVector -> ByteString
specimen :: ShareData
    }
    deriving (Int -> TestVector -> String -> String
[TestVector] -> String -> String
TestVector -> String
(Int -> TestVector -> String -> String)
-> (TestVector -> String)
-> ([TestVector] -> String -> String)
-> Show TestVector
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestVector] -> String -> String
$cshowList :: [TestVector] -> String -> String
show :: TestVector -> String
$cshow :: TestVector -> String
showsPrec :: Int -> TestVector -> String -> String
$cshowsPrec :: Int -> TestVector -> String -> String
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, [TestVector] -> Encoding
[TestVector] -> Value
TestVector -> Encoding
TestVector -> Value
(TestVector -> Value)
-> (TestVector -> Encoding)
-> ([TestVector] -> Value)
-> ([TestVector] -> Encoding)
-> ToJSON TestVector
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TestVector] -> Encoding
$ctoEncodingList :: [TestVector] -> Encoding
toJSONList :: [TestVector] -> Value
$ctoJSONList :: [TestVector] -> Value
toEncoding :: TestVector -> Encoding
$ctoEncoding :: TestVector -> Encoding
toJSON :: TestVector -> Value
$ctoJSON :: TestVector -> Value
ToJSON, Value -> Parser [TestVector]
Value -> Parser TestVector
(Value -> Parser TestVector)
-> (Value -> Parser [TestVector]) -> FromJSON TestVector
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TestVector]
$cparseJSONList :: Value -> Parser [TestVector]
parseJSON :: Value -> Parser TestVector
$cparseJSON :: Value -> Parser TestVector
FromJSON)

-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise TestVector

data WriteVector = WriteVector
    { WriteVector -> Integer
writeOffset :: Offset
    , WriteVector -> ByteString
shareData :: ShareData
    }
    deriving (Int -> WriteVector -> String -> String
[WriteVector] -> String -> String
WriteVector -> String
(Int -> WriteVector -> String -> String)
-> (WriteVector -> String)
-> ([WriteVector] -> String -> String)
-> Show WriteVector
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [WriteVector] -> String -> String
$cshowList :: [WriteVector] -> String -> String
show :: WriteVector -> String
$cshow :: WriteVector -> String
showsPrec :: Int -> WriteVector -> String -> String
$cshowsPrec :: Int -> WriteVector -> String -> String
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, [WriteVector] -> Encoding
[WriteVector] -> Value
WriteVector -> Encoding
WriteVector -> Value
(WriteVector -> Value)
-> (WriteVector -> Encoding)
-> ([WriteVector] -> Value)
-> ([WriteVector] -> Encoding)
-> ToJSON WriteVector
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WriteVector] -> Encoding
$ctoEncodingList :: [WriteVector] -> Encoding
toJSONList :: [WriteVector] -> Value
$ctoJSONList :: [WriteVector] -> Value
toEncoding :: WriteVector -> Encoding
$ctoEncoding :: WriteVector -> Encoding
toJSON :: WriteVector -> Value
$ctoJSON :: WriteVector -> Value
ToJSON, Value -> Parser [WriteVector]
Value -> Parser WriteVector
(Value -> Parser WriteVector)
-> (Value -> Parser [WriteVector]) -> FromJSON WriteVector
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WriteVector]
$cparseJSONList :: Value -> Parser [WriteVector]
parseJSON :: Value -> Parser WriteVector
$cparseJSON :: Value -> Parser WriteVector
FromJSON)

instance Serialise WriteVector

api :: Proxy StorageAPI
api :: Proxy StorageAPI
api = Proxy StorageAPI
forall k (t :: k). Proxy t
Proxy