{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

{- |
The hMPC runtime module is used to execute secure multiparty computations.

Parties perform computations on secret-shared values by exchanging messages.
Shamir's threshold secret sharing scheme is used for finite fields of any order
exceeding the number of parties. hMPC provides many secure data types, ranging
from numeric types to more advanced types, for which the corresponding operations
are made available through Haskell's mechanism for operator overloading.
-}
module Runtime (secIntGen, secFldGen, runMpc, runMpcWithArgs, runSession, Input, input, Output(..), transfer, (.+), (.-), (.*), (./), srecip, (.^), (.<), (.<=), (.>), (.==), isZero, isZeroPublic, ssignum, argmaxfunc, argmax, smaximum, ssum, sproduct,sall, randomBits, inProd, schurProd, matrixProd, IfElse(..), ifElseList, async, await) where

import Control.Lens.Traversal
import Data.Maybe
import Data.List.Split
import Data.List
import Data.Bits
import Data.Function
import Text.Printf
import System.Info (os)
import Control.Concurrent
import Control.Monad
import Control.Monad.State
import Asyncoro
import System.Process
import System.Environment
import System.Random
import Shamir
import Prelude
import Types
import Network.Socket
import Parser
import SecTypes
import FinFields
import Data.Serialize (encode, decode, Serialize)
import qualified Data.ByteString as BS
import Data.Time
import System.Log.Logger
import System.Log.Formatter
import System.Log.Handler.Simple
import System.Log.Handler (setFormatter)
import System.IO
import Options.Applicative (Parser)

-- | Runs 'MPC' computation

runMpc :: SIO a -> IO a
runMpc :: forall a. SIO a -> IO a
runMpc = \SIO a
action -> do
    Env
conf <- Options -> IO Env
Runtime.setup (Options -> IO Env) -> IO Options -> IO Env
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Options
Parser.getArgParser
    SIO a -> Env -> IO a
forall a. SIO a -> Env -> IO a
runSIO SIO a
action Env
conf

-- | Runs 'MPC' computation with user arguments

runMpcWithArgs :: Parser b -> (b -> SIO a) -> IO a
runMpcWithArgs :: forall b a. Parser b -> (b -> SIO a) -> IO a
runMpcWithArgs Parser b
parser = \b -> SIO a
action -> do
    (Options
mpcOpts, b
userOpts) <- Parser b -> IO (Options, b)
forall a. Parser a -> IO (Options, a)
Parser.getArgParserExtra Parser b
parser
    Env
conf <- Options -> IO Env
Runtime.setup Options
mpcOpts
    SIO a -> Env -> IO a
forall a. SIO a -> Env -> IO a
runSIO (b -> SIO a
action b
userOpts) Env
conf

-- | Start and Stop hMPC runtime

runSession :: SIO a -> SIO a
runSession :: forall a. SIO a -> SIO a
runSession SIO a
action = do
    Env
env <- SIO Env
Runtime.start
    IO a -> SIO a
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> SIO a) -> IO a -> SIO a
forall a b. (a -> b) -> a -> b
$ SIO a -> Env -> IO a
forall a. SIO a -> Env -> IO a
runSIO (do a
val <- SIO a
action; SIO ()
Runtime.shutdown; a -> SIO a
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val) Env
env

exchangeShares :: [BS.ByteString] -> SIO [MVar BS.ByteString]
exchangeShares :: [ByteString] -> SIO [MVar ByteString]
exchangeShares [ByteString]
inShares = do
    [Party]
parties <- (Env -> [Party]) -> StateT Env IO [Party]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> [Party]
parties

    [(Party, ByteString)] -> ((Party, ByteString) -> SIO ()) -> SIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Party] -> [ByteString] -> [(Party, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Party]
parties [ByteString]
inShares) (((Party, ByteString) -> SIO ()) -> SIO ())
-> ((Party, ByteString) -> SIO ()) -> SIO ()
forall a b. (a -> b) -> a -> b
$ \(Party
party, ByteString
bytes) ->
        Bool -> SIO () -> SIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Socket -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Socket -> Bool) -> Maybe Socket -> Bool
forall a b. (a -> b) -> a -> b
$ Party -> Maybe Socket
sock Party
party) (ByteString -> Party -> SIO ()
sendMessage ByteString
bytes Party
party)

    [(Party, Int)]
-> ((Party, Int) -> StateT Env IO (MVar ByteString))
-> SIO [MVar ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Party] -> [Int] -> [(Party, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Party]
parties [Int
0..]) (((Party, Int) -> StateT Env IO (MVar ByteString))
 -> SIO [MVar ByteString])
-> ((Party, Int) -> StateT Env IO (MVar ByteString))
-> SIO [MVar ByteString]
forall a b. (a -> b) -> a -> b
$ \(Party
party, Int
index) ->
        case Party -> Maybe Socket
sock Party
party of
        Just Socket
_ -> Party -> StateT Env IO (MVar ByteString)
receiveMessage Party
party
        Maybe Socket
Nothing -> IO (MVar ByteString) -> StateT Env IO (MVar ByteString)
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ByteString) -> StateT Env IO (MVar ByteString))
-> IO (MVar ByteString) -> StateT Env IO (MVar ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (MVar ByteString)
forall a. a -> IO (MVar a)
newMVar ([ByteString]
inShares [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
index)


-- | Transfer serializable Haskell objects

transfer :: (Serialize a) => a -> SIO (MVar [a])
transfer :: forall a. Serialize a => a -> SIO (MVar [a])
transfer a
val = do
    [Party]
parties <- (Env -> [Party]) -> StateT Env IO [Party]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> [Party]
parties
    let encVal :: ByteString
encVal = (a -> ByteString
forall a. Serialize a => a -> ByteString
encode a
val)  
    MVar [a]
out <- SIO [a] -> SIO (MVar [a])
forall a. SIO a -> SIO (MVar a)
async (SIO [a] -> SIO (MVar [a])) -> SIO [a] -> SIO (MVar [a])
forall a b. (a -> b) -> a -> b
$ do
        [Party] -> (Party -> SIO ()) -> SIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Party]
parties ((Party -> SIO ()) -> SIO ()) -> (Party -> SIO ()) -> SIO ()
forall a b. (a -> b) -> a -> b
$ \Party
party -> 
            Bool -> SIO () -> SIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Socket -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Socket -> Bool) -> Maybe Socket -> Bool
forall a b. (a -> b) -> a -> b
$ Party -> Maybe Socket
sock Party
party) (ByteString -> Party -> SIO ()
sendMessage ByteString
encVal Party
party)
  
        [Party] -> (Party -> StateT Env IO a) -> SIO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Party]
parties ((Party -> StateT Env IO a) -> SIO [a])
-> (Party -> StateT Env IO a) -> SIO [a]
forall a b. (a -> b) -> a -> b
$ \Party
party ->
            case Party -> Maybe Socket
sock Party
party of
                Just Socket
_ -> do
                    ByteString
bytes <- MVar ByteString -> SIO ByteString
forall a. MVar a -> SIO a
await (MVar ByteString -> SIO ByteString)
-> StateT Env IO (MVar ByteString) -> SIO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Party -> StateT Env IO (MVar ByteString)
receiveMessage Party
party
                    case (ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
decode ByteString
bytes) of
                        Right a
msg -> a -> StateT Env IO a
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
msg
                Maybe Socket
Nothing -> a -> StateT Env IO a
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
    MVar [a] -> SIO (MVar [a])
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MVar [a]
out


-- | Input x to the computation.

-- 

-- Value x is a secure object, or a list of secure objects.

class Input a b | a -> b where
  input :: a -> SIO b

instance Input (SIO SecureTypes) [SIO SecureTypes] where
    input :: StateT Env IO SecureTypes -> SIO [StateT Env IO SecureTypes]
input StateT Env IO SecureTypes
a = ([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> [[StateT Env IO SecureTypes]] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
forall a. HasCallStack => [a] -> a
head ([[StateT Env IO SecureTypes]] -> [StateT Env IO SecureTypes])
-> StateT Env IO [[StateT Env IO SecureTypes]]
-> SIO [StateT Env IO SecureTypes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT Env IO SecureTypes]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a b. Input a b => a -> SIO b
input [StateT Env IO SecureTypes
a]

instance Input [SIO SecureTypes] [[SIO SecureTypes]] where
    input :: [StateT Env IO SecureTypes]
-> StateT Env IO [[StateT Env IO SecureTypes]]
input [StateT Env IO SecureTypes]
xm = do
        [SecureTypes]
x <- [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [StateT Env IO SecureTypes]
xm
        Env{parties :: Env -> [Party]
parties=[Party]
parties, options :: Env -> Options
options=Options
opts, gen :: Env -> StdGen
gen=StdGen
_gen} <- SIO Env
forall s (m :: * -> *). MonadState s m => m s
get

        [[MVar FiniteField]]
outslist <- Int -> Int -> SIO [[FiniteField]] -> SIO [[MVar FiniteField]]
forall a. Int -> Int -> SIO [[a]] -> SIO [[MVar a]]
asyncListList (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Options -> Integer
m Options
opts)) ([SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SecureTypes]
x) (SIO [[FiniteField]] -> SIO [[MVar FiniteField]])
-> SIO [[FiniteField]] -> SIO [[MVar FiniteField]]
forall a b. (a -> b) -> a -> b
$ do
            [FiniteField]
xf <- [SecureTypes] -> SIO (Result [SecureTypes])
forall a. Gather a => a -> SIO (Result a)
gather [SecureTypes]
x
            let ftype :: FiniteField
ftype = ([FiniteField] -> FiniteField
forall a. HasCallStack => [a] -> a
head [FiniteField]
xf)
                length :: Int
length = (FiniteFieldMeta -> Int
byteLength (FiniteFieldMeta -> Int)
-> (FiniteField -> FiniteFieldMeta) -> FiniteField -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FiniteField -> FiniteFieldMeta
meta) FiniteField
ftype
                ([[Integer]]
inShares, StdGen
g'') = FiniteField
-> [FiniteField]
-> Integer
-> Integer
-> StdGen
-> ([[Integer]], StdGen)
forall g.
RandomGen g =>
FiniteField
-> [FiniteField] -> Integer -> Integer -> g -> ([[Integer]], g)
Shamir.randomSplit FiniteField
ftype [FiniteField]
xf (Options -> Integer
threshold Options
opts) (Options -> Integer
m Options
opts) StdGen
_gen
            (Env -> Env) -> SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env{gen = g''})

            [(Party, [Integer])] -> ((Party, [Integer]) -> SIO ()) -> SIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Party] -> [[Integer]] -> [(Party, [Integer])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Party]
parties [[Integer]]
inShares) (((Party, [Integer]) -> SIO ()) -> SIO ())
-> ((Party, [Integer]) -> SIO ()) -> SIO ()
forall a b. (a -> b) -> a -> b
$ \(Party
party, [Integer]
val) ->
                Bool -> SIO () -> SIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Socket -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Socket -> Bool) -> Maybe Socket -> Bool
forall a b. (a -> b) -> a -> b
$ Party -> Maybe Socket
sock Party
party) (ByteString -> Party -> SIO ()
sendMessage (Int -> [Integer] -> ByteString
toBytes Int
length [Integer]
val) Party
party)
            
            [(Party, Int)]
-> ((Party, Int) -> StateT Env IO [FiniteField])
-> SIO [[FiniteField]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Party] -> [Int] -> [(Party, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Party]
parties [Int
0..]) (((Party, Int) -> StateT Env IO [FiniteField])
 -> SIO [[FiniteField]])
