1 files changed, 152 insertions, 0 deletions
diff --git a/Crypto/SecretSharing/Internal.hs b/Crypto/SecretSharing/Internal.hs
new file mode 100644
index 0000000..5fff416
--- /dev/null
+++ b/Crypto/SecretSharing/Internal.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-} 
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Crypto.SecretSharing.Internal
+-- Copyright   :  Peter Robinson 2014
+-- License     :  LGPL
+-- 
+-- Maintainer  :  Peter Robinson <peter.robinson@monoid.at>
+-- Stability   :  experimental
+-- Portability :  portable
+-- 
+-----------------------------------------------------------------------------
+
+module Crypto.SecretSharing.Internal
+where
+import Math.Polynomial.Interpolation
+
+import Data.ByteString.Lazy( ByteString )
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BLC
+import qualified Data.List as L
+import Data.Char
+import Data.Vector( Vector )
+import qualified Data.Vector as V
+import Data.Typeable
+import Control.Exception
+import Control.Monad
+import Data.Binary( Binary )
+import GHC.Generics
+import Data.FiniteField.PrimeField as PF
+import Data.FiniteField.Base(FiniteField,order)
+import System.Random.Dice
+
+
+
+-- | A share of an encoded byte. 
+data ByteShare = ByteShare 
+  { shareId :: !Int                  -- ^ the index of this share 
+  , reconstructionThreshold :: !Int  -- ^ number of shares required for 
+                                     -- reconstruction
+  , shareValue :: !Int        -- ^ the value of p(shareId) where p(x) is the 
+                              --   generated (secret) polynomial
+  }
+  deriving(Typeable,Eq,Generic)
+
+instance Show ByteShare where
+  show = show . shareValue 
+
+-- | A share of the encoded secret.
+data Share = Share 
+  { theShare :: ![ByteShare] }
+  deriving(Typeable,Eq,Generic)
+
+instance Show Share where
+  show s = show (shareId $ head $ theShare s,BLC.pack $ map (chr . shareValue) $ theShare s)
+
+instance Binary ByteShare
+instance Binary Share
+
+-- | Encodes a 'ByteString' as a list of n shares, m of which are required for
+-- reconstruction.
+-- Lives in the 'IO' to access a random source.
+encode :: Int         -- ^ m 
+       -> Int         -- ^ n
+       -> ByteString  -- ^ the secret that we want to share
+       -> IO [Share] -- a list of n-shares (per byte) 
+encode m n bstr 
+  | n >= prime || m > n = throw $ AssertionFailed $ 
+      "encode: require n < " ++ show prime ++ " and m<=n."
+  | BL.null bstr = return []
+  | otherwise = do
+  let len = max 1 ((fromIntegral $ BL.length bstr) * (m-1))
+  coeffs <- (groupInto (m-1) . map fromIntegral . take len ) 
+                            `liftM` (getDiceRolls prime len)
+  let byteVecs = zipWith (encodeByte m n) coeffs $
+                    map fromIntegral $ BL.unpack bstr 
+  return [ Share $ map (V.! (i-1)) byteVecs | i <- [1..n] ]
+
+
+-- | Reconstructs a (secret) bytestring from a list of (at least @m@) shares. 
+-- Throws 'AssertionFailed' if the number of shares is too small.
+decode :: [Share]    -- ^ list of at least @m@ shares
+       -> ByteString -- ^ reconstructed secret
+decode []     = BL.pack []
+decode shares@((Share s):_) 
+  | length shares < reconstructionThreshold (head s) = throw $ AssertionFailed 
+      "decode: not enough shares for reconstruction."
+  | otherwise =
+    let origLength = length s in
+    let byteVecs = map (V.fromList . theShare) shares in
+    let byteShares = [ map ((V.! (i-1))) byteVecs | i <- [1..origLength] ] in
+    BL.pack . map (fromInteger . PF.toInteger . number) 
+            . map decodeByte $ byteShares
+    
+
+encodeByte :: Int -> Int -> Polyn -> FField -> Vector ByteShare
+encodeByte m n coeffs secret = 
+  V.fromList[ ByteShare i m $ fromInteger . PF.toInteger . number $ 
+                evalPolynomial (secret:coeffs) (fromIntegral i::FField) 
+            | i <- [1..n] 
+            ]
+
+
+decodeByte :: [ByteShare] -> FField
+decodeByte ss =
+  let m = reconstructionThreshold $ head ss in
+  if length ss < m
+    then throw $ AssertionFailed "decodeByte: insufficient number of shares for reconstruction!"
+    else
+      let shares = take m ss 
+          pts = map (\s -> (fromIntegral $ shareId s,fromIntegral $ shareValue s)) 
+                    shares 
+      in
+      polyInterp pts 0
+
+
+-- | Groups a list into blocks of certain size. Running time: /O(n)/
+groupInto :: Int -> [a] -> [[a]]
+groupInto num as
+  | num < 0  = throw $ AssertionFailed "groupInto: Need positive number as argument."
+  | otherwise = 
+    let (fs,ss) = L.splitAt num as in
+    if L.null ss 
+      then [fs]
+      else fs : groupInto num ss 
+
+
+-- | A finite prime field. All computations are performed in this field.
+--
+-- This is modified from the secret-sharing library to use 256
+-- instead of 1021. That allows values in the field to be efficiently
+-- packed into bytes. It's beleived that the finite field can be a power of
+-- a prime number (in this case, 2).
+newtype FField = FField { number :: $(primeField $ fromIntegral (256 :: Integer)) }
+  deriving(Show,Read,Ord,Eq,Num,Fractional,Generic,Typeable,FiniteField)
+  
+
+-- | The size of the finite field
+prime :: Int
+prime = fromInteger $ order (0 :: FField)
+
+
+-- | A polynomial over the finite field given as a list of coefficients.
+type Polyn = [FField] 
+
+-- | Evaluates the polynomial at a given point.
+evalPolynomial :: Polyn -> FField -> FField
+evalPolynomial coeffs x =
+  foldr (\c res -> c + (x * res)) 0 coeffs
+--  let clist = zipWith (\pow c -> (\x -> c * (x^pow))) [0..] coeffs 
+--  in L.foldl' (+) 0 [ c x | c <- clist ]
+