{- |
This module collects basic secure (secret-shared) types for hMPC.

Secure number types all use common base classes, which
ensures that operators such as +,* are defined by operator overloading.
-}
module SecTypes where

import Hgmp
import Data.Bits
import Types
import Control.Concurrent.MVar
import Control.Monad.State
import FinFields
import Parser

-- | A secret-shared object.

--

-- An MPC protocol operates on secret-shared objects of type SecureObject.

-- The basic Haskell operators are overloaded instances by SecureTypes classes.

-- An expression like a * b will create a new SecureObject, which will

-- eventually contain the product of a and b. The product is computed

-- asynchronously, using an instance of a specific cryptographic protocol.

data SecureTypes = 
    -- | Base class for secure (secret-shared) numbers.

    SecFld {SecureTypes -> FiniteField
field :: FiniteField, SecureTypes -> MVar FiniteField
share :: MVar FiniteField, SecureTypes -> Int
bitLength :: Int}
    -- | Base class for secure (secret-shared) finite field elements.

    | SecInt {field :: FiniteField, share :: MVar FiniteField, bitLength :: Int}
    | Literal {share :: MVar FiniteField}

-- | Secure l-bit integers ('SecInt').

secIntGen :: Int -> SIO (Integer -> SIO SecureTypes)
secIntGen :: Int -> SIO (Integer -> SIO SecureTypes)
secIntGen Int
l = do
    Int
k <- Options -> Int
secParam (Options -> Int) -> StateT Env IO Options -> StateT Env IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env -> Options) -> StateT Env IO Options
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Options
options
    let field :: FiniteField
field = Integer -> FiniteField
FinFields.gf (Integer -> Integer
Hgmp.prevPrime (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    (Integer -> SIO SecureTypes) -> SIO (Integer -> SIO SecureTypes)
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer -> SIO SecureTypes) -> SIO (Integer -> SIO SecureTypes))
-> (Integer -> SIO SecureTypes) -> SIO (Integer -> SIO SecureTypes)
forall a b. (a -> b) -> a -> b
$ SecureTypes -> Integer -> SIO SecureTypes
setShare (SecureTypes -> Integer -> SIO SecureTypes)
-> SecureTypes -> Integer -> SIO SecureTypes
forall a b. (a -> b) -> a -> b
$ SecInt {field :: FiniteField
field = FiniteField
field, bitLength :: Int
bitLength = Int
l}


-- | Secure finite field ('SecFld') of order q = p

-- where p is a prime number

secFldGen :: Integer -> (Integer -> SIO SecureTypes)
secFldGen :: Integer -> Integer -> SIO SecureTypes
secFldGen Integer
pnew = let field :: FiniteField
field = Integer -> FiniteField
FinFields.gf Integer
pnew
                     bitLength :: Int
bitLength = (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> (Integer -> Double) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Integer
pnew
                 in SecureTypes -> Integer -> SIO SecureTypes
setShare (SecureTypes -> Integer -> SIO SecureTypes)
-> SecureTypes -> Integer -> SIO SecureTypes
forall a b. (a -> b) -> a -> b
$ SecFld {field :: FiniteField
field = FiniteField
field, bitLength :: Int
bitLength = Int
bitLength}

setShare :: SecureTypes -> Integer -> SIO SecureTypes
setShare :: SecureTypes -> Integer -> SIO SecureTypes
setShare SecureTypes
sectype Integer
val = do
    MVar FiniteField
mvar <- IO (MVar FiniteField) -> StateT Env IO (MVar FiniteField)
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar FiniteField) -> StateT Env IO (MVar FiniteField))
-> IO (MVar FiniteField) -> StateT Env IO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ FiniteField -> IO (MVar FiniteField)
forall a. a -> IO (MVar a)
newMVar (SecureTypes -> FiniteField
field SecureTypes
sectype){value = val}
    SecureTypes -> SIO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> SIO SecureTypes) -> SecureTypes -> SIO SecureTypes
forall a b. (a -> b) -> a -> b
$ SecureTypes
sectype {share = mvar}