-- TODO: Pseudorandom secret sharing (PRSS) allows one to share pseudorandom

-- secrets without any communication, as long as the parties

-- agree on a (unique) common public input for each secret.

-- PRSS relies on parties having agreed upon the keys for a pseudorandom

-- function (PRF).

{- |
Module for information-theoretic threshold secret sharing.

Threshold secret sharing assumes secure channels for communication.
-}
module Shamir (randomSplit, _recombinationVector, recombine, IdSharesPair) where

import Control.Monad
import FinFields
import System.Random
import Data.List

-- | Couples a ID pi to the share list si.

type IdSharesPair = (Integer, [Integer]) 



-- | Split each secret given in s into m random Shamir shares.

--

-- The (maximum) degree for the Shamir polynomials is t, @0 <= t < m@.

-- Return matrix of shares, one row per party.

randomSplit :: (RandomGen g) => FiniteField -> [FiniteField] -> Integer -> Integer -> g -> ([[Integer]], g)
randomSplit :: forall g.
RandomGen g =>
FiniteField
-> [FiniteField] -> Integer -> Integer -> g -> ([[Integer]], g)
randomSplit FiniteField
field [FiniteField]
s Integer
t Integer
m g
g = let (g
g', [[Integer]]
shares) = (g -> Integer -> (g, [Integer]))
-> g -> [Integer] -> (g, [[Integer]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR g -> Integer -> (g, [Integer])
forall {a}. RandomGen a => a -> Integer -> (a, [Integer])
h g
g ((FiniteField -> Integer) -> [FiniteField] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map FiniteField -> Integer
value [FiniteField]
s)   
                            in ([[Integer]] -> [[Integer]]
forall a. [[a]] -> [[a]]
transpose [[Integer]]
shares, g
g')
    where
        randoms :: b -> Int -> p -> ([p], b)
randoms b
gen Int
len p
bound = let (b
gen1, b
gen2) = b -> (b, b)
forall g. RandomGen g => g -> (g, g)
split b
gen
                                    _rands :: [p]
_rands = Int -> [p] -> [p]
forall a. Int -> [a] -> [a]
take Int
len ([p] -> [p]) -> [p] -> [p]
forall a b. (a -> b) -> a -> b
$ (p, p) -> b -> [p]
forall g. RandomGen g => (p, p) -> g -> [p]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (p
0, p
bound) b
gen1
                                in ([p]
_rands, b
gen2)
        h :: a -> Integer -> (a, [Integer])
h a
g' Integer
s_h = let ([Integer]
coefs, a
g'') = a -> Int -> Integer -> ([Integer], a)
forall {p} {b}.
(Random p, RandomGen b, Num p) =>
b -> Int -> p -> ([p], b)
randoms a
g' (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
t) (FiniteFieldMeta -> Integer
modulus (FiniteFieldMeta -> Integer) -> FiniteFieldMeta -> Integer
forall a b. (a -> b) -> a -> b
$ FiniteField -> FiniteFieldMeta
meta FiniteField
field)
                       shares :: [Integer]
shares = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i1 -> ((Integer
s_h Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ([Integer] -> Integer -> Integer
forall {t :: * -> *} {b}. (Foldable t, Num b) => t b -> b -> b
poly [Integer]
coefs Integer
i1)) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (FiniteFieldMeta -> Integer
modulus (FiniteFieldMeta -> Integer) -> FiniteFieldMeta -> Integer
forall a b. (a -> b) -> a -> b
$ FiniteField -> FiniteFieldMeta
meta FiniteField
field))) [Integer
1..Integer
m]
                   in (a
g'', [Integer]
shares)           
        -- polynomial f(X) = s[h] + c[t-1] X + c[t-2] X^2 + ... + c[0] X^t

        poly :: t b -> b -> b
poly t b
c b
i1 = (b -> b -> b) -> b -> t b -> b
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\b
c_j b
y -> (b
y b -> b -> b
forall a. Num a => a -> a -> a
+ b
c_j) b -> b -> b
forall a. Num a => a -> a -> a
* b
i1) b
0 t b
c


-- | Compute and store a recombination vector.

--

-- A recombination vector depends on the field, the x-coordinates xs

-- of the shares and the x-coordinate x_r of the recombination point.

_recombinationVector :: FiniteField -> [Integer] -> Integer -> [Integer]
_recombinationVector :: FiniteField -> [Integer] -> Integer -> [Integer]
_recombinationVector FiniteField
field [Integer]
xs Integer
x_r = ((Integer, Integer) -> Integer)
-> [(Integer, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Integer) -> Integer
forall {a}. (Eq a, Num a, Enum a) => (a, Integer) -> Integer
coefs_div ([Integer] -> [Integer] -> [(Integer, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Integer]
xs)
    where
        coefs_div :: (a, Integer) -> Integer
coefs_div (a
i, Integer
x_i) = let (Integer
cf_n, Integer
cf_d) = a -> Integer -> (Integer, Integer)
forall {a}.
(Eq a, Num a, Enum a) =>
a -> Integer -> (Integer, Integer)
coefs a
i Integer
x_i
                             in Integer
cf_n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
cf_d
        coefs :: a -> Integer -> (Integer, Integer)
coefs a
i Integer
x_i = ((a, Integer) -> (Integer, Integer) -> (Integer, Integer))
-> (Integer, Integer) -> [(a, Integer)] -> (Integer, Integer)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
j, Integer
x_j) (Integer
coef_n, Integer
coef_d) ->
            if a
j a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
i
                then (Integer
coef_n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
x_rInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
x_j), Integer
coef_d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
x_iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
x_j))
                else (Integer
coef_n, Integer
coef_d)) (Integer
1,Integer
1) ([a] -> [Integer] -> [(a, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] [Integer]
xs)
            
-- | Recombine shares given by points into secrets.

--

-- Recombination is done for x-coordinates x_rs.

recombine :: FiniteField -> [IdSharesPair] -> [FiniteField]
recombine :: FiniteField -> [IdSharesPair] -> [FiniteField]
recombine FiniteField
field [IdSharesPair]
points =
    let ([Integer]
xs, [[Integer]]
shares) = [IdSharesPair] -> ([Integer], [[Integer]])
forall a b. [(a, b)] -> ([a], [b])
unzip [IdSharesPair]
points
        vector :: [Integer]
vector = FiniteField -> [Integer] -> Integer -> [Integer]
_recombinationVector FiniteField
field [Integer]
xs Integer
0
        p :: Integer
p = FiniteFieldMeta -> Integer
modulus (FiniteFieldMeta -> Integer) -> FiniteFieldMeta -> Integer
forall a b. (a -> b) -> a -> b
$ FiniteField -> FiniteFieldMeta
meta FiniteField
field
    in ([Integer] -> FiniteField) -> [[Integer]] -> [FiniteField]
forall a b. (a -> b) -> [a] -> [b]
map (\[Integer]
share_i -> FiniteField
field{value = (sum share_i vector) `mod` p}) ([[Integer]] -> [[Integer]]
forall a. [[a]] -> [[a]]
transpose [[Integer]]
shares)
        where
            sum :: [b] -> [b] -> b
sum [b]
share_i [b]
vector = ((Int, b) -> b -> b) -> b -> [(Int, b)] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, b
s) -> b -> b -> b
forall a. Num a => a -> a -> a
(+) (b
s b -> b -> b
forall a. Num a => a -> a -> a
* ([b]
vector [b] -> Int -> b
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) )) b
0 ([Int] -> [b] -> [(Int, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [b]
share_i)