{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
module Voting.Protocol.Arithmetic where
import Control.Arrow (first)
import Control.DeepSeq (NFData)
import Control.Monad (Monad(..))
import Data.Aeson (ToJSON(..),FromJSON(..))
import Data.Bits
import Data.Bool
import Data.Eq (Eq(..))
import Data.Foldable (Foldable, foldl')
import Data.Function (($), (.), id)
import Data.Int (Int)
import Data.Maybe (Maybe(..), fromJust)
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.Reflection (Reifies(..))
import Data.String (IsString(..))
import GHC.Natural (minusNaturalMaybe)
import Numeric.Natural (Natural)
import Prelude (Integer, Bounded(..), Integral(..), fromIntegral, Enum(..))
import Text.Read (readMaybe)
import Text.Show (Show(..))
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import qualified Data.ByteString as BS
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Prelude as Num
import qualified System.Random as Random
class
( EuclideanRing (G crypto c)
, FromNatural (G crypto c)
, ToNatural (G crypto c)
, Eq (G crypto c)
, Ord (G crypto c)
, Show (G crypto c)
, NFData (G crypto c)
, FromJSON (G crypto c)
, ToJSON (G crypto c)
, Reifies c crypto
) => CryptoParams crypto c where
groupGen :: G crypto c
groupOrder :: Proxy c -> Natural
groupGenPowers :: [G crypto c]
groupGenPowers = go one
where go g = g : go (g * groupGen)
groupGenInverses :: [G crypto c]
groupGenInverses = go one
where
invGen = inverse groupGen
go g = g : go (g * invGen)
class ReifyCrypto crypto where
reifyCrypto :: crypto -> (forall c. Reifies c crypto => CryptoParams crypto c => Proxy c -> r) -> r
class Additive a where
zero :: a
(+) :: a -> a -> a; infixl 6 +
sum :: Foldable f => f a -> a
sum = foldl' (+) zero
instance Additive Natural where
zero = 0
(+) = (Num.+)
instance Additive Integer where
zero = 0
(+) = (Num.+)
instance Additive Int where
zero = 0
(+) = (Num.+)
class Additive a => Semiring a where
one :: a
(*) :: a -> a -> a; infixl 7 *
instance Semiring Natural where
one = 1
(*) = (Num.*)
instance Semiring Integer where
one = 1
(*) = (Num.*)
instance Semiring Int where
one = 1
(*) = (Num.*)
(^) ::
forall crypto c.
Reifies c crypto =>
Semiring (G crypto c) =>
G crypto c -> E crypto c -> G crypto c
(^) b (E e)
| e == 0 = one
| otherwise = t * (b*b) ^ E (e`shiftR`1)
where t | testBit e 0 = b
| otherwise = one
infixr 8 ^
class Semiring a => Ring a where
negate :: a -> a
(-) :: a -> a -> a; infixl 6 -
x-y = x + negate y
instance Ring Integer where
negate = Num.negate
instance Ring Int where
negate = Num.negate
class Ring a => EuclideanRing a where
inverse :: a -> a
(/) :: a -> a -> a; infixl 7 /
x/y = x * inverse y
newtype G crypto c = G { unG :: FieldElement crypto }
type family FieldElement crypto :: *
newtype E crypto c = E { unE :: Natural }
deriving (Eq,Ord,Show)
deriving newtype NFData
instance ToJSON (E crypto c) where
toJSON = JSON.toJSON . show . unE
instance CryptoParams crypto c => FromJSON (E crypto c) where
parseJSON (JSON.String s)
| Just (c0,_) <- Text.uncons s
, c0 /= '0'
, Text.all Char.isDigit s
, Just x <- readMaybe (Text.unpack s)
, x < groupOrder (Proxy @c)
= return (E x)
parseJSON json = JSON.typeMismatch "Exponent" json
instance CryptoParams crypto c => FromNatural (E crypto c) where
fromNatural n = E $ n `mod` groupOrder (Proxy @c)
instance ToNatural (E crypto c) where
nat = unE
instance CryptoParams crypto c => Additive (E crypto c) where
zero = E zero
E x + E y = E $ (x + y) `mod` groupOrder (Proxy @c)
instance CryptoParams crypto c => Semiring (E crypto c) where
one = E one
E x * E y = E $ (x * y) `mod` groupOrder (Proxy @c)
instance CryptoParams crypto c => Ring (E crypto c) where
negate (E x) = E $ fromJust $ groupOrder (Proxy @c)`minusNaturalMaybe`x
instance CryptoParams crypto c => Random.Random (E crypto c) where
randomR (E lo, E hi) =
first (E . fromIntegral) .
Random.randomR
( 0`max`toInteger lo
, toInteger hi`min`(toInteger (groupOrder (Proxy @c)) - 1) )
random =
first (E . fromIntegral) .
Random.randomR (0, toInteger (groupOrder (Proxy @c)) - 1)
instance CryptoParams crypto c => Enum (E crypto c) where
toEnum = fromNatural . fromIntegral
fromEnum = fromIntegral . nat
enumFromTo lo hi = List.unfoldr
(\i -> if i<=hi then Just (i, i+one) else Nothing) lo
instance CryptoParams crypto c => Bounded (E crypto c) where
minBound = zero
maxBound = E $ fromJust $ groupOrder (Proxy @c)`minusNaturalMaybe`1
class FromNatural a where
fromNatural :: Natural -> a
instance FromNatural Natural where
fromNatural = id
class ToNatural a where
nat :: a -> Natural
instance ToNatural Natural where
nat = id
bytesNat :: ToNatural n => n -> BS.ByteString
bytesNat = fromString . show . nat