-- due to recent generic-arbitrary
{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
module System.Nix.Arbitrary.Signature where

import qualified Crypto.PubKey.Ed25519
import Crypto.Random (drgNewTest, withDRG)
import qualified Data.ByteString as BS
import qualified Data.Text as Text
import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
import Test.QuickCheck

import System.Nix.Signature

instance Arbitrary Crypto.PubKey.Ed25519.Signature where
  arbitrary :: Gen Signature
arbitrary = do
    (Word64, Word64, Word64, Word64, Word64)
seeds <- (,,,,) (Word64
 -> Word64
 -> Word64
 -> Word64
 -> Word64
 -> (Word64, Word64, Word64, Word64, Word64))
-> Gen Word64
-> Gen
     (Word64
      -> Word64
      -> Word64
      -> Word64
      -> (Word64, Word64, Word64, Word64, Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. (Bounded a, Random a) => Gen a
arbitraryBoundedRandom Gen
  (Word64
   -> Word64
   -> Word64
   -> Word64
   -> (Word64, Word64, Word64, Word64, Word64))
-> Gen Word64
-> Gen
     (Word64
      -> Word64 -> Word64 -> (Word64, Word64, Word64, Word64, Word64))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. (Bounded a, Random a) => Gen a
arbitraryBoundedRandom Gen
  (Word64
   -> Word64 -> Word64 -> (Word64, Word64, Word64, Word64, Word64))
-> Gen Word64
-> Gen
     (Word64 -> Word64 -> (Word64, Word64, Word64, Word64, Word64))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. (Bounded a, Random a) => Gen a
arbitraryBoundedRandom Gen (Word64 -> Word64 -> (Word64, Word64, Word64, Word64, Word64))
-> Gen Word64
-> Gen (Word64 -> (Word64, Word64, Word64, Word64, Word64))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. (Bounded a, Random a) => Gen a
arbitraryBoundedRandom Gen (Word64 -> (Word64, Word64, Word64, Word64, Word64))
-> Gen Word64 -> Gen (Word64, Word64, Word64, Word64, Word64)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. (Bounded a, Random a) => Gen a
arbitraryBoundedRandom
    let drg :: ChaChaDRG
drg = (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG
drgNewTest (Word64, Word64, Word64, Word64, Word64)
seeds
        (SecretKey
secretKey, ChaChaDRG
_) = ChaChaDRG
-> MonadPseudoRandom ChaChaDRG SecretKey -> (SecretKey, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
drg MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Crypto.PubKey.Ed25519.generateSecretKey
        publicKey :: PublicKey
publicKey = SecretKey -> PublicKey
Crypto.PubKey.Ed25519.toPublic SecretKey
secretKey
        ByteString
msg :: BS.ByteString = ByteString
"msg"
    Signature -> Gen Signature
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> Gen Signature) -> Signature -> Gen Signature
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Crypto.PubKey.Ed25519.sign SecretKey
secretKey PublicKey
publicKey ByteString
msg

deriving via GenericArbitrary Signature
  instance Arbitrary Signature

instance Arbitrary NarSignature where
  arbitrary :: Gen NarSignature
arbitrary = do
    Text
name <- String -> Text
Text.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
getPrintableString (PrintableString -> Text) -> Gen PrintableString -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PrintableString
-> (PrintableString -> Bool) -> Gen PrintableString
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen PrintableString
forall a. Arbitrary a => Gen a
arbitrary (\(PrintableString String
str) -> String -> Bool
validName String
str)
    Text -> Signature -> NarSignature
NarSignature Text
name (Signature -> NarSignature) -> Gen Signature -> Gen NarSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Signature
forall a. Arbitrary a => Gen a
arbitrary

validName :: String -> Bool
validName :: String -> Bool
validName String
txt = Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
':' String
txt)