-> ((Party, Int) -> StateT Env IO [FiniteField])
-> SIO [[FiniteField]]
forall a b. (a -> b) -> a -> b
$ \(Party
party, Int
index) -> do
                [Integer]
shares <- case Party -> Maybe Socket
sock Party
party of
                    Just Socket
_ -> Int -> ByteString -> [Integer]
fromBytes Int
length (ByteString -> [Integer])
-> SIO ByteString -> StateT Env IO [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVar ByteString -> SIO ByteString
forall a. MVar a -> SIO a
await (MVar ByteString -> SIO ByteString)
-> StateT Env IO (MVar ByteString) -> SIO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Party -> StateT Env IO (MVar ByteString)
receiveMessage Party
party)
                    Maybe Socket
Nothing -> [Integer] -> StateT Env IO [Integer]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Integer]]
inShares [[Integer]] -> Int -> [Integer]
forall a. HasCallStack => [a] -> Int -> a
!! Int
index)
                [FiniteField] -> StateT Env IO [FiniteField]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FiniteField] -> StateT Env IO [FiniteField])
-> [FiniteField] -> StateT Env IO [FiniteField]
forall a b. (a -> b) -> a -> b
$ (Integer -> FiniteField) -> [Integer] -> [FiniteField]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
share -> FiniteField
ftype{value = share}) [Integer]
shares
        
        [[StateT Env IO SecureTypes]]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[StateT Env IO SecureTypes]]
 -> StateT Env IO [[StateT Env IO SecureTypes]])
-> [[StateT Env IO SecureTypes]]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a b. (a -> b) -> a -> b
$ (([MVar FiniteField] -> [StateT Env IO SecureTypes])
-> [[MVar FiniteField]] -> [[StateT Env IO SecureTypes]]
forall a b. (a -> b) -> [a] -> [b]
map (([MVar FiniteField] -> [StateT Env IO SecureTypes])
 -> [[MVar FiniteField]] -> [[StateT Env IO SecureTypes]])
-> ((MVar FiniteField -> StateT Env IO SecureTypes)
    -> [MVar FiniteField] -> [StateT Env IO SecureTypes])
-> (MVar FiniteField -> StateT Env IO SecureTypes)
-> [[MVar FiniteField]]
-> [[StateT Env IO SecureTypes]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar FiniteField -> StateT Env IO SecureTypes)
-> [MVar FiniteField] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map) (\MVar FiniteField
out -> SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x){share = out}) [[MVar FiniteField]]
outslist

class Reshare a b | a -> b where
  reshare :: a -> SIO b

instance Reshare FiniteField FiniteField where
    reshare :: FiniteField -> SIO FiniteField
reshare FiniteField
a = [FiniteField] -> FiniteField
forall a. HasCallStack => [a] -> a
head ([FiniteField] -> FiniteField)
-> StateT Env IO [FiniteField] -> SIO FiniteField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FiniteField] -> StateT Env IO [FiniteField]
forall a b. Reshare a b => a -> SIO b
reshare [FiniteField
a]

instance Reshare [FiniteField] [FiniteField] where
    reshare :: [FiniteField] -> StateT Env IO [FiniteField]
reshare [FiniteField]
x = do
        Env{parties :: Env -> [Party]
parties=[Party]
parties, options :: Env -> Options
options=Options
opts, gen :: Env -> StdGen
gen=StdGen
_gen} <- SIO Int
incPC SIO Int -> SIO Env -> SIO Env
forall a b. StateT Env IO a -> StateT Env IO b -> StateT Env IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SIO Env
forall s (m :: * -> *). MonadState s m => m s
get
        let ftype :: FiniteField
ftype = [FiniteField] -> FiniteField
forall a. HasCallStack => [a] -> a
head [FiniteField]
x
            length :: Int
length = (FiniteFieldMeta -> Int
byteLength (FiniteFieldMeta -> Int)
-> (FiniteField -> FiniteFieldMeta) -> FiniteField -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FiniteField -> FiniteFieldMeta
meta) FiniteField
ftype
            ([[Integer]]
s, StdGen
g'') = FiniteField
-> [FiniteField]
-> Integer
-> Integer
-> StdGen
-> ([[Integer]], StdGen)
forall g.
RandomGen g =>
FiniteField
-> [FiniteField] -> Integer -> Integer -> g -> ([[Integer]], g)
Shamir.randomSplit FiniteField
ftype [FiniteField]
x (Options -> Integer
threshold Options
opts) (Options -> Integer
m Options
opts) StdGen
_gen
            inShares :: [ByteString]
inShares = ([Integer] -> ByteString) -> [[Integer]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Integer] -> ByteString
toBytes Int
length) [[Integer]]
s
        (Env -> Env) -> SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env{gen = g''})
        [MVar ByteString]
shares <- [ByteString] -> SIO [MVar ByteString]
exchangeShares [ByteString]
inShares
        [(Integer, [Integer])]
points <- [(MVar ByteString, Party)]
-> ((MVar ByteString, Party) -> StateT Env IO (Integer, [Integer]))
-> StateT Env IO [(Integer, [Integer])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([MVar ByteString] -> [Party] -> [(MVar ByteString, Party)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MVar ByteString]
shares [Party]
parties) (((MVar ByteString, Party) -> StateT Env IO (Integer, [Integer]))
 -> StateT Env IO [(Integer, [Integer])])
-> ((MVar ByteString, Party) -> StateT Env IO (Integer, [Integer]))
-> StateT Env IO [(Integer, [Integer])]
forall a b. (a -> b) -> a -> b
$ \(MVar ByteString
share, Party
party) -> do
                    [Integer]
val <- Int -> ByteString -> [Integer]
fromBytes Int
length (ByteString -> [Integer])
-> SIO ByteString -> StateT Env IO [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVar ByteString -> SIO ByteString
forall a. MVar a -> SIO a
await MVar ByteString
share)
                    (Integer, [Integer]) -> StateT Env IO (Integer, [Integer])
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Party -> Integer
pid Party
party) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, [Integer]
val)

        [FiniteField] -> StateT Env IO [FiniteField]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FiniteField -> [(Integer, [Integer])] -> [FiniteField]
Shamir.recombine FiniteField
ftype [(Integer, [Integer])]
points)


-- | Output the value of x to the receivers specified.

-- Value x is a secure object, or a list of secure objects.

--

-- A secure integer is output as a Haskell Integer

class Output a b | a -> b where
  output :: a -> SIO (MVar b)

instance Output (SIO SecureTypes) Integer where
    output :: StateT Env IO SecureTypes -> SIO (MVar Integer)
output StateT Env IO SecureTypes
a = [StateT Env IO SecureTypes]
-> ([Integer] -> Integer) -> SIO (MVar Integer)
forall b.
[StateT Env IO SecureTypes] -> ([Integer] -> b) -> SIO (MVar b)
_output [StateT Env IO SecureTypes
a] [Integer] -> Integer
forall a. HasCallStack => [a] -> a
head

instance Output [SIO SecureTypes] [Integer] where
    output :: [StateT Env IO SecureTypes] -> SIO (MVar [Integer])
output [StateT Env IO SecureTypes]
a = [StateT Env IO SecureTypes]
-> ([Integer] -> [Integer]) -> SIO (MVar [Integer])
forall b.
[StateT Env IO SecureTypes] -> ([Integer] -> b) -> SIO (MVar b)
_output [StateT Env IO SecureTypes]
a [Integer] -> [Integer]
forall a. a -> a
id

_output :: [SIO SecureTypes] -> ([Integer] -> b) -> SIO (MVar b)
_output :: forall b.
[StateT Env IO SecureTypes] -> ([Integer] -> b) -> SIO (MVar b)
_output [StateT Env IO SecureTypes]
xm [Integer] -> b
convert = do
    [SecureTypes]
x <- [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [StateT Env IO SecureTypes]
xm
    [Party]
parties <- (Env -> [Party]) -> StateT Env IO [Party]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> [Party]
parties
    MVar b
out <- SIO b -> SIO (MVar b)
forall a. SIO a -> SIO (MVar a)
async (SIO b -> SIO (MVar b)) -> SIO b -> SIO (MVar b)
forall a b. (a -> b) -> a -> b
$ do
        [FiniteField]
s <- [SecureTypes] -> SIO (Result [SecureTypes])
forall a. Gather a => a -> SIO (Result a)
gather [SecureTypes]
x
        let inShares :: [Integer]
inShares = (FiniteField -> Integer) -> [FiniteField] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map FiniteField -> Integer
value [FiniteField]
s
            length :: Int
length = (FiniteFieldMeta -> Int
byteLength (FiniteFieldMeta -> Int)
-> ([FiniteField] -> FiniteFieldMeta) -> [FiniteField] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FiniteField -> FiniteFieldMeta
meta (FiniteField -> FiniteFieldMeta)
-> ([FiniteField] -> FiniteField)
-> [FiniteField]
-> FiniteFieldMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FiniteField] -> FiniteField
forall a. HasCallStack => [a] -> a
head) [FiniteField]
s
        let inSharesEncoded :: ByteString
inSharesEncoded = Int -> [Integer] -> ByteString
toBytes Int
length [Integer]
inShares
        [Party] -> (Party -> SIO ()) -> SIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Party]
parties ((Party -> SIO ()) -> SIO ()) -> (Party -> SIO ()) -> SIO ()
forall a b. (a -> b) -> a -> b
$ \Party
party -> 
            Bool -> SIO () -> SIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Socket -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Socket -> Bool) -> Maybe Socket -> Bool
forall a b. (a -> b) -> a -> b
$ Party -> Maybe Socket
sock Party
party) (ByteString -> Party -> SIO ()
sendMessage ByteString
inSharesEncoded Party
party)

        [(Integer, [Integer])]
points <- [Party]
-> (Party -> StateT Env IO (Integer, [Integer]))
-> StateT Env IO [(Integer, [Integer])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Party]
parties ((Party -> StateT Env IO (Integer, [Integer]))
 -> StateT Env IO [(Integer, [Integer])])
-> (Party -> StateT Env IO (Integer, [Integer]))
-> StateT Env IO [(Integer, [Integer])]
forall a b. (a -> b) -> a -> b
$ \Party
party -> do
            [Integer]
shares <- case Party -> Maybe Socket
sock Party
party of
                Just Socket
_ -> Int -> ByteString -> [Integer]
fromBytes Int
length (ByteString -> [Integer])
-> SIO ByteString -> StateT Env IO [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVar ByteString -> SIO ByteString
forall a. MVar a -> SIO a
await (MVar ByteString -> SIO ByteString)
-> StateT Env IO (MVar ByteString) -> SIO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Party -> StateT Env IO (MVar ByteString)
receiveMessage Party
party)
                Maybe Socket
Nothing -> [Integer] -> StateT Env IO [Integer]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer]
inShares
            (Integer, [Integer]) -> StateT Env IO (Integer, [Integer])
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Party -> Integer
pid Party
party) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, [Integer]
shares)
        
        let y :: [Integer]
