{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module PrimeField (
P,
unP,
Q,
unQ,
G,
unG,
SPF,
spfP,
spfQ,
spfG,
mkSPF,
mkSPF',
SPFM,
runSPFT,
runSPFM,
gexpSafeSPF,
gexpSafeSPFM,
expSafeSPF,
expSafeSPFM,
randomInZq,
randomInZqM,
randomInZp,
randomInZpM,
modp,
modpM,
(|*|),
(|+|),
)where
import Protolude
import Crypto.Random.Types (MonadRandom(..))
import Crypto.Number.Generate (generateBetween)
import Crypto.Number.ModArithmetic (expSafe)
import Crypto.Number.Prime (generateSafePrime, isProbablyPrime)
newtype P = P { unP :: Integer }
deriving (Show, Eq, Ord)
newtype Q = Q { unQ :: Integer }
deriving (Show, Eq, Ord)
newtype G = G { unG :: Integer }
deriving (Show, Eq, Ord)
data SPF = SPF
{ spfP :: P
, spfQ :: Q
, spfG :: G
}
mkSPF :: MonadRandom m => Int -> m SPF
mkSPF nbits = do
p <- generateSafePrime nbits
let q = (p - 1) `div` 2
g <- generateBetween 2 (q-1)
return $ SPF (P p) (Q q) (G g)
mkSPF' :: Integer -> Integer -> Integer -> Maybe SPF
mkSPF' p g q
| isPPrime &&
isQPrime &&
isPSafePrime &&
isGGenerator = Just $
SPF (P p) (Q q) (G g)
| otherwise = Nothing
where
isPPrime = isProbablyPrime p
isQPrime = isProbablyPrime q
isPSafePrime = p == (2*q + 1)
isGGenerator = g > 1 && g < p
type SPFM = ReaderT SPF
runSPFT :: SPF -> SPFM m a -> m a
runSPFT = flip runReaderT
runSPFM :: SPF -> SPFM Identity a -> a
runSPFM spf = runIdentity . runSPFT spf
gexpSafeSPF :: SPF -> Integer -> Integer
gexpSafeSPF (SPF p _ g) e = expSafe (unG g) e (unP p)
gexpSafeSPFM :: Monad m => Integer -> SPFM m Integer
gexpSafeSPFM e = liftM (`gexpSafeSPF` e) ask
expSafeSPF :: SPF -> Integer -> Integer -> Integer
expSafeSPF (SPF p _ _) b e = expSafe b e (unP p)
expSafeSPFM :: Monad m => Integer -> Integer -> SPFM m Integer
expSafeSPFM b e = (\spf -> expSafeSPF spf b e) <$> ask
randomInZq :: MonadRandom m => SPF -> m Integer
randomInZq (SPF _ q _) = generateBetween 1 (unQ q - 1)
randomInZqM :: MonadRandom m => SPFM m Integer
randomInZqM = lift . randomInZq =<< ask
randomInZp :: MonadRandom m => SPF -> m Integer
randomInZp (SPF p _ _) = generateBetween 1 (unP p - 1)
randomInZpM :: MonadRandom m => SPFM m Integer
randomInZpM = lift . randomInZp =<< ask
modp :: SPF -> Integer -> Integer
modp (SPF p _ _) n = n `mod` unP p
modpM :: Monad m => Integer -> SPFM m Integer
modpM n = flip modp n <$> ask
(|*|) :: Monad m => SPFM m Integer -> SPFM m Integer -> SPFM m Integer
x |*| y = modpM =<< liftM2 (*) x y
(|+|) :: Monad m => SPFM m Integer -> SPFM m Integer -> SPFM m Integer
x |+| y = modpM =<< liftM2 (+) x y