mirror of
https://github.com/logos-storage/transport-over-mix.git
synced 2026-05-19 19:39:35 +00:00
first working version of (generic) Sphinx header construction and processing
This commit is contained in:
Balazs Komuves
parent
4896aa03a3
commit
d2f038970f
1
.gitignore
vendored
1
.gitignore
vendored
@ -1,4 +1,5 @@
|
||||
.DS_Store
|
||||
tmp/
|
||||
*.a
|
||||
*.o
|
||||
*.hi
|
||||
|
||||
@ -5,13 +5,36 @@ module Crypto.Symmetric where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Domain separation
|
||||
data Domain
|
||||
= SphinxRouteEncKey -- ^ key for encrypting the routing header in Sphinx
|
||||
| SphinxRouteEncIV -- ^ initialization vector for header stream cipher (if required)
|
||||
| SphinxMacKey -- ^ key for the MAC in the Sphinx header
|
||||
| SphinxPayloadEncKey -- ^ key to encrypt the Sphinx payload
|
||||
| SphinxBlinding -- ^ key to compute the blinding factor
|
||||
import Data.Bits
|
||||
import Data.Word
|
||||
|
||||
import qualified Crypto.Symmetric.AES128 as AES128
|
||||
import qualified Crypto.Symmetric.SHA256 as SHA256
|
||||
import qualified Crypto.Symmetric.Blake2b as Blake2b
|
||||
import qualified Crypto.Symmetric.HMAC as HMac
|
||||
|
||||
import Crypto.Types
|
||||
import Octet
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Hash functions
|
||||
data HashFunction
|
||||
= SHA256
|
||||
| Blake2b256
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Keyed hash functions
|
||||
data KeyedHash
|
||||
= KeyedHash_SHA256_Prepend -- ^ @SHA256( key | input )@
|
||||
| KeyedHash_Blake2b -- ^ Blake2b support keying natively
|
||||
| KeyedHash_HMAC_SHA256 -- ^ HMAC can be used as a keyed hash function
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Hash-based message authentication codes
|
||||
data HMAC
|
||||
= HMAC128 HashFunction -- ^ standard HMAC
|
||||
| Blake2bMAC
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Stream ciphers
|
||||
@ -20,30 +43,21 @@ data StreamCipher
|
||||
| ChaCha20 -- ^ ChaCha20
|
||||
deriving (Eq,Show )
|
||||
|
||||
-- | Domain separation (for KDFs)
|
||||
data Domain
|
||||
= SphinxRouteEncKey -- ^ key for encrypting the routing header in Sphinx
|
||||
| SphinxRouteEncIV -- ^ initialization vector for header stream cipher (if required)
|
||||
| SphinxMacKey -- ^ key for the MAC in the Sphinx header
|
||||
| SphinxPayloadEncKey -- ^ key to encrypt the Sphinx payload
|
||||
| SphinxBlinding -- ^ key to compute the blinding factor
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Key derivation functions
|
||||
data KDF
|
||||
= KDF_SHA256 -- ^ @SHA256( domain | input )@
|
||||
| KDF_TurboShake -- ^ @TurboShake( domain | input )
|
||||
| KDF_HMAC_SHA256 -- ^ HMAC with `key=domain`
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Hash functions
|
||||
data HashFunction
|
||||
= SHA256
|
||||
| Blake2b256
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Hash-based message authentication codes
|
||||
data HMAC
|
||||
= HMAC128 HashFunction
|
||||
| HMAC256 HashFunction
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Keyed hash functions
|
||||
data KeyedHash
|
||||
= KeyedHash_SHA256_Prepend -- ^ @SHA256( key | input )@
|
||||
| KeyedHash_Blake2b -- ^ Blake2b support keying natively
|
||||
| KeyedHash_HMAC_SHA256
|
||||
| KDF_TurboShake -- ^ @TurboShake( domain | input )@
|
||||
| KDF_HMAC_SHA256 -- ^ HMAC with @key=domain@
|
||||
| KDF_KeyedBlake2b -- ^ Blake2b with @key=domain@
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- | Cipher to encode the Sphinx payload (note: stream ciphers are not a valid choice here!)
|
||||
@ -52,3 +66,70 @@ data SphinxPayloadCipher
|
||||
deriving (Eq,Show)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
domainConstant :: Domain -> Word128
|
||||
domainConstant domain =
|
||||
case domain of
|
||||
SphinxRouteEncKey -> asciiStringToWord128 "route-enc-key"
|
||||
SphinxRouteEncIV -> asciiStringToWord128 "route-enc-iv"
|
||||
SphinxMacKey -> asciiStringToWord128 "mac-key"
|
||||
SphinxPayloadEncKey -> asciiStringToWord128 "payload-enc-key"
|
||||
SphinxBlinding -> asciiStringToWord128 "sphinx-blinding"
|
||||
where
|
||||
asciiStringToWord128 :: String -> Word128
|
||||
asciiStringToWord128 input
|
||||
| n <= 16 = W128 (map ord8 input ++ replicate (16-n) 0)
|
||||
| otherwise = error "stringToWord128: input string longer than 16 characters"
|
||||
where
|
||||
n = length input
|
||||
|
||||
domainConstantBytes :: Domain -> [Word8]
|
||||
domainConstantBytes = fromWord128 . domainConstant
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
hash :: HashFunction -> [Word8] -> Word256
|
||||
hash SHA256 = SHA256.sha256
|
||||
hash Blake2b256 = Blake2b.blake2b
|
||||
|
||||
keyedHash :: KeyedHash -> Key -> [Word8] -> Word256
|
||||
keyedHash which (Key key) input = case which of
|
||||
KeyedHash_SHA256_Prepend -> SHA256.sha256 (fromWord128 key ++ input)
|
||||
KeyedHash_HMAC_SHA256 -> HMac.genericHMac256 (hash SHA256) (Key key) input
|
||||
KeyedHash_Blake2b -> error "not implemented: KeyedHash_Blake2b"
|
||||
|
||||
hmac :: HMAC -> Key -> [Word8] -> MAC
|
||||
hmac (HMAC128 hashfun) key msg = MAC $ HMac.genericHMac128 (hash hashfun) key msg
|
||||
|
||||
streamCipherEncrypt :: StreamCipher -> Key -> IV -> [Word128] -> [Word128]
|
||||
streamCipherEncrypt cipher = case cipher of
|
||||
AES128_CTR -> AES128.encrypt_AES128CTR
|
||||
ChaCha20 -> error "not implemented: ChaCha20"
|
||||
|
||||
streamCipherDecrypt :: StreamCipher -> Key -> IV -> [Word128] -> [Word128]
|
||||
streamCipherDecrypt cipher = case cipher of
|
||||
AES128_CTR -> AES128.decrypt_AES128CTR
|
||||
ChaCha20 -> error "not implemented: ChaCha20"
|
||||
|
||||
streamCipherPRG :: StreamCipher -> Key -> IV -> [Word128]
|
||||
streamCipherPRG cipher = case cipher of
|
||||
AES128_CTR -> AES128.stream_AES128CTR
|
||||
ChaCha20 -> error "not implemented: ChaCha20"
|
||||
|
||||
streamCipherPRGBytes :: StreamCipher -> Key -> IV -> [Word8]
|
||||
streamCipherPRGBytes cipher key iv = concatMap fromWord128 (streamCipherPRG cipher key iv)
|
||||
|
||||
streamCipherXorBytes :: StreamCipher -> Key -> IV -> [Word8] -> [Word8]
|
||||
streamCipherXorBytes cipher key iv input = zipWith xor input (streamCipherPRGBytes cipher key iv)
|
||||
|
||||
kdf128 :: KDF -> Domain -> [Word8] -> Word128
|
||||
kdf128 kdf domain input = truncate128 (kdf256 kdf domain input)
|
||||
|
||||
kdf256 :: KDF -> Domain -> [Word8] -> Word256
|
||||
kdf256 kdf domain input = case kdf of
|
||||
KDF_SHA256 -> SHA256.sha256 (domainConstantBytes domain ++ input)
|
||||
KDF_HMAC_SHA256 -> HMac.genericHMac256 (hash SHA256) (Key $ domainConstant domain) input
|
||||
KDF_TurboShake -> error "not implemented: KDF_TurboShake"
|
||||
KDF_KeyedBlake2b -> error "not implemented: KDF_KeyedBlake2b"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
-- See <https://datatracker.ietf.org/doc/html/rfc7693>
|
||||
|
||||
{-# LANGUAGE BangPatterns, TypeApplications, FlexibleInstances, NumericUnderscores #-}
|
||||
module Ref.Blake2.BLAKE2b where
|
||||
module Crypto.Symmetric.Blake2b where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -31,7 +31,6 @@ genericHMac256 :: Hash256 -> Key -> Message -> Word256
|
||||
genericHMac256 hashfun (Key key) msg = outer where
|
||||
|
||||
outer = hashfun (key_xor_opad ++ toBytesBE inner)
|
||||
|
||||
inner = hashfun (key_xor_ipad ++ msg)
|
||||
|
||||
key_xor_opad = zipWith xor key' opad
|
||||
@ -44,6 +43,6 @@ genericHMac256 hashfun (Key key) msg = outer where
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
genericHMac128 :: Hash256 -> Key -> Message -> Word128
|
||||
genericHMac128 hashfun key msg = fst $ split128 $ genericHMac256 hashfun key msg
|
||||
genericHMac128 hashfun key msg = truncate128 $ genericHMac256 hashfun key msg
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -20,9 +20,12 @@ newtype IV
|
||||
|
||||
-- | Message authentication code (128 bits)
|
||||
newtype MAC
|
||||
= Mac Word128
|
||||
= MAC Word128
|
||||
deriving (Eq,Show)
|
||||
|
||||
type Message = [Word8]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
macBytes :: MAC -> [Word8]
|
||||
macBytes (MAC w) = fromWord128 w
|
||||
@ -17,23 +17,10 @@ import System.Random
|
||||
|
||||
import Octet
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
sanityDiffieHellman :: IO ()
|
||||
sanityDiffieHellman = do
|
||||
alice <- randomKeyPair
|
||||
bob <- randomKeyPair
|
||||
putStrLn $ "Alice: " ++ show alice
|
||||
putStrLn $ "Bob: " ++ show bob
|
||||
let sharedAlice = scalarMul (secretKeyToInteger $ fst alice) (pubKeyToGroup $ snd bob )
|
||||
let sharedBob = scalarMul (secretKeyToInteger $ fst bob ) (pubKeyToGroup $ snd alice)
|
||||
putStrLn $ "shared secret of Alice = " ++ show (xcoordAsWordLE sharedAlice)
|
||||
putStrLn $ "shared secret of Bob = " ++ show (xcoordAsWordLE sharedBob )
|
||||
print (sharedAlice == sharedBob)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | 32 bytes, little-endian
|
||||
-- | 32 bytes, little-endian (@X = x/z@ coordinate of the curve point)
|
||||
newtype PubKey
|
||||
= PK Word256
|
||||
deriving (Eq,Show,IsWord)
|
||||
@ -43,13 +30,41 @@ newtype SecretKey
|
||||
= SK Word256
|
||||
deriving (Eq,Show,IsWord)
|
||||
|
||||
xcoordAsWordLE :: G -> Word256
|
||||
xcoordAsWordLE pt = fromIntegerLE (xcoordAsInteger pt)
|
||||
fromPubKey :: PubKey -> Word256
|
||||
fromPubKey (PK word) = word
|
||||
|
||||
fromSecretKey :: SecretKey -> Word256
|
||||
fromSecretKey (SK word) = word
|
||||
|
||||
pubKeyBytes :: PubKey -> [Word8]
|
||||
pubKeyBytes = fromWord256 . fromPubKey
|
||||
|
||||
secretKeyBytes :: SecretKey -> [Word8]
|
||||
secretKeyBytes = fromWord256 . fromSecretKey
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
secretKeyToPubKey :: SecretKey -> PubKey
|
||||
secretKeyToPubKey sk = pubKeyFromGroup g where
|
||||
g = scalarMul (secretKeyToInteger sk) basePoint
|
||||
|
||||
diffieHellmanSharedSecret :: SecretKey -> PubKey -> Word256
|
||||
diffieHellmanSharedSecret sk pk
|
||||
= xcoordAsWordLE
|
||||
$ scalarMul (secretKeyToInteger sk) (pubKeyToGroup pk)
|
||||
|
||||
-- | Multiply the secret key by an integer (modulo Q).
|
||||
-- Note: the result does not necessarily satisfy the masking properties; however
|
||||
-- at least it should remain in the cofactor 8 subgroup, which is the important part (I think...).
|
||||
blindSecretKey :: Integer -> SecretKey -> SecretKey
|
||||
blindSecretKey factor sk = secretKeyFromInteger (fromFq product) where
|
||||
product = toFq factor * toFq (secretKeyToInteger sk)
|
||||
|
||||
blindPublicKey :: Integer -> PubKey -> PubKey
|
||||
blindPublicKey factor pk = pubKeyFromGroup (scalarMul factor $ pubKeyToGroup pk)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Clear bits 0, 1, 2 of the first byte, clear bit 7 of the last
|
||||
-- byte, and set bit 6 of the last byte. (NOTE: it's all little-endian!)
|
||||
maskSecretKey :: Word256 -> SecretKey
|
||||
@ -71,6 +86,9 @@ randomKeyPair = do
|
||||
let pk = secretKeyToPubKey sk
|
||||
return (sk,pk)
|
||||
|
||||
xcoordAsWordLE :: G -> Word256
|
||||
xcoordAsWordLE pt = fromIntegerLE (xcoordAsInteger pt)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
pubKeyToGroup :: PubKey -> G
|
||||
@ -92,3 +110,17 @@ secretKeyFromInteger :: Integer -> SecretKey
|
||||
secretKeyFromInteger n = SK (fromIntegerLE n)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
sanityCheckDiffieHellman :: IO ()
|
||||
sanityCheckDiffieHellman = do
|
||||
alice <- randomKeyPair
|
||||
bob <- randomKeyPair
|
||||
putStrLn $ "Alice: " ++ show alice
|
||||
putStrLn $ "Bob: " ++ show bob
|
||||
let sharedAlice = scalarMul (secretKeyToInteger $ fst alice) (pubKeyToGroup $ snd bob )
|
||||
let sharedBob = scalarMul (secretKeyToInteger $ fst bob ) (pubKeyToGroup $ snd alice)
|
||||
putStrLn $ "shared secret of Alice = " ++ show (xcoordAsWordLE sharedAlice)
|
||||
putStrLn $ "shared secret of Bob = " ++ show (xcoordAsWordLE sharedBob )
|
||||
print (sharedAlice == sharedBob)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -1,4 +1,8 @@
|
||||
|
||||
-- | Dealing with byte sequences
|
||||
--
|
||||
-- (TODO: refactor this to something nicer...)
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
|
||||
module Octet where
|
||||
|
||||
@ -38,12 +42,12 @@ fromIntegerBE = fromBytes . bytesFromIntegerBE (vecLength (Proxy @a))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | 128-bit words, stored in Big-Endian order!
|
||||
-- | 128-bit words, stored as bytes in Big-Endian order!
|
||||
newtype Word128
|
||||
= W128 [Word8]
|
||||
deriving Eq
|
||||
|
||||
-- | 256-bit words, stored in Big-Endian order!
|
||||
-- | 256-bit words, stored as bytes in Big-Endian order!
|
||||
newtype Word256
|
||||
= W256 [Word8]
|
||||
deriving Eq
|
||||
@ -54,11 +58,11 @@ fromWord128 (W128 bs) =bs
|
||||
fromWord256 :: Word256 -> [Word8]
|
||||
fromWord256 (W256 bs) = bs
|
||||
|
||||
instance Show Word128 where show (W128 bs) = showBytes bs
|
||||
instance Show Word256 where show (W256 bs) = showBytes bs
|
||||
instance Show Word128 where show (W128 bs) = showHexBytes bs
|
||||
instance Show Word256 where show (W256 bs) = showHexBytes bs
|
||||
|
||||
stringToByteList :: String -> [Word8]
|
||||
stringToByteList = map readByte . splitString where
|
||||
hexStringToByteList :: String -> [Word8]
|
||||
hexStringToByteList = map readByte . splitString where
|
||||
|
||||
readByte :: String -> Word8
|
||||
readByte [a,b] = read ("0x" ++ [a,b])
|
||||
@ -66,25 +70,31 @@ stringToByteList = map readByte . splitString where
|
||||
splitString :: String -> [String]
|
||||
splitString [] = []
|
||||
splitString (a:b:rest) = [a,b] : splitString rest
|
||||
splitString [_] = error "stringToByteList: odd length"
|
||||
splitString [_] = error "hexStringToByteList: odd length"
|
||||
|
||||
stringToWord128 :: String -> Word128
|
||||
stringToWord128 str
|
||||
hexStringToWord128 :: String -> Word128
|
||||
hexStringToWord128 str
|
||||
| length bs == 16 = W128 bs
|
||||
| otherwise = error "stringToWord128: expecting 32 hex characters"
|
||||
| otherwise = error "hexStringToWord128: expecting 32 hex characters"
|
||||
where
|
||||
bs = stringToByteList str
|
||||
bs = hexStringToByteList str
|
||||
|
||||
stringToWord256 :: String -> Word256
|
||||
stringToWord256 str
|
||||
hexStringToWord256 :: String -> Word256
|
||||
hexStringToWord256 str
|
||||
| length bs == 32 = W256 bs
|
||||
| otherwise = error "stringToWord256: expecting 64 hex characters"
|
||||
| otherwise = error "hexStringToWord256: expecting 64 hex characters"
|
||||
where
|
||||
bs = stringToByteList str
|
||||
bs = hexStringToByteList str
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- TODO: make this nicer...
|
||||
|
||||
zero128 :: Word128
|
||||
zero128 = W128 (replicate 16 0)
|
||||
|
||||
zero256 :: Word256
|
||||
zero256 = W256 (replicate 32 0)
|
||||
|
||||
xor128 :: Word128 -> Word128 -> Word128
|
||||
xor128 (W128 as) (W128 bs) = W128 (zipWith xor as bs)
|
||||
|
||||
@ -115,6 +125,9 @@ rnd128 = W128 <$> replicateM 16 randomIO
|
||||
rnd256 :: IO Word256
|
||||
rnd256 = W256 <$> replicateM 32 randomIO
|
||||
|
||||
truncate128 :: Word256 -> Word128
|
||||
truncate128 = fst . split128
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class IsWord a where
|
||||
@ -186,14 +199,14 @@ bytesFromIntegerBE len x = reverse (bytesFromIntegerLE len x)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
showBytes :: [Word8] -> String
|
||||
showBytes bs = concat [ printf "%02x" b | b <- bs ]
|
||||
showHexBytes :: [Word8] -> String
|
||||
showHexBytes bs = concat [ printf "%02x" b | b <- bs ]
|
||||
|
||||
toHexStringLE :: IsWord a => a -> String
|
||||
toHexStringLE = showBytes . toBytesLE
|
||||
toHexStringLE = showHexBytes . toBytesLE
|
||||
|
||||
toHexStringBE :: IsWord a => a -> String
|
||||
toHexStringBE = showBytes . toBytesBE
|
||||
toHexStringBE = showHexBytes . toBytesBE
|
||||
|
||||
ord8 :: Char -> Word8
|
||||
ord8 = fromIntegral . ord
|
||||
@ -201,6 +214,9 @@ ord8 = fromIntegral . ord
|
||||
chr8 :: Word8 -> Char
|
||||
chr8 = chr . fromIntegral
|
||||
|
||||
randomBytes :: Int -> IO [Word8]
|
||||
randomBytes len = replicateM len randomIO
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class ToByteString a where
|
||||
|
||||
371
reference/Sphinx/Header.hs
Normal file
371
reference/Sphinx/Header.hs
Normal file
@ -0,0 +1,371 @@
|
||||
|
||||
-- | The Sphinx packet format header.
|
||||
--
|
||||
-- See:
|
||||
--
|
||||
-- * George Danezis, Ian Goldberg: "Sphinx: A Compact and Provably Secure Mix Format"
|
||||
--
|
||||
-- <https://cypherpunks.ca/~iang/pubs/Sphinx_Oakland09.pdf>
|
||||
--
|
||||
|
||||
{-# OPTIONS_GHC -Wno-x-partial #-}
|
||||
{-# LANGUAGE DeriveGeneric, TypeApplications #-}
|
||||
module Sphinx.Header where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Bits
|
||||
import Data.Word
|
||||
import Data.Semigroup
|
||||
import Data.Monoid
|
||||
|
||||
import Control.Monad
|
||||
import System.Random
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import GHC.Generics
|
||||
import Data.Binary
|
||||
|
||||
import Crypto.X25519.DH
|
||||
import Crypto.X25519.Elliptic
|
||||
import Crypto.X25519.ScalarField ( Fq , toFq )
|
||||
|
||||
import Crypto.Symmetric
|
||||
import Crypto.Types
|
||||
|
||||
import Octet
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * global constants
|
||||
|
||||
-- | Maximum number of hops
|
||||
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
|
||||
|
||||
mixKDF :: Domain -> [Word8] -> Word128
|
||||
mixKDF = kdf128 KDF_SHA256
|
||||
|
||||
mixMAC :: Key -> [Word8] -> MAC
|
||||
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)
|
||||
|
||||
mixRouteDec :: Key -> IV -> [Word8] -> [Word8]
|
||||
mixRouteDec = mixRouteEnc
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * types
|
||||
|
||||
-- | Size of something measured in bytes
|
||||
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
|
||||
= 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 path is a route consisting of several mix nodes
|
||||
type MixPath = [MixNodeInt]
|
||||
|
||||
-- | A Sphinx header consists of three part, denoted (after the Sphinx paper) by alpha, beta, and gamma.
|
||||
data SphinxHeader = MkHeader
|
||||
{ sphinxAlpha :: PubKey -- ^ blinded per-hop public key
|
||||
, sphinxBeta :: [Word8] -- ^ encrypted routing info
|
||||
, sphinxGamma :: MAC -- ^ MAC of beta
|
||||
}
|
||||
deriving (Eq) -- ,Show)
|
||||
|
||||
instance Show SphinxHeader where
|
||||
show (MkHeader alpha beta gamma) = unlines
|
||||
[ "alpha = " ++ show alpha
|
||||
, "beta = " ++ showHexBytes beta
|
||||
, "gamma = " ++ show gamma
|
||||
]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * per-hop secrets
|
||||
|
||||
data PerHopSecrets = MkPerHopSecrets
|
||||
{ hopSecretKey :: SecretKey -- ^ per-node secret key @x@ (an element of the scalar field)
|
||||
, hopPublicKey :: PubKey -- ^ per-node public key @alpha@ (an element of the elliptic curve group)
|
||||
, hopSharedSecret :: Word256 -- ^ per-node shared secret @s@ (a group element interpreted as 32 bytes)
|
||||
, hopBlindingFactor :: Fq -- ^ the blinding factor @b@ is also an element of the scalar field
|
||||
}
|
||||
deriving (Eq,Show)
|
||||
|
||||
-- TODO: really the blinder should be computed by a "proper" KDF, but everybody out there just uses plain SHA256...
|
||||
computeBlinder :: PubKey -> Word256 -> Integer
|
||||
computeBlinder alpha sharedSecret = toIntegerLE blinder where
|
||||
blindInput = pubKeyBytes alpha ++ fromWord256 sharedSecret :: [Word8]
|
||||
blinder = hash SHA256 blindInput :: Word256
|
||||
|
||||
computePerHopSecrets :: SecretKey -> [MixNodeExt] -> [PerHopSecrets]
|
||||
computePerHopSecrets initialSecret path = go initialSecret path where
|
||||
go :: SecretKey -> [MixNodeExt] -> [PerHopSecrets]
|
||||
go _ [] = []
|
||||
go x (mixnode:rest) = this : go x' rest where
|
||||
alpha = secretKeyToPubKey x :: PubKey
|
||||
shared = diffieHellmanSharedSecret x (nodePubKey mixnode) :: Word256
|
||||
blindInput = pubKeyBytes alpha ++ fromWord256 shared :: [Word8]
|
||||
blinder = computeBlinder alpha shared :: Integer
|
||||
x' = blindSecretKey blinder x
|
||||
this = MkPerHopSecrets
|
||||
{ hopSecretKey = x
|
||||
, hopPublicKey = alpha
|
||||
, hopSharedSecret = shared
|
||||
, hopBlindingFactor = toFq blinder
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * filler strings
|
||||
|
||||
newtype Filler
|
||||
= Filler [Word8]
|
||||
deriving (Eq)
|
||||
|
||||
instance Show Filler where
|
||||
show (Filler bs) = "<" ++ showHexBytes bs ++ ">"
|
||||
|
||||
fromFiller :: Filler -> [Word8]
|
||||
fromFiller (Filler ws) = ws
|
||||
|
||||
emptyFiller :: Filler
|
||||
emptyFiller = Filler []
|
||||
|
||||
zeroFiller :: SizeInBytes -> Filler
|
||||
zeroFiller len = Filler $ replicate len 0
|
||||
|
||||
fillerSize :: Filler -> SizeInBytes
|
||||
fillerSize (Filler bs) = length bs
|
||||
|
||||
instance Semigroup Filler where
|
||||
(<>) (Filler ws1) (Filler ws2) = Filler (ws1 ++ ws2)
|
||||
|
||||
instance Monoid Filler where
|
||||
mempty = emptyFiller
|
||||
|
||||
-- | compute the both the unencrypted (plain) and encrypted fillers
|
||||
computeAllFillers :: SizeInBytes -> [(PerHopSecrets,SizeInBytes)] -> [Filler]
|
||||
computeAllFillers headerBetaSize hops
|
||||
| padding < 0 = error "computeFillers: cannot fit in the given header beta size"
|
||||
| otherwise = go emptyFiller hops
|
||||
where
|
||||
used = sum (map snd hops)
|
||||
padding = headerBetaSize - used
|
||||
|
||||
go :: Filler -> [(PerHopSecrets,SizeInBytes)] -> [Filler]
|
||||
go prev [] = []
|
||||
go prev ((perhop,size):rest) = prev : go this rest where
|
||||
ss = fromWord256 $ hopSharedSecret perhop
|
||||
key = Key (mixKDF SphinxRouteEncKey ss)
|
||||
iv = IV (mixKDF SphinxRouteEncIV ss)
|
||||
thisPlain = fromFiller (prev <> zeroFiller size)
|
||||
this = Filler $ zipWith xor thisPlain (drop padlen $ mixPRG key iv)
|
||||
padlen = headerBetaSize - fillerSize prev
|
||||
|
||||
computeFinalFiller :: SizeInBytes -> [(PerHopSecrets,SizeInBytes)] -> Filler
|
||||
computeFinalFiller headerBetaSize perHops = last $ computeAllFillers headerBetaSize perHops
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * constructing mix headers
|
||||
|
||||
encodeIntoBytes :: Binary a => a -> [Word8]
|
||||
encodeIntoBytes = L.unpack . encode
|
||||
|
||||
decodeFromBytes :: Binary a => [Word8] -> Maybe (a, SizeInBytes, [Word8])
|
||||
decodeFromBytes what = case decodeOrFail (L.pack what) of
|
||||
Left _ -> Nothing
|
||||
Right (rest,size,y) -> Just (y, fromIntegral size, L.unpack rest)
|
||||
|
||||
computeHeaderGeneric :: Binary route => SizeInBytes -> [(PerHopSecrets,route)] -> SphinxHeader
|
||||
computeHeaderGeneric betaSize hops = head $ computeAllHeadersGeneric betaSize hops
|
||||
|
||||
data NextBeta
|
||||
= NextBeta { _nextBeta :: [Word8] , _nextMac :: [Word8] } -- ^ @beta, gamma@
|
||||
| FinalBeta { _nextBeta :: [Word8] , _nextFiller :: Filler } -- ^ @beta, filler@
|
||||
deriving Show
|
||||
|
||||
computeAllHeadersGeneric :: Binary route => SizeInBytes -> [(PerHopSecrets,route)] -> [SphinxHeader]
|
||||
computeAllHeadersGeneric headerBetaSize hops
|
||||
| sum sizes > headerBetaSize = error "computeHeadersGeneric: total route size is larger than the header beta size"
|
||||
| otherwise = reverse $ worker finalBeta $ reverse (zip perhops routes)
|
||||
where
|
||||
nhops = length hops
|
||||
perhops = map fst hops :: [PerHopSecrets]
|
||||
routes = map (encodeIntoBytes . snd) hops :: [[Word8]]
|
||||
sizes = map length routes :: [SizeInBytes]
|
||||
|
||||
-- add the size of the mac to the size of the route, except for the final destination
|
||||
addMacSize :: [SizeInBytes] -> [SizeInBytes]
|
||||
addMacSize [] = []
|
||||
addMacSize [final] = [final]
|
||||
addMacSize (n:ns) = (n+16) : addMacSize ns
|
||||
|
||||
finalFiller = computeFinalFiller headerBetaSize (zip perhops $ addMacSize sizes)
|
||||
finalRoute = last routes
|
||||
finalPad = headerBetaSize - length finalRoute - fillerSize finalFiller
|
||||
finalBeta = FinalBeta (replicate finalPad 0) finalFiller
|
||||
|
||||
worker :: NextBeta -> [(PerHopSecrets, [Word8])] -> [SphinxHeader]
|
||||
worker next [] = []
|
||||
worker next ((perhop,route):rest) = header : worker next' rest where
|
||||
|
||||
ss = fromWord256 $ hopSharedSecret perhop
|
||||
encKey = Key (mixKDF SphinxRouteEncKey ss)
|
||||
encIV = IV (mixKDF SphinxRouteEncIV ss)
|
||||
macKey = Key (mixKDF SphinxMacKey ss)
|
||||
|
||||
encrypt :: [Word8] -> [Word8]
|
||||
encrypt = mixRouteEnc encKey encIV
|
||||
|
||||
beta = case next of
|
||||
NextBeta nextBeta nextGamma -> encrypt $ take headerBetaSize $ (route ++ nextGamma ++ nextBeta)
|
||||
FinalBeta nextBeta filler -> encrypt (route ++ nextBeta) ++ fromFiller filler
|
||||
|
||||
alpha = hopPublicKey perhop
|
||||
gamma = mixMAC macKey beta
|
||||
header = MkHeader alpha beta gamma
|
||||
next' = NextBeta beta (macBytes gamma)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * processing mix headers
|
||||
|
||||
processMixHeaderGeneric :: Binary route => MixNodeInt -> 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
|
||||
else case decodeFromBytes betaTilde of
|
||||
Nothing -> Left "cannot parse beginning of beta"
|
||||
Just (route, _size, rest) -> Right (route, MkHeader alpha' beta' gamma') where
|
||||
(gamma1, rest1) = splitAt 16 rest
|
||||
gamma' = MAC (W128 gamma1)
|
||||
beta' = take betaSize rest1
|
||||
|
||||
where
|
||||
shared = diffieHellmanSharedSecret (nodePrivKey mixNode) alpha
|
||||
ss = fromWord256 shared
|
||||
encKey = Key (mixKDF SphinxRouteEncKey ss)
|
||||
encIV = IV (mixKDF SphinxRouteEncIV ss)
|
||||
macKey = Key (mixKDF SphinxMacKey ss)
|
||||
|
||||
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
|
||||
|
||||
blinder = computeBlinder alpha shared
|
||||
alpha' = blindPublicKey blinder alpha
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * generate random mix nodes
|
||||
|
||||
randomMixAddr :: Int -> IO MixAddr
|
||||
randomMixAddr len = MkMixAddr <$> replicateM len randomIO
|
||||
|
||||
randomMixNode :: IO MixNodeInt
|
||||
randomMixNode = do
|
||||
(sk,pk) <- randomKeyPair
|
||||
addr <- randomMixAddr 16
|
||||
let nodeExt = MkMixNodeExt
|
||||
{ nodePubKey = pk
|
||||
, nodeAddress = addr
|
||||
}
|
||||
return $ MkMixNodeInt
|
||||
{ nodePrivKey = sk
|
||||
, nodeExt = nodeExt
|
||||
}
|
||||
|
||||
randomMixPath :: NHops -> IO [MixNodeInt]
|
||||
randomMixPath nhops = replicateM nhops randomMixNode
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- * testing
|
||||
|
||||
data TestRouting
|
||||
= A String
|
||||
| B Int
|
||||
| C Bool [Int]
|
||||
| F String
|
||||
deriving (Eq,Show,Generic)
|
||||
|
||||
instance Binary TestRouting
|
||||
|
||||
testRoute :: [TestRouting]
|
||||
testRoute =
|
||||
[ A "foobar"
|
||||
, B 1137
|
||||
, C True [3,4,5]
|
||||
, A "whatever"
|
||||
, A "almafa"
|
||||
, B 777
|
||||
, F "final destination"
|
||||
]
|
||||
|
||||
testProcess :: [MixNodeInt] -> SphinxHeader -> [TestRouting]
|
||||
testProcess = go 0 where
|
||||
go idx [] _ = []
|
||||
go idx (node:nodes) header = case processMixHeaderGeneric node header of
|
||||
Left errmsg -> error $ "error at hop #" ++ show idx ++ ": " ++ errmsg
|
||||
Right (route,header') -> route : go (idx+1) nodes header'
|
||||
|
||||
testMain :: IO ()
|
||||
testMain = do
|
||||
let headerBetaSize = 250
|
||||
sk <- randomSecretKey
|
||||
let route = testRoute
|
||||
let nhops = length route
|
||||
mixpath <- randomMixPath nhops
|
||||
let perhopsecrets = computePerHopSecrets sk (map nodeExt mixpath)
|
||||
|
||||
let headers = computeAllHeadersGeneric headerBetaSize (zip perhopsecrets route)
|
||||
-- mapM_ print headers
|
||||
let header = head headers
|
||||
print $ map (length . sphinxBeta) headers
|
||||
print $ testProcess mixpath header
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user