1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
{-# LANGUAGE Safe #-}

--------------------------------------------------------------------------------

module Data.ThresholdScheme.Shamir
  ( share
  , join
  ) where

--------------------------------------------------------------------------------

import           Data.List
  ( reverse
  )
import           Data.Maybe
  ( fromMaybe
  )

--------------------------------------------------------------------------------

share
  :: Int
  -> Int
  -> Integer
  -> [ Integer ]
  -> Integer
  -> Either String [ (Int, Integer) ]

join
  :: Integer
  -> [ (Int, Integer) ]
  -> Integer

--------------------------------------------------------------------------------

share total required prime randoms secret =
  if (required > 1) && (total >= required) then
    Right $
    points total prime (secret : randoms)
  else
    Left $
    "'required' must be greater than 1 and less-equal than 'total'."

join prime shares =
  lagrange0 prime shares

--------------------------------------------------------------------------------

points
  :: Int
  -> Integer
  -> [ Integer ]
  -> [ (Int, Integer) ]

horner
  :: Integer
  -> Integer
  -> [ Integer ]
  -> Integer

lagrange0
  :: Integer
  -> [ (Int, Integer) ]
  -> Integer

precompute
  :: Integer
  -> Int
  -> Int
  -> [ Int ]
  -> (Integer, Integer)

gcdExt
  :: Integer
  -> Integer
  -> (Integer, Integer, Integer)

modInv
  :: Integer
  -> Integer
  -> Maybe Integer

--------------------------------------------------------------------------------

points 0 _____ __ = []
points n prime xs =
  points (n - 1) prime xs ++ [(n, horner prime (toInteger n) xs)]

horner prime index xs =
  foldl
  (
    \acc x ->
      (((index * acc) `mod` prime) + x) `mod` prime
  ) 0 $ reverse xs

{-
  Protecting AES with Shamir's Secret Sharing Scheme:
  -- https://eprint.iacr.org/2011/516.pdf
-}
lagrange0 prime xs =
  let
    indexes = fst <$> xs
    precomputed =
      (
        \(i,(x,n)) ->
          (n, precompute prime i x indexes)
      ) <$> zip [ 0.. ] xs
  in
    foldl
    (
      \acc (n,(num,den)) ->
        {- As m is prime, we can default to 1 as all the non-zero elements
           of Z / p Z have multiplicative inverses -}
        let
          den' = fromMaybe 1 $ den `modInv` prime
          n'   = n * num * den'
        in
          (prime + acc + n') `mod` prime
    ) 0 $ precomputed

precompute prime index xi indexes =
  let
    fractions =
      (
        \(j,xj) ->
          if index == j then
            Nothing
          else
            Just (toInteger $ negate xj, toInteger $ xi - xj)
      ) <$> zip [ 0.. ] indexes
  in
    foldl
    (
      \acc frac ->
        case frac of
          Nothing ->
            acc
          Just (num, den) ->
            let
              num' = ((fst $ acc) * num) `mod` prime
              den' = ((snd $ acc) * den) `mod` prime
            in
              (num', den')
    ) (1,1) $ fractions

{- Extended Euclidean algorithm -}
gcdExt a 0 = (1, 0, a)
gcdExt a b =
  let
    (q, r) = a `quotRem` b
    (s, t, g) = gcdExt b r
  in
    (t, s - q * t, g)

{- Modular inverse  (in modular arithmetic, the modular multiplicative inverse):
   -- https://rosettacode.org/wiki/Modular_inverse#Haskell
-}
modInv a m =
  let
    (i, _, g) = gcdExt a m
  in
    if g == 1 then
      Just (mkPos i)
    else
      Nothing
  where
    mkPos x = if x < 0 then x + m else x

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
#!/usr/bin/env stack
{- stack
   --resolver lts-12.0
   --install-ghc
   script
   --ghc-options -Werror
   --ghc-options -Wall
   --
-}

--------------------------------------------------------------------------------

{-# LANGUAGE Safe #-}

--------------------------------------------------------------------------------

module Main (main) where

--------------------------------------------------------------------------------

import           Data.Either
  ( fromRight
  )

--------------------------------------------------------------------------------

import qualified Data.ThresholdScheme.Shamir as TSS

--------------------------------------------------------------------------------

{- https://en.wikipedia.org/wiki/Shamir's_Secret_Sharing#Solution -}
assertShare :: Either String [(Int, Integer)]
assertShare =
  TSS.share total required prime randoms secret
  where
    prime    = 1613
    secret   = 1234
    total    = 6 -- n
    required = 3 -- k
    randoms  = [ 166, 94 ]

assertJoin :: Integer
assertJoin =
  TSS.join prime shares
  where
    prime  = 1613
    shares = [ (2, 329), (4, 176), (5, 1188) ]

addition :: Integer
addition =
  -- 63 (only require "k" the shares)
  TSS.join prime $ (\((i,x),(_,y)) -> (i,(x + y) `mod` prime))
  -- <$> zip (drop 3 xs) (drop 3 ys)
  <$> zip (take 3 xs) (take 3 ys)
  where
    xs :: [ (Int, Integer) ]
    xs =
      -- 21
      fromRight [] $
      TSS.share total required prime randoms secretA
    ys :: [ (Int, Integer) ]
    ys =
      -- 42
      fromRight [] $
      TSS.share total required prime randoms secretB
    -- Fifth Fermat number: https://oeis.org/A000215
    -- prime    = 65537
    -- Sixth Bell prime:    https://oeis.org/A051131/list
    prime    = 359334085968622831041960188598043661065388726959079837
    secretA  = 21
    secretB  = 42
    total    = 6 -- n
    required = 3 -- k
    randoms  = [ 166, 94 ]

multiplication :: Integer
multiplication =
  -- 882 (require all the "n" the shares)
  TSS.join prime $ (\((i,x),(_,y)) -> (i,(x * y) `mod` prime))
  <$> zip xs ys
  where
    xs :: [ (Int, Integer) ]
    xs =
      -- 21
      fromRight [] $
      TSS.share total required prime randoms secretA
    ys :: [ (Int, Integer) ]
    ys =
      -- 42
      fromRight [] $
      TSS.share total required prime randoms secretB
    -- Fifth Fermat number: https://oeis.org/A000215
    -- prime    = 65537
    -- Sixth Bell prime:    https://oeis.org/A051131/list
    prime    = 359334085968622831041960188598043661065388726959079837
    secretA  = 21
    secretB  = 42
    total    = 6 -- n
    required = 3 -- k
    randoms  = [ 166, 94 ]

main :: IO ()
main =
  do
    putStrLn "# https://en.wikipedia.org/wiki/Shamir's_Secret_Sharing#Solution:"
    putStrLn ""
    case assertShare of
      Right shares -> putStrLn $ ("> Shares: " ++) $ show $ shares
      Left  msg    -> putStrLn $ msg
    putStrLn $ ("> Joined: " ++) $ show $ assertJoin
    putStrLn ""
    putStrLn $ ("> 21 + 42 with 'k' shares (3): " ++) $ show $ addition
    putStrLn $ ("> 21 * 42 with 'n' shares (6): " ++) $ show $ multiplication

user@personal:~/../threshold-scheme-shamir$ ./Main.hs 
# https://en.wikipedia.org/wiki/Shamir's_Secret_Sharing#Solution:

> Shares: [(1,1494),(2,329),(3,965),(4,176),(5,1188),(6,775)]
> Joined: 1234

> 21 + 42 with 'k' shares (3): 63
> 21 * 42 with 'n' shares (6): 882