tahoe-chk-0.2.0.0: test/SpecUEB.hs

{-# LANGUAGE TypeApplications #-}

module SpecUEB (tests) where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import Data.List (isInfixOf)
import qualified Data.Text as T
import Generators
import Hedgehog
import Tahoe.CHK.SHA256d (zero)
import Tahoe.CHK.Types
import Tahoe.CHK.URIExtension
import Tahoe.Netstring
import Test.Tasty
import Test.Tasty.HUnit (assertBool, assertFailure, testCase)
import Test.Tasty.Hedgehog
import Text.Megaparsec

tests :: TestTree
tests =
    testGroup
        "URIExtension"
        [ testProperty "URIExtension round-trips through put / get" prop_roundtrip
        , testCase "numeric overflow results in parse error" $ do
            let -- Get something we know is a valid serialized URI extension as
                -- a starting point for constructing something that isn't.
                validBytes = uriExtensionToBytes $ URIExtension "csr" (Parameters 1 2 3 4) (Parameters 5 6 7 8) 9 10 11 12 13 zero zero zero
                -- Replace the legitimate value of 11 for num_segments with a
                -- value that overflows Int.
                invalidBytes :: BS.ByteString
                invalidBytes =
                    replace
                        ("num_segments:" <> netstring "11")
                        ("num_segments:" <> netstring (C8.pack . show . (+ 1) . fromIntegral @Int @Integer $ maxBound))
                        validBytes

            -- Make sure we actually invalidated something
            assertBool ("invalid == " <> show invalidBytes) (validBytes /= invalidBytes)
            let parsed = parse pURIExtension "" invalidBytes
            case parsed of
                Left err -> do
                    assertBool "expected error not found" $ "above maximum allowed value" `isInfixOf` show err
                Right result -> do
                    assertFailure $ "expected parse error, got " <> show result
        ]

-- | Like Data.Text.replace but for Data.ByteString.ByteString.
replace :: BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString
replace target replacement original = e $ T.replace (d target) (d replacement) (d original)
  where
    d = T.pack . C8.unpack
    e = C8.pack . T.unpack

prop_roundtrip :: Property
prop_roundtrip = property $ do
    ueb <- forAll genURIExtension
    tripping ueb uriExtensionToBytes (parse pURIExtension "")