Browse Source

Remove channel type. Everything's a function.

tags/0.1.0.0
Thomas Kerber 1 year ago
parent
commit
4b7e53c066
Signed by: Thomas Kerber <tk@drwx.org> GPG Key ID: 8489B911F9ED617B
4 changed files with 61 additions and 69 deletions
  1. +4
    -5
      src/Yggdrasil/Adversarial.hs
  2. +26
    -32
      src/Yggdrasil/ExecutionModel.hs
  3. +22
    -24
      src/Yggdrasil/Functionalities.hs
  4. +9
    -8
      tests/FunctTests.hs

+ 4
- 5
src/Yggdrasil/Adversarial.hs View File

@@ -1,5 +1,4 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}

module Yggdrasil.Adversarial (
WithAdversary, Adversary, createAdversarial, noAdversary, dummyAdversary
@@ -8,17 +7,17 @@ module Yggdrasil.Adversarial (
import Data.Dynamic
import Yggdrasil.ExecutionModel

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

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

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

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

-- | Given an adversary, and a functionality that requires one, link the two

+ 26
- 32
src/Yggdrasil/ExecutionModel.hs View File

@@ -2,12 +2,10 @@
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}

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

import Control.Monad
@@ -18,41 +16,39 @@ import Yggdrasil.Distribution

newtype World = World [Dynamic]

-- | An operation is a stateful function of @('Ref, a) -> 'Action' b@ over
-- the state @s@.
type Operation s a b = (s, WeakRef, a) -> Action (s, b)
type Operation s a b = (s, Ref, a) -> Action (s, 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
data SendRef a b where
SendRef :: Typeable s => Int -> Operation s a b -> SendRef a b

-- | A weakened reference, that allows comparing entities for equality, but
-- nothing else.
newtype WeakRef = WeakRef Int deriving Eq
newtype Ref = Ref Int deriving Eq

-- | A special reference indicating that something is external of the world.
-- This does not have a corresponding strong reference.
external :: WeakRef
external = WeakRef (-1)
external :: Ref
external = Ref (-1)

weaken :: (a ->> b) -> WeakRef
weaken (Ref idx _) = WeakRef idx
weaken :: SendRef a b -> Ref
weaken (SendRef idx _) = Ref idx

strengthen :: Typeable s =>
World -> WeakRef -> Operation s a b -> Maybe (a ->> b)
World -> Ref -> Operation s a b -> Maybe (SendRef a b)
strengthen (World []) _ _ = Nothing
strengthen (World (x:_)) (WeakRef 0) (f :: Operation s a b) = do
strengthen (World (x:_)) (Ref 0) (f :: Operation s a b) = do
_ :: s <- fromDynamic x
return $ Ref 0 f
return $ SendRef 0 f
strengthen (World (_:xs)) wref f = do
(Ref i f') <- strengthen (World xs) wref f
return $ Ref (i+1) f'
(SendRef i f') <- strengthen (World xs) wref f
return $ SendRef (i+1) f'

new :: Typeable s => World -> s -> (World, WeakRef)
new (World xs) s = (World (xs ++ [toDyn s]), WeakRef (length xs))
new :: Typeable s => World -> s -> (World, Ref)
new (World xs) s = (World (xs ++ [toDyn s]), Ref (length xs))

safeIdx :: [a] -> Int -> Maybe a
safeIdx [] _ = Nothing
@@ -68,10 +64,10 @@ safeWriteIdx (x:xs) i x' = (:) x <$> safeWriteIdx xs (i-1) x'

data Action b where
Abort :: Action b
StrengthenSelf :: Typeable s => Operation s a b -> Action (a ->> b)
Self :: Action WeakRef
StrengthenSelf :: Typeable s => Operation s a b -> Action (a -> Action b)
Self :: Action Ref
Sample :: Distribution b -> Action b
Send :: a -> (a ->> b) -> Action b
Send :: SendRef a b -> a -> Action b
Create :: Typeable s => Functionality s b -> Action b
Compose :: Action c -> (c -> Action b) -> Action b

@@ -82,20 +78,14 @@ abort = Abort
-- | Attempts to add a new operation on ourselves.
-- This action will fail (effectively aborting) if our state is not of type
-- 's'.
interface :: Typeable s => Operation s a b -> Action (a ->> b)
interface :: Typeable s => Operation s a b -> Action (a -> Action b)
interface = StrengthenSelf
-- | Obtain a weak reference on ourselves.
self :: Action WeakRef
self :: Action Ref
self = Self
-- | Sample from a distribution
doSample :: Distribution b -> Action b
doSample = Sample
(->>) :: 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 b -> Action b
@@ -116,13 +106,13 @@ run a = runMaybeT $ snd <$> run' (World []) external a
--run :: Sampler s => s -> Action b -> Maybe (b, s)
--run s a = (\(_, b, s') -> (b, s')) <$> run' s (World []) external a

run' :: World -> WeakRef -> Action b -> MaybeT Distribution (World, b)
run' :: World -> Ref -> Action b -> MaybeT Distribution (World, b)
run' _ _ Abort = MaybeT $ return Nothing
run' wld slf (StrengthenSelf f) = MaybeT $ return $
(wld,) <$> strengthen wld slf f
(wld,) . Send <$> strengthen wld slf f
run' wld slf Self = MaybeT $ return $ Just (wld, slf)
run' wld _ (Sample d) = lift $ (wld,) <$> d
run' (World xs) from (Send m to@(Ref idx func)) = do
run' (World xs) from (Send to@(SendRef idx func) m) = do
dyns <- MaybeT $ return $ safeIdx xs idx
st <- MaybeT $ return $ fromDynamic dyns
let action = func (st, from, m)

+ 22
- 24
src/Yggdrasil/Functionalities.hs View File

@@ -1,5 +1,3 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}

module Yggdrasil.Functionalities (
ROState, SigState, SignatureInterface(..), commonRandomString,
@@ -7,7 +5,6 @@ module Yggdrasil.Functionalities (
) where

import Data.Dynamic
import Data.Maybe
import Yggdrasil.Adversarial
import Yggdrasil.ExecutionModel
import Yggdrasil.Distribution
@@ -16,8 +13,8 @@ crsOp :: Distribution b -> Operation (Maybe b) () b
crsOp _ (Just x, _, ()) = return (Just x, x)
crsOp d (Nothing, _, ()) = (\x -> (Just x, x)) <$> doSample d
commonRandomString :: Typeable b =>
Distribution b -> Functionality (Maybe b) (() ->> b)
commonRandomString d = Functionality Nothing (interface $ crsOp d)
Distribution b -> Functionality (Maybe b) (Action b)
commonRandomString d = Functionality Nothing ((\f -> f ()) <$> interface (crsOp d))

type ROState a b = [(a, b)]
roLookup :: Eq a => ROState a b -> a -> Maybe b
@@ -31,39 +28,40 @@ roOp d (xs, _, x') = case roLookup xs x' of
y <- doSample d
return ((x', y):xs, y)
randomOracle :: (Eq a, Typeable a, Typeable b) =>
Distribution b -> Functionality (ROState a b) (a ->> b)
Distribution b -> Functionality (ROState a b) (a -> Action 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)]
type SigState m s = [(m, s, Ref)]
data SignatureInterface m s = SignatureInterface
{ sign :: m ->> s
, verify :: (m, s, WeakRef) ->> Bool
{ sign :: m -> Action s
, verify :: (m, s, Ref) -> Action Bool
}
signOp :: Eq s => ((m, WeakRef) ->> s) -> Operation (SigState m s) m s
signOp :: Eq s => ((m, Ref) -> Action s) -> Operation (SigState m s) m s
signOp adv (st, from, m) = do
sig <- adv <<- (m, from)
if any (== sig) (map (\(_, s, _) -> s) st)
sig <- adv (m, from)
if sig `elem` 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)
verifyOp :: (Eq m, Eq s) => Operation (SigState m s) (m, s, Ref) Bool
verifyOp (st, _, s) = return (st, s `elem` st)
signature :: (Eq m, Eq s, Typeable m, Typeable s) =>
WithAdversary ((m, WeakRef) ->> s)
WithAdversary ((m, Ref) -> Action s)
(Functionality (SigState m s) (SignatureInterface m s))
signature adv = Functionality [] (do
adv' <- adv <<- ()
adv'' <- fromMaybe abort (return <$> adv')
adv' <- adv
adv'' <- maybe abort return adv'
--adv'' <- fromMaybe abort (return <$> adv')
sign' <- interface $ signOp adv''
verify' <- interface $ verifyOp
verify' <- interface verifyOp
return $ SignatureInterface sign' verify')

robustSignOp :: Maybe ((m, WeakRef) ->> [Bool]) -> Int ->
robustSignOp :: Maybe ((m, Ref) -> Action [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)
sig <- adv (m, from)
sig' <- if sig `elem` map (\(_, s, _) -> s) st
then forceSample secparam
else return sig
return ((m, sig', from):st, sig')
@@ -72,10 +70,10 @@ robustSignOp Nothing secparam (st, from, m) =
forceSample :: Int -> Action [Bool]
forceSample secparam = sequence [doSample coin | _ <- [0..secparam]]
robustSignature :: (Eq m, Typeable m) =>
Int -> WithAdversary ((m, WeakRef) ->> [Bool])
Int -> WithAdversary ((m, Ref) -> Action [Bool])
(Functionality (SigState m [Bool]) (SignatureInterface m [Bool]))
robustSignature secparam adv = Functionality [] (do
adv' <- adv <<- ()
adv' <- adv
sign' <- interface $ robustSignOp adv' secparam
verify' <- interface $ verifyOp
verify' <- interface verifyOp
return $ SignatureInterface sign' verify')

+ 9
- 8
tests/FunctTests.hs View File

@@ -1,5 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module FunctTests (spec) where

@@ -12,21 +11,23 @@ import Yggdrasil.Functionalities
crsSameTest :: Action Bool
crsSameTest = do
crsHandle <- create $ commonRandomString (uniform [0..10000::Int])
fst' <- () ->> crsHandle
snd' <- () ->> crsHandle
fst' <- crsHandle
snd' <- crsHandle
return (fst' == snd')

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

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

spec :: IO Spec

Loading…
Cancel
Save