TCP relay packet serialization.

1 files changed, 48 insertions, 0 deletions

diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 10bd5a44..ef9121f2 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
@@ -41,6 +42,8 @@ module Network.Tox.Onion.Transport
     , decrypt
     , peelSymmetric
     , OnionRoute(..)
+    , N0
+    , N1
     , N3
     , onionKey
     , onionAliasSelector
@@ -62,6 +65,7 @@ import Control.Concurrent.STM
 import Control.Monad
 import qualified Data.ByteString    as B
          ;import Data.ByteString    (ByteString)
+import Data.Data
 import Data.Function
 import Data.Functor.Contravariant
 import Data.Functor.Identity
@@ -101,6 +105,16 @@ data OnionMessage (f :: * -> *)
     | OnionToRoute PublicKey (Asymm (Encrypted DataToRoute)) -- destination key, aliased Asymm
     | OnionToRouteResponse (Asymm (Encrypted DataToRoute))
 
+deriving instance ( Eq (f (AnnounceRequest, Nonce8))
+                  , Eq (f AnnounceResponse)
+                  , Eq (f DataToRoute)
+                  ) => Eq (OnionMessage f)
+
+deriving instance ( Ord (f (AnnounceRequest, Nonce8))
+                  , Ord (f AnnounceResponse)
+                  , Ord (f DataToRoute)
+                  ) => Ord (OnionMessage f)
+
 deriving instance ( Show (f (AnnounceRequest, Nonce8))
                   , Show (f AnnounceResponse)
                   , Show (f DataToRoute)
@@ -304,6 +318,30 @@ data OnionRequest n = OnionRequest
     , onionForward  :: Forwarding (ThreeMinus n) (OnionMessage Encrypted)
     , pathFromOwner :: ReturnPath n
     }
+ deriving (Eq,Ord)
+
+
+instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n)
+         , Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
+         ) => Data (OnionRequest n) where
+  gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt
+  toConstr _     = error "OnionRequest.toConstr"
+  gunfold _ _    = error "OnionRequest.gunfold"
+#if MIN_VERSION_base(4,2,0)
+  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.OnionRequest"
+#else
+  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.OnionRequest"
+#endif
+
+instance (Typeable n, Serialize (ReturnPath n)) => Data (OnionResponse n) where
+  gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt
+  toConstr _     = error "OnionResponse.toConstr"
+  gunfold _ _    = error "OnionResponse.gunfold"
+#if MIN_VERSION_base(4,2,0)
+  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.OnionResponse"
+#else
+  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.OnionResponse"
+#endif
 
 deriving instance ( Show (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
                   , KnownNat (PeanoNat n)
@@ -336,6 +374,7 @@ data OnionResponse n = OnionResponse
     { pathToOwner :: ReturnPath n
     , msgToOwner  :: OnionMessage Encrypted
     }
+    deriving (Eq,Ord)
 
 deriving instance KnownNat (PeanoNat n) => Show (OnionResponse n)
 
@@ -383,6 +422,9 @@ type N1 = S N0
 type N2 = S N1
 type N3 = S N2
 
+deriving instance Data N0
+deriving instance Data n => Data (S n)
+
 class KnownPeanoNat n where
     peanoVal :: p n -> Int
 
@@ -399,6 +441,9 @@ data ReturnPath n where
     NoReturnPath :: ReturnPath N0
     ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath n)) -> ReturnPath (S n)
 
+deriving instance Eq (ReturnPath n)
+deriving instance Ord (ReturnPath n)
+
 -- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
 instance Sized (ReturnPath N0) where size = ConstSize 0
 instance Sized (ReturnPath n) => Sized (ReturnPath (S n)) where
@@ -444,6 +489,9 @@ data Forwarding n msg where
     NotForwarded :: msg -> Forwarding N0 msg
     Forwarding :: PublicKey -> Encrypted (Addressed (Forwarding n msg)) -> Forwarding (S n) msg
 
+deriving instance Eq msg => Eq (Forwarding n msg)
+deriving instance Ord msg => Ord (Forwarding n msg)
+
 instance Show msg => Show (Forwarding N0 msg) where
     show (NotForwarded x) = "NotForwarded "++show x