{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Test.Cardano.Ledger.Shelley.Generator.ScriptClass (
  ScriptClass (..),
  Quantifier (..),
  exponential,
  anyOf,
  allOf,
  mOf,
  keyPairs,
  mkPayScriptHashMap,
  mkStakeScriptHashMap,
  mkScriptsFromKeyPair,
  mkKeyPairs,
  mkScripts,
  mkScriptCombinations,
  combinedScripts,
  baseScripts,
  scriptKeyCombinations,
  scriptKeyCombination,
) where

import Cardano.Ledger.Core
import Cardano.Ledger.Keys (asWitness)
import Data.List (permutations)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.Tuple (swap)
import Data.Word (Word64)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), KeyPairs, vKey)
import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair)
import Test.QuickCheck (Gen)
import qualified Test.QuickCheck as QC

{------------------------------------------------------------------------------
  ScriptClass defines the operations that enable an Era's scripts to
  be adapated to property tests. This is a key component of the EraGen class.
------------------------------------------------------------------------------}

class EraScript era => ScriptClass era where
  basescript :: Proxy era -> KeyHash Witness -> Script era
  isKey :: Proxy era -> Script era -> Maybe (KeyHash Witness)
  isOnePhase :: Proxy era -> Script era -> Bool
  isOnePhase Proxy era
_proxy Script era
_ = Bool
True -- Many Eras have only OnePhase Scripts.
  quantify :: Proxy era -> Script era -> Quantifier (Script era)
  unQuantify :: Proxy era -> Quantifier (Script era) -> Script era

{------------------------------------------------------------------------------
  Abstracts the quantifier structure of (Script era)
  used in the 'quantify' and 'unQuantify' methods of ScriptClass.
 -----------------------------------------------------------------------------}

data Quantifier t = AllOf [t] | AnyOf [t] | MOf Int [t] | Leaf t
  deriving ((forall a b. (a -> b) -> Quantifier a -> Quantifier b)
-> (forall a b. a -> Quantifier b -> Quantifier a)
-> Functor Quantifier
forall a b. a -> Quantifier b -> Quantifier a
forall a b. (a -> b) -> Quantifier a -> Quantifier b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Quantifier a -> Quantifier b
fmap :: forall a b. (a -> b) -> Quantifier a -> Quantifier b
$c<$ :: forall a b. a -> Quantifier b -> Quantifier a
<$ :: forall a b. a -> Quantifier b -> Quantifier a
Functor)

anyOf :: forall era. ScriptClass era => Proxy era -> [Script era] -> Script era
anyOf :: forall era.
ScriptClass era =>
Proxy era -> [Script era] -> Script era
anyOf Proxy era
prox [Script era]
xs = Proxy era -> Quantifier (Script era) -> Script era
forall era.
ScriptClass era =>
Proxy era -> Quantifier (Script era) -> Script era
unQuantify Proxy era
prox (Quantifier (Script era) -> Script era)
-> Quantifier (Script era) -> Script era
forall a b. (a -> b) -> a -> b
$ [Script era] -> Quantifier (Script era)
forall t. [t] -> Quantifier t
AnyOf [Script era]
xs

allOf :: forall era. ScriptClass era => Proxy era -> [Script era] -> Script era
allOf :: forall era.
ScriptClass era =>
Proxy era -> [Script era] -> Script era
allOf Proxy era
prox [Script era]
xs = Proxy era -> Quantifier (Script era) -> Script era
forall era.
ScriptClass era =>
Proxy era -> Quantifier (Script era) -> Script era
unQuantify Proxy era
prox (Quantifier (Script era) -> Script era)
-> Quantifier (Script era) -> Script era
forall a b. (a -> b) -> a -> b
$ [Script era] -> Quantifier (Script era)
forall t. [t] -> Quantifier t
AllOf [Script era]
xs

