Browse Source

Better distributions; now documented!

tags/0.1.0.0
Thomas Kerber 1 year ago
parent
commit
bf4195cca5
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
5 changed files with 35 additions and 46 deletions
  1. +3
    -2
      src/Yggdrasil/Adversarial.hs
  2. +24
    -35
      src/Yggdrasil/Distribution.hs
  3. +1
    -1
      src/Yggdrasil/ExecutionModel.hs
  4. +3
    -4
      tests/ExecTests.hs
  5. +4
    -4
      tests/FunctTests.hs

+ 3
- 2
src/Yggdrasil/Adversarial.hs View File

@@ -13,11 +13,12 @@

module Yggdrasil.Adversarial
( Adversary
, MaybeMap
, WithAdversary
, WithAdversary'(..)
, NoAdversary(noAdversary)
, NoAdversary(..)
, DummyInterfaces
, DummyAdversary(dummyAdversary)
, DummyAdversary(..)
, CreateAdversarial(..)
) where


+ 24
- 35
src/Yggdrasil/Distribution.hs View File

@@ -2,45 +2,28 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- | Provides primitives for high-level cryptographic sampling.
module Yggdrasil.Distribution
( Distribution(Distribution)
( Distribution
, DistributionT(DistributionT, runDistT)
, Sampler
, sample
, sample'
, Sampler(..)
, liftDistribution
, coin
, uniform
, liftDistribution
) where

import Control.Monad (ap, (>=>))
import Control.Monad.State.Lazy (State, runState, state)
import Control.Monad.Trans.Class (MonadTrans (lift))
import Crypto.Random (SystemDRG, randomBytesGenerate)
import Data.Bits ((.&.))
import qualified Data.ByteArray as B
import Data.Functor.Identity (Identity (Identity), runIdentity)
import Data.Maybe (fromJust)

newtype Distribution b =
Distribution (forall s. Sampler s =>
State s b)

instance Functor Distribution where
fmap f x = pure f <*> x

instance Applicative Distribution where
pure x = Distribution $ state (x, )
(<*>) = ap

instance Monad Distribution where
a >>= b =
Distribution $
state
(\s ->
let (a', s') = sample s a
(b', s'') = sample s' (b a')
in (b', s''))
-- | Allows randomly sampling elements of type @b@.
type Distribution = DistributionT Identity

-- | Allows randomly sampling elements of type @b@ in the context of monad @m@.
newtype DistributionT m b = DistributionT
{ runDistT :: forall s. Sampler s =>
s -> m (b, s)
@@ -59,11 +42,17 @@ instance Monad m => Monad (DistributionT m) where
instance MonadTrans DistributionT where
lift m = DistributionT $ \s -> (, s) <$> m

liftDistribution :: Monad m => Distribution b -> DistributionT m b
liftDistribution d = DistributionT $ \s -> return $ sample s d
class Sampler s where
-- | Provides randomness.
class Sampler s
where
-- | Produce a bit of randomness.
sampleCoin :: s -> (Bool, s)
-- | Samples a distribution.
sample :: s -> DistributionT m b -> m (b, s)
sample s d = runDistT d s
-- | Samples a distribution, discarding the result randomness.
sample' :: Monad m => s -> DistributionT m b -> m b
sample' s d = fst <$> sample s d

instance Sampler SystemDRG where
sampleCoin s = (b .&. 1 == 1, s')
@@ -72,15 +61,15 @@ instance Sampler SystemDRG where
-- fromJust is safe, as the array is not empty.
(b, _) = fromJust $ B.uncons ba

sample :: Sampler s => s -> Distribution b -> (b, s)
sample s (Distribution st) = runState st s

sample' :: Sampler s => s -> Distribution b -> b
sample' s = fst . sample s
-- | Lifts a 'Distribution' to an arbitrary monadic 'DistributionT'.
liftDistribution :: Monad m => Distribution b -> DistributionT m b
liftDistribution d = DistributionT $ return . runIdentity . runDistT d

-- | Tosses a fair coin.
coin :: Distribution Bool
coin = Distribution $ state sampleCoin
coin = DistributionT (Identity . sampleCoin)

-- | A uniform 'Distribution' over all elements of @[a]@.
uniform :: [a] -> Distribution a
uniform xs = do
let l = length xs

+ 1
- 1
src/Yggdrasil/ExecutionModel.hs View File

@@ -18,7 +18,7 @@ module Yggdrasil.ExecutionModel
, Operations
, Interfaces
, Functionality(..)
, InterfaceMap
, InterfaceMap(..)
, ForceSample(forceSample)
, run
) where

+ 3
- 4
tests/ExecTests.hs View File

@@ -8,7 +8,7 @@ import Crypto.Random (getSystemDRG)
import Data.Maybe (fromJust)
import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec.QuickCheck (prop)
import Yggdrasil.Distribution (runDistT, uniform)
import Yggdrasil.Distribution (sample', uniform)
import Yggdrasil.ExecutionModel (Action (Sample), run)

inSampleRange :: Int -> Bool
@@ -30,7 +30,6 @@ spec = do
return $
describe "action" $ do
prop "obeys return" $ \(x :: String) ->
(fst <$> runDistT (run (return x)) rnd) == Just x
sample' rnd (run (return x)) == Just x
it "samples evenly" $
inSampleRange (fst $ fromJust $ runDistT (run sampleTest) rnd) `shouldBe`
True
inSampleRange (fromJust $ sample' rnd (run sampleTest)) `shouldBe` True

+ 4
- 4
tests/FunctTests.hs View File

@@ -7,7 +7,7 @@ module FunctTests

import Crypto.Random (getSystemDRG)
import Test.Hspec (Spec, describe, it, shouldBe)
import Yggdrasil.Distribution (runDistT, uniform)
import Yggdrasil.Distribution (sample', uniform)
import Yggdrasil.ExecutionModel (Action (Create), run)
import Yggdrasil.Functionalities (commonRandomString, randomOracle)
import Yggdrasil.HList (HList ((:::), Nil))
@@ -41,9 +41,9 @@ spec = do
return $ do
describe "common random string" $
it "returns the same value" $
(fst <$> runDistT (run crsSameTest) rnd) `shouldBe` Just True
sample' rnd (run crsSameTest) `shouldBe` Just True
describe "random oracle" $ do
it "returns the same for the same query" $
(fst <$> runDistT (run roSameTest) rnd) `shouldBe` Just True
sample' rnd (run roSameTest) `shouldBe` Just True
it "is random with different queries" $
(fst <$> runDistT (run roAllEqual) rnd) `shouldBe` Just False
sample' rnd (run roAllEqual) `shouldBe` Just False

Loading…
Cancel
Save