fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(tests): ensure only valid CryptoIDs are generated

Browse Source
This commit is contained in:
Gregor Kleen 2020-12-01 11:50:56 +01:00
parent ee6fecb79e
commit b36ddce3e3
2 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
test/FoundationSpec.hs
View File

@ -4,7 +4,6 @@ import TestImport
import ModelSpec () import ModelSpec ()
import qualified Data.CryptoID as CID
import Yesod.EmbeddedStatic import Yesod.EmbeddedStatic
instance Arbitrary (Route Auth) where instance Arbitrary (Route Auth) where
@ -110,9 +109,6 @@ instance Arbitrary (Route UniWorX) where
arbitrary = genericArbitrary arbitrary = genericArbitrary
shrink = genericShrink shrink = genericShrink
instance Arbitrary a => Arbitrary (CID.CryptoID ns a) where
arbitrary = CID.CryptoID <$> arbitrary
spec :: Spec spec :: Spec
spec = do spec = do
parallel $ parallel $

11
test/ModelSpec.hs
View File

@ -27,6 +27,8 @@ import Utils
import Data.CryptoID.Poly import Data.CryptoID.Poly
import qualified Data.CryptoID.Class.ImplicitNamespace as Implicit 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) 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) arbitrary = arbitrary <&> \pt -> (pt, either (error . show) id . runCatch $ runReaderT (Implicit.encrypt pt) tmpKey)
where where
tmpKey = unsafePerformIO genKey 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 CoArbitrary ct => CoArbitrary (CryptoID ns ct)
instance Function ct => Function (CryptoID ns ct) instance Function ct => Function (CryptoID ns ct)