Browse Source

Add signature functionality back.

tags/0.1.0.0
Thomas Kerber 1 year ago
parent
commit
bb18b10184
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
5 changed files with 83 additions and 50 deletions
  1. +24
    -12
      src/Yggdrasil/Adversarial.hs
  2. +2
    -3
      src/Yggdrasil/Distribution.hs
  3. +5
    -3
      src/Yggdrasil/ExecutionModel.hs
  4. +51
    -32
      src/Yggdrasil/Functionalities.hs
  5. +1
    -0
      src/Yggdrasil/HList.hs

+ 24
- 12
src/Yggdrasil/Adversarial.hs View File

@@ -6,7 +6,6 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
@@ -15,12 +14,14 @@
module Yggdrasil.Adversarial
( Adversary
, WithAdversary
, WithAdversary'(..)
, NoAdversary(noAdversary)
, DummyInterfaces
, DummyAdversary(dummyAdversary)
, createAdversarial
, CreateAdversarial(..)
) where

import Control.Arrow (second)
import Control.Monad.Trans.Class (lift)
import Yggdrasil.ExecutionModel (Action (Create),
Functionality (Functionality),
@@ -33,8 +34,12 @@ type family MaybeMap (bs :: [(*, *)]) = (ys :: [(*, *)]) | ys -> bs where
MaybeMap '[] = '[]
MaybeMap ('( a, b) ': xs) = '( a, Maybe b) ': MaybeMap xs

type WithAdversary s (ts :: [(*, *)]) b
= HList (Interfaces s (MaybeMap ts)) -> b
newtype WithAdversary s (ts :: [(*, *)]) b =
WithAdversary (HList (Interfaces s (MaybeMap ts)) -> b)

data WithAdversary' s c (as :: [(*, *)]) (bs :: [(*, *)]) =
WithAdversary' (HList (Interfaces s (MaybeMap as)) -> HList (Operations s c as))
(HList (Operations s c as) -> Functionality s c bs)

type Adversary s c as bs = Functionality s c (as +|+ MaybeMap bs)

@@ -69,11 +74,18 @@ instance DummyAdversary s bs => DummyAdversary s ('( a, b) ': bs) where
((\ref x -> lift $ b ref x) :: Operation s () a (Maybe b)) :::
operations @s @bs bs

createAdversarial ::
( HSplit (Interfaces s (as +|+ MaybeMap bs)) (Interfaces s as) (Interfaces s (MaybeMap bs))
, InterfaceMap s c (as +|+ MaybeMap bs)
)
=> Adversary s c as bs
-> WithAdversary s bs b
-> Action s (HList (Interfaces s as), b)
createAdversarial adv f = (\(a, b) -> (a, f b)) <$> hsplit <$> Create adv
class CreateAdversarial s c as bs adv b where
createAdversarial ::
( HSplit (Interfaces s (as +|+ MaybeMap bs)) (Interfaces s as) (Interfaces s (MaybeMap bs))
, InterfaceMap s c (as +|+ MaybeMap bs)
)
=> Adversary s c as bs
-> adv
-> Action s (HList (Interfaces s as), b)

instance CreateAdversarial s c as bs (WithAdversary s bs b) b where
createAdversarial adv (WithAdversary f) = second f . hsplit <$> Create adv

instance CreateAdversarial s c as bs (WithAdversary' s c bs cs) (Functionality s c cs) where
createAdversarial adv (WithAdversary' g f) =
(\(a, b) -> (a, f (g b))) . hsplit <$> Create adv

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

@@ -13,7 +13,7 @@ module Yggdrasil.Distribution
, liftDistribution
) where

import Control.Monad (ap)
import Control.Monad ((>=>), ap)
import Control.Monad.State.Lazy (State, runState, state)
import Control.Monad.Trans.Class (MonadTrans (lift))
import Crypto.Random (SystemDRG, randomBytesGenerate)
@@ -54,8 +54,7 @@ instance Monad m => Applicative (DistributionT m) where
(<*>) = ap

instance Monad m => Monad (DistributionT m) where
a >>= b =
DistributionT (\s -> (runDistT a) s >>= (\(a', s') -> (runDistT (b a')) s'))
a >>= b = DistributionT $ runDistT a >=> (\(a', s') -> runDistT (b a') s')

instance MonadTrans DistributionT where
lift m = DistributionT $ \s -> (, s) <$> m

+ 5
- 3
src/Yggdrasil/ExecutionModel.hs View File

@@ -6,7 +6,6 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
@@ -15,7 +14,7 @@ module Yggdrasil.ExecutionModel
( Operation
, RealRef
, Ref(External)
, Action(Abort, Sample, Create)
, Action(Abort, Sample, Create, SecParam)
, Operations
, Interfaces
, Functionality(..)
@@ -73,6 +72,7 @@ weaken (SendRef ref _) = Ref ref

data Action s b where
Abort :: Action s b
SecParam :: Action s Int
Sample :: Distribution b -> Action s b
Send :: SendRef s a b -> a -> Action s b
Create
@@ -100,6 +100,8 @@ run a =

run' :: Ref s -> Action s b -> DistributionT (MaybeT (ST s)) b
run' _ Abort = DistributionT $ \_ -> MaybeT $ return Nothing
-- TODO: Make a parameter
run' _ SecParam = return 128
run' _ (Sample d) = liftDistribution d
run' from (Send to@(SendRef (RealRef (ptr :: STRef s c) _) op) msg) = do
c <- lift . lift $ readSTRef ptr
@@ -120,4 +122,4 @@ instance InterfaceMap s c '[] where
ifmap _ Nil = Nil

instance InterfaceMap s c as => InterfaceMap s c ('( a, b) ': as) where
ifmap ref (x ::: xs) = (\a -> Send (SendRef ref x) a) ::: ifmap ref xs
ifmap ref (x ::: xs) = Send (SendRef ref x) ::: ifmap ref xs

+ 51
- 32
src/Yggdrasil/Functionalities.hs View File

@@ -1,25 +1,26 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

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

import Control.Monad.State.Lazy (get, modify, put)
import Control.Monad.Trans.Class (lift)

--import Yggdrasil.Adversarial (WithAdversary)
import Yggdrasil.Distribution (Distribution)
import Yggdrasil.ExecutionModel (Action (Sample),
import Yggdrasil.Adversarial (WithAdversary' (WithAdversary'))
import Yggdrasil.Distribution (Distribution, coin)
import Yggdrasil.ExecutionModel (Action (Sample, SecParam),
Functionality (Functionality),
Operation)
Interfaces, Operation, Operations,
Ref)
import Yggdrasil.HList (HList ((:::), Nil))

crsOp :: Distribution b -> Operation s (Maybe b) () b
@@ -54,62 +55,42 @@ roOp d _ x =
randomOracle ::
Eq a => Distribution b -> Functionality s (ROState a b) '[ '( a, b)]
randomOracle d = Functionality [] (roOp d ::: Nil)
--type SigState m s = [(m, s, Ref)]
--
--data SignatureInterface m s = SignatureInterface
--
--signOp :: Eq s => ((m, Ref) -> Action s) -> Operation (SigState m s) m s
--signOp adv (st, from, m) = do
--
--verifyOp :: (Eq m, Eq s) => Operation (SigState m s) (m, s, Ref) Bool
--verifyOp (st, _, s) = return (st, s `elem` st)
--signature ::
--signature adv =
--
--robustSignOp ::
--robustSignOp (Just adv) secparam (st, from, m) = do
--robustSignOp Nothing secparam (st, from, m) =
--
--forceSample :: Int -> Action [Bool]
--forceSample secparam = sequence [doSample coin | _ <- [0 .. secparam]]
--
--robustSignature ::
--robustSignature secparam adv =

type SigState s msg = [(msg, [Bool], Ref s)]

verifyOp :: (Eq msg) => Operation s (SigState s msg) (msg, [Bool], Ref s) Bool
verifyOp _ s = (s `elem`) <$> get

forceSample :: Action s [Bool]
forceSample = SecParam >>= (\sp -> sequence [Sample coin | _ <- [0 .. sp]])

fixAdv ::
Eq msg
=> HList (Interfaces s '[ '( (msg, Ref s), Maybe [Bool])])
-> HList (Operations s (SigState s msg) '[ '( (msg, Ref s), [Bool])])
fixAdv (sign ::: Nil) = sign' ::: Nil
where
sign' _ (msg, ref) =
lift (sign (msg, ref)) >>=
(\case
Just s ->
get >>=
(\st ->
if (msg, s, ref) `elem` st
then lift forceSample
else return s)
Nothing -> lift forceSample) >>=
(\s -> modify ((msg, s, ref) :) >> return s)

signature ::
Eq msg
=> WithAdversary' s (SigState s msg)
'[ '( (msg, Ref s), [Bool])]
'[
'( (msg, Ref s), [Bool]),
'( (msg, [Bool], Ref s), Bool)
]
signature =
WithAdversary'
fixAdv
(\(sign ::: Nil) -> Functionality [] (sign ::: verifyOp ::: Nil))

+ 1
- 0
src/Yggdrasil/HList.hs View File

@@ -17,6 +17,7 @@ module Yggdrasil.HList
, HSplit(hsplit)
) where

infixr 5 :::
data HList :: [*] -> * where
Nil :: HList '[]
(:::) :: a -> HList as -> HList (a ': as)

Loading…
Cancel
Save