mOf :: forall era. ScriptClass era => Proxy era -> Int -> [Script era] -> Script era
mOf :: forall era.
ScriptClass era =>
Proxy era -> Int -> [Script era] -> Script era
mOf Proxy era
prox Int
m [Script era]
xs = Proxy era -> Quantifier (Script era) -> Script era
forall era.
ScriptClass era =>
Proxy era -> Quantifier (Script era) -> Script era
unQuantify Proxy era
prox (Quantifier (Script era) -> Script era)
-> Quantifier (Script era) -> Script era
forall a b. (a -> b) -> a -> b
$ Int -> [Script era] -> Quantifier (Script era)
forall t. Int -> [t] -> Quantifier t
MOf Int
m [Script era]
xs

{------------------------------------------------------------------------------
  Compute lists of keyHashes
------------------------------------------------------------------------------}

-- | return the first sublist that meets the predicate p.
getFirst :: ([a] -> Bool) -> [[a]] -> [a]
getFirst :: forall a. ([a] -> Bool) -> [[a]] -> [a]
getFirst [a] -> Bool
_p [] = []
getFirst [a] -> Bool
p ([a]
xs : [[a]]
xss) = if [a] -> Bool
p [a]
xs then [a]
xs else ([a] -> Bool) -> [[a]] -> [a]
forall a. ([a] -> Bool) -> [[a]] -> [a]
getFirst [a] -> Bool
p [[a]]
xss

-- | Produce a valid list of key hashes that appear in a Script.
-- Note: in the case of AnyOf, we just take the first script in the expression.
-- This only works if we generate AnyOf scripts such that all script options
-- are valid scripts (that is, valid in the context of a transaction, at generation time
-- and execution/spend time).
scriptKeyCombination ::
  forall era.
  ScriptClass era =>
  Proxy era ->
  Script era ->
  [KeyHash Witness]
scriptKeyCombination :: forall era.
ScriptClass era =>
Proxy era -> Script era -> [KeyHash Witness]
scriptKeyCombination Proxy era
prox Script era
script = case Proxy era -> Script era -> Quantifier (Script era)
forall era.
ScriptClass era =>
Proxy era -> Script era -> Quantifier (Script era)
quantify Proxy era
prox Script era
script of
  AllOf [Script era]
xs -> (Script era -> [KeyHash Witness])
-> [Script era] -> [KeyHash Witness]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proxy era -> Script era -> [KeyHash Witness]
forall era.
ScriptClass era =>
Proxy era -> Script era -> [KeyHash Witness]
scriptKeyCombination Proxy era
prox) [Script era]
xs
  AnyOf [Script era]
xs -> ([KeyHash Witness] -> Bool)
-> [[KeyHash Witness]] -> [KeyHash Witness]
forall a. ([a] -> Bool) -> [[a]] -> [a]
getFirst (Bool -> Bool
not (Bool -> Bool)
-> ([KeyHash Witness] -> Bool) -> [KeyHash Witness] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyHash Witness] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ((Script era -> [KeyHash Witness])
-> [Script era] -> [[KeyHash Witness]]
forall a b. (a -> b) -> [a] -> [b]
map (Proxy era -> Script era -> [KeyHash Witness]
forall era.
ScriptClass era =>
Proxy era -> Script era -> [KeyHash Witness]
scriptKeyCombination Proxy era
prox) [Script era]
xs)
  MOf Int
m [Script era]
xs -> (Script era -> [KeyHash Witness])
-> [Script era] -> [KeyHash Witness]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proxy era -> Script era -> [KeyHash Witness]
forall era.
ScriptClass era =>
Proxy era -> Script era -> [KeyHash Witness]
scriptKeyCombination Proxy era
prox) (Int -> [Script era] -> [Script era]
forall a. Int -> [a] -> [a]
take Int
m [Script era]
xs)
  Leaf Script era
