From 52b32cc5d67723d4285610f21a240cf4d0b3a2b0 Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 1 Sep 2017 23:32:31 -0400 Subject: Encryption layer for DHT and Onion transports. --- DHTTransport.hs | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- OnionTransport.hs | 59 +++++++++++++++++++++++++++++++++++++++++++++++++- ToxAddress.hs | 5 ++++- ToxCrypto.hs | 13 ++++++++++- 4 files changed, 137 insertions(+), 4 deletions(-) diff --git a/DHTTransport.hs b/DHTTransport.hs index 97a8113c..690ee346 100644 --- a/DHTTransport.hs +++ b/DHTTransport.hs @@ -2,6 +2,8 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeOperators #-} module DHTTransport ( parseDHTAddr , encodeDHTAddr @@ -16,15 +18,20 @@ module DHTTransport , Cookie , DHTRequest , mapMessage + , encrypt + , decrypt ) where import ToxAddress -import ToxCrypto +import ToxCrypto hiding (encrypt,decrypt) +import qualified ToxCrypto import Network.QueryResponse import Control.Arrow +import Control.Monad import qualified Data.ByteString as B ;import Data.ByteString (ByteString) +import Data.Tuple import Data.Serialize as S (Get, Serialize, get, put, runGet) import Data.Word import Network.Socket @@ -124,6 +131,10 @@ data DHTRequest | NATPong Nonce8 | DHTPK DHTPublicKey +instance Serialize DHTRequest where + get = return _todo + put _ = return () -- todo + -- | Length | Contents | -- |:------------|:------------------------------------| -- | `1` | `uint8_t` (0x9c) | @@ -177,6 +188,10 @@ data Cookie = Cookie Nonce24 (Encrypted CookieData) instance Sized Cookie where size = ConstSize 112 -- 24 byte nonce + 88 byte cookie data +instance Serialize Cookie where + get = return $ Cookie _todo _todo + put _ = return () -- todo + data CookieData = CookieData -- 16 (mac) { cookieTime :: Word64 -- 8 , longTermKey :: PublicKey -- 32 @@ -186,6 +201,10 @@ data CookieData = CookieData -- 16 (mac) instance Sized CookieRequest where size = ConstSize 64 -- 32 byte key + 32 byte padding +instance Serialize CookieRequest where + get = CookieRequest <$> return _todo + put (CookieRequest _) = return () -- todo + forwardDHTRequests :: TransportCrypto -> (PublicKey -> IO (Maybe NodeInfo)) -> DHTTransport -> DHTTransport forwardDHTRequests crypto closeLookup dht = dht { awaitMessage = await' } where @@ -198,3 +217,46 @@ forwardDHTRequests crypto closeLookup dht = dht { awaitMessage = await' } await' pass m -> pass m +encrypt :: TransportCrypto -> DHTMessage ((,) Nonce8) -> NodeInfo -> (DHTMessage Encrypted8, NodeInfo) +encrypt crypto msg ni = (transcode (encryptMessage crypto) msg, ni) + +encryptMessage :: Serialize a => + TransportCrypto -> Nonce24 -> Either (Nonce8,a) (Assym (Nonce8,a)) -> Encrypted8 a +encryptMessage crypto n (Right assym) = E8 $ ToxCrypto.encrypt secret plain + where + secret = computeSharedSecret (transportSecret crypto) (senderKey assym) n + plain = encodePlain $ swap $ assymData assym +encryptMessage crypto n (Left plain) = _todo + +decrypt :: TransportCrypto -> DHTMessage Encrypted8 -> NodeInfo -> Either String (DHTMessage ((,) Nonce8), NodeInfo) +decrypt crypto msg ni = (, ni) <$> (sequenceMessage $ transcode (decryptMessage crypto) msg) + +decryptMessage :: Serialize x => + TransportCrypto + -> Nonce24 + -> Either (Encrypted8 x) (Assym (Encrypted8 x)) + -> (Either String ∘ ((,) Nonce8)) x +decryptMessage crypto n (Right assymE) = plain8 $ ToxCrypto.decrypt secret e + where + secret = computeSharedSecret (transportSecret crypto) (senderKey assymE) n + E8 e = assymData assymE + plain8 = Composed . fmap swap . (>>= decodePlain) +decryptMessage crypto n (Left (E8 e)) = _todo + +sequenceMessage :: Applicative m => DHTMessage (m ∘ f) -> m (DHTMessage f) +sequenceMessage (DHTPing asym) = fmap DHTPing $ sequenceA $ fmap uncomposed asym +sequenceMessage (DHTPong asym) = fmap DHTPong $ sequenceA $ fmap uncomposed asym +sequenceMessage (DHTGetNodes asym) = fmap DHTGetNodes $ sequenceA $ fmap uncomposed asym +sequenceMessage (DHTSendNodes asym) = fmap DHTSendNodes $ sequenceA $ fmap uncomposed asym +sequenceMessage (DHTCookieRequest asym) = fmap DHTCookieRequest $ sequenceA $ fmap uncomposed asym +sequenceMessage (DHTCookie n dta) = fmap (DHTCookie n) $ uncomposed dta +sequenceMessage (DHTDHTRequest pubkey asym) = fmap (DHTDHTRequest pubkey) $ sequenceA $ fmap uncomposed asym + +transcode :: forall f g. (forall a. Serialize a => Nonce24 -> Either (f a) (Assym (f a)) -> g a) -> DHTMessage f -> DHTMessage g +transcode f (DHTPing asym) = DHTPing $ asym { assymData = f (assymNonce asym) (Right asym) } +transcode f (DHTPong asym) = DHTPong $ asym { assymData = f (assymNonce asym) (Right asym) } +transcode f (DHTGetNodes asym) = DHTGetNodes $ asym { assymData = f (assymNonce asym) (Right asym) } +transcode f (DHTSendNodes asym) = DHTSendNodes $ asym { assymData = f (assymNonce asym) (Right asym) } +transcode f (DHTCookieRequest asym) = DHTCookieRequest $ asym { assymData = f (assymNonce asym) (Right asym) } +transcode f (DHTCookie n dta) = DHTCookie n $ f n $ Left dta +transcode f (DHTDHTRequest pubkey asym) = DHTDHTRequest pubkey $ asym { assymData = f (assymNonce asym) (Right asym) } diff --git a/OnionTransport.hs b/OnionTransport.hs index 804c444e..aa4bae1e 100644 --- a/OnionTransport.hs +++ b/OnionTransport.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} @@ -21,15 +22,20 @@ module OnionTransport , OnionResponse(..) , Addressed(..) , UDPTransport + , KeyRecord(..) + , encrypt + , decrypt ) where import Network.QueryResponse -import ToxCrypto +import ToxCrypto hiding (encrypt,decrypt) +import qualified ToxCrypto import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo) import Control.Arrow import qualified Data.ByteString as B ;import Data.ByteString (ByteString) +import Data.Functor.Identity import Data.Serialize as S (Get, Put, Serialize, get, put, runGet) import Data.Typeable import Data.Word @@ -52,6 +58,7 @@ data OnionMessage (f :: * -> *) data OnionToOwner = OnionToOwner NodeInfo (ReturnPath 3) | OnionToMe SockAddr -- SockAddr is immediate peer in route + deriving Show onionToOwner assym ret3 saddr = do @@ -127,6 +134,10 @@ data ReturnPath (n :: Nat) where NoReturnPath :: ReturnPath 0 ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath n)) -> ReturnPath (n + 1) +instance KnownNat n => Show (ReturnPath n) where + show rpath = "ReturnPath" ++ show (natVal rpath) + + -- 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) ) @@ -194,3 +205,49 @@ data DataToRoute = DataToRoute , dataToRoute :: Encrypted (Word8,ByteString) } +instance Serialize DataToRoute where + get = return $ DataToRoute _todo _todo + put _ = return () -- todo + +encrypt :: TransportCrypto -> OnionMessage Identity -> OnionToOwner -> (OnionMessage Encrypted, OnionToOwner) +encrypt crypto msg rpath = (transcode (encryptMessage crypto) msg, rpath) + +encryptMessage :: Serialize a => + TransportCrypto -> Nonce24 -> Either (Identity a) (Assym (Identity a)) -> Encrypted a +encryptMessage crypto n (Right a) = ToxCrypto.encrypt secret plain + where + secret = computeSharedSecret (transportSecret crypto) (senderKey a) n + plain = encodePlain $ runIdentity $ assymData a +encryptMessage crypto n (Left x) = ToxCrypto.encrypt secret plain + where + secret = computeSharedSecret (transportSecret crypto) _todo n + plain = encodePlain $ runIdentity $ x + +decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionToOwner -> Either String (OnionMessage Identity, OnionToOwner) +decrypt crypto msg addr = (, addr) <$> (sequenceMessage $ transcode (decryptMessage crypto) msg) + +decryptMessage :: Serialize x => + TransportCrypto + -> Nonce24 + -> Either (Encrypted x) (Assym (Encrypted x)) + -> (Either String ∘ Identity) x +decryptMessage crypto n (Right assymE) = plain $ ToxCrypto.decrypt secret e + where + secret = computeSharedSecret (transportSecret crypto) (senderKey assymE) n + e = assymData assymE + plain = Composed . fmap Identity . (>>= decodePlain) +decryptMessage crypto n (Left e) = _todo + + +sequenceMessage :: Applicative m => OnionMessage (m ∘ f) -> m (OnionMessage f) +sequenceMessage (OnionAnnounce a) = fmap OnionAnnounce $ sequenceA $ fmap uncomposed a +sequenceMessage (OnionToRoute pub a) = fmap (OnionToRoute pub) $ sequenceA $ fmap uncomposed a +sequenceMessage (OnionToRouteResponse a) = fmap OnionToRouteResponse $ sequenceA $ fmap uncomposed a +sequenceMessage (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 <$> uncomposed dta + +transcode :: forall f g. (forall a. Serialize a => Nonce24 -> Either (f a) (Assym (f a)) -> g a) -> OnionMessage f -> OnionMessage g +transcode f (OnionAnnounce a) = OnionAnnounce $ a { assymData = f (assymNonce a) (Right a) } +transcode f (OnionToRoute pub a) = OnionToRoute pub $ a { assymData = f (assymNonce a) (Right a) } +transcode f (OnionToRouteResponse a) = OnionToRouteResponse $ a { assymData = f (assymNonce a) (Right a) } +transcode f (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 $ f n24 $ Left dta + diff --git a/ToxAddress.hs b/ToxAddress.hs index f0d4aba3..ea69f6e3 100644 --- a/ToxAddress.hs +++ b/ToxAddress.hs @@ -13,7 +13,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -module ToxAddress (NodeInfo(..),NodeId(..),nodeInfo) where +module ToxAddress (NodeInfo(..),NodeId(..),nodeInfo,zeroID) where import Control.Applicative import Control.Monad @@ -88,6 +88,9 @@ instance S.Serialize NodeId where instance Bits NodeId where -- TODO +instance Hashable NodeId where + hashWithSalt salt (NodeId key) = hashWithSalt salt (BA.convert key :: ByteString) + instance FiniteBits NodeId where finiteBitSize _ = 256 diff --git a/ToxCrypto.hs b/ToxCrypto.hs index 6b5e6f19..c2e2bbeb 100644 --- a/ToxCrypto.hs +++ b/ToxCrypto.hs @@ -2,6 +2,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE TypeOperators #-} module ToxCrypto ( PublicKey , publicKey @@ -9,9 +13,12 @@ module ToxCrypto , SymmetricKey(..) , TransportCrypto(..) , Encrypted - , Encrypted8 + , Encrypted8(..) + , type (∘)(..) , Assym(..) , Plain + , encodePlain + , decodePlain , computeSharedSecret , encrypt , decrypt @@ -24,6 +31,8 @@ module ToxCrypto , Sized(..) , Size(..) , State(..) + , zeros32 + , zeros24 ) where import qualified Crypto.Cipher.Salsa as Salsa @@ -56,6 +65,7 @@ newtype Encrypted a = Encrypted ByteString newtype Encrypted8 a = E8 (Encrypted (a,Nonce8)) deriving Serialize +newtype (f ∘ g) x = Composed { uncomposed :: f (g x) } newtype Auth = Auth Poly1305.Auth deriving (Eq, ByteArrayAccess) instance Ord Auth where @@ -229,6 +239,7 @@ data Assym a = Assym , assymNonce :: Nonce24 , assymData :: a } + deriving (Functor,Foldable,Traversable) newtype SymmetricKey = SymmetricKey ByteString -- cgit v1.2.3