very early steps towards a discrete event simulator for Mix

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
 ```

reference/.gitignore

@@ -0,0 +1,3 @@
+.DS_Store
+.ghc.environment.*
+tmp*

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'
+
+--------------------------------------------------------------------------------

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
+
+--------------------------------------------------------------------------------

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
+  

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