t -> case Proxy era -> Script era -> Maybe (KeyHash Witness)
forall era.
ScriptClass era =>
Proxy era -> Script era -> Maybe (KeyHash Witness)
isKey Proxy era
prox Script era
t of
    Just KeyHash Witness
hk -> [KeyHash Witness
hk]
    Maybe (KeyHash Witness)
Nothing -> []

-- | Return all valid lists of KeyHashes that appear in a Script
--   used in testing.
scriptKeyCombinations ::
  forall era.
  ScriptClass era =>
  Proxy era ->
  Script era ->
  [[KeyHash Witness]]
scriptKeyCombinations :: forall era.
ScriptClass era =>
Proxy era -> Script era -> [[KeyHash Witness]]
scriptKeyCombinations Proxy era
prox Script era
script = case Proxy era -> Script era -> Quantifier (Script era)
forall era.
ScriptClass era =>
Proxy era -> Script era -> Quantifier (Script era)
quantify Proxy era
prox Script era
script of
  AllOf [Script era]
xs -> [[[KeyHash Witness]] -> [KeyHash Witness]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KeyHash Witness]] -> [KeyHash Witness])
-> [[KeyHash Witness]] -> [KeyHash Witness]
forall a b. (a -> b) -> a -> b
$ (Script era -> [[KeyHash Witness]])
-> [Script era] -> [[KeyHash Witness]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proxy era -> Script era -> [[KeyHash Witness]]
forall era.
ScriptClass era =>
Proxy era -> Script era -> [[KeyHash Witness]]
scriptKeyCombinations Proxy era
prox) [Script era]
xs]
  AnyOf [Script era]
xs -> (Script era -> [[KeyHash Witness]])
-> [Script era] -> [[KeyHash Witness]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proxy era -> Script era -> [[KeyHash Witness]]
forall era.
ScriptClass era =>
Proxy era -> Script era -> [[KeyHash Witness]]
scriptKeyCombinations Proxy era
prox) [Script era]
xs
  MOf Int
m [Script era]
xs ->
    let perms :: [[Script era]]
perms = ([Script era] -> [Script era]) -> [[Script era]] -> [[Script era]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Script era] -> [Script era]
forall a. Int -> [a] -> [a]
take Int
m) ([[Script era]] -> [[Script era]])
-> [[Script era]] -> [[Script era]]
forall a b. (a -> b) -> a -> b
$ [Script era] -> [[Script era]]
forall a. [a] -> [[a]]
permutations [Script era]
xs
     in ([Script era] -> [KeyHash Witness])
-> [[Script era]] -> [[KeyHash Witness]]
forall a b. (a -> b) -> [a] -> [b]
map ([[KeyHash Witness]] -> [KeyHash Witness]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KeyHash Witness]] -> [KeyHash Witness])
-> ([Script era] -> [[KeyHash Witness]])
-> [Script era]
-> [KeyHash Witness]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Script era -> [[KeyHash Witness]])
-> [Script era] -> [[KeyHash Witness]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Proxy era -> Script era -> [[KeyHash Witness]]
forall era.
ScriptClass era =>
Proxy era -> Script era -> [[KeyHash Witness]]
scriptKeyCombinations Proxy era
prox)) [[Script era]]
perms
  Leaf Script era
t -> case Proxy era -> Script era -> Maybe (KeyHash Witness)
forall era.
ScriptClass era =>
Proxy era -> Script era -> Maybe (KeyHash Witness)
isKey Proxy era
prox Script era
t of
    Just KeyHash Witness
hk -> [[KeyHash Witness
hk]]
    Maybe (KeyHash Witness)
Nothing -> [[]]

