Browse Source

Add functionality tests, some renaming.

tags/0.1.0.0
Thomas Kerber 1 year ago
parent
commit
38ea33dfe8
Signed by: Thomas Kerber <tk@drwx.org> GPG Key ID: 8489B911F9ED617B
5 changed files with 59 additions and 15 deletions
  1. +8
    -9
      src/Yggdrasil/ExecutionModel.hs
  2. +4
    -5
      src/Yggdrasil/Functionalities.hs
  3. +43
    -0
      tests/FunctTests.hs
  4. +3
    -0
      tests/Spec.hs
  5. +1
    -1
      yggdrasil.cabal

+ 8
- 9
src/Yggdrasil/ExecutionModel.hs View File

@@ -7,9 +7,8 @@
TupleSections #-}

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

import Control.Monad
@@ -70,7 +69,7 @@ data Action b where
StrengthenSelf :: Typeable s => Operation s a b -> Action (a ->> b)
Self :: Action WeakRef
Sample :: Distribution b -> Action b
Send :: (a ->> b) -> a -> Action b
Send :: a -> (a ->> b) -> Action b
Create :: Typeable s => Functionality s b -> Action b
Compose :: Action c -> (c -> Action b) -> Action b

@@ -81,8 +80,8 @@ abort = Abort
-- | Attempts to add a new operation on ourselves.
-- This action will fail (effectively aborting) if our state is not of type
-- 's'.
strengthenSelf :: Typeable s => Operation s a b -> Action (a ->> b)
strengthenSelf = StrengthenSelf
interface :: Typeable s => Operation s a b -> Action (a ->> b)
interface = StrengthenSelf
-- | Obtain a weak reference on ourselves.
self :: Action WeakRef
self = Self
@@ -91,8 +90,8 @@ doSample :: Distribution b -> Action b
doSample = Sample
-- | Send a message to a receipient we know the reference of.
-- Unless the receipient aborts, he must eventually respond.
send :: a ->> b -> a -> Action b
send = Send
(->>) :: a -> (a ->> b) -> Action b
(->>) = Send
-- | Creates a new autonomous party, with a given initial state, and a given
-- program.
create :: Typeable s => Functionality s b -> Action b
@@ -117,7 +116,7 @@ run' s wld slf (StrengthenSelf f) =
(wld, , s) <$> strengthen wld slf f
run' s wld slf Self = return (wld, slf, s)
run' s wld _ (Sample d) = let (y, s') = sample s d in Just (wld, y, s')
run' s (World xs) from (Send to@(Ref idx func) m) = do
run' s (World xs) from (Send m to@(Ref idx func)) = do
dyns <- safeIdx xs idx
st <- fromDynamic dyns
let action = func (st, from, m)

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

@@ -8,13 +8,12 @@ import Data.Dynamic
import Yggdrasil.ExecutionModel
import Yggdrasil.Distribution

type CRSState b = Maybe b
crsOp :: Distribution b -> Operation (CRSState b) () b
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 (CRSState b) (() ->> b)
commonRandomString d = Functionality Nothing (strengthenSelf (crsOp d))
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
@@ -29,4 +28,4 @@ roOp d (xs, _, x') = case roLookup xs x' of
return ((x', y):xs, y)
randomOracle :: (Eq a, Typeable a, Typeable b) =>
Distribution b -> Functionality (ROState a b) (a ->> b)
randomOracle d = Functionality [] (strengthenSelf (roOp d))
randomOracle d = Functionality [] (interface (roOp d))

+ 43
- 0
tests/FunctTests.hs View File

@@ -0,0 +1,43 @@
{-# LANGUAGE ScopedTypeVariables,
TypeOperators #-}

module FunctTests (spec) where

import Crypto.Random
import Test.Hspec
import Yggdrasil.ExecutionModel
import Yggdrasil.Distribution
import Yggdrasil.Functionalities

crsSameTest :: Action Bool
crsSameTest = do
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])
fst' <- 1 ->> roHandle
snd' <- 1 ->> roHandle
return (fst' == snd')

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

spec :: IO Spec
spec = do
rnd <- getSystemDRG
return $ do
describe "common random string" $ do
it "returns the same value" $
(fmap fst (run rnd crsSameTest)) `shouldBe` Just True
describe "random oracle" $ do
it "returns the same for the same query" $
(fmap fst (run rnd roSameTest)) `shouldBe` Just True
it "is random with different queries" $
(fmap fst (run rnd roAllEqual)) `shouldBe` Just False

+ 3
- 0
tests/Spec.hs View File

@@ -1,8 +1,11 @@
import Test.Hspec

import qualified ExecTests
import qualified FunctTests

main :: IO ()
main = do
execTests <- ExecTests.spec
functTests <- FunctTests.spec
hspec execTests
hspec functTests

+ 1
- 1
yggdrasil.cabal View File

@@ -32,5 +32,5 @@ test-suite spec
hs-source-dirs: tests
ghc-options: -Wall -Werror
main-is: Spec.hs
other-modules: ExecTests
other-modules: ExecTests, FunctTests
build-depends: cryptonite, base, hspec, QuickCheck, yggdrasil

Loading…
Cancel
Save