Browse Source

Add adverserial + signature functionality.

tags/0.1.0.0
Thomas Kerber 1 year ago
parent
commit
068aa0bdec
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
5 changed files with 105 additions and 17 deletions
  1. +31
    -0
      src/Yggdrasil/Adversarial.hs
  2. +13
    -7
      src/Yggdrasil/ExecutionModel.hs
  3. +56
    -6
      src/Yggdrasil/Functionalities.hs
  4. +3
    -3
      tests/FunctTests.hs
  5. +2
    -1
      yggdrasil.cabal

+ 31
- 0
src/Yggdrasil/Adversarial.hs View File

@@ -0,0 +1,31 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}

module Yggdrasil.Adversarial (
WithAdversary, Adversary, createAdversarial, noAdversary, dummyAdversary
) where

import Data.Dynamic
import Yggdrasil.ExecutionModel

type WithAdversary b c = (() ->> Maybe b) -> c

type Adversary s a b = Functionality s (() ->> Maybe a, b)

-- | An adversary that just returns 'Nothing'.
noAdversary :: Adversary () a ()
noAdversary = Functionality ()
((,()) <$> interface (\_ -> return ((), Nothing)))

-- | An adversary that simply forwards a reference to the environment
dummyAdversary :: (() ->> Maybe b) -> Adversary () b ()
dummyAdversary ref = Functionality () (return (ref, ()))