y = (FiniteField -> Integer) -> [FiniteField] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map FiniteField -> Integer
value (FiniteField -> [(Integer, [Integer])] -> [FiniteField]
recombine ((SecureTypes -> FiniteField
field (SecureTypes -> FiniteField)
-> ([SecureTypes] -> SecureTypes) -> [SecureTypes] -> FiniteField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head) [SecureTypes]
x) [(Integer, [Integer])]
points)
        b -> SIO b
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> SIO b) -> b -> SIO b
forall a b. (a -> b) -> a -> b
$ [Integer] -> b
convert [Integer]
y
    MVar b -> SIO (MVar b)
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MVar b
out
    
    
shutdown :: SIO ()
shutdown :: SIO ()
shutdown = do
    Env{parties :: Env -> [Party]
parties=[Party]
parties, options :: Env -> Options
options=Options
opt, forkIOBarrier :: Env -> Barrier
forkIOBarrier=Barrier
barrier, startTime :: Env -> UTCTime
startTime=UTCTime
_startTime} <- SIO Env
forall s (m :: * -> *). MonadState s m => m s
get

    -- wait until all forkIO tasks have completed

    IO () -> SIO ()
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ Barrier -> IO ()
Asyncoro.decreaseBarrier Barrier
barrier
    IO () -> SIO ()
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar (Barrier -> MVar ()
signal Barrier
barrier)

    UTCTime
endTime <- IO UTCTime -> StateT Env IO UTCTime
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> StateT Env IO UTCTime)
-> IO UTCTime -> StateT Env IO UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
getCurrentTime
    [Int]
bytes <- (Party -> SIO Int) -> [Party] -> StateT Env IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (MVar Int -> SIO Int
forall a. MVar a -> SIO a
await (MVar Int -> SIO Int) -> (Party -> MVar Int) -> Party -> SIO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Party -> MVar Int
nbytesSent) [Party]
parties
    let elapsedTime :: NominalDiffTime
elapsedTime = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endTime UTCTime
_startTime
    IO () -> SIO ()
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ Priority -> String -> IO ()
logging Priority
INFO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Computation time: %s sec | bytes sent: %d \n" (NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
elapsedTime) ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
bytes)    

    -- Synchronize with all parties before shutdown

    MVar [Integer] -> StateT Env IO [Integer]
forall a. MVar a -> SIO a
await (MVar [Integer] -> StateT Env IO [Integer])
-> SIO (MVar [Integer]) -> StateT Env IO [Integer]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> SIO (MVar [Integer])
forall a. Serialize a => a -> SIO (MVar [a])
transfer (Options -> Integer
myPid Options
opt)

    -- close connections peer_pid > pid

    IO () -> SIO ()
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ [Party] -> (Party -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((Party -> Bool) -> [Party] -> [Party]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Party
x -> ((Party -> Integer
pid Party
x) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (Options -> Integer
myPid Options
opt))) [Party]
parties) ((Party -> IO ()) -> IO ()) -> (Party -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Party
party -> do
        case (Party -> Maybe Socket
sock Party
party) of
            Just Socket
_sock -> Socket -> IO ()
close Socket
_sock

-- | Secure addition of a and b.

(.+) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
.+ :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.+) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = do
    (SecureTypes
a, SecureTypes
b) <- LensLike
  (WrappedMonad (StateT Env IO))
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
-> (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
-> StateT Env IO (SecureTypes, SecureTypes)
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf LensLike
  (WrappedMonad (StateT Env IO))
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
Traversal
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (StateT Env IO SecureTypes
am, StateT Env IO SecureTypes
bm)
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ do 
        (FiniteField
af, FiniteField
bf) <- (SecureTypes, SecureTypes)
-> SIO (Result (SecureTypes, SecureTypes))
forall a. Gather a => a -> SIO (Result a)
gather (SecureTypes
a, SecureTypes
b)
        FiniteField -> SIO FiniteField
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FiniteField
af FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
+ FiniteField
bf)
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> SecureTypes -> SecureTypes
_coerce SecureTypes
a SecureTypes
b){share = out}

-- | Secure subtraction of a and b.

(.-) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
.- :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.-) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = do
    (SecureTypes
a, SecureTypes
b) <- LensLike
  (WrappedMonad (StateT Env IO))
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
-> (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
-> StateT Env IO (SecureTypes, SecureTypes)
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf LensLike
  (WrappedMonad (StateT Env IO))
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
Traversal
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (StateT Env IO SecureTypes
am, StateT Env IO SecureTypes
bm)
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ do
        (FiniteField
af, FiniteField
bf) <- (SecureTypes, SecureTypes)
-> SIO (Result (SecureTypes, SecureTypes))
forall a. Gather a => a -> SIO (Result a)
gather (SecureTypes
a, SecureTypes
b)
        FiniteField -> SIO FiniteField
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FiniteField
af FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
- FiniteField
bf)
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> SecureTypes -> SecureTypes
_coerce SecureTypes
a SecureTypes
b){share = out}    

-- | Secure multiplication of a and b.

(.*) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
.* :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.*) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = do
    (SecureTypes
a, SecureTypes
b) <- LensLike
  (WrappedMonad (StateT Env IO))
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
-> (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
-> StateT Env IO (SecureTypes, SecureTypes)
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf LensLike
  (WrappedMonad (StateT Env IO))
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
Traversal
  (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
  (SecureTypes, SecureTypes)
  (StateT Env IO SecureTypes)
  SecureTypes
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (StateT Env IO SecureTypes
am, StateT Env IO SecureTypes
bm)
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ do
        (FiniteField
af, FiniteField
bf) <- (SecureTypes, SecureTypes)
-> SIO (Result (SecureTypes, SecureTypes))
forall a. Gather a => a -> SIO (Result a)
gather (SecureTypes
a, SecureTypes
b)
        FiniteField -> SIO FiniteField
forall a b. Reshare a b => a -> SIO b
reshare (FiniteField
af FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
* FiniteField
bf)
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> SecureTypes -> SecureTypes
_coerce SecureTypes
a SecureTypes
b){share = out}

-- | Secure division of a by b, for nonzero b.

(./) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
./ :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(./) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = do
    (StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Fractional a => a -> a
recip StateT Env IO SecureTypes
bm) StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
* StateT Env IO SecureTypes
am

-- | Secure reciprocal (multiplicative field inverse) of a, for nonzero a.

srecip :: SIO SecureTypes -> SIO SecureTypes
srecip :: StateT Env IO SecureTypes -> StateT Env IO SecureTypes
srecip StateT Env IO SecureTypes
am = do
    SecureTypes
a <- StateT Env IO SecureTypes
am
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ (SIO FiniteField -> SIO FiniteField) -> SIO FiniteField
forall a. (a -> a) -> a
fix ((SIO FiniteField -> SIO FiniteField) -> SIO FiniteField)
-> (SIO FiniteField -> SIO FiniteField) -> SIO FiniteField
forall a b. (a -> b) -> a -> b
$ \SIO FiniteField
loop -> do
            [SecureTypes
r] <- SecureTypes
-> Integer -> Maybe Integer -> StateT Env IO [SecureTypes]
_randoms SecureTypes
a Integer
1 Maybe Integer
forall a. Maybe a
Nothing
            Integer
ar <- MVar Integer -> SIO Integer
forall a. MVar a -> SIO a
await (MVar Integer -> SIO Integer) -> SIO (MVar Integer) -> SIO Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT Env IO SecureTypes -> SIO (MVar Integer)
forall a b. Output a b => a -> SIO (MVar b)
output ((SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a) StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
.* (SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
r))
            if (Integer
ar Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) 
                then SIO FiniteField
loop
                else do 
                    FiniteField
rfld <- SecureTypes -> SIO (Result SecureTypes)
forall a. Gather a => a -> SIO (Result a)
gather SecureTypes
r
                    FiniteField -> SIO FiniteField
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FiniteField
rfld FiniteField -> FiniteField -> FiniteField
forall a. Fractional a => a -> a -> a
/ FiniteField
rfld{value = ar})
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a{share = out}

-- | Secure exponentiation a raised to the power of b, for public integer b.

(.^) :: SIO SecureTypes -> Integer -> SIO SecureTypes
.^ :: StateT Env IO SecureTypes -> Integer -> StateT Env IO SecureTypes
(.^) StateT Env IO SecureTypes
am Integer
b = do
    SecureTypes
a <- StateT Env IO SecureTypes
am
    [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
sproduct ([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
forall a b. (a -> b) -> a -> b
$ Int -> StateT Env IO SecureTypes -> [StateT Env IO SecureTypes]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b) (SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a)

-- | Secure comparison a < b.

(.<) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
.< :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.<) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = Bool
-> Bool -> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
ssignum Bool
True Bool
False (StateT Env IO SecureTypes
am StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
- StateT Env IO SecureTypes
bm)

-- | Secure comparison a <= b.

(.<=) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
.<= :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.<=) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = StateT Env IO SecureTypes
1 StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
- (StateT Env IO SecureTypes
bm StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
.< StateT Env IO SecureTypes
am)

-- | Secure comparison a > b.

(.>) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
.> :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.>) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = (StateT Env IO SecureTypes
bm StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
.< StateT Env IO SecureTypes
am)

-- | Secure comparison a == b.

(.==) :: SIO SecureTypes -> SIO SecureTypes -> SIO SecureTypes
.== :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.==) StateT Env IO SecureTypes
am StateT Env IO SecureTypes
bm = StateT Env IO SecureTypes -> StateT Env IO SecureTypes
isZero (StateT Env IO SecureTypes
am StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
- StateT Env IO SecureTypes
bm)

-- | Secure zero test a == 0.

isZero :: SIO SecureTypes -> SIO SecureTypes
isZero :: StateT Env IO SecureTypes -> StateT Env IO SecureTypes
isZero StateT Env IO SecureTypes
am = do
    SecureTypes
a <- StateT Env IO SecureTypes
am
    case SecureTypes
a of
        SecFld {field :: SecureTypes -> FiniteField
field=FiniteField
fld} -> (StateT Env IO SecureTypes
1 StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
- ((SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a) StateT Env IO SecureTypes -> Integer -> StateT Env IO SecureTypes
.^ ((FiniteFieldMeta -> Integer
modulus (FiniteFieldMeta -> Integer)
-> (FiniteField -> FiniteFieldMeta) -> FiniteField -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FiniteField -> FiniteFieldMeta
meta) FiniteField
fld Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))) -- todo modulus = order

        SecureTypes
_ -> Bool
-> Bool -> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
ssignum Bool
False Bool
True (SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a)

-- | Secure public zero test of a.

isZeroPublic :: SIO SecureTypes -> SIO (MVar Bool)
isZeroPublic :: StateT Env IO SecureTypes -> SIO (MVar Bool)
isZeroPublic StateT Env IO SecureTypes
am = do
    SecureTypes
a <- StateT Env IO SecureTypes
am
    [SecureTypes
r] <- SecureTypes
-> Integer -> Maybe Integer -> StateT Env IO [SecureTypes]
_randoms SecureTypes
a Integer
1 Maybe Integer
forall a. Maybe a
Nothing
    MVar Bool
out <- SIO Bool -> SIO (MVar Bool)
forall a. SIO a -> SIO (MVar a)
async (SIO Bool -> SIO (MVar Bool)) -> SIO Bool -> SIO (MVar Bool)
forall a b. (a -> b) -> a -> b
$ do
        (FiniteField
afld, FiniteField
rfld) <- (SecureTypes, SecureTypes)
-> SIO (Result (SecureTypes, SecureTypes))
forall a. Gather a => a -> SIO (Result a)
gather (SecureTypes
a, SecureTypes
r)
        Integer
res <- MVar Integer -> SIO Integer
forall a. MVar a -> SIO a
await (MVar Integer -> SIO Integer) -> SIO (MVar Integer) -> SIO Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (StateT Env IO SecureTypes -> SIO (MVar Integer)
forall a b. Output a b => a -> SIO (MVar b)
output (StateT Env IO SecureTypes -> SIO (MVar Integer))
-> StateT Env IO SecureTypes -> SIO (MVar Integer)
forall a b. (a -> b) -> a -> b
$ SecureTypes -> Integer -> StateT Env IO SecureTypes
setShare SecureTypes
a (FiniteField -> Integer
value (FiniteField
afld FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
* FiniteField
rfld)))
        Bool -> SIO Bool
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
res Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)
    MVar Bool -> SIO (MVar Bool)
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MVar Bool
out

