From b36ddce3e374e73cfd33479283c6553dfb0fa952 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 1 Dec 2020 11:50:56 +0100 Subject: [PATCH] chore(tests): ensure only valid CryptoIDs are generated --- test/FoundationSpec.hs | 4 ---- test/ModelSpec.hs | 11 +++++++++++ 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/test/FoundationSpec.hs b/test/FoundationSpec.hs index 63815f508..45080259b 100644 --- a/test/FoundationSpec.hs +++ b/test/FoundationSpec.hs @@ -4,7 +4,6 @@ import TestImport import ModelSpec () -import qualified Data.CryptoID as CID import Yesod.EmbeddedStatic instance Arbitrary (Route Auth) where @@ -110,9 +109,6 @@ instance Arbitrary (Route UniWorX) where arbitrary = genericArbitrary shrink = genericShrink -instance Arbitrary a => Arbitrary (CID.CryptoID ns a) where - arbitrary = CID.CryptoID <$> arbitrary - spec :: Spec spec = do parallel $ diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs index ebb0030e3..b0adbaaec 100644 --- a/test/ModelSpec.hs +++ b/test/ModelSpec.hs @@ -27,6 +27,8 @@ import Utils import Data.CryptoID.Poly import qualified Data.CryptoID.Class.ImplicitNamespace as Implicit +import qualified Data.CryptoID.Class as Explicit +import Data.Binary.SerializationLength import Control.Monad.Catch.Pure (Catch, runCatch) @@ -172,6 +174,15 @@ instance {-# OVERLAPS #-} (HasCryptoID ns ct pt (ReaderT CryptoIDKey Catch), Arb arbitrary = arbitrary <&> \pt -> (pt, either (error . show) id . runCatch $ runReaderT (Implicit.encrypt pt) tmpKey) where tmpKey = unsafePerformIO genKey + +instance HasFixedSerializationLength () where + type SerializationLength () = 0 + +instance HasCryptoID ns ct () (ReaderT CryptoIDKey Catch) => Arbitrary (CryptoID ns ct) where + arbitrary = return . either (error . show) id . runCatch $ runReaderT (Explicit.encrypt ()) tmpKey + where + tmpKey = unsafePerformIO genKey + instance CoArbitrary ct => CoArbitrary (CryptoID ns ct) instance Function ct => Function (CryptoID ns ct)