From dfab3e5315ff430ca43ee02c1017be1c8137a7eb Mon Sep 17 00:00:00 2001 From: Balazs Komuves Date: Fri, 19 Jun 2026 11:06:07 +0200 Subject: [PATCH] very early steps towards a discrete event simulator for Mix --- README.md | 15 +++- reference/.gitignore | 3 + reference/Simulate/DiscreteEvents.hs | 58 +++++++++++++ reference/Simulate/Distributions.hs | 122 +++++++++++++++++++++++++++ reference/Simulate/Mix.hs | 54 ++++++++++++ transport-over-mix.cabal | 4 + 6 files changed, 253 insertions(+), 3 deletions(-) create mode 100644 reference/.gitignore create mode 100644 reference/Simulate/DiscreteEvents.hs create mode 100644 reference/Simulate/Distributions.hs create mode 100644 reference/Simulate/Mix.hs diff --git a/README.md b/README.md index ea856f2..a089595 100644 --- a/README.md +++ b/README.md @@ -12,9 +12,18 @@ but otherwise pretty normally behaving network socket). Furthermore, we also take the opportunity to document (including an executable specification) both the Sphinx mix packet format, and SURBs (Single Use Reply Blocks). -## Quick Start +### Quick Start + +First (you normally only need to do this at most once): ```bash -cabal update -cabal build +cabal update # update the package directory +``` + +Then: + +```bash +cabal clean # start from a clean state +cabal build # build the library +cabal repl # read-eval-print loop ``` diff --git a/reference/.gitignore b/reference/.gitignore new file mode 100644 index 0000000..ca61732 --- /dev/null +++ b/reference/.gitignore @@ -0,0 +1,3 @@ +.DS_Store +.ghc.environment.* +tmp* diff --git a/reference/Simulate/DiscreteEvents.hs b/reference/Simulate/DiscreteEvents.hs new file mode 100644 index 0000000..1ef4f8a --- /dev/null +++ b/reference/Simulate/DiscreteEvents.hs @@ -0,0 +1,58 @@ + +-- | Discrete event simulation + +{-# LANGUAGE BangPatterns, StrictData, ScopedTypeVariables #-} +module Simulate.DiscreteEvents where + +-------------------------------------------------------------------------------- + +import Data.List +import qualified Data.PQueue.Prio.Min as Prio + +-------------------------------------------------------------------------------- + +type Time = Double + +type Queue a = Prio.MinPQueue Time a + +data Event a = Event + { eventOccuredAt :: !Time + , eventPayload :: !a + } + deriving (Eq,Show) + +data Action a + = NewEvent (Event a) + deriving (Eq,Show) + +insertNewEvent :: Action a -> Queue a -> Queue a +insertNewEvent (NewEvent (Event !t !payload)) !queue = Prio.insert t payload queue + +insertNewEvents :: [Action a] -> Queue a -> Queue a +insertNewEvents actions !queue = foldl' (flip insertNewEvent) queue actions + +-------------------------------------------------------------------------------- + +type KickStart s a = IO ([Action a],s) +type EventHandler s a = Event a -> s -> IO ([Action a],s) + +simulateEvents :: forall s a. KickStart s a -> EventHandler s a -> Time -> IO s +simulateEvents kickStart handler stopTime = + + do + (!actions0,!state0) <- kickStart + let !queue0 = insertNewEvents actions0 Prio.empty + go queue0 state0 + + where + go :: Queue a -> s -> IO s + go !queue !state = case Prio.getMin queue of + Nothing -> return state + Just (!time, !payload) -> do + (!actions, !state') <- handler (Event time payload) state + let !queue' = insertNewEvents actions queue + if time <= stopTime + then go queue' state' + else return state' + +-------------------------------------------------------------------------------- diff --git a/reference/Simulate/Distributions.hs b/reference/Simulate/Distributions.hs new file mode 100644 index 0000000..47d4e50 --- /dev/null +++ b/reference/Simulate/Distributions.hs @@ -0,0 +1,122 @@ + +-- | Probability distributions + +{-# LANGUAGE BangPatterns, StrictData #-} +module Simulate.Distributions where + +-------------------------------------------------------------------------------- + +import Data.List + +import Control.Monad +import System.Random + +-------------------------------------------------------------------------------- + +class Distribution distrib where + sample :: distrib -> IO Double + sample2 :: distrib -> IO (Double,Double) + + sample distrib = fst <$> sample2 distrib + sample2 distrib = do + x <- sample distrib + y <- sample distrib + return (x,y) + +sampleN :: Distribution distrib => distrib -> Int -> IO [Double] +sampleN distrib n = replicateM n (sample distrib) + +-------------------------------------------------------------------------------- + +-- | Diract delta distribution, defined by its support value +data DiracDelta + = DiracDelta Double + deriving (Show) + +-- | Exponential distribution defined by its mean +data ExpoDistr + = ExpoDistr Double + deriving (Show) + +-- | Truncated exponential distribution defined by its maximum and the underlying exponential +data TruncExpoDistr + = TruncExpoDistr Double ExpoDistr + deriving (Show) + +-- | Bi-truncated exponential distribution defined by its minimum, maximum and the underlying exponential +data BiTruncExpoDistr + = BiTruncExpoDistr (Double,Double) ExpoDistr + deriving (Show) + +-- | Gaussian distribution defined by its mean and standard deviation +data GaussDistr + = GaussDistr Double Double + deriving (Show) + +-- | Gaussian distribution, but truncated from the left +data LeftTruncGaussDistr + = LeftTruncGaussDistr Double GaussDistr + deriving (Show) + +---------------------------------------- + +instance Distribution DiracDelta where + sample (DiracDelta x) = return x + +instance Distribution ExpoDistr where + sample (ExpoDistr mean) = do + u <- randomIO + return (- mean * log u) + +instance Distribution TruncExpoDistr where + sample (TruncExpoDistr maximum expo) = loop where + loop = do + y <- sample expo + if y < maximum + then return y + else loop + +instance Distribution BiTruncExpoDistr where + sample (BiTruncExpoDistr (minimum,maximum) expo) = loop where + loop = do + y <- sample expo + if y > minimum && y < maximum + then return y + else loop + +instance Distribution GaussDistr where + -- Marsaglia polar method + sample2 distrib@(GaussDistr mean dev) = do + u <- randomRIO (-1,1) + v <- randomRIO (-1,1) + let s = u*u + v*v + if s >= 1 + then sample2 distrib + else do + let w = sqrt ( - 2*log s / s ) + let x = u*w + let y = v*w + return (mean + x*dev , mean + y*dev) + +instance Distribution LeftTruncGaussDistr where + sample (LeftTruncGaussDistr minimum gauss) = loop where + loop = do + y <- sample gauss + if y > minimum + then return y + else loop + +-------------------------------------------------------------------------------- + +average :: [Double] -> Double +average xs = sum xs / fromIntegral (length xs) + +variance :: [Double] -> Double +variance xs = average y2s where + y2s = [ y*y | x<-xs, let y = x-a ] + a = average xs + +deviation :: [Double] -> Double +deviation = sqrt . variance + +-------------------------------------------------------------------------------- diff --git a/reference/Simulate/Mix.hs b/reference/Simulate/Mix.hs new file mode 100644 index 0000000..9ef84d5 --- /dev/null +++ b/reference/Simulate/Mix.hs @@ -0,0 +1,54 @@ + +-- | Mix simulator + +{-# LANGUAGE StrictData #-} +module Simulate.Mix where + +-------------------------------------------------------------------------------- + +import Data.Word + +import Simulate.Distributions +import Simulate.DiscreteEvents + +-------------------------------------------------------------------------------- + +type Address = String + +data NodeType + = MixNode + | ExternalNode + deriving (Eq,Show) + +data CoverTrafficStrategy + = NoCoverTraffic + | ConstantRateCoverTraffic Double + | Poisson + deriving (Eq,Show) + +data GlobalConfig = MkGlobCfg + { _numberOfMixNodes :: Int + , _numberOfExtNodes :: Int + , _meanDelay :: Double + , _coverTraffic :: CoverTrafficStrategy + , _epochInSeconds :: Int -- ^ epoch time in seconds + , _ratePerEpoch :: Int -- ^ max number of messages per epoch + , _networkDropRate :: Double -- ^ percentage of packets dropped by the ambient networking layer + } + deriving (Eq,Show) + +-------------------------------------------------------------------------------- + +-- | Globally unique packet id +type PacketUID = Word64 + +data Event + = PacketReceived Address Time PacketUID + +-------------------------------------------------------------------------------- + +data ExtNodeCfg + = ExtNodePoisson ExpoDistr + | ExtNodeSteady LeftTruncGaussDistr + deriving Show + \ No newline at end of file diff --git a/transport-over-mix.cabal b/transport-over-mix.cabal index d1c3e92..ddfa7fa 100644 --- a/transport-over-mix.cabal +++ b/transport-over-mix.cabal @@ -35,6 +35,7 @@ Library bytestring >= 0.12 && < 0.14, random >= 1.3 && < 1.4, binary >= 0.8 && < 0.9, + pqueue >= 1.7.0 && < 2.0.0, hs-leopard >= 0.0.1 && < 0.0.3 Exposed-Modules: Sphinx.Header @@ -44,6 +45,9 @@ Library Transport.Chunks Transport.Types Transport.Misc + Simulate.Mix + Simulate.DiscreteEvents + Simulate.Distributions Crypto.Symmetric Crypto.Symmetric.AES128 Crypto.Symmetric.Blake2b