core: move Arbitrary instances near their types

This allows us to use them in remote serialization
round trip props.

Couple of them are not needed anymore (`NixLike` is the
default now) so whole `tests/Arbitrary` is gone.
This commit is contained in:
Richard Marko 2023-11-15 07:12:03 +01:00
parent 2a6fd965f6
commit 5dc1802665
5 changed files with 34 additions and 75 deletions

View File

@ -70,6 +70,7 @@ library
, monad-control
, mtl
, nix-derivation >= 1.1.1 && <2
, QuickCheck
, saltine
, time
, text
@ -114,7 +115,6 @@ test-suite format-tests
type: exitcode-stdio-1.0
main-is: Driver.hs
other-modules:
Arbitrary
Derivation
NarFormat
Hash

View File

@ -49,6 +49,8 @@ import Crypto.Hash ( SHA256
, HashAlgorithm
)
import Test.QuickCheck
-- | A path in a Nix store.
--
-- From the Nix thesis: A store path is the full path of a store
@ -72,6 +74,12 @@ instance Hashable StorePath where
hashWithSalt s StorePath{..} =
s `hashWithSalt` storePathHash `hashWithSalt` storePathName
instance Arbitrary StorePath where
arbitrary =
liftA2 StorePath
arbitrary
arbitrary
-- | The name portion of a Nix path.
--
-- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start
@ -82,6 +90,13 @@ newtype StorePathName = StorePathName
unStorePathName :: Text
} deriving (Eq, Hashable, Ord, Show)
instance Arbitrary StorePathName where
arbitrary = StorePathName . toText <$> ((:) <$> s1 <*> listOf sn)
where
alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']
s1 = elements $ alphanum <> "+-_?="
sn = elements $ alphanum <> "+-._?="
-- | The hash algorithm used for store path hashes.
newtype StorePathHashPart = StorePathHashPart
{ -- | Extract the contents of the hash.
@ -89,6 +104,9 @@ newtype StorePathHashPart = StorePathHashPart
}
deriving (Eq, Hashable, Ord, Show)
instance Arbitrary StorePathHashPart where
arbitrary = mkStorePathHashPart @SHA256 . Bytes.Char8.pack <$> arbitrary
mkStorePathHashPart
:: forall hashAlgo
. HashAlgorithm hashAlgo
@ -167,6 +185,9 @@ newtype StoreDir = StoreDir {
unStoreDir :: RawFilePath
} deriving (Eq, Hashable, Ord, Show)
instance Arbitrary StoreDir where
arbitrary = StoreDir . ("/" <>) . Bytes.Char8.pack <$> arbitrary
-- | Render a 'StorePath' as a 'RawFilePath'.
storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath
storePathToRawFilePath storeDir StorePath{..} =

View File

@ -1,58 +0,0 @@
{-# language DataKinds #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Arbitrary where
import qualified Data.ByteString.Char8 as BSC
import Test.Tasty.QuickCheck
import System.Nix.Internal.StorePath
import Crypto.Hash ( SHA256
, Digest
, hash
)
genSafeChar :: Gen Char
genSafeChar = choose ('\1', '\127') -- ASCII without \NUL
nonEmptyString :: Gen String
nonEmptyString = listOf1 genSafeChar
dir :: Gen String
dir = ('/':) <$> listOf1 (elements $ '/':['a'..'z'])
instance Arbitrary StorePathName where
arbitrary = StorePathName . toText <$> ((:) <$> s1 <*> listOf sn)
where
alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']
s1 = elements $ alphanum <> "+-_?="
sn = elements $ alphanum <> "+-._?="
instance Arbitrary StorePathHashPart where
arbitrary = mkStorePathHashPart @SHA256 . BSC.pack <$> arbitrary
instance Arbitrary (Digest SHA256) where
arbitrary = hash . BSC.pack <$> arbitrary
instance Arbitrary StoreDir where
arbitrary = StoreDir . ("/" <>) . BSC.pack <$> arbitrary
newtype NixLike = NixLike {getNixLike :: StorePath}
deriving (Eq, Ord, Show)
instance Arbitrary NixLike where
arbitrary =
NixLike <$>
liftA2 StorePath
arbitraryTruncatedDigest
arbitrary
where
-- 160-bit hash, 20 bytes, 32 chars in base32
arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar
instance Arbitrary StorePath where
arbitrary =
liftA2 StorePath
arbitrary
arbitrary

View File

@ -13,7 +13,6 @@ import Test.Tasty.QuickCheck
import System.Nix.Hash
import System.Nix.StorePath
import Arbitrary
import System.Nix.Internal.Base
import Crypto.Hash ( MD5
, SHA1
@ -49,6 +48,12 @@ spec_hash = do
prop_nixBase32Roundtrip :: Property
prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $
\x -> pure (encodeUtf8 x) === (B32.decode . B32.encode . encodeUtf8 $ x)
where
nonEmptyString :: Gen String
nonEmptyString = listOf1 genSafeChar
genSafeChar :: Gen Char
genSafeChar = choose ('\1', '\127') -- ASCII without \NUL
-- | API variants
prop_nixBase16Roundtrip :: StorePathHashPart -> Property

View File

@ -9,22 +9,13 @@ import qualified Data.Attoparsec.Text
import Test.Tasty.QuickCheck
import System.Nix.StorePath
import Arbitrary
-- | Test that Nix(OS) like paths roundtrip
prop_storePathRoundtrip :: StoreDir -> NixLike -> NixLike -> Property
prop_storePathRoundtrip storeDir (_ :: NixLike) (NixLike x) =
-- | Test @StorePath@ roundtrips using @parsePath@
prop_storePathRoundtrip :: StoreDir -> StorePath -> Property
prop_storePathRoundtrip storeDir x =
parsePath storeDir (storePathToRawFilePath storeDir x) === pure x
-- | Test that any `StorePath` roundtrips
prop_storePathRoundtrip' :: StoreDir -> StorePath -> Property
prop_storePathRoundtrip' storeDir x =
parsePath storeDir (storePathToRawFilePath storeDir x) === pure x
prop_storePathRoundtripParser :: StoreDir -> NixLike -> NixLike -> Property
prop_storePathRoundtripParser storeDir (_ :: NixLike) (NixLike x) =
Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x
prop_storePathRoundtripParser' :: StoreDir -> StorePath -> Property
prop_storePathRoundtripParser' storeDir x =
-- | Test @StorePath@ roundtrips using @pathParser@
prop_storePathRoundtripParser :: StoreDir -> StorePath -> Property
prop_storePathRoundtripParser storeDir x =
Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x