-- | Secure sign(um) of a, return -1 if a < 0 else 0 if a == 0 else 1.

--

-- If Boolean flag LT is set, perform a secure less than zero test instead, and

-- return 1 if a < 0 else 0, saving the work for a secure equality test.

-- If Boolean flag EQ is set, perform a secure equal to zero test instead, and

-- return 1 if a == 0 else 0, saving the work for a secure comparison.

ssignum :: Bool -> Bool -> SIO SecureTypes -> SIO SecureTypes
ssignum :: Bool
-> Bool -> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
ssignum Bool
True Bool
True StateT Env IO SecureTypes
_ = String -> StateT Env IO SecureTypes
forall a. HasCallStack => String -> a
error String
"lt and eq both true"
ssignum Bool
lt Bool
eq StateT Env IO SecureTypes
am = do
    SecureTypes
a <- StateT Env IO SecureTypes
am
    Options
opt <- (Env -> Options) -> StateT Env IO Options
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Options
options
    let l :: Int
l = (SecureTypes -> Int
bitLength SecureTypes
a)
    [SecureTypes]
r_bits <- [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes])
-> SIO [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT Env IO SecureTypes
-> Int -> Bool -> SIO [StateT Env IO SecureTypes]
randomBits (SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a) Int
l Bool
False
    [SecureTypes
r] <- SecureTypes
-> Integer -> Maybe Integer -> StateT Env IO [SecureTypes]
_randoms SecureTypes
a Integer
1 (Maybe Integer -> StateT Env IO [SecureTypes])
-> Maybe Integer -> StateT Env IO [SecureTypes]
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Options -> Int
secParam Options
opt)
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ do
        [FiniteField]
r_bits_fld <- [SecureTypes] -> SIO (Result [SecureTypes])
forall a. Gather a => a -> SIO (Result a)
gather [SecureTypes]
r_bits
        let r_modl :: Integer
r_modl = (FiniteField -> Integer -> Integer)
-> Integer -> [FiniteField] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\FiniteField
x Integer
acc -> (Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (FiniteField -> Integer
value FiniteField
x)) Integer
0 [FiniteField]
r_bits_fld

        (FiniteField
r_divl, FiniteField
af) <- (SecureTypes, SecureTypes)
-> SIO (Result (SecureTypes, SecureTypes))
forall a. Gather a => a -> SIO (Result a)
gather (SecureTypes
r, SecureTypes
a)
        let a_rmodl :: FiniteField
a_rmodl = FiniteField
af FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
+ Integer -> FiniteField
forall a. Num a => Integer -> a
fromInteger ((Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
l) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r_modl)
        Integer
c <- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
l)) 
                (Integer -> Integer) -> SIO Integer -> SIO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVar Integer -> SIO Integer
forall a. MVar a -> SIO a
await (MVar Integer -> SIO Integer) -> SIO (MVar Integer) -> SIO Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT Env IO SecureTypes -> SIO (MVar Integer)
forall a b. Output a b => a -> SIO (MVar b)
output (SecureTypes -> Integer -> StateT Env IO SecureTypes
setShare SecureTypes
a (FiniteField -> Integer
value (FiniteField -> Integer) -> FiniteField -> Integer
forall a b. (a -> b) -> a -> b
$ FiniteField
a_rmodl FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
+ Integer -> FiniteField
forall a. Num a => Integer -> a
fromInteger ((FiniteField -> Integer
value FiniteField
r_divl) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
l))))

        FiniteField
z1 <- if Bool -> Bool
not Bool
eq then do
            Integer