-- | Make a simple (non-combined, ie NO quantifer like All, Any, MofN, etc.) script.
--   'basescript' is a method of ScriptClass, and is different for every Era.
mkScriptFromKey :: forall era. ScriptClass era => KeyPair Witness -> Script era
mkScriptFromKey :: forall era. ScriptClass era => KeyPair Witness -> Script era
mkScriptFromKey = Proxy era -> KeyHash Witness -> Script era
forall era.
ScriptClass era =>
Proxy era -> KeyHash Witness -> Script era
basescript (Proxy era
forall {k} (t :: k). Proxy t
Proxy :: Proxy era) (KeyHash Witness -> Script era)
-> (KeyPair Witness -> KeyHash Witness)
-> KeyPair Witness
-> Script era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Witness -> KeyHash Witness
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Witness -> KeyHash Witness)
-> (KeyPair Witness -> VKey Witness)
-> KeyPair Witness
-> KeyHash Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair Witness -> VKey Witness
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey

mkScriptsFromKeyPair ::
  forall era.
  ScriptClass era =>
  (KeyPair Payment, KeyPair Staking) ->
  (Script era, Script era)
mkScriptsFromKeyPair :: forall era.
ScriptClass era =>
(KeyPair Payment, KeyPair Staking) -> (Script era, Script era)
mkScriptsFromKeyPair (KeyPair Payment
k0, KeyPair Staking
k1) =
  (forall era. ScriptClass era => KeyPair Witness -> Script era
mkScriptFromKey @era (KeyPair Witness -> Script era) -> KeyPair Witness -> Script era
forall a b. (a -> b) -> a -> b
$ KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
k0, forall era. ScriptClass era => KeyPair Witness -> Script era
mkScriptFromKey @era (KeyPair Witness -> Script era) -> KeyPair Witness -> Script era
forall a b. (a -> b) -> a -> b
$ KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Staking
k1)

-- | make Scripts based on the given key pairs
mkScripts ::
  forall era.
  ScriptClass era =>
  KeyPairs ->
  [(Script era, Script era)]
mkScripts :: forall era.
ScriptClass era =>
KeyPairs -> [(Script era, Script era)]
mkScripts = ((KeyPair Payment, KeyPair Staking) -> (Script era, Script era))
-> KeyPairs -> [(Script era, Script era)]
forall a b. (a -> b) -> [a] -> [b]
map (forall era.
ScriptClass era =>
(KeyPair Payment, KeyPair Staking) -> (Script era, Script era)
mkScriptsFromKeyPair @era)

mkPayScriptHashMap ::
  forall era.
  ScriptClass era =>
  [(Script era, Script era)] ->
  Map.Map ScriptHash (Script era, Script era)
mkPayScriptHashMap :: forall era.
ScriptClass era =>
[(Script era, Script era)]
-> Map ScriptHash (Script era, Script era)
mkPayScriptHashMap [(Script era, Script era)]
scripts =
  [(ScriptHash, (Script era, Script era))]
-> Map ScriptHash (Script era, Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Script era, Script era) -> (ScriptHash, (Script era, Script era))
f ((Script era, Script era)
 -> (ScriptHash, (Script era, Script era)))
-> [(Script era, Script era)]
-> [(ScriptHash, (Script era, Script era))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Script era, Script era)]
scripts)
  where
    f :: (Script era, Script era) -> (ScriptHash, (Script era, Script era))
f script :: (Script era, Script era)
script@(Script era
pay, Script era
_ssStake) = (forall era. EraScript era => Script era -> ScriptHash
hashScript @era Script era
pay, (Script era, Script era)
script)

-- | Generate a mapping from stake script hash to script pair.
mkStakeScriptHashMap ::
  forall era.
  ScriptClass era =>
  [(Script era, Script era)] ->
  Map.Map ScriptHash (Script era, Script era)
mkStakeScriptHashMap :: forall era.
ScriptClass era =>
[(Script era, Script era)]
-> Map ScriptHash (Script era, Script era)
mkStakeScriptHashMap [(Script era, Script era)]
scripts =
  [(ScriptHash, (Script era, Script era))]
-> Map ScriptHash (Script era, Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Script era, Script era) -> (ScriptHash, (Script era, Script era))
f ((Script era, Script era)
 -> (ScriptHash, (Script era, Script era)))
