reworking... ToxTransport and related modules.

6 files changed, 885 insertions, 1 deletions

diff --git a/ToxAddress.hs b/ToxAddress.hs
new file mode 100644
index 00000000..08c9031b
--- /dev/null
+++ b/ToxAddress.hs
@@ -0,0 +1,383 @@
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE ExistentialQuantification  #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE PatternSynonyms            #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TupleSections              #-}
+{-# LANGUAGE TypeApplications           #-}
+module ToxAddress where
+
+import Control.Applicative
+import Control.Monad
+import qualified Data.Aeson                   as JSON
+         ;import Data.Aeson                   (FromJSON, ToJSON, (.=))
+import Data.Bits
+import Data.Bits.ByteString                   ()
+import Data.ByteArray                         as BA (ByteArrayAccess, Bytes)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString              as B
+         ;import Data.ByteString              (ByteString)
+import qualified Data.ByteString.Base16       as Base16
+import qualified Data.ByteString.Char8        as C8
+import Data.Char
+import Data.Data
+import Data.Hashable
+import Data.IP
+import Data.Serialize                         as S
+import Data.Word
+import Network.Address                        hiding (nodePort)
+import Network.Socket
+import qualified Text.ParserCombinators.ReadP as RP
+import Text.Read
+import GHC.TypeLits
+import Crypto.PubKey.Curve25519
+
+data Address
+ = DHTNode        NodeInfo                 -- A direct DHT exchange.
+ | OnionFromOwner NodeInfo (ForwardPath 3) -- Your own created onion path.
+ | OnionToOwner   NodeInfo (ReturnPath 3)  -- An onion path end point.
+
+-- | perform io for hashes that do allocation and ffi.
+-- unsafeDupablePerformIO is used when possible as the
+-- computation is pure and the output is directly linked
+-- to the input. we also do not modify anything after it has
+-- been returned to the user.
+unsafeDoIO :: IO a -> a
+#if __GLASGOW_HASKELL__ > 704
+unsafeDoIO = unsafeDupablePerformIO
+#else
+unsafeDoIO = unsafePerformIO
+#endif
+
+unpackPublicKey :: PublicKey -> [Word64]
+unpackPublicKey bs = loop 0
+  where loop i
+            | i == 4    = []
+            | otherwise =
+                let !v = unsafeDoIO $ BA.withByteArray bs (\p -> peekElemOff p i)
+                 in v : loop (i+1)
+
+newtype NodeId = NodeId PublicKey
+ deriving (Eq,ByteArrayAccess) -- (Eq,Ord,ByteArrayAccess, Bits, Hashable)
+
+instance Ord NodeId where
+    compare (NodeId a) (NodeId b) = compare (unpackPublicKey a) (unpackPublicKey b)
+
+zeroID :: NodeId
+zeroID = NodeId $ throwCryptoError $ publicKey $ B.replicate 32 0
+
+{-
+instance Read NodeId where
+    readsPrec _ str
+        | (bs, xs) <- Base16.decode $ C8.pack str
+        , B.length bs == 32
+                    = [ (NodeId bs, drop 64 str) ]
+        | otherwise = []
+-}
+
+instance Show NodeId where
+    show (NodeId bs) = C8.unpack $ Base16.encode $ BA.convert bs
+
+instance S.Serialize NodeId where
+    get = NodeId . throwCryptoError . publicKey <$> S.getBytes 32
+    put (NodeId bs) = S.putByteString $ BA.convert bs
+
+data NodeInfo = NodeInfo
+  { nodeId   :: NodeId
+  , nodeIP   :: IP
+  , nodePort :: PortNumber
+  }
+ deriving (Eq,Ord)
+
+nodeInfo :: NodeId -> SockAddr -> Either String NodeInfo
+nodeInfo nid saddr
+    | Just ip <- fromSockAddr saddr
+    , Just port <- sockAddrPort saddr = Right $ NodeInfo nid ip port
+    | otherwise                       = Left "Address family not supported."
+
+
+instance ToJSON NodeInfo where
+    toJSON (NodeInfo nid (IPv4 ip) port)
+        = JSON.object [ "public_key" .= show nid
+                      , "ipv4" .= show ip
+                      , "port" .= (fromIntegral port :: Int)
+                      ]
+    toJSON (NodeInfo nid (IPv6 ip6) port)
+        | Just ip <- un4map ip6
+          = JSON.object [ "public_key" .= show nid
+                        , "ipv4" .= show ip
+                        , "port" .= (fromIntegral port :: Int)
+                        ]
+        | otherwise
+          = JSON.object [ "public_key" .= show nid
+                        , "ipv6" .= show ip6
+                        , "port" .= (fromIntegral port :: Int)
+                        ]
+instance FromJSON NodeInfo where
+    parseJSON (JSON.Object v) = do
+        nidstr <- v JSON..: "public_key"
+        ip6str <- v JSON..:? "ipv6"
+        ip4str <- v JSON..:? "ipv4"
+        portnum <- v JSON..: "port"
+        ip <- maybe empty (return . IPv6) (ip6str >>= readMaybe)
+              <|> maybe empty (return . IPv4) (ip4str >>= readMaybe)
+        let (bs,_) = Base16.decode (C8.pack nidstr)
+        guard (B.length bs == 32)
+        return $ NodeInfo (NodeId $ throwCryptoError . publicKey $ bs) ip (fromIntegral (portnum :: Word16))
+
+getIP :: Word8 -> S.Get IP
+getIP 0x02 = IPv4 <$> S.get
+getIP 0x0a = IPv6 <$> S.get
+getIP 0x82 = IPv4 <$> S.get -- TODO: TCP
+getIP 0x8a = IPv6 <$> S.get -- TODO: TCP
+getIP x    = fail ("unsupported address family ("++show x++")")
+
+instance S.Serialize NodeInfo where
+    get = do
+        addrfam <- S.get :: S.Get Word8
+        ip <- getIP addrfam
+        port <- S.get :: S.Get PortNumber
+        nid <- S.get
+        return $ NodeInfo nid ip port
+
+    put (NodeInfo nid ip port) = do
+        case ip of
+            IPv4 ip4 -> S.put (2 :: Word8) >> S.put ip4
+            IPv6 ip6 -> S.put (10 :: Word8) >> S.put ip6
+        S.put port
+        S.put nid
+
+hexdigit :: Char -> Bool
+hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F')
+
+instance Read NodeInfo where
+  readsPrec i = RP.readP_to_S $ do
+    RP.skipSpaces
+    let n = 64 -- characters in node id.
+        parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')'))
+                      RP.+++ RP.munch (not . isSpace)
+        nodeidAt = do hexhash <- sequence $ replicate n (RP.satisfy hexdigit)
+                      RP.char '@' RP.+++ RP.satisfy isSpace
+                      addrstr <- parseAddr
+                      nid <- case Base16.decode $ C8.pack hexhash of
+                              (bs,_) | B.length bs==32 -> return (NodeId $ throwCryptoError . publicKey $ bs)
+                              _                        -> fail "Bad node id."
+                      return (nid,addrstr)
+    (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) )
+    let raddr = do
+            ip <- RP.between (RP.char '[') (RP.char ']')
+                         (IPv6 <$> RP.readS_to_P (readsPrec i))
+                  RP.+++ (IPv4 <$> RP.readS_to_P (readsPrec i))
+            _    <- RP.char ':'
+            port <- toEnum <$> RP.readS_to_P (readsPrec i)
+            return (ip, port)
+
+    (ip,port) <- case RP.readP_to_S raddr addrstr of
+                    [] -> fail "Bad address."
+                    ((ip,port),_):_ -> return (ip,port)
+    return $ NodeInfo nid ip port
+
+-- The Hashable instance depends only on the IP address and port number.
+instance Hashable NodeInfo where
+  hashWithSalt s ni = hashWithSalt s (nodeIP ni , nodePort ni)
+  {-# INLINE hashWithSalt #-}
+
+
+instance Show NodeInfo where
+    showsPrec _ (NodeInfo nid ip port) =
+        shows nid . ('@' :) . showsip . (':' :) . shows port
+     where
+        showsip
+            | IPv4 ip4 <- ip                          = shows ip4
+            | IPv6 ip6 <- ip , Just ip4 <- un4map ip6 = shows ip4
+            | otherwise                               = ('[' :) . shows ip . (']' :)
+
+
+
+
+{-
+type NodeId = PubKey
+
+pattern NodeId bs = PubKey bs
+
+-- TODO: This should probably be represented by Curve25519.PublicKey, but
+-- ByteString has more instances...
+newtype PubKey = PubKey ByteString
+ deriving (Eq,Ord,Data, ByteArrayAccess, Bits, Hashable)
+
+instance Serialize PubKey where
+    get = PubKey <$> getBytes 32
+    put (PubKey bs) = putByteString bs
+
+instance Show PubKey where
+    show (PubKey bs) = C8.unpack $ Base16.encode bs
+
+instance FiniteBits PubKey where
+    finiteBitSize _ = 256
+
+instance Read PubKey where
+    readsPrec _ str
+        | (bs, xs) <- Base16.decode $ C8.pack str
+        , B.length bs == 32
+                    = [ (PubKey bs, drop 64 str) ]
+        | otherwise = []
+
+
+
+
+data NodeInfo = NodeInfo
+  { nodeId   :: NodeId
+  , nodeIP   :: IP
+  , nodePort :: PortNumber
+  }
+ deriving (Eq,Ord,Data)
+
+instance Data PortNumber where
+    dataTypeOf _ = mkNoRepType "PortNumber"
+    toConstr _     = error "PortNumber.toConstr"
+    gunfold _ _    = error "PortNumber.gunfold"
+
+instance ToJSON NodeInfo where
+    toJSON (NodeInfo nid (IPv4 ip) port)
+        = JSON.object [ "public_key" .= show nid
+                      , "ipv4" .= show ip
+                      , "port" .= (fromIntegral port :: Int)
+                      ]
+    toJSON (NodeInfo nid (IPv6 ip6) port)
+        | Just ip <- un4map ip6
+          = JSON.object [ "public_key" .= show nid
+                        , "ipv4" .= show ip
+                        , "port" .= (fromIntegral port :: Int)
+                        ]
+        | otherwise
+          = JSON.object [ "public_key" .= show nid
+                        , "ipv6" .= show ip6
+                        , "port" .= (fromIntegral port :: Int)
+                        ]
+instance FromJSON NodeInfo where
+    parseJSON (JSON.Object v) = do
+        nidstr <- v JSON..: "public_key"
+        ip6str <- v JSON..:? "ipv6"
+        ip4str <- v JSON..:? "ipv4"
+        portnum <- v JSON..: "port"
+        ip <- maybe empty (return . IPv6) (ip6str >>= readMaybe)
+              <|> maybe empty (return . IPv4) (ip4str >>= readMaybe)
+        let (bs,_) = Base16.decode (C8.pack nidstr)
+        guard (B.length bs == 32)
+        return $ NodeInfo (NodeId bs) ip (fromIntegral (portnum :: Word16))
+
+getIP :: Word8 -> S.Get IP
+getIP 0x02 = IPv4 <$> S.get
+getIP 0x0a = IPv6 <$> S.get
+getIP 0x82 = IPv4 <$> S.get -- TODO: TCP
+getIP 0x8a = IPv6 <$> S.get -- TODO: TCP
+getIP x    = fail ("unsupported address family ("++show x++")")
+
+instance S.Serialize NodeInfo where
+    get = do
+        addrfam <- S.get :: S.Get Word8
+        ip <- getIP addrfam
+        port <- S.get :: S.Get PortNumber
+        nid <- S.get
+        return $ NodeInfo nid ip port
+
+    put (NodeInfo nid ip port) = do
+        case ip of
+            IPv4 ip4 -> S.put (2 :: Word8) >> S.put ip4
+            IPv6 ip6 -> S.put (10 :: Word8) >> S.put ip6
+        S.put port
+        S.put nid
+
+-- node format:
+-- [uint8_t family (2 == IPv4, 10 == IPv6, 130 == TCP IPv4, 138 == TCP IPv6)]
+-- [ip (in network byte order), length=4 bytes if ipv4, 16 bytes if ipv6]
+-- [port (in network byte order), length=2 bytes]
+-- [char array (node_id), length=32 bytes]
+--
+
+
+hexdigit :: Char -> Bool
+hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F')
+
+instance Read NodeInfo where
+  readsPrec i = RP.readP_to_S $ do
+    RP.skipSpaces
+    let n = 64 -- characters in node id.
+        parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')'))
+                      RP.+++ RP.munch (not . isSpace)
+        nodeidAt = do hexhash <- sequence $ replicate n (RP.satisfy hexdigit)
+                      RP.char '@' RP.+++ RP.satisfy isSpace
+                      addrstr <- parseAddr
+                      nid <- case Base16.decode $ C8.pack hexhash of
+                              (bs,_) | B.length bs==32 -> return (PubKey bs)
+                              _                        -> fail "Bad node id."
+                      return (nid,addrstr)
+    (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) )
+    let raddr = do
+            ip <- RP.between (RP.char '[') (RP.char ']')
+                         (IPv6 <$> RP.readS_to_P (readsPrec i))
+                  RP.+++ (IPv4 <$> RP.readS_to_P (readsPrec i))
+            _    <- RP.char ':'
+            port <- toEnum <$> RP.readS_to_P (readsPrec i)
+            return (ip, port)
+
+    (ip,port) <- case RP.readP_to_S raddr addrstr of
+                    [] -> fail "Bad address."
+                    ((ip,port),_):_ -> return (ip,port)
+    return $ NodeInfo nid ip port
+
+
+-- The Hashable instance depends only on the IP address and port number.
+instance Hashable NodeInfo where
+  hashWithSalt s ni = hashWithSalt s (nodeIP ni , nodePort ni)
+  {-# INLINE hashWithSalt #-}
+
+
+instance Show NodeInfo where
+    showsPrec _ (NodeInfo nid ip port) =
+        shows nid . ('@' :) . showsip . (':' :) . shows port
+     where
+        showsip
+            | IPv4 ip4 <- ip                          = shows ip4
+            | IPv6 ip6 <- ip , Just ip4 <- un4map ip6 = shows ip4
+            | otherwise                               = ('[' :) . shows ip . (']' :)
+
+nodeAddr :: NodeInfo -> SockAddr
+nodeAddr (NodeInfo _ ip port) = setPort port $ toSockAddr ip
+
+nodeInfo :: NodeId -> SockAddr -> Either String NodeInfo
+nodeInfo nid saddr
+    | Just ip <- fromSockAddr saddr
+    , Just port <- sockAddrPort saddr = Right $ NodeInfo nid ip port
+    | otherwise                       = Left "Address family not supported."
+
+zeroID :: NodeId
+zeroID = PubKey $ B.replicate 32 0
+
+-}
+
+newtype ReturnPath (n::Nat) = ReturnPath ByteString
+ deriving (Eq, Ord,Data)
+
+instance KnownNat n => Serialize (ReturnPath n) where
+    -- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
+    get = ReturnPath <$> getBytes ( 59 * (fromIntegral $ natVal $ Proxy @n) )
+    put (ReturnPath bs) = putByteString bs
+
+newtype ForwardPath (n::Nat) = ForwardPath ByteString
+ deriving (Eq, Ord,Data)
+
+{-
+class KnownNat n => OnionPacket n where
+    mkOnion :: ReturnPath n -> Packet -> Packet
+instance OnionPacket 0 where mkOnion _ = id
+instance OnionPacket 3 where mkOnion = OnionResponse3
+-}
diff --git a/ToxCrypto.hs b/ToxCrypto.hs
new file mode 100644
index 00000000..98e02e91
--- /dev/null
+++ b/ToxCrypto.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module ToxCrypto
+    ( PublicKey
+    , publicKey
+    , SecretKey
+    , Encrypted
+    , Plain
+    , computeSharedSecret
+    , encrypt
+    , decrypt
+    , Nonce8
+    , Nonce24
+    , Nonce32
+    , getRemainingEncrypted
+    , putEncrypted
+    , Auth
+    ) where
+
+import qualified Crypto.Cipher.Salsa    as Salsa
+import qualified Crypto.Cipher.XSalsa   as XSalsa
+import Crypto.ECC.Class
+import qualified Crypto.Error           as Cryptonite
+import qualified Crypto.MAC.Poly1305    as Poly1305
+import Crypto.PubKey.Curve25519
+import qualified Data.ByteArray         as BA
+         ;import Data.ByteArray         as BA (ByteArrayAccess, Bytes)
+import Data.ByteString                  as B
+import qualified Data.ByteString.Base16 as Base16
+import qualified Data.ByteString.Char8  as C8
+import Data.Data
+import Data.Kind
+import Data.Ord
+import Data.Serialize
+import Data.Word
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import System.Endian
+import qualified Data.ByteString.Internal
+
+-- | A 16-byte mac and an arbitrary-length encrypted stream.
+newtype Encrypted a = Encrypted ByteString
+ deriving (Eq,Ord,Data)
+
+newtype Auth = Auth Poly1305.Auth deriving (Eq, ByteArrayAccess)
+instance Ord Auth where
+    compare (Auth a) (Auth b) = comparing (BA.convert :: Poly1305.Auth -> Bytes) a b
+instance Data Auth where
+    gfoldl k z x = z x
+    -- Well, this is a little wonky... XXX
+    gunfold k z c = k (z (Auth . Poly1305.Auth . (BA.convert :: ByteString -> Bytes)))
+    toConstr _ = con_Auth
+    dataTypeOf _ = mkDataType "ToxMessage" [con_Auth]
+con_Auth = mkConstr (dataTypeOf (Auth (error "con_Auth"))) "Auth" [] Prefix
+instance Serialize Auth where
+    get = Auth . Poly1305.Auth . BA.convert <$> getBytes 16
+    put (Auth (Poly1305.Auth bs)) = putByteString $ BA.convert bs
+
+encryptedAuth :: Encrypted a -> Auth
+encryptedAuth (Encrypted bs)
+    | Right auth <- decode (B.take 16 bs) = auth
+    | otherwise                           = error "encryptedAuth: insufficient bytes"
+
+authAndBytes :: Encrypted a -> (Auth, ByteString)
+authAndBytes (Encrypted bs) = (auth,bs')
+ where
+    (as,bs')   = B.splitAt 16 bs
+    Right auth = decode as
+
+data Size a = ConstSize Int
+            | VarSize (a -> Int)
+
+class Sized a where size :: Size a
+
+instance Sized a => Serialize (Encrypted a) where
+    get = case size :: Size a of
+            VarSize _   -> Encrypted <$> (remaining >>= getBytes)
+            ConstSize n -> Encrypted <$> getBytes (16 + n) -- 16 extra for Poly1305 mac
+    put = putEncrypted
+
+getRemainingEncrypted :: Get (Encrypted a)
+getRemainingEncrypted = Encrypted <$> (remaining >>= getBytes)
+
+putEncrypted :: Encrypted a -> Put
+putEncrypted (Encrypted bs) = putByteString bs
+
+newtype Plain (s:: * -> Constraint) a = Plain ByteString
+
+
+decodePlain :: Serialize a => Plain Serialize a -> Either String a
+decodePlain (Plain bs) = decode bs
+
+encodePlain :: Serialize a => a -> Plain Serialize a
+encodePlain a = Plain $ encode a
+
+storePlain :: Storable a => a -> IO (Plain Storable a)
+storePlain a = Plain <$> BA.create (sizeOf a) (`poke` a)
+
+retrievePlain :: Storable a => Plain Storable a -> IO a
+retrievePlain (Plain bs) = BA.withByteArray bs peek
+
+data State = State Poly1305.State XSalsa.State
+
+decrypt :: State -> Encrypted a -> Either String (Plain s a)
+decrypt (State hash crypt) ciphertext
+    | (a == mac) = Right (Plain m)
+    | otherwise  = Left "decipherAndAuth: auth fail"
+  where
+    (mac, c) = authAndBytes ciphertext
+    m = fst . XSalsa.combine crypt $ c
+    a = Auth . Poly1305.finalize . Poly1305.update hash $ c
+
+-- Encrypt-then-Mac:  Encrypt the cleartext, then compute the MAC on the
+-- ciphertext, and prepend it to the ciphertext
+encrypt :: State -> Plain s a -> Encrypted a
+encrypt (State hash crypt) (Plain m) = Encrypted $ B.append (encode a) c
+  where
+    c = fst . XSalsa.combine crypt $ m
+    a = Auth . Poly1305.finalize . Poly1305.update hash $ c
+
+-- (Poly1305.State, XSalsa.State)
+computeSharedSecret :: SecretKey -> PublicKey -> Nonce24 -> State
+computeSharedSecret sk recipient nonce = State hash crypt
+ where
+    -- diffie helman
+    shared = ecdh (Proxy :: Proxy Curve_X25519) sk recipient
+    -- shared secret XSalsa key
+    k = hsalsa20 shared zeros24
+    -- cipher state
+    st0 = XSalsa.initialize 20 k nonce
+    -- Poly1305 key
+    (rs, crypt) = XSalsa.combine st0 zs where Nonce32 zs = zeros32
+    -- Since rs is 32 bytes, this pattern should never fail...
+    Cryptonite.CryptoPassed hash = Poly1305.initialize rs
+
+hsalsa20 k n = BA.append a b
+ where
+    Salsa.State st = XSalsa.initialize 20 k n
+    (_, as) = BA.splitAt 4 st
+    (a, xs) = BA.splitAt 16 as
+    (_, bs) = BA.splitAt 24 xs
+    (b, _ ) = BA.splitAt 16 bs
+
+
+newtype Nonce24 = Nonce24 ByteString
+ deriving (Eq, Ord, ByteArrayAccess,Data)
+
+quoted :: ShowS -> ShowS
+quoted shows s = '"':shows ('"':s)
+
+bin2hex :: ByteArrayAccess bs => bs -> String
+bin2hex = C8.unpack . Base16.encode . BA.convert
+
+instance Show Nonce24 where
+    showsPrec d nonce = quoted (mappend $ bin2hex nonce)
+
+instance Sized Nonce24 where size = ConstSize 24
+
+instance Serialize Nonce24 where
+    get = Nonce24 <$> getBytes 24
+    put (Nonce24 bs) = putByteString bs
+
+newtype Nonce8 = Nonce8 Word64
+ deriving (Eq, Ord, Data, Serialize)
+
+-- Note: Big-endian to match Serialize instance.
+instance Storable Nonce8 where
+    sizeOf _ = 8
+    alignment _ = alignment (undefined::Word64)
+    peek ptr = Nonce8 . fromBE64 <$> peek (castPtr ptr)
+    poke ptr (Nonce8 w) = poke (castPtr ptr) (toBE64 w)
+
+instance Sized Nonce8 where size = ConstSize 8
+
+instance ByteArrayAccess Nonce8 where
+    length _ = 8
+    withByteArray (Nonce8 w64) kont =
+        allocaBytes 8 $ \p -> do
+            poke (castPtr p :: Ptr Word64) $ toBE64 w64
+            kont p
+
+instance Show Nonce8 where
+    showsPrec d nonce = quoted (mappend $ bin2hex nonce)
+
+
+newtype Nonce32 = Nonce32 ByteString
+ deriving (Eq, Ord, ByteArrayAccess, Data)
+
+instance Serialize Nonce32 where
+    get = Nonce32 <$> getBytes 32
+    put (Nonce32 bs) = putByteString bs
+
+instance Sized Nonce32 where size = ConstSize 32
+
+
+zeros32 :: Nonce32
+zeros32 = Nonce32 $ BA.replicate 32 0
+
+zeros24 :: ByteString
+zeros24 = BA.take 24 zs where Nonce32 zs = zeros32
diff --git a/ToxData.hs b/ToxData.hs
new file mode 100644
index 00000000..06a9b3b8
--- /dev/null
+++ b/ToxData.hs
@@ -0,0 +1,23 @@
+module ToxData where
+
+import Crypto
+
+-- data DHTPacketKind = Ping | Pong | GetNodes | SendNodes
+data DHTPacket a = DHTPacket
+    { dhtSender     :: PublicKey
+    , dhtEncrypted  :: WithNonce24 (Encrypted (WithNonce8 a))
+    }
+
+data WithNonce8 a = WithNonce8 a Nonce8
+
+data WithNonce24 a = WithNonce24 a Nonce24
+
+data AliasedRequest a = AliasedRequest
+    { alias        :: PublicKey
+    , aliasPayload :: WithNonce24 (Encrypted (WithNonce8 a))
+    }
+
+data ForwardedRequest a = ForwardedRequest
+    { forwardTo :: PublicKey
+    , forwarded :: AliasedRequest a
+    }
diff --git a/ToxPacket.hs b/ToxPacket.hs
new file mode 100644
index 00000000..d10a7597
--- /dev/null
+++ b/ToxPacket.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections              #-}
+module ToxPacket where
+
+import ToxCrypto
+import Data.Serialize as S
+import Data.Aeson as JSON
+import Data.IP
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString as B
+import Data.Word
+import qualified Data.ByteString.Base16 as Base16
+import Network.Socket
+import Data.ByteArray (ByteArrayAccess)
+import qualified Data.ByteArray as BA
+import Data.Hashable
+import Data.Bits
+import System.IO.Unsafe
+import qualified Text.ParserCombinators.ReadP as RP
+import Foreign.Storable
+import ToxAddress -- import Network.Address hiding (nodePort,nodeInfo)
+import Text.Read
+import Control.Applicative
+import Data.Char
+import Control.Monad
+import Crypto.Error.Types (throwCryptoError)
+
+-- ## DHT Request packets
+--
+-- | Length | Contents                  |
+-- |:-------|:--------------------------|
+-- | `1`    | `uint8_t` (0x20)          |
+-- | `32`   | receiver's DHT public key |
+--   ...      ...
+
+data DHTRequestPacket = DHTRequestPacket
+    { requestTarget :: PublicKey
+    , request       :: Assym (Encrypted DHTRequest)
+    }
+
+instance Serialize DHTRequestPacket where
+    get = _todo
+    put = _todo
+
+
+data DHTRequest
+    = NATPing Nonce8
+    | NATPong Nonce8
+    | DHTPK DHTPublicKey
+
+-- | Length      | Contents                            |
+-- |:------------|:------------------------------------|
+-- | `1`         | `uint8_t` (0x9c)                    |
+-- | `8`         | `uint64_t` `no_replay`              |
+-- | `32`        | Our DHT public key                  |
+-- | `[39, 204]` | Maximum of 4 nodes in packed format |
+data DHTPublicKey = DHTPublicKey
+    { dhtpkNonce :: Nonce8
+    , dhtpk :: PublicKey
+    , dhtpkNodes :: SendNodes
+    }
+
+-- | `32`   | sender's DHT public key   |
+-- | `24`   | nonce                     |
+-- | `?`    | encrypted message         |
+data Assym a = Assym
+    { senderKey :: PublicKey
+    , assymNonce :: Nonce24
+    , assymData :: a
+    }
+
+newtype SendNodes = SendNodes [NodeInfo]
+    deriving (Eq,Ord,Show,Read)
+
diff --git a/ToxTransport.hs b/ToxTransport.hs
new file mode 100644
index 00000000..1b2bcbe4
--- /dev/null
+++ b/ToxTransport.hs
@@ -0,0 +1,199 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds,KindSignatures #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+module ToxTransport where
+
+import Network.QueryResponse
+import ToxCrypto
+import ToxAddress as Tox hiding (ReturnPath)
+import ToxPacket
+
+import Control.Concurrent.STM
+import qualified Data.ByteString as B
+         ;import Data.ByteString (ByteString)
+import Data.Word
+import Network.Socket
+import Data.Serialize as S (decode, Serialize, get, put, Get, Put)
+import GHC.TypeLits
+import Data.Typeable
+
+newtype SymmetricKey = SymmetricKey ByteString
+
+data TransportCrypto = TransportCrypto
+    { transportSecret :: SecretKey
+    , transportPublic :: PublicKey
+    , transportSymmetric :: STM SymmetricKey
+    }
+
+transportDecrypt :: TransportCrypto -> Assym (Encrypted a) -> Either String a
+transportDecrypt = _todo
+
+-- layer :: TransportCrypto
+          -- -> Transport String SockAddr    ByteString
+          -- -> Transport String Tox.Address ByteString
+-- layer crypto = layerTransport (toxParse crypto) (toxEncode crypto)
+
+toxEncode :: TransportCrypto -> ByteString -> Tox.Address -> (ByteString, SockAddr)
+toxEncode = _todo
+
+-- toxParse :: TransportCrypto -> ByteString -> SockAddr -> Either String (ByteString, Tox.Address)
+-- toxParse crypto bs saddr = case B.head bs of _todo
+
+data Message = Todo | DHTReq DHTRequest | AnnounceReq AnnounceRequest
+
+-- awaitMessage :: forall a. (Maybe (Either err (x, addr)) -> IO a) -> IO a
+
+toxTransport :: TransportCrypto -> Transport String SockAddr ByteString -> Transport String Tox.Address Message
+toxTransport crypto (Transport await send close) = Transport await' send' close
+ where
+    await' :: HandleHi a -> IO a
+    await' forMe = fix $ await . handleOnion crypto forMe
+
+    send' = _todo
+
+type HandleHi a = Maybe (Either String (Message, Tox.Address)) -> IO a
+type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
+
+--   Byte value   Packet Kind           Return address
+--  :----------- :--------------------
+--   `0x00`       Ping Request          DHTNode
+--   `0x01`       Ping Response         -
+--   `0x02`       Nodes Request         DHTNode
+--   `0x04`       Nodes Response        -
+--   `0x18`       Cookie Request        DHTNode, but without sending pubkey
+--   `0x19`       Cookie Response       -
+--
+--   `0x21`       LAN Discovery         DHTNode (No reply, port 33445, trigger Nodes Request/Response)
+--
+--   `0x20`       DHT Request           DHTNode/-forward
+--
+--   `0x1a`       Crypto Handshake      CookieAddress
+--
+--   `0x1b`       Crypto Data           SessionAddress
+--
+--   `0x83`       Announce Request      OnionToOwner
+--   `0x84`       Announce Response     -
+--   `0x85`       Onion Data Request    OnionToOwner
+--   `0x86`       Onion Data Response   -
+--
+--   `0xf0`       Bootstrap Info        SockAddr?
+--
+--   `0x80`       Onion Request 0       -forward
+--   `0x81`       Onion Request 1       -forward
+--   `0x82`       Onion Request 2       -forward
+--   `0x8c`       Onion Response 3      -return
+--   `0x8d`       Onion Response 2      -return
+--   `0x8e`       Onion Response 1      -return
+
+handleOnion :: forall a. TransportCrypto -> HandleHi a -> IO a -> HandleLo a
+handleOnion crypto forMe forThem (Just (Right (bs,saddr))) = case B.head bs of
+    0x20 -> forward forMe bs $ handleDHTRequest crypto saddr forMe forThem
+    0x80 -> forward forMe bs $ handleOnionRequest (Proxy :: Proxy 0) crypto saddr forThem
+    0x81 -> forward forMe bs $ handleOnionRequest (Proxy :: Proxy 1) crypto saddr forThem
+    0x82 -> forward forMe bs $ handleOnionRequest (Proxy :: Proxy 2) crypto saddr forThem
+    0x8c -> forward forMe bs $ handleOnionResponse (Proxy :: Proxy 3) crypto saddr forThem
+    0x8d -> forward forMe bs $ handleOnionResponse (Proxy :: Proxy 2) crypto saddr forThem
+    0x8e -> forward forMe bs $ handleOnionResponse (Proxy :: Proxy 1) crypto saddr forThem
+    typ  -> go typ (B.tail bs)
+ where
+    go :: Word8 -> ByteString -> IO a
+    go typ bs = forMe $ Just (parseMessage typ bs)
+
+forward :: forall c b b1.
+          Serialize b =>
+              (Maybe (Either String b1) -> c) -> ByteString -> (b -> c) -> c
+forward forMe bs f = either (forMe . Just . Left) f $ decode $ B.tail bs
+
+parseMessage :: Word8 -> ByteString -> Either String (Message,Address)
+--     Announce :: Aliased Assymetric -> ReturnPath 3 -> Packet --0x83
+parseMessage 0x83 bs = _todo -- Announce Request      OnionToOwner
+parseMessage _ _ = _todo
+
+handleDHTRequest :: forall a. TransportCrypto -> SockAddr -> HandleHi a -> IO a -> DHTRequestPacket -> IO a
+handleDHTRequest crypto saddr forMe forThem (DHTRequestPacket target payload)
+    | target == transportPublic crypto = forMe' payload
+    | otherwise                        = _todo -- lookup target in close list, forward message
+                                         >> forThem
+ where
+    forMe' :: Assym (Encrypted DHTRequest) -> IO a
+    forMe' payload = do
+        case (,) <$> transportDecrypt crypto payload <*> eaddr of
+            Left e         -> forMe (Just (Left e))
+            Right (p,addr) -> forMe (Just (Right (DHTReq p,addr)))
+
+    eaddr :: Either String Tox.Address
+    eaddr = fmap DHTNode $ nodeInfo (NodeId $ senderKey payload) saddr
+
+data Attributed a = Attributed
+    { author          :: PublicKey
+    , attributedNonce :: Nonce24
+    , attributed      :: a
+    }
+
+--   `0x83`       Announce Request      OnionToOwner
+--   `0x85`       Onion Data Request    OnionToOwner
+data OPacket -- payload of an onion request
+
+
+--   `0x84`       Announce Response     -
+--   `0x86`       Onion Data Response   -
+data RPacket -- payload of an onion response
+
+-- n = 0, 1, 2
+data OnionRequest (n :: Nat) = OnionRequest
+    { onionNonce    :: Nonce24
+    , onionForward  :: Forwarding (3 - n) OPacket
+    , pathFromOwner :: ReturnPath n
+    }
+
+instance Serialize (OnionRequest n) where { get = _todo; put = _todo }
+instance Serialize (OnionResponse n) where { get = _todo; put = _todo }
+
+-- n = 1, 2, 3
+-- Attributed (Encrypted (
+
+data OnionResponse (n :: Nat) = OnionResponse
+    { pathToOwner :: ReturnPath n
+    , msgToOwner  :: RPacket
+    }
+
+data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a }
+
+data ReturnPath (n :: Nat) where
+    NoReturnPath :: ReturnPath 0
+    ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath n)) -> ReturnPath (n + 1)
+
+data Forwarding (n :: Nat) msg where
+    NotForwarded :: msg -> Forwarding 0 msg
+    Forwarding :: Attributed (Encrypted (Addressed (Forwarding n msg))) -> Forwarding (n + 1) msg
+
+handleOnionRequest :: KnownNat n => proxy n -> TransportCrypto -> SockAddr -> IO a -> OnionRequest n -> IO a
+handleOnionRequest = _todo
+
+handleOnionResponse :: KnownNat n => proxy n -> TransportCrypto -> SockAddr -> IO a -> OnionResponse n -> IO a
+handleOnionResponse = _todo
+
+{-
+data Size a = ConstSize Int
+            | VarSize (a -> Int)
+
+data PacketChunk a
+    = Plain a
+    | Assymetric a
+    | Symmetric a
+    -}
+
+
+data AnnounceRequest = AnnounceRequest
+    { announcePingId  :: Nonce32 -- Ping ID
+    , announceSeeking :: NodeId  -- Public key we are searching for
+    , announceKey     :: NodeId  -- Public key that we want those sending back data packets to use
+    }
+
+instance S.Serialize AnnounceRequest where
+    get = AnnounceRequest <$> S.get <*> S.get <*> S.get
+    put (AnnounceRequest p s k) = S.put (p,s,k)
+
+getOnionRequest :: Get (Assym (Encrypted msg), ReturnPath 3)
+getOnionRequest = _todo
diff --git a/c b/c
index e98a6d7b..f11856e2 100755
--- a/c
+++ b/c
@@ -2,4 +2,4 @@
 defs="-DBENCODE_AESON -DTHREAD_DEBUG"
 hide="-hide-package crypto-random -hide-package crypto-api -hide-package crypto-numbers -hide-package cryptohash -hide-package prettyclass"
 cbits="cbits/*.c"
-ghc -freverse-errors $hide -isrc -XOverloadedStrings -XRecordWildCards $defs $cbits "$@"
+ghc -fdefer-typed-holes -Wno-typed-holes -freverse-errors $hide -isrc -XOverloadedStrings -XRecordWildCards $defs $cbits "$@"