WIP transport layer impl (erasure coding of messages into chunks seems to work)

.gitignore

@@ -6,3 +6,4 @@ dist-newstyle/
 *.o
 *.hi
 .ghc.environment*
+cabal.project

README.md

@@ -7,7 +7,7 @@ a transport abstraction layer over the [Mix Protocol](https://lip.logos.co/ift-t
 The idea is to hide the packet size and other limitations of Mix behind a nice
 abstraction layer, so applications can pretend they are communicating over
 a "normal" network not unlike TCP (a very slow, and moderately reliable, 
-but otherwise pretty normally behaving network).
+but otherwise pretty normally behaving network socket).
 
-Furthermore, we also take the opportunity to document both the Sphinx mix packet 
-format, and SURBs (Single Use Reply Blocks).
+Furthermore, we also take the opportunity to document (including an executable
+specification) both the Sphinx mix packet format, and SURBs (Single Use Reply Blocks).

reference/Crypto/PRP/Lioness.hs

@@ -7,17 +7,19 @@
 --
 
 {-# LANGUAGE NumericUnderscores #-}
-module Crypto.Lioness where
+module Crypto.PRP.Lioness where
 
 --------------------------------------------------------------------------------
 
 import Data.Bits
 import Data.Word
 
+import qualified Data.ByteString as B
+
 import Crypto.Symmetric     -- for testing only??
 
 import Crypto.Types
-import Octet
+import Data.Octets
 
 --------------------------------------------------------------------------------
 
@@ -66,6 +68,9 @@ xorWithKey (Key256 key) bytes = Key256 $ W256 $ xorBytes bytes (fromWord256 key)
 
 --------------------------------------------------------------------------------
 
+lionessPermBS :: LionessInstance -> Key256 -> B.ByteString -> B.ByteString
+lionessPermBS inst key = B.pack . lionessPerm inst key . B.unpack
+
 lionessPerm :: LionessInstance -> Key256 -> [Word8] -> [Word8]
 lionessPerm inst@(MkLioness kdfFun hashFun streamFun) masterKey input 
   | n < 64     = error "lionessPerm: input is too small (the minimum is 64 bytes)" 

reference/Crypto/Symmetric.hs

@@ -14,7 +14,7 @@ import qualified Crypto.Symmetric.Blake2b as Blake2b
 import qualified Crypto.Symmetric.HMAC    as HMac
 
 import Crypto.Types
-import Octet
+import Data.Octets
 
 --------------------------------------------------------------------------------
 

reference/Crypto/Symmetric/AES128.hs

@@ -16,7 +16,7 @@ import Data.Int
 
 -- import Text.Printf
 
-import Octet
+import Data.Octets
 import Crypto.Types
 
 --------------------------------------------------------------------------------

reference/Crypto/Symmetric/Blake2b.hs

@@ -14,10 +14,12 @@ import Data.Bits
 import Data.Char
 import Data.List hiding (partition)
 
-import Octet
+import Data.Octets
 
 --------------------------------------------------------------------------------
 
+-- TODO: implement keyed version
+
 kk =  0       -- key bytes
 nn = 32       -- output bytes
 

reference/Crypto/Symmetric/HMAC.hs

@@ -9,7 +9,7 @@ import Data.Char
 
 import Crypto.Symmetric.SHA256
 
-import Octet
+import Data.Octets
 import Crypto.Types
 
 --------------------------------------------------------------------------------

reference/Crypto/Symmetric/SHA256.hs

@@ -19,7 +19,7 @@ import Data.Word
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 
-import Octet
+import Data.Octets
 
 --------------------------------------------------------------------------------
 

reference/Crypto/Types.hs

@@ -4,7 +4,7 @@ module Crypto.Types where
 --------------------------------------------------------------------------------
 
 import Data.Word
-import Octet
+import Data.Octets
 
 --------------------------------------------------------------------------------
 

reference/Crypto/X25519/DH.hs

@@ -16,8 +16,7 @@ import Crypto.X25519.Elliptic
 import Control.Monad
 import System.Random
 
-import Octet
-
+import Data.Octets
 
 --------------------------------------------------------------------------------
 

reference/Data/Octets.hs

@@ -4,7 +4,7 @@
 -- (TODO: refactor this to something nicer...)
 
 {-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
-module Octet where
+module Data.Octets where
 
 --------------------------------------------------------------------------------
 

reference/Mix/Address.hs

@@ -0,0 +1,71 @@
+
+-- | Mix address field encoding
+
+{-# LANGUAGE StrictData #-}
+module Mix.Address where
+
+--------------------------------------------------------------------------------
+
+import Data.Word
+
+import Control.Monad
+import System.Random
+
+import Data.Octets
+
+--------------------------------------------------------------------------------
+-- * network addresses
+
+-- | We encode networks addresses as strings for simplicity
+type NetworkAddress = String
+
+-- | Compressed mix addresses are something like a hash
+newtype ComprMixAddr 
+  = MkMixAddr [Word8]
+  deriving (Eq,Show)
+
+-- | A mix node can have a full address or a compressed address
+data MixAddress 
+  = CompressedMixAddr ComprMixAddr
+  | FullMixAddr       NetworkAddress
+  deriving (Eq,Show)
+
+-- | An address can be a mix node or an external address
+data SomeAddress  
+  = MixAddress      MixAddress
+  | ExternalAddress NetworkAddress
+  deriving (Eq,Show)
+
+--------------------------------------------------------------------------------
+-- * delays
+
+newtype DelayHint 
+  = DelayHint Word16
+  deriving (Eq,Show)
+
+randomDelayHint :: IO DelayHint
+randomDelayHint = DelayHint <$> randomRIO (1,2^15-1)
+
+--------------------------------------------------------------------------------
+-- * mix addresses
+
+data TransportVersion
+  = TransportVersion1
+  deriving (Eq,Show)
+
+data RecvProtocol
+  = BasicMixProtocol                           -- ^ just sending packets
+  | MixTransportProtocol TransportVersion      -- ^ it's the transport layer protocol
+  deriving (Eq,Show)
+
+data FwdAddress
+  = ForwardingHop MixAddress
+  | FinalHop      RecvProtocol SomeAddress
+  deriving (Eq,Show)
+
+-- | An address field contains a delay hint, and an forwarding address
+data AddressField 
+  = MkAddressField DelayHint FwdAddress
+  deriving (Eq,Show)
+
+--------------------------------------------------------------------------------

reference/Mix/Packet.hs

@@ -0,0 +1,18 @@
+
+module Mix.Packet where
+
+--------------------------------------------------------------------------------
+
+import Data.Word
+import Sphinx.Header
+import Mix.Address
+
+--------------------------------------------------------------------------------
+
+data MixPacket = MkMixPacket
+  { mixHeader  :: SphinxHeader
+  , mixPayload :: ByteString
+  }
+  deriving (Eq)
+
+--------------------------------------------------------------------------------

reference/Sphinx/Header.hs

@@ -4,8 +4,9 @@
 -- See:
 --
 -- * George Danezis, Ian Goldberg: "Sphinx: A Compact and Provably Secure Mix Format"
+--   <https://cypherpunks.ca/~iang/pubs/Sphinx_Oakland09.pdf>
 --
--- <https://cypherpunks.ca/~iang/pubs/Sphinx_Oakland09.pdf>
+-- * see also the @docs@ subdirectory in this repo
 --
 
 {-# OPTIONS_GHC -Wno-x-partial #-}
@@ -34,7 +35,7 @@ import Crypto.X25519.ScalarField ( Fq , toFq )
 import Crypto.Symmetric
 import Crypto.Types
 
-import Octet
+import Data.Octets
 
 --------------------------------------------------------------------------------
 -- * global constants
@@ -43,12 +44,14 @@ import Octet
 maxNumberOfHops :: Int
 maxNumberOfHops = 5
 
+{-
 -- | Targeted security in bits = size of symmetric keys = size of MACs = half the size of private keys
 lambda :: Int
 lambda = 128
 
 lambdaBytes :: Int
 lambdaBytes = div lambda 8
+-}
 
 --------------------------------------------------------------------------------
 -- * crypto primitives
@@ -62,11 +65,9 @@ mixMAC = hmac (HMAC128 SHA256)
 mixPRG :: Key -> IV -> [Word8]
 mixPRG = streamCipherPRGBytes AES128_CTR 
 
-mixRouteEnc :: Key -> IV -> [Word8] -> [Word8]
-mixRouteEnc key iv input = zipWith xor input (mixPRG key iv)
+mixRouteEncDec :: Key -> IV -> [Word8] -> [Word8]
+mixRouteEncDec key iv input = zipWith xor input (mixPRG key iv)
 
-mixRouteDec :: Key -> IV -> [Word8] -> [Word8]
-mixRouteDec = mixRouteEnc
 
 --------------------------------------------------------------------------------
 -- * types
@@ -77,40 +78,42 @@ type SizeInBytes = Int
 -- | The actual number of hops. Can be less or equal to @maxNumberOfHops@.
 type NHops = Int
 
+{-
 -- | A destination address is usually outside the mix network. We represent it by
 -- a string (padded to a fixed length)
 type DestinationAddr = String
 
--- | A mix node address should be represented as a fixed length bytestring
-newtype MixAddr 
+-- | A compressed mix node address should be represented as a fixed length bytestring
+newtype ComprMixAddr 
   = MkMixAddr [Word8]
   deriving (Eq,Show)
 
 -- | A (random) message identifier, to identify replies. 
 type MessageId = Word128
 
--- | A mix node (extenal view) has a public key and an address
-data MixNodeExt = MkMixNodeExt
-  { nodePubKey  :: PubKey
-  , nodeAddress :: MixAddr
-  }
-  deriving (Eq,Show)
-
--- | Internally, a mix node also has a private key (required for processing)
-data MixNodeInt = MkMixNodeInt
-  { nodePrivKey :: SecretKey 
-  , nodeExt     :: MixNodeExt 
-  }
-  deriving (Eq,Show)
-
 data Address
   = ForwardDestination !DestinationAddr
   | ReplyDestination   !DestinationAddr
   | MixNode            !MixAddr
   deriving (Eq,Show)
+-}
+
+-- | A mix node (extenal view) has a public key and an address
+data MixNodeExt addr = MkMixNodeExt
+  { nodePubKey  :: PubKey
+  , nodeAddress :: addr
+  }
+  deriving (Eq,Show)
+
+-- | Internally, a mix node also has a private key (required for processing)
+data MixNodeInt addr = MkMixNodeInt
+  { nodePrivKey :: SecretKey 
+  , nodeExt     :: MixNodeExt addr 
+  }
+  deriving (Eq,Show)
 
 -- | A mix path is a route consisting of several mix nodes
-type MixPath = [MixNodeInt]
+type MixPath addr = [MixNodeInt addr]
 
 -- | A Sphinx header consists of three part, denoted (after the Sphinx paper) by alpha, beta, and gamma.
 data SphinxHeader = MkHeader
@@ -144,9 +147,9 @@ computeBlinder alpha sharedSecret = toIntegerLE blinder where
   blindInput  = pubKeyBytes alpha ++ fromWord256 sharedSecret :: [Word8]
   blinder     = hash SHA256 blindInput                        :: Word256 
 
-computePerHopSecrets :: SecretKey -> [MixNodeExt] -> [PerHopSecrets]
+computePerHopSecrets :: SecretKey -> [MixNodeExt addr] -> [PerHopSecrets]
 computePerHopSecrets initialSecret path = go initialSecret path where
-  go :: SecretKey -> [MixNodeExt] -> [PerHopSecrets]
+  go :: SecretKey -> [MixNodeExt addr] -> [PerHopSecrets]
   go _ []             = []
   go x (mixnode:rest) = this : go x' rest where
     alpha       = secretKeyToPubKey x                                :: PubKey
@@ -261,7 +264,7 @@ computeAllHeadersGeneric headerBetaSize hops
       macKey = Key (mixKDF SphinxMacKey      ss)
 
       encrypt :: [Word8] -> [Word8]
-      encrypt = mixRouteEnc encKey encIV
+      encrypt = mixRouteEncDec encKey encIV
 
       beta = case next of
         NextBeta  nextBeta nextGamma -> encrypt $ take headerBetaSize $ (route ++ nextGamma ++ nextBeta)
@@ -275,7 +278,7 @@ computeAllHeadersGeneric headerBetaSize hops
 --------------------------------------------------------------------------------
 -- * processing mix headers
 
-processMixHeaderGeneric :: Binary route => MixNodeInt -> SphinxHeader -> Either String (route, SphinxHeader)
+processMixHeaderGeneric :: Binary route => MixNodeInt addr -> SphinxHeader -> Either String (route, SphinxHeader)
 processMixHeaderGeneric mixNode (MkHeader alpha beta gamma) = 
   if gamma /= macBeta  
     then Left $ "MAC of beta doesn't match\n - header gamma = " ++ show gamma ++ "\n - MAC(beta)    = " ++ show macBeta
@@ -295,7 +298,7 @@ processMixHeaderGeneric mixNode (MkHeader alpha beta gamma) =
 
     betaSize  = length beta
     macBeta   = mixMAC macKey beta
-    betaTilde = mixRouteDec encKey encIV (beta ++ replicate betaSize 0)  -- we don't know yet how long "route" is, so just add enough zeros lol
+    betaTilde = mixRouteEncDec encKey encIV (beta ++ replicate betaSize 0)  -- we don't know yet how long "route" is, so just add enough zeros lol
 
     blinder = computeBlinder alpha shared
     alpha'  = blindPublicKey blinder alpha
@@ -303,13 +306,10 @@ processMixHeaderGeneric mixNode (MkHeader alpha beta gamma) =
 --------------------------------------------------------------------------------
 -- * generate random mix nodes 
 
-randomMixAddr :: Int -> IO MixAddr
-randomMixAddr len = MkMixAddr <$> replicateM len randomIO
-
-randomMixNode :: IO MixNodeInt
-randomMixNode = do
+randomMixNode' :: IO addr -> IO (MixNodeInt addr)
+randomMixNode' mkRndAddr = do
   (sk,pk) <- randomKeyPair
-  addr    <- randomMixAddr 16
+  addr    <- mkRndAddr -- randomMixAddr 16
   let nodeExt = MkMixNodeExt
        { nodePubKey  = pk
        , nodeAddress = addr
@@ -319,11 +319,18 @@ randomMixNode = do
     , nodeExt     = nodeExt
     }
 
-randomMixPath :: NHops -> IO [MixNodeInt]
-randomMixPath nhops = replicateM nhops randomMixNode
+randomMixPath' :: IO addr -> NHops -> IO [MixNodeInt addr]
+randomMixPath' mkRndAddr nhops = replicateM nhops (randomMixNode' mkRndAddr)
 
 --------------------------------------------------------------------------------
--- * testing
+-- * basic sanity check testing
+
+newtype TmpAddr 
+  = MkTmpAddr [Word8]
+  deriving (Eq,Show)
+
+randomTmpAddr :: Int -> IO TmpAddr
+randomTmpAddr len = MkTmpAddr <$> replicateM len randomIO
 
 data TestRouting 
   = A String
@@ -345,7 +352,7 @@ testRoute =
   , F "final destination"
   ]
 
-testProcess :: [MixNodeInt] -> SphinxHeader -> [TestRouting]
+testProcess :: [MixNodeInt TmpAddr] -> SphinxHeader -> [TestRouting]
 testProcess = go 0 where
   go idx []           _      = []
   go idx (node:nodes) header = case processMixHeaderGeneric node header of
@@ -358,7 +365,7 @@ testMain = do
   sk <- randomSecretKey
   let route = testRoute
   let nhops = length route
-  mixpath <- randomMixPath nhops
+  mixpath <- randomMixPath' (randomTmpAddr 16) nhops
   let perhopsecrets = computePerHopSecrets sk (map nodeExt mixpath)
 
   let headers = computeAllHeadersGeneric headerBetaSize (zip perhopsecrets route)

reference/Transport/Chunks.hs

@@ -0,0 +1,176 @@
+
+-- | For transporting data not fitting into a single Mix packet, we need
+-- to chunk it (ideally with redundancy) 
+--
+
+{-# LANGUAGE StrictData, RecordWildCards, DerivingVia #-}
+module Transport.Chunks where
+
+--------------------------------------------------------------------------------
+
+import Data.Bits
+import Data.Word
+import Data.Array
+
+import Data.ByteString      (ByteString    ) ; import qualified Data.ByteString      as B
+import Data.ByteString.Lazy (LazyByteString) ; import qualified Data.ByteString.Lazy as L
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
+
+import Control.Monad
+
+-- import Leopard.Binding
+-- import Leopard.Types
+import Leopard.Misc
+
+import Transport.Types
+import Transport.Misc
+
+--------------------------------------------------------------------------------
+-- TODO: move these somewhere else
+
+-- | Payload size including the integerity check @= |delta|@
+grossPayloadSize :: Int
+grossPayloadSize = 4096 + 16 + 24
+
+-- | Payload size without the integerity check (and other metadata)
+netPayloadSize :: Int
+netPayloadSize = grossPayloadSize - 16
+
+--------------------------------------------------------------------------------
+
+-- | normally 16 + 8 = 24 bytes
+chunkMetaSize :: Int
+chunkMetaSize = sessionIdSize + 4 + 2 + 2
+
+-- | Should by divisible by 64 (because of Leopard restriction)
+chunkDataSize :: Int
+chunkDataSize = netPayloadSize - chunkMetaSize
+
+--------------------------------------------------------------------------------
+
+-- | We prepend the length of the payload, then pad to a multiple of chunk data size,
+-- partition into pieces, and prepare each chunk's metadata
+chunkMsgPayload :: SessionId -> MsgIdx -> ByteString -> Array Int Chunk
+chunkMsgPayload sessionId msgIdx msgPayload = arr where
+  padded = buildLazyByteString (putMsgPayload msgPayload)
+  m      = fromIntegral (L.length padded)
+  (k,0)  = divMod m chunkDataSize
+  nOrigs = fromIntegral k
+  pieces = partitionLazyByteString chunkDataSize padded
+  arr    = listArray (0,k-1) 
+             [ MkChunk (MkChunkMeta sessionId msgIdx nOrigs) i (L.toStrict dat) | (i,dat) <- zip [0..] pieces ]
+
+-- | Before chunking, we encoded message payloads by prepending their length (8 bytes), 
+-- and then padding with zero bytes. We need to reverse this after recovering from EC chunks
+parseMsgPayload :: ByteString -> Maybe ByteString
+parseMsgPayload bs = case runGetOrFail getMsgPayload (L.fromStrict bs) of
+  Left  _             -> Nothing
+  Right (rem, _, out) -> Just out
+
+putMsgPayload :: ByteString -> Put
+putMsgPayload rawmsg  = do
+  putWord64be   (fromIntegral rawlen)
+  putByteString rawmsg
+  putByteString (B.replicate padlen 0) 
+  where
+    padlen = requiredPadToMultipleOf chunkDataSize (rawlen + 8)
+    rawlen = B.length rawmsg
+
+getMsgPayload :: Get ByteString
+getMsgPayload = do
+  len <- getWord64be
+  getByteString (fromIntegral len)
+
+partitionLazyByteString :: Int -> L.ByteString -> [L.ByteString]
+partitionLazyByteString m = go where
+  m64 = fromIntegral m
+  go lbs = if L.null lbs 
+    then []
+    else L.take m64 lbs : go (L.drop m64 lbs)
+
+--------------------------------------------------------------------------------
+
+-- | Note: We don't need the the number of parity chunks, because we think of the parity
+-- in a streaming fashion. We send some amount of parity chunks initially, and if the other party
+-- doesn't receive enough data to reconstruct, we can simply send more parity chunks
+--
+data ChunkMeta = MkChunkMeta
+  { _cmSessionId   :: SessionId     -- ^ session id
+  , _cmMessageIdx  :: Word32        -- ^ message index within the session
+  , _cmNOrigChunks :: Word16        -- ^ K = number of chunks containing the original data
+  }
+  deriving (Eq,Show)
+
+data Chunk = MkChunk
+  { _chunkMeta   :: ChunkMeta     -- ^ metadata shared by all chunks of a message
+  , _chunkIndex  :: Word16        -- ^ index of this chunk (0 <= idx < K is original chunk, K >= idx is parity chunk)
+  , _chunkData   :: ByteString    -- ^ chunk raw data (usually an EC chunk)
+  }
+  deriving Eq
+
+instance Show Chunk where
+  show (MkChunk meta idx dat) 
+    =  "MkChunk"
+    ++ " { _chunkMeta = "  ++ show meta
+    ++ " ; _chunkIndex = " ++ show idx
+    ++ " ; _chunkData = "  ++ showByteString dat
+    ++ " }"
+
+--------------------------------------------------------------------------------
+-- * Serialization
+
+encodeChunk :: Chunk -> ByteString
+encodeChunk = buildStrictByteString . putChunk
+
+buildStrictByteString :: Put -> ByteString
+buildStrictByteString = B.toStrict . buildLazyByteString
+
+buildLazyByteString :: Put -> L.ByteString
+buildLazyByteString = runPut
+
+putChunk :: Chunk -> Put
+putChunk (MkChunk meta idx raw) = do
+  putChunkMeta  meta  
+  putWord16be   idx
+  putByteString raw
+
+putChunkMeta :: ChunkMeta -> Put
+putChunkMeta (MkChunkMeta{..}) = do
+  putSessionId _cmSessionId 
+  putWord32be  _cmMessageIdx 
+  putWord16be  _cmNOrigChunks 
+
+putSessionId :: SessionId -> Put
+putSessionId (MkSessionId bytes) = mapM_ putWord8 bytes
+
+----------------------------------------
+-- * Deserialization
+
+decodeChunk :: ByteString -> Maybe Chunk
+decodeChunk = decodeChunkLazy . L.fromStrict
+
+decodeChunkLazy :: LazyByteString -> Maybe Chunk
+decodeChunkLazy bs = case runGetOrFail getChunk bs of
+  Left  _            -> Nothing
+  Right (rem, _, ck) -> if L.null rem
+    then Just ck
+    else Nothing
+
+getChunk :: Get Chunk
+getChunk = MkChunk 
+  <$> getChunkMeta 
+  <*> getWord16be
+  <*> getByteString chunkDataSize
+
+getChunkMeta :: Get ChunkMeta
+getChunkMeta = MkChunkMeta
+  <$> getSessionId
+  <*> getWord32be
+  <*> getWord16be
+
+getSessionId :: Get SessionId
+getSessionId = MkSessionId <$> replicateM sessionIdSize getWord8 
+
+--------------------------------------------------------------------------------

reference/Transport/EC.hs

@@ -0,0 +1,216 @@
+
+-- | Erasure coding of chunks
+
+{-# OPTIONS_GHC -Wno-x-partial #-}
+{-# LANGUAGE StrictData, RecordWildCards, DerivingVia #-}
+module Transport.EC where
+
+--------------------------------------------------------------------------------
+
+import Data.Bits
+import Data.Word
+import Data.Array
+import Data.List
+import Data.Ord
+import Data.Maybe
+
+import Data.ByteString      (ByteString    ) ; import qualified Data.ByteString      as B
+import Data.ByteString.Lazy (LazyByteString) ; import qualified Data.ByteString.Lazy as L
+
+import Control.Monad
+import System.IO.Unsafe
+import System.Random
+
+import Leopard.Binding
+import Leopard.Types
+import Leopard.Misc
+
+import Transport.Chunks
+import Transport.Types
+import Transport.Misc
+
+--------------------------------------------------------------------------------
+-- * sanity check "testing"
+
+findCounterExample :: IO ()
+findCounterExample = do
+  putStrLn "---------------------------------"
+  ok <- testEC
+  when ok findCounterExample
+
+testEC :: IO Bool
+testEC = withLeopard $ do
+  sessionId <- randomSessionId
+  msgIdx    <- randomRIO (0,99)
+  len       <- randomRIO (5000,50000)     -- singleton chunks need to be handled specially...
+  payload   <- randomByteString len
+
+  let origChunksArr = chunkMsgPayload sessionId msgIdx payload
+  let origChunks    = elems origChunksArr
+  let ecK = length origChunks
+  let ecM = deterministicParityCount ecK   -- min 5 ecK
+
+  let parityChunks = computeParityChunks' ecM origChunks
+  let allChunks    = origChunks ++ parityChunks
+  let ecN          = length allChunks
+
+  bad <- randomRIO (0,ecM+1)
+  received <- catMaybes <$> maskListRandomly bad allChunks
+
+  -- putStrLn $ "chunks received:"
+  -- forM_ received $ \chunk -> do
+  --   putStrLn $ " - " ++ show chunk
+  -- putStrLn ""
+
+  putStrLn $ "chunks received = " ++ show (map _chunkIndex received)
+
+  let ei = decodeFromChunks received
+
+  putStrLn $ "session id  = " ++ show sessionId
+  putStrLn $ "message idx = " ++ show msgIdx
+  putStrLn $ "original payload length = " ++ show len
+  putStrLn $ "K = " ++ show ecK
+  putStrLn $ "M = " ++ show ecM
+  putStrLn $ "N = " ++ show ecN ++ " | N == K + M: " ++ show (ecN == ecK + ecM) 
+  putStrLn $ "didn't receive = " ++ show bad
+  putStrLn $ "did receive    = " ++ show (ecN - bad)
+  putStrLn $ "result:"
+
+  fine <- case ei of
+
+    Left  err -> do
+      putStrLn $ " - error = " ++ show err
+      return (bad > ecM)      
+
+    Right dec -> case dec of
+      MkDecodedMessage reSId reIdx bs -> do
+        let ok = bs == payload
+        putStrLn $ " - recovered session id      = " ++ show reSId
+        putStrLn $ " - recovered message idx     = " ++ show reIdx
+        putStrLn $ " - recovered payload length  = " ++ show (B.length bs) 
+        putStrLn $ " - recovered payload matches = " ++ show ok
+        return ok
+
+  return fine
+
+--------------------------------------------------------------------------------
+
+-- | Unfortunately, Leopard doesn't seem to work the way I naively assumed, namely
+-- that we can just add parity chunks (up to a limit)
+--
+-- This is not that suprising: it probably uses the smallest power-of-two subgroup 
+-- into which @N = K + M@ fits; so if we vary M, the subgroup can change.
+--
+-- Hence for any K we just deterministically figure out an M, and always use that.
+--
+deterministicECParams :: Int -> ECParams
+deterministicECParams k = ECParams k n where
+  n  = k + m
+  m  = min k m'          -- we have the restriction M < K
+  m' = if k < 16
+    then 8
+    else div k 2         -- TODO: finetune this!
+
+deterministicParityCount :: Int -> Int
+deterministicParityCount k = let ECParams k' n = deterministicECParams k in (n - k')
+
+--------------------------------------------------------------------------------
+-- * EC encoding
+
+computeParityChunks :: [Chunk] -> [Chunk]
+computeParityChunks chunks = computeParityChunks' m chunks where
+  m = deterministicParityCount (length chunks)
+
+{-# NOINLINE computeParityChunks' #-}
+computeParityChunks' :: Int -> [Chunk] -> [Chunk]
+computeParityChunks' 0       origChunks  = origChunks 
+computeParityChunks' mparity [origChunk] = [origChunk] 
+computeParityChunks' mparity origChunks  = 
+  case fromChunks origChunks of
+    Left  err         -> error err
+    Right (meta,ibss) -> case unsafePerformIO (unsafeEncodeIOList ecp $ map snd ibss) of
+      Left  err         -> error $ decodeLeopardResult err
+      Right bss         -> [ MkChunk meta (fromIntegral j) bs | (j,bs) <- zip [k..] bss ]
+  where
+    ecp = ECParams k (k+mparity)
+    k   = length origChunks
+    
+--------------------------------------------------------------------------------
+-- * EC decoding
+
+data DecodeError
+  = NotEnoughChunks Int              -- ^ how many more is required
+  | InvalidChunks   String           -- ^ invalid and\/or incompatible set of chunks
+  | LeopardError    LeopardResult    -- ^ Leopard reported an error
+  | CannotParseMsg                   -- ^ can't parse the decoded bytestring
+  deriving (Eq,Show)
+
+data DecodedMessage = MkDecodedMessage
+  { _msgSessionId  :: SessionId
+  , _msgMessageIdx :: MsgIdx
+  , _msgPayload    :: ByteString
+  }
+  deriving (Eq,Show)
+
+----------------------------------------
+
+{-# NOINLINE decodeFromChunks #-}
+decodeFromChunks :: [Chunk] -> Either DecodeError DecodedMessage
+decodeFromChunks []     = error "decodeFromChunks: fatal: empty input"
+decodeFromChunks chunks = 
+
+  case fromChunks chunks of
+    Left  err         -> Left $ InvalidChunks err
+    Right (meta,ibss) -> handle meta ibss
+  
+  where
+  
+    handle :: ChunkMeta -> [(ChunkIdx,ByteString)] -> Either DecodeError DecodedMessage
+    handle meta ibss
+      | minIdx < 0        = Left $ InvalidChunks "negative chunk index"
+      | maxIdx >= 2*ecK   = Left $ InvalidChunks "too big chunk index (max is 2*K because of Leopard)"
+      | repeated_idxs     = Left $ InvalidChunks "repeated chunk indicies"
+      | haveCnt < ecK_int = Left $ NotEnoughChunks (ecK_int - haveCnt)
+      | otherwise         = case unsafePerformIO (unsafeDecodeIO ecp mbArr) of
+          Left  leoRes -> Left (LeopardError leoRes)
+          Right arr    -> case parseMsgPayload (B.concat (elems arr)) of
+            Nothing      -> Left  $ CannotParseMsg
+            Just bs      -> Right $ MkDecodedMessage sessionId msgIdx bs            
+
+      where
+        MkChunkMeta sessionId msgIdx ecK = meta
+        ecK_int  = fromIntegral ecK                 :: Int
+        ecp      = deterministicECParams ecK_int    :: ECParams
+        ecM_int  = _ecM ecp                         :: Int
+        ecN_int  = _ecN ecp                         :: Int
+        haveIdxs = map fst ibss                     :: [ChunkIdx]
+        haveCnt  = length  haveIdxs                 :: Int
+        minIdx   = minimum haveIdxs                 :: ChunkIdx
+        maxIdx   = maximum haveIdxs                 :: ChunkIdx
+        -- maxIdxI  = fromIntegral maxIdx              :: Int
+        -- ecN_int  = maxIdxI + 1                      :: Int
+        repeated_idxs = nubOrd haveIdxs /= sort haveIdxs
+        mbArr    = listArray (0,ecN_int-1) (map fun' [0..ecN_int-1])
+
+        fun' :: Int -> Maybe ByteString
+        fun' j = fun (fromIntegral j)
+
+        fun :: ChunkIdx -> Maybe ByteString
+        fun j    = case find (\(i,bs) -> i == j) ibss of  
+          Just (_,bs) -> Just bs
+          Nothing     -> Nothing
+
+--------------------------------------------------------------------------------
+-- * Shared
+
+-- | Chunks of the same message
+fromChunks :: [Chunk] -> Either String (ChunkMeta,[(ChunkIdx,ByteString)])
+fromChunks [] = error "fromChunks: fatal: empty input"
+fromChunks chunks
+  | any (/= chunkMeta) (map _chunkMeta chunks)  = Left $ "fromChunks: chunk metadata differs from each other"
+  | otherwise                                   = Right (chunkMeta, map f chunks)
+  where
+    chunkMeta = _chunkMeta (head chunks)
+    f (MkChunk meta idx payload) = (idx, payload)
+
+--------------------------------------------------------------------------------

reference/Transport/Misc.hs

@@ -0,0 +1,27 @@
+
+module Transport.Misc where
+
+--------------------------------------------------------------------------------
+
+import Data.Word
+
+import qualified Data.ByteString      as B
+import qualified Data.ByteString.Lazy as L
+
+import qualified Data.Set as Set
+
+--------------------------------------------------------------------------------
+-- * alternative Show instance for ByteString
+
+showByteString :: B.ByteString -> String
+showByteString b = "<<bytestring of size " ++ show (B.length b) ++ ">>"
+
+showLazyByteString :: L.ByteString -> String
+showLazyByteString lb = "<<lazy bytestring of size " ++ show (L.length lb) ++ ">>"
+
+--------------------------------------------------------------------------------
+
+nubOrd :: (Eq a, Ord a) => [a] -> [a]
+nubOrd = Set.toList . Set.fromList
+
+--------------------------------------------------------------------------------

reference/Transport/Protocol.hs

@@ -0,0 +1,50 @@
+
+
+{-# LANGUAGE StrictData, DerivingVia #-}
+module Transport.Protocol where
+
+--------------------------------------------------------------------------------
+
+import Data.Word
+
+import Data.ByteString      (ByteString    ) ; import qualified Data.ByteString      as B
+import Data.ByteString.Lazy (LazyByteString) ; import qualified Data.ByteString.Lazy as L
+
+import Transport.Types
+import Transport.Misc
+
+--------------------------------------------------------------------------------
+
+data SessionControl
+  = InitialMessage
+  | Continue
+  | CloseSession
+  deriving (Eq,Show)
+
+data AckEntry
+  = MsgReceived    MsgIdx            -- ^ message received intact
+  | MsgFailed      MsgIdx            -- ^ message failed (eg. decoding or checksum)
+  | NeedMoreChunks MsgIdx Int        -- ^ we need more chunks 
+  deriving (Eq,Show)
+
+--------------------------------------------------------------------------------
+
+data MsgMeta = MkMsgMeta
+  { _msgControl  :: SessionControl   -- ^ where we are in the session
+  , _msgReqSURBs :: Int              -- ^ how many more SURBs we need 
+  , _msgAcks     :: [AckEntry]       -- ^ status of previous messages
+  }
+  deriving (Eq,Show)
+
+data Message = MkMessage
+  { _msgMeta     :: MsgMeta          -- ^ message metadata
+  , _msgSURBs    :: [SURB]           -- ^ the new SURBs we send
+  , _msgPayload  :: ByteString       -- ^ the actual payload
+  }
+  deriving Eq
+
+instance Show Message where
+  show (MkMessage meta surbs payload) = 
+    "MkMessage (" ++ show meta ++ ") " ++ show surbs ++ " " ++ showByteString payload
+
+--------------------------------------------------------------------------------

reference/Transport/State.hs

@@ -0,0 +1,76 @@
+
+-- | State of a connection
+
+{-# LANGUAGE StrictData #-}
+module Transport.State where
+
+--------------------------------------------------------------------------------
+
+import Data.IORef
+
+import Data.Map as Map 
+import qualified Data.Map as Map
+
+import Transport.Chunks
+import Transport.Types
+
+--------------------------------------------------------------------------------
+
+-- | Our role in the protocol
+data Role
+  = Client                      -- ^ the initiator of the connection
+  | Server                      -- ^ the other party in the connection 
+  deriving (Eq,Show)
+
+-- | The address of the other party
+data ConnAddress 
+  = NetworkAddress String       -- ^ we know some kind of address for the other party
+  | ReplyToSURB                 -- ^ we don't know their address, instead we can use SURBs to send
+  deriving (Eq,Show)
+
+data Connection = MkConnection
+  { _connSessionId   :: SessionId                   -- ^ the session id
+  , _connRole        :: Role                        -- ^ our role in the connection (client or server)
+  , _connDestAddr    :: ConnAddress                 -- ^ the address of the other party
+  , _connState       :: IORef ConnectionState       -- ^ current state of the connection
+  }
+
+data ConnectionState = MkConnState
+  { _connNextSendIdx  :: MsgIdx                      -- ^ index of the next message to send
+  , _connNextRecvIdx  :: MsgIdx                      -- ^ index of the next message to receive
+  , _connUnusedSURBs  :: [SURB]                      -- ^ set of unused SURBs
+  , _connSentMsgState :: Map MsgIdx SentMsgState     -- ^ state of messages we sent
+  , _connRecvMsgState :: Map MsgIdx RecvMsgState     -- ^ state of messages we are receiving
+  , _connExpectedData :: Maybe Int                   -- ^ number of bytes we are expecting to receive, and haven't sent SURBs for yet
+  }  
+  deriving (Eq,Show)
+
+-- | State of a message we are sending
+data SentMsgState = SentMsgState
+  { _origChunks   :: [Chunk]
+  , _parityChunks :: [Chunk]
+  , _msgStatus    :: SentMsgStatus
+  }
+  deriving (Eq,Show)
+
+data SentCounter = MkSentCounter
+  { _alreadySent  :: Int        -- ^ we already sent this many chunks (0..K-1 means orig; >= K means parity)
+  , _needsToSend  :: Int        -- ^ we were asked for this many more chunks
+  }        
+  deriving (Eq,Show)
+
+data SentMsgStatus
+  = SentMsgFailed                           -- ^ the message failed completely; we should probably retransmit  
+  | SentMsgSingleton                        -- ^ the message was only a single chunk, so we don't do EC; we can just retransmit
+  | SentMsgNeedsMoreChunks SentCounter      -- ^ the other party asked for more chunks
+  deriving (Eq,Show)
+
+-- | State of a message we are receiving
+data RecvMsgState = RecvMsgState
+  { _receivedChunks :: Map ChunkIdx Chunk   -- ^ chunks we received so far
+  , _msgNOrigCHunks :: Int                  -- ^ number of original chunks
+  }
+  deriving (Eq,Show)
+  
+--------------------------------------------------------------------------------
+

reference/Transport/Types.hs

@@ -0,0 +1,51 @@
+
+module Transport.Types where
+
+--------------------------------------------------------------------------------
+
+import Data.Word
+
+import qualified Data.ByteString      as B
+import qualified Data.ByteString.Lazy as L
+
+import Control.Monad
+import System.Random
+
+import Data.Octets
+
+--------------------------------------------------------------------------------
+
+-- | Message index within a session
+type MsgIdx = Word32
+
+-- | Chunk index within a chunked messages
+type ChunkIdx = Word16
+
+--------------------------------------------------------------------------------
+
+-- | A (random) session identifier
+newtype SessionId
+  = MkSessionId [Word8]
+  deriving (Eq)
+
+instance Show SessionId where
+  show (MkSessionId xs) = "<session_id = " ++ showHexBytes xs ++ ">"
+
+-- | Session Ids have constant length (16 bytes)
+sessionIdSize :: Int
+sessionIdSize = 16
+
+randomSessionId :: IO SessionId
+randomSessionId = MkSessionId <$> replicateM sessionIdSize randomIO
+
+-- | Here we just look at a SURB as a fixed-sized bytestring
+data OpaqueSURB 
+  = MkOpaqueSURB B.ByteString
+  deriving Eq
+
+instance Show OpaqueSURB where 
+  show (MkOpaqueSURB bs) = "<<SURB of size " ++ show (B.length bs) ++ ">>"
+
+type SURB = OpaqueSURB
+
+--------------------------------------------------------------------------------

transport-over-mix.cabal

@@ -29,26 +29,34 @@ source-repository head
 
 Library
 
-  Build-Depends:        base >= 4 && <5, 
+  Build-Depends:        base >= 4 && < 5, 
                         array >= 0.5 && < 0.6,
-                        random >= 1.3 && < 1.4,
+                        containers >= 0.7 && < 0.8,
                         bytestring >= 0.12 && < 0.14,
-                        binary >= 0.8 && < 0.9
+                        random >= 1.3 && < 1.4,
+                        binary >= 0.8 && < 0.9,
+                        hs-leopard >= 0.0.1 && < 0.0.3
 
   Exposed-Modules:      Sphinx.Header
+                        Transport.Protocol
+                        Transport.State
+                        Transport.EC
+                        Transport.Chunks
+                        Transport.Types
+                        Transport.Misc
                         Crypto.Symmetric
                         Crypto.Symmetric.AES128
                         Crypto.Symmetric.Blake2b
                         Crypto.Symmetric.HMAC
                         Crypto.Symmetric.KeccakPerm
                         Crypto.Symmetric.SHA256
+                        Crypto.PRP.Lioness
                         Crypto.X25519.BaseField
                         Crypto.X25519.ScalarField
                         Crypto.X25519.Elliptic
                         Crypto.X25519.DH
-                        Crypto.Lioness
                         Crypto.Types
-                        Octet
+                        Data.Octets
 
   Default-Language:     Haskell2010
   Default-Extensions:   BangPatterns, NumericUnderscores