s_sign <- FiniteField -> Integer
value (FiniteField -> Integer) -> SIO FiniteField -> SIO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT Env IO SecureTypes
-> Int -> Bool -> SIO [StateT Env IO SecureTypes]
randomBits (SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a) Int
1 Bool
True SIO [StateT Env IO SecureTypes]
-> ([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> StateT Env IO SecureTypes
forall a b.
StateT Env IO a -> (a -> StateT Env IO b) -> StateT Env IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
forall a. HasCallStack => [a] -> a
head StateT Env IO SecureTypes
-> (SecureTypes -> SIO FiniteField) -> SIO FiniteField
forall a b.
StateT Env IO a -> (a -> StateT Env IO b) -> StateT Env IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SecureTypes -> SIO FiniteField
SecureTypes -> SIO (Result SecureTypes)
forall a. Gather a => a -> SIO (Result a)
gather)
        
            let ([StateT Env IO SecureTypes]
e, Integer
sumXors) = (([StateT Env IO SecureTypes], Integer)
 -> (FiniteField, Int) -> ([StateT Env IO SecureTypes], Integer))
-> ([StateT Env IO SecureTypes], Integer)
-> [(FiniteField, Int)]
-> ([StateT Env IO SecureTypes], Integer)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\([StateT Env IO SecureTypes]
e, Integer
sumXors) (FiniteField
bit, Int
i) ->
                    let c_i :: Integer
c_i = ((Integer
c Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
i) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
1)
                    in (SecureTypes -> Integer -> StateT Env IO SecureTypes
setShare SecureTypes
a (Integer
s_sign Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (FiniteField -> Integer
value FiniteField
bit) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
c_i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
sumXors) StateT Env IO SecureTypes
-> [StateT Env IO SecureTypes] -> [StateT Env IO SecureTypes]
forall a. a -> [a] -> [a]
: [StateT Env IO SecureTypes]
e,
                        Integer
sumXors Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ if Integer
c_i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (FiniteField -> Integer
value FiniteField
bit) else (FiniteField -> Integer
value FiniteField
bit)))
                    ([], Integer
0) ([FiniteField] -> [Int] -> [(FiniteField, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([FiniteField] -> [FiniteField]
forall a. [a] -> [a]
reverse [FiniteField]
r_bits_fld) [Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..])

            Bool
g <- MVar Bool -> SIO Bool
forall a. MVar a -> SIO a
await (MVar Bool -> SIO Bool) -> SIO (MVar Bool) -> SIO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (StateT Env IO SecureTypes -> SIO (MVar Bool)
isZeroPublic (StateT Env IO SecureTypes -> SIO (MVar Bool))
-> StateT Env IO SecureTypes -> SIO (MVar Bool)
forall a b. (a -> b) -> a -> b
$ [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
sproduct (SecureTypes -> Integer -> StateT Env IO SecureTypes
setShare SecureTypes
a (Integer
s_sign Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
sumXors) StateT Env IO SecureTypes
-> [StateT Env IO SecureTypes] -> [StateT Env IO SecureTypes]
forall a. a -> [a] -> [a]
: [StateT Env IO SecureTypes]
e))
            let h :: Integer
h = if Bool
g then Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
s_sign else Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
s_sign
            FiniteField -> SIO FiniteField
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FiniteField -> SIO FiniteField) -> FiniteField -> SIO FiniteField
forall a b. (a -> b) -> a -> b
$ (Integer -> FiniteField
forall a. Num a => Integer -> a
fromInteger (Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
h Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
- FiniteField
a_rmodl) FiniteField -> FiniteField -> FiniteField
forall a. Fractional a => a -> a -> a
/ Integer -> FiniteField
forall a. Num a => Integer -> a
fromInteger (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
l)
        else FiniteField -> SIO FiniteField
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FiniteField{}
        
        if Bool -> Bool
not Bool
lt then do
            FiniteField
h <- MVar FiniteField -> SIO FiniteField
forall a. MVar a -> SIO a
await (MVar FiniteField -> SIO FiniteField)
-> (SecureTypes -> MVar FiniteField)
-> SecureTypes
-> SIO FiniteField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecureTypes -> MVar FiniteField
share (SecureTypes -> SIO FiniteField)
-> StateT Env IO SecureTypes -> SIO FiniteField
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
sall (((FiniteField, Int) -> StateT Env IO SecureTypes)
-> [(FiniteField, Int)] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map (\(FiniteField
bit, Int
i) -> 
                SecureTypes -> Integer -> StateT Env IO SecureTypes
setShare SecureTypes
a (Integer -> StateT Env IO SecureTypes)
-> Integer -> StateT Env IO SecureTypes
forall a b. (a -> b) -> a -> b
$ FiniteField -> Integer
value (FiniteField -> Integer) -> FiniteField -> Integer
forall a b. (a -> b) -> a -> b
$ if ((Integer
c Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
i) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
1) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then FiniteField
bit else FiniteField
1 FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
- FiniteField
bit) ([FiniteField] -> [Int] -> [(FiniteField, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FiniteField]
r_bits_fld [Int
0..])) 
            if Bool
eq then FiniteField -> SIO FiniteField
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FiniteField
h
            else FiniteField -> SIO FiniteField
forall a b. Reshare a b => a -> SIO b
reshare ((FiniteField
h FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
- FiniteField
1) FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
* (FiniteField
2FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
*FiniteField
z1 FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
- FiniteField
1))
        else FiniteField -> SIO FiniteField
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FiniteField
z1

    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a{share = out}

argmaxfunc :: [[SIO SecureTypes]] -> ([SIO SecureTypes] -> [SIO SecureTypes] -> SIO SecureTypes) -> SIO (SIO SecureTypes, [SIO SecureTypes])
argmaxfunc :: [[StateT Env IO SecureTypes]]
-> ([StateT Env IO SecureTypes]
    -> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> SIO (StateT Env IO SecureTypes, [StateT Env IO SecureTypes])
argmaxfunc [[StateT Env IO SecureTypes]
xm] [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
_ = do
    [SecureTypes]
x <- [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [StateT Env IO SecureTypes]
xm    
    (StateT Env IO SecureTypes, [StateT Env IO SecureTypes])
-> SIO (StateT Env IO SecureTypes, [StateT Env IO SecureTypes])
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> Integer -> StateT Env IO SecureTypes
setShare ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x) Integer
0, (SecureTypes -> StateT Env IO SecureTypes)
-> [SecureTypes] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SecureTypes]
x)
argmaxfunc [[StateT Env IO SecureTypes]]
x [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
f = do
            let n :: Int
n = [[StateT Env IO SecureTypes]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[StateT Env IO SecureTypes]]
x
            let ([[StateT Env IO SecureTypes]]
x0, [[StateT Env IO SecureTypes]]
x1) = Int
-> [[StateT Env IO SecureTypes]]
-> ([[StateT Env IO SecureTypes]], [[StateT Env IO SecureTypes]])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [[StateT Env IO SecureTypes]]
x
            (StateT Env IO SecureTypes
i0, [StateT Env IO SecureTypes]
m0) <- [[StateT Env IO SecureTypes]]
-> ([StateT Env IO SecureTypes]
    -> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> SIO (StateT Env IO SecureTypes, [StateT Env IO SecureTypes])
argmaxfunc [[StateT Env IO SecureTypes]]
x0 [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
f
            (StateT Env IO SecureTypes
i1, [StateT Env IO SecureTypes]
m1) <- [[StateT Env IO SecureTypes]]
-> ([StateT Env IO SecureTypes]
    -> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> SIO (StateT Env IO SecureTypes, [StateT Env IO SecureTypes])
argmaxfunc [[StateT Env IO SecureTypes]]
x1 [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
f
            StateT Env IO SecureTypes
c <- SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> StateT Env IO SecureTypes)
-> StateT Env IO SecureTypes
-> StateT Env IO (StateT Env IO SecureTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
f [StateT Env IO SecureTypes]
m0 [StateT Env IO SecureTypes]
m1
            SecureTypes
a <- StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
forall a b.
IfElse a b =>
StateT Env IO SecureTypes -> a -> a -> SIO b
ifElse StateT Env IO SecureTypes
c (StateT Env IO SecureTypes
i1 StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
+ Int -> StateT Env IO SecureTypes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)) StateT Env IO SecureTypes
i0
            [StateT Env IO SecureTypes]
m <- StateT Env IO SecureTypes
-> [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes]
-> SIO [StateT Env IO SecureTypes]
forall a b.
IfElse a b =>
StateT Env IO SecureTypes -> a -> a -> SIO b
ifElse StateT Env IO SecureTypes
c [StateT Env IO SecureTypes]
m1 [StateT Env IO SecureTypes]
m0
            (StateT Env IO SecureTypes, [StateT Env IO SecureTypes])
-> SIO (StateT Env IO SecureTypes, [StateT Env IO SecureTypes])
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a, [StateT Env IO SecureTypes]
m)


-- | Secure argmax of all given elements in x.

--

-- In case of multiple occurrences of the maximum values,

-- the index of the first occurrence is returned.

argmax :: [SIO SecureTypes] -> SIO (SIO SecureTypes, SIO SecureTypes)
argmax :: [StateT Env IO SecureTypes]
-> SIO (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
argmax [StateT Env IO SecureTypes
xm] = do
    SecureTypes
x <- StateT Env IO SecureTypes
xm
    (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
-> SIO (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> Integer -> StateT Env IO SecureTypes
setShare SecureTypes
x Integer
0, SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
x)
argmax [StateT Env IO SecureTypes]
x = do
    let n :: Int
n = [StateT Env IO SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StateT Env IO SecureTypes]
x
    let ([StateT Env IO SecureTypes]
x0, [StateT Env IO SecureTypes]
x1) = Int
-> [StateT Env IO SecureTypes]
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [StateT Env IO SecureTypes]
x 
    (StateT Env IO SecureTypes
i0, StateT Env IO SecureTypes
m0) <- [StateT Env IO SecureTypes]
-> SIO (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
argmax [StateT Env IO SecureTypes]
x0
    (StateT Env IO SecureTypes
i1, StateT Env IO SecureTypes
m1) <- [StateT Env IO SecureTypes]
-> SIO (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
argmax [StateT Env IO SecureTypes]
x1
    StateT Env IO SecureTypes
c <- SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> StateT Env IO SecureTypes)
-> StateT Env IO SecureTypes
-> StateT Env IO (StateT Env IO SecureTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT Env IO SecureTypes
m0) StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
.< (StateT Env IO SecureTypes
m1)
    SecureTypes
a <- StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
forall a b.
IfElse a b =>
StateT Env IO SecureTypes -> a -> a -> SIO b
ifElse StateT Env IO SecureTypes
c (StateT Env IO SecureTypes
i1 StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
+ Int -> StateT Env IO SecureTypes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)) StateT Env IO SecureTypes
i0
    SecureTypes
m <- StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
forall a b.
IfElse a b =>
StateT Env IO SecureTypes -> a -> a -> SIO b
ifElse StateT Env IO SecureTypes
c StateT Env IO SecureTypes
m1 StateT Env IO SecureTypes
m0
    (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
-> SIO (StateT Env IO SecureTypes, StateT Env IO SecureTypes)
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
a, SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
m)

-- | Secure maximum of all given elements in x, similar to Haskell's built-in maximum.

smaximum :: [SIO SecureTypes] -> SIO SecureTypes
smaximum :: [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
smaximum [StateT Env IO SecureTypes
a] = StateT Env IO SecureTypes
a
smaximum [StateT Env IO SecureTypes]
x = do 
    let ([StateT Env IO SecureTypes]
x0, [StateT Env IO SecureTypes]
x1) = Int
-> [StateT Env IO SecureTypes]
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
forall a. Int -> [a] -> ([a], [a])
splitAt ([StateT Env IO SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StateT Env IO SecureTypes]
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [StateT Env IO SecureTypes]
x 
    StateT Env IO SecureTypes
m0 <- SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> StateT Env IO SecureTypes)
-> StateT Env IO SecureTypes
-> StateT Env IO (StateT Env IO SecureTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
smaximum [StateT Env IO SecureTypes]
x0
    StateT Env IO SecureTypes
m1 <- SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> StateT Env IO SecureTypes)
-> StateT Env IO SecureTypes
-> StateT Env IO (StateT Env IO SecureTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
smaximum [StateT Env IO SecureTypes]
x1
    (StateT Env IO SecureTypes
m0 StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
.< StateT Env IO SecureTypes
m1) StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
* (StateT Env IO SecureTypes
m1 StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
- StateT Env IO SecureTypes
m0) StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
+ StateT Env IO SecureTypes
m0

-- | Secure sum of all elements in x, similar to Haskell's built-in sum.

ssum :: [SIO SecureTypes] -> SIO SecureTypes
ssum :: [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
ssum [StateT Env IO SecureTypes]
xm = do
    [SecureTypes]
x <- [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [StateT Env IO SecureTypes]
xm
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ [FiniteField] -> FiniteField
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([FiniteField] -> FiniteField)
-> StateT Env IO [FiniteField] -> SIO FiniteField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SecureTypes] -> SIO (Result [SecureTypes])
forall a. Gather a => a -> SIO (Result a)
gather [SecureTypes]
x
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x){share = out}

-- | Secure product of all elements in x, similar to Haskell's product.

--

-- Runs in log_2 len(x) rounds).

sproduct :: [SIO SecureTypes] -> SIO SecureTypes
sproduct :: [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
sproduct [StateT Env IO SecureTypes]
xm = do
    [SecureTypes]
x <- [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [StateT Env IO SecureTypes]
xm
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ [FiniteField] -> FiniteField
forall a. HasCallStack => [a] -> a
head ([FiniteField] -> FiniteField)
-> StateT Env IO [FiniteField] -> SIO FiniteField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT Env IO [FiniteField] -> StateT Env IO [FiniteField])
-> StateT Env IO [FiniteField] -> [StateT Env IO [FiniteField]]
forall a. (a -> a) -> a -> [a]
iterate (\StateT Env IO [FiniteField]
xold -> do
        ([FiniteField]
xmul, [FiniteField]
leftover) <- (FiniteField -> FiniteField -> FiniteField)
-> [FiniteField] -> ([FiniteField], [FiniteField])
forall a. (a -> a -> a) -> [a] -> ([a], [a])
pairwise FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
(*) ([FiniteField] -> ([FiniteField], [FiniteField]))
-> StateT Env IO [FiniteField]
-> StateT Env IO ([FiniteField], [FiniteField])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Env IO [FiniteField]
xold
        ([FiniteField]
leftover [FiniteField] -> [FiniteField] -> [FiniteField]
forall a. [a] -> [a] -> [a]
++) ([FiniteField] -> [FiniteField])
-> StateT Env IO [FiniteField] -> StateT Env IO [FiniteField]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FiniteField] -> StateT Env IO [FiniteField]
forall a b. Reshare a b => a -> SIO b
reshare [FiniteField]
xmul) ([SecureTypes] -> SIO (Result [SecureTypes])
forall a. Gather a => a -> SIO (Result a)
gather [SecureTypes]
x) [StateT Env IO [FiniteField]] -> Int -> StateT Env IO [FiniteField]
forall a. HasCallStack => [a] -> Int -> a
!! ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> (Int -> Double) -> Int -> 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) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SecureTypes]
x))        
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x){share = out}

-- | Secure all of elements in x, similar to Haskell's built-in all.

--

-- Elements of x are assumed to be either 0 or 1 (Boolean).

-- Runs in log_2 len(x) rounds).

sall :: [SIO SecureTypes] -> SIO SecureTypes
sall :: [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
sall [StateT Env IO SecureTypes]
xm = do
    [SecureTypes]
x <- [StateT Env IO SecureTypes] -> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [StateT Env IO SecureTypes]
xm
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ [FiniteField] -> FiniteField
forall a. HasCallStack => [a] -> a
head ([FiniteField] -> FiniteField)
-> StateT Env IO [FiniteField] -> SIO FiniteField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT Env IO [FiniteField] -> StateT Env IO [FiniteField])
-> StateT Env IO [FiniteField] -> [StateT Env IO [FiniteField]]
forall a. (a -> a) -> a -> [a]
iterate (\StateT Env IO [FiniteField]
xold -> do
        ([FiniteField]
xmul, [FiniteField]
leftover) <- (FiniteField -> FiniteField -> FiniteField)
-> [FiniteField] -> ([FiniteField], [FiniteField])
forall a. (a -> a -> a) -> [a] -> ([a], [a])
pairwise FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
(*) ([FiniteField] -> ([FiniteField], [FiniteField]))
-> StateT Env IO [FiniteField]
-> StateT Env IO ([FiniteField], [FiniteField])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Env IO [FiniteField]
xold
        ([FiniteField]
leftover [FiniteField] -> [FiniteField] -> [FiniteField]
forall a. [a] -> [a] -> [a]
++) ([FiniteField] -> [FiniteField])
-> StateT Env IO [FiniteField] -> StateT Env IO [FiniteField]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FiniteField] -> StateT Env IO [FiniteField]
forall a b. Reshare a b => a -> SIO b
reshare [FiniteField]
xmul) ([SecureTypes] -> SIO (Result [SecureTypes])
forall a. Gather a => a -> SIO (Result a)
gather [SecureTypes]
x) [StateT Env IO [FiniteField]] -> Int -> StateT Env IO [FiniteField]
forall a. HasCallStack => [a] -> Int -> a
!! ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> (Int -> Double) -> Int -> 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) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SecureTypes]
x))        
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x){share = out}

-- | Return n secure random values of the given type in the given range.

_randoms :: SecureTypes -> Integer -> Maybe Integer -> SIO [SecureTypes]
_randoms :: SecureTypes
-> Integer -> Maybe Integer -> StateT Env IO [SecureTypes]
_randoms SecureTypes
st Integer
n Maybe Integer
bound = do
    Integer
t <- Options -> Integer
threshold (Options -> Integer) -> StateT Env IO Options -> SIO Integer
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)
    (StdGen
g', StdGen
g'') <- StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
System.Random.split (StdGen -> (StdGen, StdGen))
-> StateT Env IO StdGen -> StateT Env IO (StdGen, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env -> StdGen) -> StateT Env IO StdGen
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> StdGen
gen
    let fld :: FiniteField
fld = SecureTypes -> FiniteField
field SecureTypes
st
        _bound :: Integer
_bound = case Maybe Integer
bound of
                Just Integer
b -> Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (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
b Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)))
                Maybe Integer
Nothing -> (FiniteFieldMeta -> Integer
modulus (FiniteFieldMeta -> Integer)
-> (FiniteField -> FiniteFieldMeta) -> FiniteField -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FiniteField -> FiniteFieldMeta
meta) FiniteField
fld -- todo modulus = order

        x :: [Integer]
x = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> StdGen -> [Integer]
forall g. RandomGen g => (Integer, Integer) -> g -> [Integer]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Integer
0, Integer
_bound Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) StdGen
g'
    (Env -> Env) -> SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env{gen = g''})
    [[StateT Env IO SecureTypes]]
xlist <- [StateT Env IO SecureTypes]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a b. Input a b => a -> SIO b
input ([StateT Env IO SecureTypes]
 -> StateT Env IO [[StateT Env IO SecureTypes]])
-> [StateT Env IO SecureTypes]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a b. (a -> b) -> a -> b
$ (Integer -> StateT Env IO SecureTypes)
-> [Integer] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
rand -> do
                MVar FiniteField