-- | Given an adversary, and a functionality that requires one, link the two
-- and return their respective handles.
createAdversarial :: (Typeable s, Typeable s') =>
Adversary s a c -> WithAdversary a (Functionality s' b) -> Action (b, c)
createAdversarial adv fnc = do
(advFnc, advEnv) <- create adv
fncEnv <- create $ fnc advFnc
return (fncEnv, advEnv)

+ 13
- 7
src/Yggdrasil/ExecutionModel.hs View File

@@ -5,8 +5,9 @@
{-# LANGUAGE TypeOperators #-}

module Yggdrasil.ExecutionModel (
Operation, WeakRef, Action, Functionality(..), type (->>), (->>), external,
weaken, abort, interface, self, doSample, create, run
Operation, WeakRef, Action, Functionality(..), type (->>), (->>), (<<-),
type (<<-), external, weaken, abort, interface, self, doSample, create,
run
) where

import Control.Monad
@@ -17,14 +18,15 @@ import Yggdrasil.Distribution

newtype World = World [Dynamic]

-- | An operation is a stateful function of @('WeakRef', a) -> 'Action' b@ over
-- the state @s@.
type Operation s a b = (s, WeakRef, a) -> Action (s, b)

data Functionality s a b = Functionality s (a -> Action b)
data Functionality s b = Functionality s (Action b)

data a ->> b where
Ref :: Typeable s => Int -> Operation s a b -> (a ->> b)
type a <<- b = b ->> a

-- | A weakened reference, that allows comparing entities for equality, but
-- nothing else.
@@ -70,7 +72,7 @@ data Action b where
Self :: Action WeakRef
Sample :: Distribution b -> Action b
Send :: a -> (a ->> b) -> Action b
Create :: Typeable s => Functionality s a b -> a -> Action b
Create :: Typeable s => Functionality s b -> Action b
Compose :: Action c -> (c -> Action b) -> Action b

-- Export visible constructors as functions.
@@ -92,9 +94,11 @@ doSample = Sample
-- Unless the receipient aborts, he must eventually respond.
(->>) :: a -> (a ->> b) -> Action b
(->>) = Send
(<<-) :: (a ->> b) -> a -> Action b
a <<- b = b ->> a
-- | Creates a new autonomous party, with a given initial state, and a given
-- program.
create :: Typeable s => Functionality s a b -> a -> Action b
create :: Typeable s => Functionality s b -> Action b
create = Create

instance Functor Action where
@@ -126,8 +130,8 @@ run' (World xs) from (Send m to@(Ref idx func)) = do
xs'' <- MaybeT $ return $ safeWriteIdx xs' idx (toDyn st')
return (World xs'', y)
-- Note: This could cause a re-entrancy style bug!
run' wld _ (Create (Functionality st f) x) =
let (wld', from') = new wld st in run' wld' from' (f x)
run' wld _ (Create (Functionality st a)) =
let (wld', from') = new wld st in run' wld' from' a
run' wld from (Compose a f) = do
(wld', b) <- run' wld from a
run' wld' from (f b)

+ 56
- 6
src/Yggdrasil/Functionalities.hs View File

@@ -1,19 +1,23 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}

module Yggdrasil.Functionalities (
ROState, commonRandomString, randomOracle
ROState, SigState, SignatureInterface(..), commonRandomString,
randomOracle, signature, robustSignature
) where

import Data.Dynamic
import Data.Maybe
import Yggdrasil.Adversarial
import Yggdrasil.ExecutionModel
import Yggdrasil.Distribution

crsOp :: Distribution b -> Operation (Maybe b) () b
crsOp _ (Just x, _, ()) = return (Just x, x)
crsOp d (Nothing, _, ()) = (\x -> (Just x, x)) <$> doSample d
crsOp d (Nothing, _, ()) = (\x -> (Just x, x)) <$> doSample d
commonRandomString :: Typeable b =>
Functionality (Maybe b) (Distribution b) (() ->> b)
commonRandomString = Functionality Nothing (interface . crsOp)
Distribution b -> Functionality (Maybe b) (() ->> b)
commonRandomString d = Functionality Nothing (interface $ crsOp d)

type ROState a b = [(a, b)]
roLookup :: Eq a => ROState a b -> a -> Maybe b
@@ -27,5 +31,51 @@ roOp d (xs, _, x') = case roLookup xs x' of
y <- doSample d
return ((x', y):xs, y)
randomOracle :: (Eq a, Typeable a, Typeable b) =>
Functionality (ROState a b) (Distribution b) (a ->> b)
randomOracle = Functionality [] (interface . roOp)
Distribution b -> Functionality (ROState a b) (a ->> b)
randomOracle d = Functionality [] (interface $ roOp d)

-- TODO: Don't abort with bad adversaries? Would probably need a specialised s
-- though.
type SigState m s = [(m, s, WeakRef)]
data SignatureInterface m s = SignatureInterface
{ sign :: m ->> s
, verify :: (m, s, WeakRef) ->> Bool
}
signOp :: Eq s => ((m, WeakRef) ->> s) -> Operation (SigState m s) m s
signOp adv (st, from, m) = do
sig <- adv <<- (m, from)
if any (== sig) (map (\(_, s, _) -> s) st)
then abort
else return ((m, sig, from):st, sig)
verifyOp :: (Eq m, Eq s) => Operation (SigState m s) (m, s, WeakRef) Bool
verifyOp (st, _, s) = return $ (st, s `elem` st)
signature :: (Eq m, Eq s, Typeable m, Typeable s) =>
WithAdversary ((m, WeakRef) ->> s)
(Functionality (SigState m s) (SignatureInterface m s))
signature adv = Functionality [] (do
adv' <- adv <<- ()
adv'' <- fromMaybe abort (return <$> adv')
sign' <- interface $ signOp adv''
verify' <- interface $ verifyOp
return $ SignatureInterface sign' verify')

robustSignOp :: Maybe ((m, WeakRef) ->> [Bool]) -> Int ->
Operation (SigState m [Bool]) m [Bool]
robustSignOp (Just adv) secparam (st, from, m) = do
sig <- adv <<- (m, from)
sig' <- if any (== sig) (map (\(_, s, _) -> s) st)
then forceSample secparam
else return sig
return ((m, sig', from):st, sig')
robustSignOp Nothing secparam (st, from, m) =
(\sig -> ((m, sig, from):st, sig)) <$> forceSample secparam
forceSample :: Int -> Action [Bool]
forceSample secparam = sequence [doSample coin | _ <- [0..secparam]]
robustSignature :: (Eq m, Typeable m) =>
Int -> WithAdversary ((m, WeakRef) ->> [Bool])
(Functionality (SigState m [Bool]) (SignatureInterface m [Bool]))
robustSignature secparam adv = Functionality [] (do
adv' <- adv <<- ()
sign' <- interface $ robustSignOp adv' secparam
verify' <- interface $ verifyOp
return $ SignatureInterface sign' verify')

+ 3
- 3
tests/FunctTests.hs View File

@@ -11,21 +11,21 @@ import Yggdrasil.Functionalities

crsSameTest :: Action Bool
crsSameTest = do
crsHandle <- create commonRandomString (uniform [0..10000::Int])
crsHandle <- create $ commonRandomString (uniform [0..10000::Int])
fst' <- () ->> crsHandle
snd' <- () ->> crsHandle
return (fst' == snd')

roSameTest :: Action Bool
roSameTest = do
roHandle :: (Int ->> Int) <- create randomOracle (uniform [0..1000::Int])
roHandle :: (Int ->> Int) <- create $ randomOracle (uniform [0..1000::Int])
fst' <- 1 ->> roHandle
snd' <- 1 ->> roHandle
return (fst' == snd')

roAllEqual :: Action Bool
roAllEqual = do
roHandle :: (Int ->> Int) <- create randomOracle (uniform [0..1000::Int])
roHandle :: (Int ->> Int) <- create $ randomOracle (uniform [0..1000::Int])
xs <- sequence [i ->> roHandle | i <- [1..1000]]
return $ all (== head xs) (tail xs)


+ 2
- 1
yggdrasil.cabal View File

@@ -17,7 +17,8 @@ extra-source-files: ChangeLog.md
cabal-version: >=1.10

library
exposed-modules: Yggdrasil.Distribution
exposed-modules: Yggdrasil.Adversarial
Yggdrasil.Distribution
Yggdrasil.ExecutionModel
Yggdrasil.Functionalities
-- other-modules:

Loading…
Cancel
Save