{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module TahoeLAFS.Storage.APIDocs where

import Prelude hiding (
    Eq,
 )

import Data.Bits (
    shiftL,
 )

import Data.Map (
    Map,
    fromList,
 )

import Servant (
    Capture,
    QueryParams,
 )

import Servant.Docs (
    DocCapture (DocCapture),
    DocQueryParam (DocQueryParam),
    ParamKind (List),
    ToCapture (toCapture),
    ToParam (toParam),
    ToSample (toSamples),
    samples,
    singleSample,
 )

import TahoeLAFS.Storage.API (
    AllocateBuckets (AllocateBuckets),
    AllocationResult (AllocationResult),
    CorruptionDetails (CorruptionDetails),
    ReadResult,
    ReadTestWriteResult (ReadTestWriteResult),
    ReadTestWriteVectors (ReadTestWriteVectors),
    ReadVector,
    ShareData,
    ShareNumber (ShareNumber),
    StorageIndex,
    TestOperator (Eq),
    TestVector (TestVector),
    TestWriteVectors (TestWriteVectors),
    Version (Version),
    Version1Parameters (Version1Parameters),
    WriteVector (WriteVector),
 )

instance ToCapture (Capture "storage_index" StorageIndex) where
    toCapture :: Proxy (Capture "storage_index" StorageIndex) -> DocCapture
toCapture Proxy (Capture "storage_index" StorageIndex)
_ = StorageIndex -> StorageIndex -> DocCapture
DocCapture StorageIndex
"storage index" StorageIndex
"(hex string) a storage index to use to address the data"

instance ToCapture (Capture "share_number" ShareNumber) where
    toCapture :: Proxy (Capture "share_number" ShareNumber) -> DocCapture
toCapture Proxy (Capture "share_number" ShareNumber)
_ = StorageIndex -> StorageIndex -> DocCapture
DocCapture StorageIndex
"share number" StorageIndex
"(integer) a share number to use to address a particular share"

instance ToParam (QueryParams "share_number" ShareNumber) where
    toParam :: Proxy (QueryParams "share_number" ShareNumber) -> DocQueryParam
toParam Proxy (QueryParams "share_number" ShareNumber)
_ = StorageIndex
-> [StorageIndex] -> StorageIndex -> ParamKind -> DocQueryParam
DocQueryParam StorageIndex
"share_number" [] StorageIndex
"(integer) a share number to use to address a particular share" ParamKind
List

instance ToParam (QueryParams "offset" Integer) where
    toParam :: Proxy (QueryParams "offset" Integer) -> DocQueryParam
toParam Proxy (QueryParams "offset" Integer)
_ = StorageIndex
-> [StorageIndex] -> StorageIndex -> ParamKind -> DocQueryParam
DocQueryParam StorageIndex
"offset" [] StorageIndex
"(integer) offset into a share to read or write" ParamKind
List

instance ToParam (QueryParams "size" Integer) where
    toParam :: Proxy (QueryParams "size" Integer) -> DocQueryParam
toParam Proxy (QueryParams "size" Integer)
_ = StorageIndex
-> [StorageIndex] -> StorageIndex -> ParamKind -> DocQueryParam
DocQueryParam StorageIndex
"size" [] StorageIndex
"(integer) number of bytes of a share to read" ParamKind
List

instance ToSample ReadResult where
    toSamples :: Proxy ReadResult -> [(Text, ReadResult)]
toSamples Proxy ReadResult
_ = ReadResult -> [(Text, ReadResult)]
forall a. a -> [(Text, a)]
singleSample ReadResult
forall a. Monoid a => a
mempty

instance ToSample Version where
    toSamples :: Proxy Version -> [(Text, Version)]
toSamples Proxy Version
_ =
        Version -> [(Text, Version)]
forall a. a -> [(Text, a)]
singleSample (Version -> [(Text, Version)]) -> Version -> [(Text, Version)]
forall a b. (a -> b) -> a -> b
$
            Version1Parameters -> ApplicationVersion -> Version
Version (Integer -> Integer -> Integer -> Version1Parameters
Version1Parameters (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) (Integer
2 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) (Integer
2 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
64)) ApplicationVersion
"blub version??"

instance ToSample AllocateBuckets where
    toSamples :: Proxy AllocateBuckets -> [(Text, AllocateBuckets)]
toSamples Proxy AllocateBuckets
_ =
        AllocateBuckets -> [(Text, AllocateBuckets)]
forall a. a -> [(Text, a)]
singleSample
            ( [ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets
                [Integer -> ShareNumber
ShareNumber Integer
1, Integer -> ShareNumber
ShareNumber Integer
3]
                Integer
1024
            )

instance ToSample AllocationResult where
    toSamples :: Proxy AllocationResult -> [(Text, AllocationResult)]
toSamples Proxy AllocationResult
_ =
        AllocationResult -> [(Text, AllocationResult)]
forall a. a -> [(Text, a)]
singleSample (AllocationResult -> [(Text, AllocationResult)])
-> AllocationResult -> [(Text, AllocationResult)]
forall a b. (a -> b) -> a -> b
$ [ShareNumber] -> [ShareNumber] -> AllocationResult
AllocationResult [Integer -> ShareNumber
ShareNumber Integer
1] [Integer -> ShareNumber
ShareNumber Integer
3]

instance ToSample ShareData where
    toSamples :: Proxy ApplicationVersion -> [(Text, ApplicationVersion)]
toSamples Proxy ApplicationVersion
_ =
        ApplicationVersion -> [(Text, ApplicationVersion)]
forall a. a -> [(Text, a)]
singleSample ApplicationVersion
"abcdefgh"

instance ToSample () where
    toSamples :: Proxy () -> [(Text, ())]
toSamples Proxy ()
_ = () -> [(Text, ())]
forall a. a -> [(Text, a)]
singleSample ()

instance ToSample CorruptionDetails where
    toSamples :: Proxy CorruptionDetails -> [(Text, CorruptionDetails)]
toSamples Proxy CorruptionDetails
_ = CorruptionDetails -> [(Text, CorruptionDetails)]
forall a. a -> [(Text, a)]
singleSample (CorruptionDetails -> [(Text, CorruptionDetails)])
-> CorruptionDetails -> [(Text, CorruptionDetails)]
forall a b. (a -> b) -> a -> b
$ StorageIndex -> CorruptionDetails
CorruptionDetails StorageIndex
"sha256 mismatch maybe?"

instance ToSample ShareNumber where
    toSamples :: Proxy ShareNumber -> [(Text, ShareNumber)]
toSamples Proxy ShareNumber
_ = [ShareNumber] -> [(Text, ShareNumber)]
forall a. [a] -> [(Text, a)]
samples [Integer -> ShareNumber
ShareNumber Integer
0, Integer -> ShareNumber
ShareNumber Integer
3]

instance ToSample ReadTestWriteVectors where
    toSamples :: Proxy ReadTestWriteVectors -> [(Text, ReadTestWriteVectors)]
toSamples Proxy ReadTestWriteVectors
_ =
        ReadTestWriteVectors -> [(Text, ReadTestWriteVectors)]
forall a. a -> [(Text, a)]
singleSample (ReadTestWriteVectors -> [(Text, ReadTestWriteVectors)])
-> ReadTestWriteVectors -> [(Text, ReadTestWriteVectors)]
forall a b. (a -> b) -> a -> b
$
            Map ShareNumber TestWriteVectors
-> [ReadVector] -> ReadTestWriteVectors
ReadTestWriteVectors
                Map ShareNumber TestWriteVectors
sampleTestWriteVectors
                [ReadVector]
sampleReadVector

instance ToSample ReadTestWriteResult where
    toSamples :: Proxy ReadTestWriteResult -> [(Text, ReadTestWriteResult)]
toSamples Proxy ReadTestWriteResult
_ =
        ReadTestWriteResult -> [(Text, ReadTestWriteResult)]
forall a. a -> [(Text, a)]
singleSample (ReadTestWriteResult -> [(Text, ReadTestWriteResult)])
-> ReadTestWriteResult -> [(Text, ReadTestWriteResult)]
forall a b. (a -> b) -> a -> b
$
            Bool -> ReadResult -> ReadTestWriteResult
ReadTestWriteResult Bool
True ReadResult
sampleReadResult

sampleTestWriteVectors :: Map ShareNumber TestWriteVectors
sampleTestWriteVectors :: Map ShareNumber TestWriteVectors
sampleTestWriteVectors =
    [(ShareNumber, TestWriteVectors)]
-> Map ShareNumber TestWriteVectors
forall k a. Ord k => [(k, a)] -> Map k a
fromList
        [
            ( Integer -> ShareNumber
ShareNumber Integer
0
            , [TestVector] -> [WriteVector] -> Maybe Integer -> TestWriteVectors
TestWriteVectors
                [Integer
-> Integer -> TestOperator -> ApplicationVersion -> TestVector
TestVector Integer
32 Integer
33 TestOperator
Eq ApplicationVersion
"x"]
                [Integer -> ApplicationVersion -> WriteVector
WriteVector Integer
32 ApplicationVersion
"y"]
                (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
100)
            )
        ]

sampleReadVector :: [ReadVector]
sampleReadVector :: [ReadVector]
sampleReadVector = [ReadVector]
forall a. Monoid a => a
mempty

sampleReadResult :: ReadResult
sampleReadResult :: ReadResult
sampleReadResult = ReadResult
forall a. Monoid a => a
mempty

example :: Int -> [a] -> [a]
example :: Int -> [a] -> [a]
example Int
n [a]
s = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate Int
n [a]
s