randmvar <- IO (MVar FiniteField) -> SIO (MVar FiniteField)
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar FiniteField) -> SIO (MVar FiniteField))
-> IO (MVar FiniteField) -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ FiniteField -> IO (MVar FiniteField)
forall a. a -> IO (MVar a)
newMVar FiniteField
fld{value = rand} :: SIO (MVar FiniteField)
                SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
st{share = randmvar}) [Integer]
x
    [[StateT Env IO SecureTypes]]
-> ([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([[StateT Env IO SecureTypes]] -> [[StateT Env IO SecureTypes]]
forall a. [[a]] -> [[a]]
transpose [[StateT Env IO SecureTypes]]
xlist) (([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
 -> StateT Env IO [SecureTypes])
-> ([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> StateT Env IO [SecureTypes]
forall a b. (a -> b) -> a -> b
$ \[StateT Env IO SecureTypes]
_x -> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
ssum [StateT Env IO SecureTypes]
_x

-- | Return n secure uniformly random bits of the given type.

randomBits :: SIO SecureTypes -> Int -> Bool -> SIO [SIO SecureTypes]
randomBits :: StateT Env IO SecureTypes
-> Int -> Bool -> SIO [StateT Env IO SecureTypes]
randomBits StateT Env IO SecureTypes
stm Int
n Bool
signed = do
    SecureTypes
st <- StateT Env IO SecureTypes
stm
    (StdGen
g', StdGen
g'') <- StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
System.Random.split (StdGen -> (StdGen, StdGen))
-> StateT Env IO StdGen -> StateT Env IO (StdGen, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env -> StdGen) -> StateT Env IO StdGen
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> StdGen
gen
    let x :: [Integer]
x = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> StdGen -> [Integer]
forall g. RandomGen g => (Integer, Integer) -> g -> [Integer]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Integer
0, Integer
1) StdGen
g'
    (Env -> Env) -> SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env{gen = g''})
    [[StateT Env IO SecureTypes]]
xlist <- [StateT Env IO SecureTypes]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a b. Input a b => a -> SIO b
input ([StateT Env IO SecureTypes]
 -> StateT Env IO [[StateT Env IO SecureTypes]])
-> [StateT Env IO SecureTypes]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a b. (a -> b) -> a -> b
$ (Integer -> StateT Env IO SecureTypes)
-> [Integer] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
bit -> do
            MVar FiniteField
randmvar <- IO (MVar FiniteField) -> SIO (MVar FiniteField)
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar FiniteField) -> SIO (MVar FiniteField))
-> IO (MVar FiniteField) -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ FiniteField -> IO (MVar FiniteField)
forall a. a -> IO (MVar a)
newMVar (SecureTypes -> FiniteField
field SecureTypes
st){value = ((2*bit)-1)} :: SIO (MVar FiniteField)
            SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
st{share = randmvar}) [Integer]
x

    [SecureTypes]
secbits <- [[StateT Env IO SecureTypes]]
-> ([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> StateT Env IO [SecureTypes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([[StateT Env IO SecureTypes]] -> [[StateT Env IO SecureTypes]]
forall a. [[a]] -> [[a]]
transpose [[StateT Env IO SecureTypes]]
xlist) (([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
 -> StateT Env IO [SecureTypes])
-> ([StateT Env IO SecureTypes] -> StateT Env IO SecureTypes)
-> StateT Env IO [SecureTypes]
forall a b. (a -> b) -> a -> b
$ \[StateT Env IO SecureTypes]
x -> do
        let secbit :: StateT Env IO SecureTypes
secbit = [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
sproduct [StateT Env IO SecureTypes]
x   
        if Bool
signed then StateT Env IO SecureTypes
secbit
            else (StateT Env IO SecureTypes
secbit StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
+ StateT Env IO SecureTypes
1) StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
* Integer -> StateT Env IO SecureTypes
forall a. Num a => Integer -> a
fromInteger (((FiniteFieldMeta -> Integer
modulus (FiniteFieldMeta -> Integer)
-> (SecureTypes -> FiniteFieldMeta) -> SecureTypes -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FiniteField -> FiniteFieldMeta
meta (FiniteField -> FiniteFieldMeta)
-> (SecureTypes -> FiniteField) -> SecureTypes -> FiniteFieldMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecureTypes -> FiniteField
field) SecureTypes
st Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) -- todo modulus = characteristics

    
    [StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes])
-> [StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes]
forall a b. (a -> b) -> a -> b
$ (SecureTypes -> StateT Env IO SecureTypes)
-> [SecureTypes] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map (\SecureTypes
secbit -> SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecureTypes
secbit) [SecureTypes]
secbits

-- | Secure dot product of x and y (one resharing).

inProd :: [SIO SecureTypes] -> [SIO SecureTypes] -> SIO SecureTypes
inProd :: [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes] -> StateT Env IO SecureTypes
inProd [StateT Env IO SecureTypes]
xm [StateT Env IO SecureTypes]
ym = do
    ([SecureTypes]
x, [SecureTypes]
y) <- LensLike
  (WrappedMonad (StateT Env IO))
  ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
  ([SecureTypes], [SecureTypes])
  (StateT Env IO SecureTypes)
  SecureTypes
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
-> StateT Env IO ([SecureTypes], [SecureTypes])
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf (([StateT Env IO SecureTypes]
 -> WrappedMonad (StateT Env IO) [SecureTypes])
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
-> WrappedMonad (StateT Env IO) ([SecureTypes], [SecureTypes])
Traversal
  ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
  ([SecureTypes], [SecureTypes])
  [StateT Env IO SecureTypes]
  [SecureTypes]
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (([StateT Env IO SecureTypes]
  -> WrappedMonad (StateT Env IO) [SecureTypes])
 -> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
 -> WrappedMonad (StateT Env IO) ([SecureTypes], [SecureTypes]))
-> ((StateT Env IO SecureTypes
     -> WrappedMonad (StateT Env IO) SecureTypes)
    -> [StateT Env IO SecureTypes]
    -> WrappedMonad (StateT Env IO) [SecureTypes])
-> LensLike
     (WrappedMonad (StateT Env IO))
     ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
     ([SecureTypes], [SecureTypes])
     (StateT Env IO SecureTypes)
     SecureTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT Env IO SecureTypes
 -> WrappedMonad (StateT Env IO) SecureTypes)
-> [StateT Env IO SecureTypes]
-> WrappedMonad (StateT Env IO) [SecureTypes]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [StateT Env IO SecureTypes]
  [SecureTypes]
  (StateT Env IO SecureTypes)
  SecureTypes
traversed) ([StateT Env IO SecureTypes]
xm, [StateT Env IO SecureTypes]
ym)
    MVar FiniteField
out <- SIO FiniteField -> SIO (MVar FiniteField)
forall a. SIO a -> SIO (MVar a)
async (SIO FiniteField -> SIO (MVar FiniteField))
-> SIO FiniteField -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ do
        ([FiniteField]
xf, [FiniteField]
yf) <- ([SecureTypes], [SecureTypes])
-> SIO (Result ([SecureTypes], [SecureTypes]))
forall a. Gather a => a -> SIO (Result a)
gather ([SecureTypes]
x, [SecureTypes]
y)
        FiniteField -> SIO FiniteField
forall a b. Reshare a b => a -> SIO b
reshare (FiniteField -> SIO FiniteField) -> FiniteField -> SIO FiniteField
forall a b. (a -> b) -> a -> b
$ [FiniteField] -> FiniteField
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([FiniteField] -> FiniteField) -> [FiniteField] -> FiniteField
forall a b. (a -> b) -> a -> b
$ (FiniteField -> FiniteField -> FiniteField)
-> [FiniteField] -> [FiniteField] -> [FiniteField]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
(*) [FiniteField]
xf [FiniteField]
yf
    SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x){share = out}

-- | Secure entrywise multiplication of vectors x and y.

schurProd :: [SIO SecureTypes] -> [SIO SecureTypes] -> SIO [SIO SecureTypes]
schurProd :: [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes]
schurProd [StateT Env IO SecureTypes]
xm [StateT Env IO SecureTypes]
ym = do
    ([SecureTypes]
x, [SecureTypes]
y) <- LensLike
  (WrappedMonad (StateT Env IO))
  ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
  ([SecureTypes], [SecureTypes])
  (StateT Env IO SecureTypes)
  SecureTypes
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
-> StateT Env IO ([SecureTypes], [SecureTypes])
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf (([StateT Env IO SecureTypes]
 -> WrappedMonad (StateT Env IO) [SecureTypes])
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
-> WrappedMonad (StateT Env IO) ([SecureTypes], [SecureTypes])
Traversal
  ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
  ([SecureTypes], [SecureTypes])
  [StateT Env IO SecureTypes]
  [SecureTypes]
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (([StateT Env IO SecureTypes]
  -> WrappedMonad (StateT Env IO) [SecureTypes])
 -> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
 -> WrappedMonad (StateT Env IO) ([SecureTypes], [SecureTypes]))
-> ((StateT Env IO SecureTypes
     -> WrappedMonad (StateT Env IO) SecureTypes)
    -> [StateT Env IO SecureTypes]
    -> WrappedMonad (StateT Env IO) [SecureTypes])
-> LensLike
     (WrappedMonad (StateT Env IO))
     ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
     ([SecureTypes], [SecureTypes])
     (StateT Env IO SecureTypes)
     SecureTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT Env IO SecureTypes
 -> WrappedMonad (StateT Env IO) SecureTypes)
-> [StateT Env IO SecureTypes]
-> WrappedMonad (StateT Env IO) [SecureTypes]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [StateT Env IO SecureTypes]
  [SecureTypes]
  (StateT Env IO SecureTypes)
  SecureTypes
traversed) ([StateT Env IO SecureTypes]
xm, [StateT Env IO SecureTypes]
ym)
    [MVar FiniteField]
outs <- Int -> StateT Env IO [FiniteField] -> SIO [MVar FiniteField]
forall a. Int -> SIO [a] -> SIO [MVar a]
asyncList ([SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SecureTypes]
x) (StateT Env IO [FiniteField] -> SIO [MVar FiniteField])
-> StateT Env IO [FiniteField] -> SIO [MVar FiniteField]
forall a b. (a -> b) -> a -> b
$ do
        ([FiniteField]
xf, [FiniteField]
yf) <- ([SecureTypes], [SecureTypes])
-> SIO (Result ([SecureTypes], [SecureTypes]))
forall a. Gather a => a -> SIO (Result a)
gather ([SecureTypes]
x, [SecureTypes]
y)
        [FiniteField] -> StateT Env IO [FiniteField]
forall a b. Reshare a b => a -> SIO b
reshare ([FiniteField] -> StateT Env IO [FiniteField])
-> [FiniteField] -> StateT Env IO [FiniteField]
forall a b. (a -> b) -> a -> b
$ (FiniteField -> FiniteField -> FiniteField)
-> [FiniteField] -> [FiniteField] -> [FiniteField]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
(*) [FiniteField]
xf [FiniteField]
yf
    [StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes])
-> [StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes]
forall a b. (a -> b) -> a -> b
$ (MVar FiniteField -> StateT Env IO SecureTypes)
-> [MVar FiniteField] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map (\MVar FiniteField
out -> SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x){share = out}) [MVar FiniteField]
outs

-- | Secure matrix product of A with (transposed) B.

matrixProd :: [[SIO SecureTypes]] -> [[SIO SecureTypes]] -> Bool -> SIO [[SIO SecureTypes]]
matrixProd :: [[StateT Env IO SecureTypes]]
-> [[StateT Env IO SecureTypes]]
-> Bool
-> StateT Env IO [[StateT Env IO SecureTypes]]
matrixProd [[StateT Env IO SecureTypes]]
am [[StateT Env IO SecureTypes]]
bm Bool
tr = do
    ([[SecureTypes]]
a, [[SecureTypes]]
b) <- LensLike
  (WrappedMonad (StateT Env IO))
  ([[StateT Env IO SecureTypes]], [[StateT Env IO SecureTypes]])
  ([[SecureTypes]], [[SecureTypes]])
  (StateT Env IO SecureTypes)
  SecureTypes
-> ([[StateT Env IO SecureTypes]], [[StateT Env IO SecureTypes]])
-> StateT Env IO ([[SecureTypes]], [[SecureTypes]])
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf (([[StateT Env IO SecureTypes]]
 -> WrappedMonad (StateT Env IO) [[SecureTypes]])
-> ([[StateT Env IO SecureTypes]], [[StateT Env IO SecureTypes]])
-> WrappedMonad (StateT Env IO) ([[SecureTypes]], [[SecureTypes]])
Traversal
  ([[StateT Env IO SecureTypes]], [[StateT Env IO SecureTypes]])
  ([[SecureTypes]], [[SecureTypes]])
  [[StateT Env IO SecureTypes]]
  [[SecureTypes]]
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (([[StateT Env IO SecureTypes]]
  -> WrappedMonad (StateT Env IO) [[SecureTypes]])
 -> ([[StateT Env IO SecureTypes]], [[StateT Env IO SecureTypes]])
 -> WrappedMonad (StateT Env IO) ([[SecureTypes]], [[SecureTypes]]))
-> ((StateT Env IO SecureTypes
     -> WrappedMonad (StateT Env IO) SecureTypes)
    -> [[StateT Env IO SecureTypes]]
    -> WrappedMonad (StateT Env IO) [[SecureTypes]])
-> LensLike
     (WrappedMonad (StateT Env IO))
     ([[StateT Env IO SecureTypes]], [[StateT Env IO SecureTypes]])
     ([[SecureTypes]], [[SecureTypes]])
     (StateT Env IO SecureTypes)
     SecureTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([StateT Env IO SecureTypes]
 -> WrappedMonad (StateT Env IO) [SecureTypes])
-> [[StateT Env IO SecureTypes]]
-> WrappedMonad (StateT Env IO) [[SecureTypes]]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [[StateT Env IO SecureTypes]]
  [[SecureTypes]]
  [StateT Env IO SecureTypes]
  [SecureTypes]
traversed (([StateT Env IO SecureTypes]
  -> WrappedMonad (StateT Env IO) [SecureTypes])
 -> [[StateT Env IO SecureTypes]]
 -> WrappedMonad (StateT Env IO) [[SecureTypes]])
-> ((StateT Env IO SecureTypes
     -> WrappedMonad (StateT Env IO) SecureTypes)
    -> [StateT Env IO SecureTypes]
    -> WrappedMonad (StateT Env IO) [SecureTypes])
-> (StateT Env IO SecureTypes
    -> WrappedMonad (StateT Env IO) SecureTypes)
-> [[StateT Env IO SecureTypes]]
-> WrappedMonad (StateT Env IO) [[SecureTypes]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT Env IO SecureTypes
 -> WrappedMonad (StateT Env IO) SecureTypes)
-> [StateT Env IO SecureTypes]
-> WrappedMonad (StateT Env IO) [SecureTypes]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [StateT Env IO SecureTypes]
  [SecureTypes]
  (StateT Env IO SecureTypes)
  SecureTypes
traversed) ([[StateT Env IO SecureTypes]]
am, [[StateT Env IO SecureTypes]]
bm)
    let n2 :: Int
n2 = if Bool
tr then ([[SecureTypes]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[SecureTypes]]
b) else ([SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[SecureTypes]] -> [SecureTypes]
forall a. HasCallStack => [a] -> a
head [[SecureTypes]]
b))
    [[MVar FiniteField]]
outslist <- Int -> Int -> SIO [[FiniteField]] -> SIO [[MVar FiniteField]]
forall a. Int -> Int -> SIO [[a]] -> SIO [[MVar a]]
asyncListList ([[SecureTypes]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[SecureTypes]]
a) Int
n2 (SIO [[FiniteField]] -> SIO [[MVar FiniteField]])
-> SIO [[FiniteField]] -> SIO [[MVar FiniteField]]
forall a b. (a -> b) -> a -> b
$ do
        ([[FiniteField]]
af, [[FiniteField]]
bf) <- ([[SecureTypes]], [[SecureTypes]])
-> SIO (Result ([[SecureTypes]], [[SecureTypes]]))
forall a. Gather a => a -> SIO (Result a)
gather ([[SecureTypes]]
a, [[SecureTypes]]
b)
        let bft :: [[FiniteField]]
bft = if Bool
tr then [[FiniteField]]
bf else [[FiniteField]] -> [[FiniteField]]
forall a. [[a]] -> [[a]]
transpose [[FiniteField]]
bf
        Int -> [FiniteField] -> [[FiniteField]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
n2 ([FiniteField] -> [[FiniteField]])
-> StateT Env IO [FiniteField] -> SIO [[FiniteField]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FiniteField] -> StateT Env IO [FiniteField]
forall a b. Reshare a b => a -> SIO b
reshare ([[FiniteField]] -> [FiniteField]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[FiniteField] -> FiniteField
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([FiniteField] -> FiniteField) -> [FiniteField] -> FiniteField
forall a b. (a -> b) -> a -> b
$ (FiniteField -> FiniteField -> FiniteField)
-> [FiniteField] -> [FiniteField] -> [FiniteField]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
(*) [FiniteField]
ai [FiniteField]
bi | [FiniteField]
bi <- [[FiniteField]]
bft] | [FiniteField]
ai <- [[FiniteField]]
af])

    [[StateT Env IO SecureTypes]]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[StateT Env IO SecureTypes]]
 -> StateT Env IO [[StateT Env IO SecureTypes]])
