tahoe-chk-0.1.0.2: test/SpecServer.hs

module SpecServer (tests) where

import Control.Monad (void, zipWithM_)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (decode, encode)
import qualified Data.ByteString as BS
import Generators (shareNumbers, storageIndexes, storageServerAnnouncements, storageServerIdentifiers)
import Hedgehog (Property, diff, forAll, property, tripping)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Tahoe.CHK.Server (StorageServer (storageServerRead, storageServerWrite))
import Tahoe.Server (directoryStorageServer', memoryStorageServer)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testProperty)

tests :: TestTree
tests =
    testGroup
        "Server"
        [ testProperty
            "immutable data round-trips through memoryStorageServer write / read"
            (prop_immutable_tripping memoryStorageServer)
        , testProperty
            "immutable data round-trips through directoryStorageServer write / read"
            (prop_immutable_tripping (directoryStorageServer' "SpecServer-storage"))
        , testProperty
            "Maps of StorageServerAnnouncement round-trip through JSON"
            prop_servers_json_tripping
        ]

prop_servers_json_tripping :: Property
prop_servers_json_tripping = property $ do
    servers <- forAll $ Gen.map (Range.linear 1 10) ((,) <$> storageServerIdentifiers <*> storageServerAnnouncements)
    tripping servers encode decode

prop_immutable_tripping :: IO StorageServer -> Property
prop_immutable_tripping newServer = property $ do
    server <- liftIO newServer
    storageIndex <- forAll storageIndexes
    shareNum <- forAll shareNumbers
    shareChunks <- forAll $ Gen.list (Range.linear 1 100) (Gen.bytes (Range.linear 1 100))

    let write' = storageServerWrite server storageIndex shareNum
        read' = storageServerRead server storageIndex shareNum
        offsets = scanl (flip $ (+) . BS.length) 0 shareChunks

    void . liftIO $ zipWithM_ (write' . fromIntegral) offsets shareChunks

    result <- liftIO read'
    diff (BS.concat shareChunks) (==) result