Skip to content
Snippets Groups Projects
Spec.hs 2.47 KiB
Newer Older
  • Learn to ignore specific revisions
  • 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 (StorageServerAnnouncement (..))
    
    Jean-Paul Calderone's avatar
    Jean-Paul Calderone committed
    import Tahoe.Download (DownloadError (..), download)
    
    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)
    
                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 servers =
                        Map.fromList
                            [
                                ( "v0-abc123"
                                , StorageServerAnnouncement
                                    { storageServerAnnouncementFURL = Nothing
                                    , storageServerAnnouncementNick = Just "unreachable"
                                    , storageServerAnnouncementPermutationSeed = Nothing
                                    }
                                )
                            ]
    
                result <- liftIO $ download servers (trivialCap 1 1)
                assertEqual
                    "download should fail with no reachable servers"
                    (Left NoReachableServers)
                    result
    
    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