-> [[StateT Env IO SecureTypes]]
-> StateT Env IO [[StateT Env IO SecureTypes]]
forall a b. (a -> b) -> a -> b
$ (([MVar FiniteField] -> [StateT Env IO SecureTypes])
-> [[MVar FiniteField]] -> [[StateT Env IO SecureTypes]]
forall a b. (a -> b) -> [a] -> [b]
map (([MVar FiniteField] -> [StateT Env IO SecureTypes])
 -> [[MVar FiniteField]] -> [[StateT Env IO SecureTypes]])
-> ((MVar FiniteField -> StateT Env IO SecureTypes)
    -> [MVar FiniteField] -> [StateT Env IO SecureTypes])
-> (MVar FiniteField -> StateT Env IO SecureTypes)
-> [[MVar FiniteField]]
-> [[StateT Env IO SecureTypes]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar FiniteField -> StateT Env IO SecureTypes)
-> [MVar FiniteField] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map) (\MVar FiniteField
out -> SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head ([SecureTypes] -> SecureTypes)
-> ([[SecureTypes]] -> [SecureTypes])
-> [[SecureTypes]]
-> SecureTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[SecureTypes]] -> [SecureTypes]
forall a. HasCallStack => [a] -> a
head) [[SecureTypes]]
a){share = out}) [[MVar FiniteField]]
outslist

-- | Secure selection between x and y based on condition c.

class IfElse a b | a -> b where
    ifElse :: SIO SecureTypes -> a -> a -> SIO b

instance IfElse (SIO SecureTypes) (SecureTypes) where
    ifElse :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
-> StateT Env IO SecureTypes
ifElse StateT Env IO SecureTypes
cm StateT Env IO SecureTypes
xm StateT Env IO SecureTypes
ym = do
        StateT Env IO SecureTypes
y <- SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureTypes -> StateT Env IO SecureTypes)
-> StateT Env IO SecureTypes
-> StateT Env IO (StateT Env IO SecureTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Env IO SecureTypes
ym
        StateT Env IO SecureTypes
cm StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
* (StateT Env IO SecureTypes
xm StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
- StateT Env IO SecureTypes
y) StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
forall a. Num a => a -> a -> a
+ StateT Env IO SecureTypes
y

instance IfElse [SIO SecureTypes] [SIO SecureTypes] where
    ifElse :: StateT Env IO SecureTypes
-> [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes]
-> SIO [StateT Env IO SecureTypes]
ifElse = StateT Env IO SecureTypes
-> [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes]
-> SIO [StateT Env IO SecureTypes]
ifElseList

ifElseList :: SIO SecureTypes -> [SIO SecureTypes] -> [SIO SecureTypes] -> SIO [SIO SecureTypes]
ifElseList :: StateT Env IO SecureTypes
-> [StateT Env IO SecureTypes]
-> [StateT Env IO SecureTypes]
-> SIO [StateT Env IO SecureTypes]
ifElseList StateT Env IO SecureTypes
am [StateT Env IO SecureTypes]
xm [StateT Env IO SecureTypes]
ym = do
    ([SecureTypes]
x, [SecureTypes]
y) <- LensLike
  (WrappedMonad (StateT Env IO))
  ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
  ([SecureTypes], [SecureTypes])
  (StateT Env IO SecureTypes)
  SecureTypes
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
-> StateT Env IO ([SecureTypes], [SecureTypes])
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf (([StateT Env IO SecureTypes]
 -> WrappedMonad (StateT Env IO) [SecureTypes])
-> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
-> WrappedMonad (StateT Env IO) ([SecureTypes], [SecureTypes])
Traversal
  ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
  ([SecureTypes], [SecureTypes])
  [StateT Env IO SecureTypes]
  [SecureTypes]
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (([StateT Env IO SecureTypes]
  -> WrappedMonad (StateT Env IO) [SecureTypes])
 -> ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
 -> WrappedMonad (StateT Env IO) ([SecureTypes], [SecureTypes]))
-> ((StateT Env IO SecureTypes
     -> WrappedMonad (StateT Env IO) SecureTypes)
    -> [StateT Env IO SecureTypes]
    -> WrappedMonad (StateT Env IO) [SecureTypes])
-> LensLike
     (WrappedMonad (StateT Env IO))
     ([StateT Env IO SecureTypes], [StateT Env IO SecureTypes])
     ([SecureTypes], [SecureTypes])
     (StateT Env IO SecureTypes)
     SecureTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT Env IO SecureTypes
 -> WrappedMonad (StateT Env IO) SecureTypes)
-> [StateT Env IO SecureTypes]
-> WrappedMonad (StateT Env IO) [SecureTypes]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [StateT Env IO SecureTypes]
  [SecureTypes]
  (StateT Env IO SecureTypes)
  SecureTypes
traversed) ([StateT Env IO SecureTypes]
xm, [StateT Env IO SecureTypes]
ym)
    SecureTypes
a <- StateT Env IO SecureTypes
am
    [MVar FiniteField]
outs <- Int -> StateT Env IO [FiniteField] -> SIO [MVar FiniteField]
forall a. Int -> SIO [a] -> SIO [MVar a]
asyncList ([SecureTypes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SecureTypes]
x) (StateT Env IO [FiniteField] -> SIO [MVar FiniteField])
-> StateT Env IO [FiniteField] -> SIO [MVar FiniteField]
forall a b. (a -> b) -> a -> b
$ do
        (FiniteField
af, [FiniteField]
xf, [FiniteField]
yf) <- (SecureTypes, [SecureTypes], [SecureTypes])
-> SIO (Result (SecureTypes, [SecureTypes], [SecureTypes]))
forall a. Gather a => a -> SIO (Result a)
gather (SecureTypes
a, [SecureTypes]
x, [SecureTypes]
y)
        [FiniteField] -> StateT Env IO [FiniteField]
