mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-19 22:07:13 +03:00
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:
parent
2a6fd965f6
commit
5dc1802665
@ -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
|
||||
|
@ -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{..} =
|
||||
|
@ -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
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user