feat: Add new group chats savedata support.

TokTok · Dec 22, 2023 · 2c15af9 · 2c15af9
1 parent b92867f
commit 2c15af9
Show file tree

Hide file tree

Showing 18 changed files with 361 additions and 77 deletions.
diff --git a/BUILD.bazel b/BUILD.bazel
@@ -7,14 +7,14 @@ project(custom_cirrus = True)
 haskell_library(
     name = "hs-toxcore",
     srcs = glob(["src/**/*.*hs"]),
-    compiler_flags = [
-        "-j4",
-    ],
+    ghcopts = ["-j4"],
     src_strip_prefix = "src",
     version = "0.2.12",
     visibility = ["//visibility:public"],
     deps = [
+        "//hs-msgpack-arbitrary",
         "//hs-msgpack-binary",
+        "//hs-msgpack-types",
         "//third_party/haskell:MonadRandom",
         "//third_party/haskell:QuickCheck",
         "//third_party/haskell:base",
@@ -39,9 +39,7 @@ haskell_library(
 hspec_test(
     name = "testsuite",
     size = "small",
-    compiler_flags = [
-        "-j4",
-    ],
+    ghcopts = ["-j4"],
     deps = [
         ":hs-toxcore",
         "//hs-msgpack-binary",

diff --git a/src/Network/Tox/Binary.hs b/src/Network/Tox/Binary.hs
@@ -2,26 +2,16 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData          #-}
 module Network.Tox.Binary
-  ( typeName
-  , encode
+  ( encode
   , decode
   ) where
 
 import           Data.Binary          (Binary)
 import           Data.ByteString      (ByteString)
-import           Data.Kind            (Type)
-import           Data.Typeable        (Typeable)
-import qualified Data.Typeable        as Typeable
 
 import qualified Network.Tox.Encoding as Encoding
 
 
-typeName :: Typeable (a :: Type) => proxy a -> String
-typeName (_ :: proxy a) =
-  show . Typeable.typeOf $ (undefined :: a)
-
-
-
 --------------------------------------------------------------------------------
 --
 -- :: decode

diff --git a/src/Network/Tox/Crypto/Key.lhs b/src/Network/Tox/Crypto/Key.lhs
@@ -11,29 +11,32 @@
 {-# LANGUAGE StrictData                 #-}
 module Network.Tox.Crypto.Key where
 
-import           Control.Monad               ((>=>))
-import           Control.Monad.Validate      (MonadValidate, refute)
-import qualified Crypto.Saltine.Class        as Sodium (IsEncoding, decode,
-                                                        encode)
-import qualified Crypto.Saltine.Core.Box     as Sodium (CombinedKey, Nonce,
-                                                        PublicKey, SecretKey)
-import qualified Crypto.Saltine.Internal.Box as Sodium (box_beforenmbytes,
-                                                        box_noncebytes,
-                                                        box_publickeybytes,
-                                                        box_secretkeybytes)
-import           Data.Binary                 (Binary)
-import qualified Data.Binary                 as Binary (get, put)
-import qualified Data.Binary.Get             as Binary (getByteString, runGet)
-import qualified Data.Binary.Put             as Binary (putByteString)
-import qualified Data.ByteString             as ByteString
-import qualified Data.ByteString.Base16      as Base16
-import qualified Data.ByteString.Lazy        as LazyByteString
-import           Data.MessagePack            (DecodeError, MessagePack (..))
-import           Data.Proxy                  (Proxy (..))
-import           Data.Typeable               (Typeable)
-import           Test.QuickCheck.Arbitrary   (Arbitrary, arbitrary)
-import qualified Test.QuickCheck.Arbitrary   as Arbitrary
-import           Text.Read                   (readPrec)
+import           Control.Monad                ((>=>))
+import           Control.Monad.Validate       (MonadValidate, refute)
+import qualified Crypto.Saltine.Class         as Sodium (IsEncoding, decode,
+                                                         encode)
+import qualified Crypto.Saltine.Core.Box      as Sodium (CombinedKey, Nonce,
+                                                         PublicKey, SecretKey)
+import qualified Crypto.Saltine.Core.Sign     as Sodium (Signature)
+import qualified Crypto.Saltine.Internal.Box  as Sodium (box_beforenmbytes,
+                                                         box_noncebytes,
+                                                         box_publickeybytes,
+                                                         box_secretkeybytes)
+import qualified Crypto.Saltine.Internal.Sign as Sodium (sign_bytes)
+import           Data.Binary                  (Binary)
+import qualified Data.Binary                  as Binary (get, put)
+import qualified Data.Binary.Get              as Binary (getByteString, runGet)
+import qualified Data.Binary.Put              as Binary (putByteString)
+import qualified Data.ByteString              as ByteString
+import qualified Data.ByteString.Base16       as Base16
+import qualified Data.ByteString.Lazy         as LazyByteString
+import           Data.MessagePack             (DecodeError, MessagePack (..))
+import           Data.Proxy                   (Proxy (..))
+import           Data.String                  (fromString)
+import           Data.Typeable                (Typeable)
+import qualified Test.QuickCheck.Arbitrary    as Arbitrary
+import           Test.QuickCheck.Arbitrary    (Arbitrary, arbitrary)
+import           Text.Read                    (readPrec)
 
 
 {-------------------------------------------------------------------------------
@@ -78,11 +81,13 @@ instance CryptoNumber Sodium.PublicKey   where { encodedByteSize _ = Sodium.box_
 instance CryptoNumber Sodium.SecretKey   where { encodedByteSize _ = Sodium.box_secretkeybytes }
 instance CryptoNumber Sodium.CombinedKey where { encodedByteSize _ = Sodium.box_beforenmbytes  }
 instance CryptoNumber Sodium.Nonce       where { encodedByteSize _ = Sodium.box_noncebytes     }
+instance CryptoNumber Sodium.Signature   where { encodedByteSize _ = Sodium.sign_bytes         }
 
 deriving instance Typeable Sodium.PublicKey
 deriving instance Typeable Sodium.SecretKey
 deriving instance Typeable Sodium.CombinedKey
 deriving instance Typeable Sodium.Nonce
+deriving instance Typeable Sodium.Signature
 
 newtype Key a = Key { unKey :: a }
   deriving (Eq, Ord, Typeable)
@@ -91,6 +96,7 @@ type PublicKey   = Key Sodium.PublicKey
 type SecretKey   = Key Sodium.SecretKey
 type CombinedKey = Key Sodium.CombinedKey
 type Nonce       = Key Sodium.Nonce
+type Signature   = Key Sodium.Signature
 
 instance Sodium.IsEncoding a => Sodium.IsEncoding (Key a) where
   encode = Sodium.encode . unKey
@@ -117,7 +123,7 @@ decode :: (CryptoNumber a, MonadValidate DecodeError m) => ByteString.ByteString
 decode bytes =
   case Sodium.decode bytes of
     Just key -> return $ Key key
-    Nothing  -> refute "unable to decode ByteString to Key"
+    Nothing  -> refute $ fromString $ "unable to decode ByteString to Key: " <> show (ByteString.length bytes)
 
 
 instance CryptoNumber a => Binary (Key a) where

diff --git a/src/Network/Tox/DHT/ClientList.lhs b/src/Network/Tox/DHT/ClientList.lhs
@@ -11,8 +11,8 @@ import           Data.Map                      (Map)
 import qualified Data.Map                      as Map
 import           Test.QuickCheck.Arbitrary     (Arbitrary, arbitrary,
                                                 arbitrarySizedNatural)
-import           Test.QuickCheck.Gen           (Gen)
 import qualified Test.QuickCheck.Gen           as Gen
+import           Test.QuickCheck.Gen           (Gen)
 
 import           Network.Tox.Crypto.Key        (PublicKey)
 import           Network.Tox.DHT.ClientNode    (ClientNode)

diff --git a/src/Network/Tox/DHT/KBuckets.lhs b/src/Network/Tox/DHT/KBuckets.lhs
@@ -21,8 +21,8 @@ import           Data.Ord                      (comparing)
 import           Data.Traversable              (mapAccumR)
 import           Data.Word                     (Word8)
 import           Test.QuickCheck.Arbitrary     (Arbitrary, arbitrary)
-import           Test.QuickCheck.Gen           (Gen)
 import qualified Test.QuickCheck.Gen           as Gen
+import           Test.QuickCheck.Gen           (Gen)
 
 import           Network.Tox.Crypto.Key        (PublicKey)
 import           Network.Tox.DHT.ClientList    (ClientList)

diff --git a/src/Network/Tox/DHT/Operation.lhs b/src/Network/Tox/DHT/Operation.lhs
@@ -33,10 +33,10 @@ import           System.Random                        (StdGen, mkStdGen)
 import           Test.QuickCheck.Arbitrary            (Arbitrary, arbitrary)
 
 import           Network.Tox.Crypto.Key               (PublicKey)
-import qualified Network.Tox.Crypto.KeyPair           as KeyPair
 import           Network.Tox.Crypto.Keyed             (Keyed)
 import           Network.Tox.Crypto.KeyedT            (KeyedT)
 import qualified Network.Tox.Crypto.KeyedT            as KeyedT
+import qualified Network.Tox.Crypto.KeyPair           as KeyPair
 import           Network.Tox.DHT.ClientList           (ClientList)
 import qualified Network.Tox.DHT.ClientList           as ClientList
 import           Network.Tox.DHT.ClientNode           (ClientNode)

diff --git a/src/Network/Tox/SaveData.lhs b/src/Network/Tox/SaveData.lhs
@@ -10,7 +10,6 @@ module Network.Tox.SaveData
     , Section (..)
     , NospamKeys (..)
     , Friends (..)
-    , Bytes (..)
     ) where
 \end{code}
 
@@ -36,9 +35,13 @@ import           Data.MessagePack                 (MessagePack)
 import           Data.Word                        (Word16, Word32, Word8)
 import           GHC.Generics                     (Generic)
 import           Network.Tox.Crypto.Key           (PublicKey, SecretKey)
+import           Network.Tox.Crypto.KeyPair       (KeyPair (..))
+import qualified Network.Tox.Crypto.KeyPair       as KeyPair
+import           Network.Tox.SaveData.Bytes       (Bytes)
 import           Network.Tox.SaveData.Conferences (Conferences)
 import           Network.Tox.SaveData.DHT         (DHT)
 import           Network.Tox.SaveData.Friend      (Friend)
+import           Network.Tox.SaveData.Groups      (Groups)
 import           Network.Tox.SaveData.Nodes       (Nodes)
 import qualified Network.Tox.SaveData.Util        as Util
 import           Test.QuickCheck.Arbitrary        (Arbitrary (..),
@@ -124,6 +127,7 @@ Section types:
   Name          & 0x04 \\
   StatusMessage & 0x05 \\
   Status        & 0x06 \\
+  Groups        & 0x07 \\
   TcpRelays     & 0x0A \\
   PathNodes     & 0x0B \\
   Conferences   & 0x14 \\
@@ -147,6 +151,7 @@ getSections = go
             0x04 -> load SectionName
             0x05 -> load SectionStatusMessage
             0x06 -> load SectionStatus
+            0x07 -> load SectionGroups
             0x0A -> load SectionTcpRelays
             0x0B -> load SectionPathNodes
             0x14 -> load SectionConferences
@@ -169,6 +174,7 @@ putSections = mapM_ go
         SectionName          x -> (0x04, put x)
         SectionStatusMessage x -> (0x05, put x)
         SectionStatus        x -> (0x06, put x)
+        SectionGroups        x -> (0x07, put x)
         SectionTcpRelays     x -> (0x0A, put x)
         SectionPathNodes     x -> (0x0B, put x)
         SectionConferences   x -> (0x14, put x)
@@ -270,6 +276,7 @@ data Section
     | SectionName Bytes
     | SectionStatusMessage Bytes
     | SectionStatus Word8
+    | SectionGroups Groups
     | SectionTcpRelays Nodes
     | SectionPathNodes Nodes
     | SectionConferences Conferences
@@ -286,6 +293,7 @@ instance Arbitrary Section where
         , SectionName <$> arbitrary
         , SectionStatusMessage <$> arbitrary
         , SectionStatus <$> arbitrary
+        , SectionGroups <$> arbitrary
         , SectionTcpRelays <$> arbitrary
         , SectionPathNodes <$> arbitrary
         , SectionConferences <$> arbitrary
@@ -313,10 +321,12 @@ instance Binary NospamKeys where
         put secretKey
 
 instance Arbitrary NospamKeys where
-    arbitrary = NospamKeys
-        <$> arbitrary
-        <*> arbitrary
-        <*> arbitrary
+    arbitrary = do
+        KeyPair sk pk <- KeyPair.fromSecretKey <$> arbitrary
+        NospamKeys
+            <$> arbitrary
+            <*> pure pk
+            <*> pure sk
     shrink = genericShrink
 
 newtype Friends = Friends [Friend]
@@ -332,16 +342,4 @@ instance Arbitrary Friends where
     arbitrary = Friends <$> arbitrary
     shrink = genericShrink
 
-newtype Bytes = Bytes LBS.ByteString
-    deriving (Eq, Show, Read, Generic)
-
-instance MessagePack Bytes
-
-instance Binary Bytes where
-    get = Bytes <$> Get.getRemainingLazyByteString
-    put (Bytes bs) = Put.putLazyByteString bs
-
-instance Arbitrary Bytes where
-    arbitrary = Bytes . LBS.pack <$> arbitrary
-
 \end{code}
diff --git a/src/Network/Tox/SaveData/Bytes.lhs b/src/Network/Tox/SaveData/Bytes.lhs
@@ -0,0 +1,32 @@
+\subsection{Bytes}
+
+Arbitrary byte array.
+
+\begin{code}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData    #-}
+module Network.Tox.SaveData.Bytes
+    ( Bytes (..)
+    ) where
+
+import           Data.Binary               (Binary (..))
+import qualified Data.Binary.Get           as Get
+import qualified Data.Binary.Put           as Put
+import qualified Data.ByteString.Lazy      as LBS
+import           Data.MessagePack          (MessagePack)
+import           GHC.Generics              (Generic)
+import           Test.QuickCheck.Arbitrary (Arbitrary (..))
+
+newtype Bytes = Bytes LBS.ByteString
+    deriving (Eq, Show, Read, Generic)
+
+instance MessagePack Bytes
+
+instance Binary Bytes where
+    get = Bytes <$> Get.getRemainingLazyByteString
+    put (Bytes bs) = Put.putLazyByteString bs
+
+instance Arbitrary Bytes where
+    arbitrary = Bytes . LBS.pack <$> arbitrary
+
+\end{code}
diff --git a/src/Network/Tox/SaveData/Conferences.lhs b/src/Network/Tox/SaveData/Conferences.lhs
@@ -19,7 +19,6 @@ import           GHC.Generics              (Generic)
 import           Network.Tox.Crypto.Key    (PublicKey)
 import qualified Network.Tox.SaveData.Util as Util
 import           Test.QuickCheck.Arbitrary (Arbitrary (..), genericShrink)
-import qualified Test.QuickCheck.Arbitrary as Arbitrary
 
 \end{code}
 
@@ -72,7 +71,7 @@ maxTitleLen = 128
 
 data Conference = Conference
     { conferenceType     :: Word8
-    , conferenceId       :: BS.ByteString
+    , conferenceId       :: PublicKey
     , messageNumber      :: Word32
     , lossyMessageNumber :: Word16
     , selfPeerNumber     :: Word16
@@ -86,7 +85,7 @@ instance MessagePack Conference
 instance Binary Conference where
     get = do
         conferenceType     <- Get.getWord8
-        conferenceId       <- Get.getByteString 32
+        conferenceId       <- get
         messageNumber      <- Get.getWord32le
         lossyMessageNumber <- Get.getWord16le
         selfPeerNumber     <- Get.getWord16le
@@ -98,7 +97,7 @@ instance Binary Conference where
 
     put Conference{..} = do
         Put.putWord8      conferenceType
-        Put.putByteString conferenceId
+        put               conferenceId
         Put.putWord32le   messageNumber
         Put.putWord16le   lossyMessageNumber
         Put.putWord16le   selfPeerNumber
@@ -111,7 +110,7 @@ instance Binary Conference where
 instance Arbitrary Conference where
     arbitrary = Conference
         <$> arbitrary
-        <*> (BS.pack <$> Arbitrary.vector 32)
+        <*> arbitrary
         <*> arbitrary
         <*> arbitrary
         <*> arbitrary