-> [(Script era, Script era)]
-> [(ScriptHash, (Script era, Script era))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Script era, Script era)]
scripts)
  where
    f :: (Script era, Script era) -> (ScriptHash, (Script era, Script era))
f script :: (Script era, Script era)
script@(Script era
_pay, Script era
stake) = (forall era. EraScript era => Script era -> ScriptHash
hashScript @era Script era
stake, (Script era, Script era)
script)

-- | Combine a list of script pairs into hierarchically structured multi-sig
-- scripts, list must have at least length 3. Be careful not to call with too
-- many pairs in order not to create too many of the possible combinations.
mkScriptCombinations ::
  forall era.
  ScriptClass era =>
  [(Script era, Script era)] ->
  [(Script era, Script era)]
mkScriptCombinations :: forall era.
ScriptClass era =>
[(Script era, Script era)] -> [(Script era, Script era)]
mkScriptCombinations [(Script era, Script era)]
msigs =
  if [(Script era, Script era)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Script era, Script era)]
msigs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
    then [Char] -> [(Script era, Script era)]
forall a. HasCallStack => [Char] -> a
error [Char]
"length of input msigs must be at least 3"
    else
      ( ([(Script era, Script era)]
 -> [(Script era, Script era)] -> [(Script era, Script era)])
-> [(Script era, Script era)]
-> [[(Script era, Script era)]]
-> [(Script era, Script era)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' [(Script era, Script era)]
-> [(Script era, Script era)] -> [(Script era, Script era)]
forall a. [a] -> [a] -> [a]
(++) [] ([[(Script era, Script era)]] -> [(Script era, Script era)])
-> [[(Script era, Script era)]] -> [(Script era, Script era)]
forall a b. (a -> b) -> a -> b
$
          do
            (k1, k2) <- [(Script era, Script era)]
msigs
            (k3, k4) <- msigs List.\\ [(k1, k2)]
            (k5, k6) <- msigs List.\\ [(k1, k2), (k3, k4)]

            pure
              [ (pay, stake)
              | pay <-
                  [ anyOf (Proxy @era) [k1, k3, k5]
                  , allOf (Proxy @era) [k1, k3, k5]
                  , mOf (Proxy @era) 1 [k1, k3, k5]
                  , mOf (Proxy @era) 2 [k1, k3, k5]
                  , mOf (Proxy @era) 3 [k1, k3, k5]
                  ]
              , stake <-
                  [ anyOf (Proxy @era) [k2, k4, k6]
                  , allOf (Proxy @era) [k2, k4, k6]
                  , mOf (Proxy @era) 1 [k2, k4, k6]
                  , mOf (Proxy @era) 2 [k2, k4, k6]
                  , mOf (Proxy @era) 3 [k2, k4, k6]
                  ]
              ]
      ) ::
        [(Script era, Script era)]

-- | Make list of script pairs (payment,staking). These are non-combined scripts
--   Ie NO quantifer like All, Any, MofN, etc.) scripts.
--   In post Shelley Eras, either Keylock or Require Start-Finish scripts.
baseScripts ::
  forall era.
  ScriptClass era =>
  Constants ->
  [(Script era, Script era)]
baseScripts :: forall era.
ScriptClass era =>
Constants -> [(Script era, Script era)]
baseScripts Constants
c = forall era.
ScriptClass era =>
KeyPairs -> [(Script era, Script era)]
mkScripts @era (Constants -> KeyPairs
keyPairs Constants
c)

-- | Make a list of script pairs (payment,staking). Each of these are combined scripts.
--   I.e.  All, Any, MofN, etc. These come from combining the the first N (numBaseScripts) baseScripts
--   When N==3, we get about 150 combined scripts.
combinedScripts ::
  forall era.
  ScriptClass era =>
  Constants ->
  [(Script era, Script era)]
