1 files changed, 58 insertions, 1 deletions

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
+