Implemented instance Read (NodeId ...)

3 files changed, 10 insertions, 0 deletions

diff --git a/src/Network/DatagramServer/Mainline.hs b/src/Network/DatagramServer/Mainline.hs
index c127c07b..87825ce0 100644
--- a/src/Network/DatagramServer/Mainline.hs
+++ b/src/Network/DatagramServer/Mainline.hs
@@ -358,3 +358,5 @@ instance (Typeable tid, BEncode tid) => BEncode (KError tid) where
   {-# INLINE fromBEncode #-}
 #endif
 
+instance Read (NodeId KMessageOf) where readsPrec d s = map (\(w,xs) -> (NodeId w, xs)) $ decodeHex s
+
diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs
index 2c432d70..b323a4df 100644
--- a/src/Network/DatagramServer/Tox.hs
+++ b/src/Network/DatagramServer/Tox.hs
@@ -286,3 +286,5 @@ instance WireFormat ByteString Message where
 
     decodeHeaders ctx bs = runGet getMessage bs >>= decipher ctx
     encodeHeaders ctx msg = runPut $ putMessage $ encipher ctx msg
+
+instance Read (NodeId Message) where readsPrec d s = map (\(w,xs) -> (NodeId w, xs)) $ decodeHex s
diff --git a/src/Network/DatagramServer/Types.hs b/src/Network/DatagramServer/Types.hs
index ea38d46e..e2d56dc0 100644
--- a/src/Network/DatagramServer/Types.hs
+++ b/src/Network/DatagramServer/Types.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE StandaloneDeriving     #-}
 module Network.DatagramServer.Types
@@ -336,6 +337,11 @@ class Envelope envelope => WireFormat raw envelope where
 encodeHexDoc :: Serialize x => x -> Doc
 encodeHexDoc nid = PP.text $ Char8.unpack $ Base16.encode $ S.encode nid
 
+decodeHex :: Serialize x => String -> [(x,String)]
+decodeHex s = either (const []) (pure . (, Char8.unpack ybs)) $ S.decode xbs
+    where
+        (xbs,ybs) = Base16.decode $ Char8.pack s
+
 -- FIXME Orphan Serialize intance for large words
 instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where
    put (LargeKey lo hi) = put hi >> put lo