Spec.hs

module Main where

import Control.Monad.IO.Class (liftIO)
import Crypto.Classes (buildKey)
import qualified Data.ByteString as B
import qualified Data.Map.Strict as Map
import Data.Word (Word16)
import System.IO (hSetEncoding, stderr, stdout, utf8)
import Tahoe.CHK.Capability (Reader (..), Verifier (..))
import Tahoe.CHK.Server (StorageServer (..), StorageServerAnnouncement (..))
import Tahoe.Download (DownloadError (..), download)
import Tahoe.Server (memoryStorageServer)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)

tests :: TestTree
tests =
    testGroup
        "All tests"
        [ testCase "no configured servers" $ do
            -- If there are no servers then we can't possibly get enough
            -- shares to recover the application data.
            result <- liftIO $ download mempty (trivialCap 1 1) noServers
            assertEqual
                "download should fail with no servers"
                (Left NoConfiguredServers)
                result
        , testCase "no reachable servers" $ do
            -- If we can't contact any configured server then we can't
            -- possibly get enough shares to recover the application data.
            let anns =
                    Map.fromList
                        [
                            ( "v0-abc123"
                            , StorageServerAnnouncement
                                { storageServerAnnouncementFURL = Nothing
                                , storageServerAnnouncementNick = Just "unreachable"
                                , storageServerAnnouncementPermutationSeed = Nothing
                                }
                            )
                        ]

            result <- liftIO $ download anns (trivialCap 1 1) noServers
            assertEqual
                "download should fail with no reachable servers"
                (Left NoReachableServers)
                result
        , testCase "not enough shares" $ do
            -- If we can't recover enough shares from the configured servers
            -- then we can't possibly get enough shares to recover the
            -- application data.
            let anns =
                    Map.fromList
                        [
                            ( "v0-abc123"
                            , StorageServerAnnouncement
                                { storageServerAnnouncementFURL = Just "somewhere"
                                , storageServerAnnouncementNick = Just "abc123"
                                , storageServerAnnouncementPermutationSeed = Nothing
                                }
                            )
                        ]
                cap = trivialCap 3 3

            -- Two shares exist.
            server <- memoryStorageServer
            storageServerWrite server (storageIndex . verifier $ cap) 0 0 "Hello world"
            storageServerWrite server (storageIndex . verifier $ cap) 1 0 "Hello world"

            -- Make the server reachable.
            let openServer furl =
                    if furl == "somewhere"
                        then pure . pure $ server
                        else pure Nothing

            -- Try to download the cap which requires three shares to reconstruct.
            result <- liftIO $ download anns cap openServer
            assertEqual
                "download should fail with not enough shares"
                (Left NotEnoughShares{notEnoughSharesNeeded = 3, notEnoughSharesFound = 2})
                result
        ]
  where
    noServers _ = pure Nothing

trivialCap :: Word16 -> Word16 -> Reader
trivialCap required total = Reader{..}
  where
    Just readKey = buildKey $ B.replicate 32 0x00
    storageIndex = B.replicate 32 0x00
    fingerprint = B.replicate 32 0x00
    size = 1234
    verifier = Verifier{..}

main :: IO ()
main = do
    -- Hedgehog writes some non-ASCII and the whole test process will die if
    -- it can't be encoded.  Increase the chances that all of the output can
    -- be encoded by forcing the use of UTF-8 (overriding the LANG-based
    -- choice normally made).
    hSetEncoding stdout utf8
    hSetEncoding stderr utf8

    defaultMain tests