{-# OPTIONS_GHC -fno-warn-orphans #-}
module Protocol.Arithmetic
( module Protocol.Arithmetic
, Natural
) where
import Control.Arrow (first)
import Control.Monad (Monad(..))
import Data.Bits
import Data.Bool
import Data.Eq (Eq(..))
import Data.Foldable (Foldable, foldl')
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Numeric.Natural (Natural)
import Prelude (Integer, Integral(..), fromIntegral, Enum(..))
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State.Strict as S
import qualified Crypto.Hash as Crypto
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import qualified Data.List as List
import qualified Prelude as Num
import qualified System.Random as Random
newtype F p = F { unF :: Natural }
deriving (Eq,Ord,Show)
instance PrimeField p => FromNatural (F p) where
fromNatural i = F (abs (i `mod` fieldCharac @p))
where abs x | x < 0 = x + fieldCharac @p
| otherwise = x
instance ToNatural (F p) where
nat = unF
instance PrimeField p => Additive (F p) where
zero = F 0
F x + F y = F ((x + y) `mod` fieldCharac @p)
instance PrimeField p => Negable (F p) where
neg (F x) | x == 0 = zero
| otherwise = F (fromIntegral (Num.negate (toInteger x) + toInteger (fieldCharac @p)))
instance PrimeField p => Multiplicative (F p) where
one = F 1
F x * F y = F ((x * y) `mod` fieldCharac @p)
instance PrimeField p => Random.Random (F p) where
randomR (F lo, F hi) =
first (F . fromIntegral) .
Random.randomR
( 0`max`toInteger lo
, toInteger hi`min`(toInteger (fieldCharac @p) - 1))
random = first (F . fromIntegral) . Random.randomR (0, toInteger (fieldCharac @p) - 1)
class PrimeField p where
fieldCharac :: Natural
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 => Negable a where
neg :: a -> a
(-) :: a -> a -> a; infixl 6 -
x-y = x + neg y
instance Negable Integer where
neg = Num.negate
instance Negable Int where
neg = Num.negate
class Multiplicative a where
one :: a
(*) :: a -> a -> a; infixl 7 *
instance Multiplicative Natural where
one = 1
(*) = (Num.*)
instance Multiplicative Integer where
one = 1
(*) = (Num.*)
instance Multiplicative Int where
one = 1
(*) = (Num.*)
class Multiplicative a => Invertible a where
inv :: a -> a
(/) :: a -> a -> a; infixl 7 /
x/y = x * inv y
newtype G q = G { unG :: F (P q) }
deriving (Eq,Ord,Show)
instance PrimeField (P q) => FromNatural (G q) where
fromNatural = G . fromNatural
instance ToNatural (G q) where
nat = unF . unG
instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (G q) where
one = G one
G x * G y = G (x * y)
instance (SubGroup q, Multiplicative (F (P q))) => Invertible (G q) where
inv = (^ E (neg one + groupOrder @q))
class
( PrimeField (P q)
, Multiplicative (F (P q))
) => SubGroup q where
type P q :: *
groupGen :: G q
groupOrder :: F (P q)
groupGenInverses :: [G q]
groupGenInverses = go one
where
go g = g : go (g * invGen)
invGen = inv groupGen
hash ::
SubGroup q =>
BS.ByteString -> [G q] -> E q
hash bs gs =
let s = bs <> BS.intercalate (fromString ",") (bytesNat <$> gs) in
let h = ByteArray.convert (Crypto.hashWith Crypto.SHA256 s) in
fromNatural (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Natural) h)
newtype E q = E { unE :: F (P q) }
deriving (Eq,Ord,Show)
instance SubGroup q => FromNatural (E q) where
fromNatural i = E (F (abs (i `mod` unF (groupOrder @q))))
where abs x | x < 0 = x + unF (groupOrder @q)
| otherwise = x
instance ToNatural (E q) where
nat = unF . unE
instance (SubGroup q, Additive (F (P q))) => Additive (E q) where
zero = E zero
E (F x) + E (F y) = E (F ((x + y) `mod` unF (groupOrder @q)))
instance (SubGroup q, Negable (F (P q))) => Negable (E q) where
neg (E (F x)) | x == 0 = zero
| otherwise = E (F (fromIntegral ( neg (toInteger x)
+ toInteger (unF (groupOrder @q)) )))
instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (E q) where
one = E one
E (F x) * E (F y) = E (F ((x * y) `mod` unF (groupOrder @q)))
instance SubGroup q => Random.Random (E q) where
randomR (E (F lo), E (F hi)) =
first (E . F . fromIntegral) .
Random.randomR
( 0`max`toInteger lo
, toInteger hi`min`(toInteger (unF (groupOrder @q)) - 1) )
random =
first (E . F . fromIntegral) .
Random.randomR (0, toInteger (unF (groupOrder @q)) - 1)
instance SubGroup q => Enum (E q) where
toEnum = fromNatural . fromIntegral
fromEnum = fromIntegral . nat
enumFromTo lo hi = List.unfoldr
(\i -> if i<=hi then Just (i, i+one) else Nothing) lo
infixr 8 ^
(^) :: SubGroup q => G q -> E q -> G q
(^) b (E (F e))
| e == zero = one
| otherwise = t * (b*b) ^ E (F (e`shiftR`1))
where
t | testBit e 0 = b
| otherwise = one
type RandomGen = Random.RandomGen
randomR ::
Monad m =>
RandomGen r =>
Random.Random i =>
Negable i =>
Multiplicative i =>
i -> S.StateT r m i
randomR i = S.StateT $ return . Random.randomR (zero, i-one)
random ::
Monad m =>
RandomGen r =>
Random.Random i =>
Negable i =>
Multiplicative i =>
S.StateT r m i
random = S.StateT $ return . Random.random
instance Random.Random Natural where
randomR (mini,maxi) =
first (fromIntegral::Integer -> Natural) .
Random.randomR (fromIntegral mini, fromIntegral maxi)
random = first (fromIntegral::Integer -> Natural) . Random.random
data WeakParams
instance PrimeField WeakParams where
fieldCharac = 263
instance SubGroup WeakParams where
type P WeakParams = WeakParams
groupGen = G (F 2)
groupOrder = F 131
data BeleniosParams
instance PrimeField BeleniosParams where
fieldCharac = 20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719
instance SubGroup BeleniosParams where
type P BeleniosParams = BeleniosParams
groupGen = G (F 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627)
groupOrder = F 78571733251071885079927659812671450121821421258408794611510081919805623223441
class FromNatural a where
fromNatural :: Natural -> a
class ToNatural a where
nat :: a -> Natural
bytesNat :: ToNatural n => n -> BS.ByteString
bytesNat = fromString . show . nat