combinedScripts :: forall era.
ScriptClass era =>
Constants -> [(Script era, Script era)]
combinedScripts c :: Constants
c@(Constants {Int
numBaseScripts :: Int
numBaseScripts :: Constants -> Int
numBaseScripts}) =
  forall era.
ScriptClass era =>
[(Script era, Script era)] -> [(Script era, Script era)]
mkScriptCombinations @era ([(Script era, Script era)] -> [(Script era, Script era)])
-> ([(Script era, Script era)] -> [(Script era, Script era)])
-> [(Script era, Script era)]
-> [(Script era, Script era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Script era, Script era)] -> [(Script era, Script era)]
forall a. Int -> [a] -> [a]
take Int
numBaseScripts ([(Script era, Script era)] -> [(Script era, Script era)])
-> [(Script era, Script era)] -> [(Script era, Script era)]
forall a b. (a -> b) -> a -> b
$ forall era.
ScriptClass era =>
Constants -> [(Script era, Script era)]
baseScripts @era Constants
c

-- | Constant list of KeyPairs intended to be used in the generators.
keyPairs :: Constants -> KeyPairs
keyPairs :: Constants -> KeyPairs
keyPairs Constants {Word64
numKeyPairs :: Word64
numKeyPairs :: Constants -> Word64
numKeyPairs} = Word64 -> (KeyPair Payment, KeyPair Staking)
forall (kr :: KeyRole) (kr' :: KeyRole).
Word64 -> (KeyPair kr, KeyPair kr')
mkKeyPairs (Word64 -> (KeyPair Payment, KeyPair Staking))
-> [Word64] -> KeyPairs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word64
1 .. Word64
numKeyPairs]

mkKeyPairs ::
  Word64 ->
  (KeyPair kr, KeyPair kr')
mkKeyPairs :: forall (kr :: KeyRole) (kr' :: KeyRole).
Word64 -> (KeyPair kr, KeyPair kr')
mkKeyPairs Word64
n =
  (Word64 -> KeyPair kr
forall {kd :: KeyRole}. Word64 -> KeyPair kd
mkKeyPair_ (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n), Word64 -> KeyPair kr'
forall {kd :: KeyRole}. Word64 -> KeyPair kd
mkKeyPair_ (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1))
  where
    mkKeyPair_ :: Word64 -> KeyPair kd
mkKeyPair_ Word64
n_ =
      ((VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd)
-> (VKey kd, SignKeyDSIGN DSIGN) -> KeyPair kd
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair ((VKey kd, SignKeyDSIGN DSIGN) -> KeyPair kd)
-> ((SignKeyDSIGN DSIGN, VKey kd) -> (VKey kd, SignKeyDSIGN DSIGN))
-> (SignKeyDSIGN DSIGN, VKey kd)
-> KeyPair kd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignKeyDSIGN DSIGN, VKey kd) -> (VKey kd, SignKeyDSIGN DSIGN)
forall a b. (a, b) -> (b, a)
swap)
        (RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
n_ Word64
n_ Word64
n_ Word64
n_ Word64
n_))

{------------------------------------------------------------------------------
  How to be a Generic Value
------------------------------------------------------------------------------}

exponential :: Integer -> Integer -> Gen Integer
exponential :: Integer -> Integer -> Gen Integer
exponential Integer
minc Integer
maxc = [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency [(Int, Gen Integer)]
spread
  where
    width :: Integer
width = (Integer
maxc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
minc) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
n
    deltas :: [Gen Integer]
deltas = [(Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
minc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
width, Integer
minc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
width) | Integer
i <- [Integer
1 .. Integer
n]]
    scales :: [Int]
scales = [Int
1, Int
2, Int
4, Int
6, Int
4, Int
2, Int
1]
    n :: Integer
n = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
scales)
    spread :: [(Int, Gen Integer)]
spread = [Int] -> [Gen Integer] -> [(Int, Gen Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
scales [Gen Integer]
deltas