forall a b. Reshare a b => a -> SIO b
reshare ([FiniteField] -> StateT Env IO [FiniteField])
-> [FiniteField] -> StateT Env IO [FiniteField]
forall a b. (a -> b) -> a -> b
$ ((FiniteField, FiniteField) -> FiniteField)
-> [(FiniteField, FiniteField)] -> [FiniteField]
forall a b. (a -> b) -> [a] -> [b]
map (\(FiniteField
x_i, FiniteField
y_i) -> FiniteField
x_i{value = (value af) * ((value x_i) - (value y_i)) + (value y_i)}) ([FiniteField] -> [FiniteField] -> [(FiniteField, FiniteField)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FiniteField]
xf [FiniteField]
yf)

    [StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes]
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes])
-> [StateT Env IO SecureTypes] -> SIO [StateT Env IO SecureTypes]
forall a b. (a -> b) -> a -> b
$ (MVar FiniteField -> StateT Env IO SecureTypes)
-> [MVar FiniteField] -> [StateT Env IO SecureTypes]
forall a b. (a -> b) -> [a] -> [b]
map (\MVar FiniteField
out -> SecureTypes -> StateT Env IO SecureTypes
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecureTypes] -> SecureTypes
forall a. HasCallStack => [a] -> a
head [SecureTypes]
x){share = out}) [MVar FiniteField]
outs
    
randomR' :: (Integer, Integer) -> SIO Integer
randomR' :: (Integer, Integer) -> SIO Integer
randomR' (Integer, Integer)
range = do
    StdGen
_gen <- (Env -> StdGen) -> StateT Env IO StdGen
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> StdGen
gen
    let (Integer
value, StdGen
newGen) = (Integer, Integer) -> StdGen -> (Integer, StdGen)
forall g. RandomGen g => (Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Integer, Integer)
range StdGen
_gen
    (Env -> Env) -> SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env{gen = newGen})
    Integer -> SIO Integer
forall a. a -> StateT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
value

pairwise :: (a -> a -> a) -> [a] -> ([a], [a])
pairwise :: forall a. (a -> a -> a) -> [a] -> ([a], [a])
pairwise a -> a -> a
_ [] = ([],[]) 
pairwise a -> a -> a
_ [a
x] = ([],[a
x])                           
pairwise a -> a -> a
f (a
x:a
y:[a]
xs) =
    let ([a]
z, [a]
leftover) = (a -> a -> a) -> [a] -> ([a], [a])
forall a. (a -> a -> a) -> [a] -> ([a], [a])
pairwise a -> a -> a
f [a]
xs
    in (a -> a -> a
f a
x a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
z, [a]
leftover)

receiveMessage :: Party -> SIO (MVar BS.ByteString)
receiveMessage :: Party -> StateT Env IO (MVar ByteString)
receiveMessage Party
party = do
    Int
pc <- (Env -> Int) -> SIO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Int
pc 
    Int -> Party -> StateT Env IO (MVar ByteString)
Asyncoro.receive Int
pc Party
party

-- | Send data to given peer, labeled by current program counter.

sendMessage :: BS.ByteString -> Party -> SIO ()
sendMessage :: ByteString -> Party -> SIO ()
sendMessage ByteString
bytes Party
party = do
    Int
pc <- (Env -> Int) -> SIO Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Int
pc
    Int -> ByteString -> Party -> SIO ()
Asyncoro.send Int
pc ByteString
bytes Party
party
    
-- Start the hMPC runtime.

start :: SIO Env
start :: SIO Env
start = do
    Env{parties :: Env -> [Party]
parties=[Party]
parties, options :: Env -> Options
options=Options
opt} <- SIO Env
forall s (m :: * -> *). MonadState s m => m s
get
    IO Env -> SIO Env
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Env -> SIO Env) -> IO Env -> SIO Env
forall a b. (a -> b) -> a -> b
$ do
        [Party]
parties <- Int -> [Party] -> IO [Party]
Asyncoro.createConnections (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Options -> Integer
myPid Options
opt) [Party]
parties
        MVar Int
countVar <- Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
newMVar Int
1
        StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
        MVar ()
signalVar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
        UTCTime
startTime <- IO UTCTime
getCurrentTime
        Env -> IO Env
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Env -> IO Env) -> Env -> IO Env
forall a b. (a -> b) -> a -> b
$ [Party] -> Int -> Options -> Barrier -> StdGen -> UTCTime -> Env
Env [Party]
parties Int
0 Options
opt (MVar Int -> MVar () -> Barrier
Barrier MVar Int
countVar MVar ()
signalVar) StdGen
gen UTCTime
startTime

setup :: Options -> IO Env
setup :: Options -> IO Env
setup Options
opt = do
    Int -> IO ()
setNumCapabilities (Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Int -> (Int -> IO Int) -> Maybe Int -> IO Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Int
getNumCapabilities Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Maybe Int
nrThreads Options
opt)
    GenericHandler Handle
h <- Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
stdout Priority
INFO IO (GenericHandler Handle)
-> (GenericHandler Handle -> IO (GenericHandler Handle))
-> IO (GenericHandler Handle)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GenericHandler Handle
lh -> GenericHandler Handle -> IO (GenericHandler Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericHandler Handle -> IO (GenericHandler Handle))
-> GenericHandler Handle -> IO (GenericHandler Handle)
forall a b. (a -> b) -> a -> b
$
         GenericHandler Handle
-> LogFormatter (GenericHandler Handle) -> GenericHandler Handle
forall a. LogHandler a => a -> LogFormatter a -> a
setFormatter GenericHandler Handle
lh (String -> String -> LogFormatter (GenericHandler Handle)
forall a. String -> String -> LogFormatter a
tfLogFormatter String
"%Y-%m-%d %H:%M:%S%Q" String
"$time $msg")    
    String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
rootLoggerName ([GenericHandler Handle] -> Logger -> Logger
forall a. LogHandler a => [a] -> Logger -> Logger
setHandlers [GenericHandler Handle
h] (Logger -> Logger) -> (Logger -> Logger) -> Logger -> Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Priority -> Logger -> Logger
setLevel Priority
INFO)
    Env{options :: Env -> Options
options = Options
_opt, parties :: Env -> [Party]
parties=[Party]
_parties} <- if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Options -> [String]
parsParties Options
opt) 
        then do
            let _m :: Integer
_m = if (Options -> Integer
m Options
opt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) then Integer
1 else (Options -> Integer
m Options
opt)
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
_m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 Bool -> Bool -> Bool
&& (Options -> Integer
myPid Options
opt) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -Integer
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                String
exPath <- IO String
getExecutablePath
                [String]
args <- IO [String]
getArgs
                [Integer]
-> (Integer
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Integer
1..(Integer
_mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)] ((Integer
  -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
 -> IO ())
-> (Integer
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
                    let cmdLine :: String
cmdLine = String -> String -> String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%s %s -I %d" String
exPath ([String] -> String
unwords [String]
args) Integer
i
                    CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> CreateProcess
shell (String -> CreateProcess) -> String -> CreateProcess
forall a b. (a -> b) -> a -> b
$
                        if String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32" then (String
"start " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdLine)
                        else if String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"darwin" then String -> String -> String
forall r. PrintfType r => String -> r
printf String
"osascript -e 'tell application \"Terminal\" to do script \"%s\"'" String
cmdLine
                        else String
"")
            
            let _mypid :: Integer
_mypid = if (Options -> Integer
myPid Options
opt) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then (Options -> Integer
myPid Options
opt) else Integer
0
                _parties :: [Party]
_parties = (Integer -> Party) -> [Integer] -> [Party]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> Integer -> String -> Integer -> Party
mkParty Integer
i String
"127.0.0.1" ((Options -> Integer
basePort Options
opt) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)) [Integer
0..Integer
_mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1]
                _noASync :: Bool
_noASync = Integer
_m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
&& ((Options -> Bool
noAsync Options
opt) Bool -> Bool -> Bool
|| Bool -> Bool
not ((Options -> Integer
m Options
opt) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0))
            Env -> IO Env
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Env{options :: Options
options = Options
opt{myPid = _mypid, m = _m, noAsync = _noASync}, parties :: [Party]
parties = [Party]
_parties}
        else do
            let addresses :: [[String]]
addresses = (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\String
addr -> String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
":" String
addr) (Options -> [String]
parsParties Options
opt)
                _mypid :: Integer
_mypid = Integer -> (Int -> Integer) -> Maybe Int -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Options -> Integer
myPid Options
opt) Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
"" (([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
forall a. HasCallStack => [a] -> a
head [[String]]
addresses))
                _parties :: [Party]
_parties = ((Integer, [String]) -> Party) -> [(Integer, [String])] -> [Party]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
i, [String
host, String
port]) -> Integer -> String -> Integer -> Party
mkParty Integer
i (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
host then String
"127.0.0.1" else String
host) (String -> Integer
forall a. Read a => String -> a
read String
port)) ([Integer] -> [[String]] -> [(Integer, [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [[String]]
addresses)
                _m :: Integer
_m =  (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> ([Party] -> Int) -> [Party] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [Party]
_parties
            Env -> IO Env
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Env{options :: Options
options = Options
opt{myPid = _mypid, m = _m}, parties :: [Party]
parties = [Party]
_parties}

    let threshold :: Integer
threshold = ((Options -> Integer
m Options
_opt)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2
    Env -> IO Env
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Env{options :: Options
options = Options
_opt{threshold = threshold}, parties :: [Party]
parties = [Party]
_parties}
    where
        mkParty :: Integer -> String -> Integer -> Party
mkParty Integer
pid String
host Integer
port = Party{pid :: Integer
pid = Integer
pid, host :: String
host = String
host, port :: Integer
port = Integer
port}


-- secure types operator overloading

instance Num (SIO SecureTypes) where
    * :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(*) = StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.*)
    + :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(+) = StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.+)
    (-) = StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(.-)
    signum :: StateT Env IO SecureTypes -> StateT Env IO SecureTypes
signum = Bool
-> Bool -> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
ssignum Bool
False Bool
False
    fromInteger :: Integer -> StateT Env IO SecureTypes
fromInteger Integer
i =
         MVar FiniteField -> SecureTypes
SecTypes.Literal (MVar FiniteField -> SecureTypes)
-> SIO (MVar FiniteField) -> StateT Env IO SecureTypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (MVar FiniteField) -> SIO (MVar FiniteField)
forall a. IO a -> StateT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar FiniteField) -> SIO (MVar FiniteField))
-> IO (MVar FiniteField) -> SIO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ FiniteField -> IO (MVar FiniteField)
forall a. a -> IO (MVar a)
newMVar (FiniteField -> IO (MVar FiniteField))
-> FiniteField -> IO (MVar FiniteField)
forall a b. (a -> b) -> a -> b
$ Integer -> FiniteField
FinFields.Literal Integer
i)

instance Fractional (SIO SecureTypes) where
    / :: StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(/) = StateT Env IO SecureTypes
-> StateT Env IO SecureTypes -> StateT Env IO SecureTypes
(./)
    recip :: StateT Env IO SecureTypes -> StateT Env IO SecureTypes
recip = StateT Env IO SecureTypes -> StateT Env IO SecureTypes
srecip

_coerce :: SecureTypes -> SecureTypes -> SecureTypes
_coerce :: SecureTypes -> SecureTypes -> SecureTypes
_coerce (SecTypes.Literal MVar FiniteField
_) SecureTypes
f2 = SecureTypes
f2
_coerce SecureTypes
f1 SecureTypes
_ = SecureTypes
f1