From 29d91794c2d2810136df4d265714a0157dbdf6a4 Mon Sep 17 00:00:00 2001 From: iphydf Date: Tue, 7 Nov 2023 18:38:33 +0000 Subject: [PATCH] feat: Add new group chats savedata support. --- BUILD.bazel | 2 + src/Network/Tox/Binary.hs | 12 +- src/Network/Tox/Crypto/Key.lhs | 54 +++--- src/Network/Tox/DHT/ClientList.lhs | 2 +- src/Network/Tox/DHT/KBuckets.lhs | 2 +- src/Network/Tox/DHT/Operation.lhs | 2 +- src/Network/Tox/SaveData.lhs | 31 ++-- src/Network/Tox/SaveData/Bytes.lhs | 34 ++++ src/Network/Tox/SaveData/Conferences.lhs | 2 +- src/Network/Tox/SaveData/Groups.lhs | 223 +++++++++++++++++++++++ src/Network/Tox/TypeName.hs | 15 ++ test/Network/Tox/Crypto/KeySpec.hs | 5 +- test/Network/Tox/EncodingSpec.hs | 2 +- tools/toxsave-convert.hs | 3 +- tools/toxsave-test.hs | 5 +- toxcore.cabal | 5 + 16 files changed, 338 insertions(+), 61 deletions(-) create mode 100644 src/Network/Tox/SaveData/Bytes.lhs create mode 100644 src/Network/Tox/SaveData/Groups.lhs create mode 100644 src/Network/Tox/TypeName.hs diff --git a/BUILD.bazel b/BUILD.bazel index d9a0add7..e2d16c86 100644 --- a/BUILD.bazel +++ b/BUILD.bazel @@ -14,7 +14,9 @@ haskell_library( 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", diff --git a/src/Network/Tox/Binary.hs b/src/Network/Tox/Binary.hs index 19754104..76f41378 100644 --- 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 index f3644071..de4ec9f5 100644 --- 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 index 57a1bba7..18cd7a57 100644 --- 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 index 98f788c3..48eb7390 100644 --- 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 index a9b09cd0..9f347465 100644 --- 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 index 65ca4933..d49dde93 100644 --- a/src/Network/Tox/SaveData.lhs +++ b/src/Network/Tox/SaveData.lhs @@ -36,9 +36,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 +128,7 @@ Section types: Name & 0x04 \\ StatusMessage & 0x05 \\ Status & 0x06 \\ + Groups & 0x07 \\ TcpRelays & 0x0A \\ PathNodes & 0x0B \\ Conferences & 0x14 \\ @@ -147,6 +152,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 +175,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 +277,7 @@ data Section | SectionName Bytes | SectionStatusMessage Bytes | SectionStatus Word8 + | SectionGroups Groups | SectionTcpRelays Nodes | SectionPathNodes Nodes | SectionConferences Conferences @@ -286,6 +294,7 @@ instance Arbitrary Section where , SectionName <$> arbitrary , SectionStatusMessage <$> arbitrary , SectionStatus <$> arbitrary + , SectionGroups <$> arbitrary , SectionTcpRelays <$> arbitrary , SectionPathNodes <$> arbitrary , SectionConferences <$> arbitrary @@ -313,10 +322,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 +343,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 new file mode 100644 index 00000000..78886092 --- /dev/null +++ b/src/Network/Tox/SaveData/Bytes.lhs @@ -0,0 +1,34 @@ +\subsection{Bytes} + +Arbitrary byte array. + +\begin{code} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} +module Network.Tox.SaveData.Bytes + ( Bytes (..) + ) where + +import Data.Binary (Binary (..)) +import Data.Binary.Get (Get) +import qualified Data.Binary.Get as Get +import Data.Binary.Put (Put) +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 index 29a0c88f..92d2a796 100644 --- a/src/Network/Tox/SaveData/Conferences.lhs +++ b/src/Network/Tox/SaveData/Conferences.lhs @@ -18,8 +18,8 @@ import Data.Word (Word16, Word32, Word64, Word8) 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 +import Test.QuickCheck.Arbitrary (Arbitrary (..), genericShrink) \end{code} diff --git a/src/Network/Tox/SaveData/Groups.lhs b/src/Network/Tox/SaveData/Groups.lhs new file mode 100644 index 00000000..30105307 --- /dev/null +++ b/src/Network/Tox/SaveData/Groups.lhs @@ -0,0 +1,223 @@ +\subsection{Groups (0x14)} + +This section contains a list of saved conferences. + +\begin{code} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} +module Network.Tox.SaveData.Groups where + +import qualified Crypto.Saltine.Class as Sodium (encode) +import Data.Binary (Binary (..)) +import qualified Data.Binary.Get as Get +import qualified Data.Binary.Put as Put +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as Base16 +import Data.MessagePack (MessagePack (..), defaultConfig, + toObject) +import Data.MessagePack.Arbitrary () +import Data.MessagePack.Types (Object, fromObject) +import Data.Word (Word16, Word32, Word64, Word8) +import GHC.Generics (Generic) +import Network.Tox.Crypto.Key (PublicKey, Signature) +import qualified Network.Tox.SaveData.Util as Util +import qualified Test.QuickCheck.Arbitrary as Arbitrary +import Test.QuickCheck.Arbitrary (Arbitrary (..), genericShrink) + +\end{code} + +\begin{tabular}{l|l} + Length & Contents \\ + \hline + \texttt{?} & List of conferences \\ +\end{tabular} + +\begin{code} + +newtype Groups = Groups [Group] + deriving (Eq, Show, Read, Generic, Arbitrary) + +instance MessagePack Groups + +instance Binary Groups where + get = do + obj <- get + fromObject obj + + put gs = put $ toObject defaultConfig gs + +\end{code} + +Group: + +\begin{tabular}{l|l} + Length & Contents \\ + \hline + \texttt{1} & \texttt{uint8\_t} Groupchat type \\ + \texttt{32} & Groupchat id \\ + \texttt{4} & \texttt{uint32\_t} Message number \\ + \texttt{2} & \texttt{uint16\_t} Lossy message number \\ + \texttt{2} & \texttt{uint16\_t} Peer number \\ + \texttt{4} & \texttt{uint32\_t} Number of peers \\ + \texttt{1} & \texttt{uint8\_t} Title length \\ + \texttt{?} & Title \\ + \texttt{?} & List of peers \\ +\end{tabular} + +All peers other than the saver are saved, including frozen peers. On reload, +they all start as frozen. + +\begin{code} + +data Group = Group + { groupStateValues :: StateValues + , groupStateBin :: StateBin + , groupTopicInfo :: TopicInfo + , groupModList :: ModList + , groupKeys :: Keys + , groupSelfInfo :: SelfInfo + , groupSavedPeers :: (Int, BS.ByteString) + } deriving (Eq, Show, Read, Generic) + +instance MessagePack Group + +instance Arbitrary Group where + arbitrary = Group + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> pure (0, BS.empty) + +data StateValues = StateValues + { connectionState :: Bool + , groupNameLen :: Word16 + , privacyState :: Word8 + , maxPeers :: Word16 + , passwordLength :: Word16 + , version :: Word32 + , topicLock :: Word32 + , voiceState :: Word8 + } deriving (Eq, Show, Read, Generic) + +instance MessagePack StateValues + +instance Arbitrary StateValues where + arbitrary = StateValues + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +data StateBin = StateBin + { signature :: Signature + , founderPublicKey :: Signature + , groupName :: BS.ByteString + , password :: BS.ByteString + , modListHash :: PublicKey + } deriving (Eq, Show, Read, Generic) + +instance MessagePack StateBin + +instance Arbitrary StateBin where + arbitrary = StateBin + <$> arbitrary + <*> arbitrary + <*> (BS.pack <$> (Arbitrary.vector =<< arbitrary)) + <*> (BS.pack <$> (Arbitrary.vector =<< arbitrary)) + <*> arbitrary + +data TopicInfo = TopicInfo + { topicVersion :: Word32 + , topicLength :: Word16 + , topicChecksum :: Word8 + , topic :: BS.ByteString + , topicPublicKey :: PublicKey + , topicSignature :: Signature + } deriving (Eq, Show, Read, Generic) + +instance MessagePack TopicInfo + +instance Arbitrary TopicInfo where + arbitrary = TopicInfo + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> (BS.pack <$> (Arbitrary.vector =<< arbitrary)) + <*> arbitrary + <*> arbitrary + +data ModList = ModList + { modList :: [PublicKey] + } deriving (Eq, Show, Read, Generic) + +instance MessagePack ModList where + toObject cfg (ModList mods) = toObject cfg $ (length mods, BS.concat $ map Sodium.encode mods) + fromObjectWith cfg obj = do + -- (len, catMods) <- fromObjectWith cfg obj + return $ ModList [] + +instance Arbitrary ModList where + arbitrary = ModList + <$> arbitrary + +data Keys = Keys + { chatPublicKey :: Signature + , chatSecretKey :: BS.ByteString + , selfPublicKey :: Signature + , selfSecretKey :: BS.ByteString + } deriving (Eq, Show, Read, Generic) + +instance MessagePack Keys + +instance Arbitrary Keys where + arbitrary = Keys + <$> arbitrary + <*> (BS.pack <$> Arbitrary.vector 96) + <*> arbitrary + <*> (BS.pack <$> Arbitrary.vector 96) + +data SelfInfo = SelfInfo + { selfNickLength :: Word16 + , selfRole :: Word8 + , selfStatus :: Word8 + , selfNick :: BS.ByteString + } deriving (Eq, Show, Read, Generic) + +instance MessagePack SelfInfo + +instance Arbitrary SelfInfo where + arbitrary = do + nick <- BS.pack <$> (Arbitrary.vector =<< arbitrary) + SelfInfo + <$> (pure . fromIntegral . BS.length $ nick) + <*> arbitrary + <*> arbitrary + <*> pure nick + +\end{code} + +Peer: + +\begin{tabular}{l|l} + Length & Contents \\ + \hline + \texttt{32} & Long term public key \\ + \texttt{32} & DHT public key \\ + \texttt{2} & \texttt{uint16\_t} Peer number \\ + \texttt{8} & \texttt{uint64\_t} Last active timestamp \\ + \texttt{1} & \texttt{uint8\_t} Name length \\ + \texttt{?} & Name \\ +\end{tabular} + +\begin{code} + +\end{code} diff --git a/src/Network/Tox/TypeName.hs b/src/Network/Tox/TypeName.hs new file mode 100644 index 00000000..7e111aef --- /dev/null +++ b/src/Network/Tox/TypeName.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} +module Network.Tox.TypeName + ( typeName + ) where + +import Data.Kind (Type) +import Data.Typeable (Typeable) +import qualified Data.Typeable as Typeable + + +typeName :: Typeable (a :: Type) => proxy a -> String +typeName (_ :: proxy a) = + show . Typeable.typeOf $ (undefined :: a) diff --git a/test/Network/Tox/Crypto/KeySpec.hs b/test/Network/Tox/Crypto/KeySpec.hs index ac84ac56..1e3d3159 100644 --- a/test/Network/Tox/Crypto/KeySpec.hs +++ b/test/Network/Tox/Crypto/KeySpec.hs @@ -20,6 +20,7 @@ import qualified Network.Tox.Binary as Binary import Network.Tox.Crypto.Key (Key (..)) import qualified Network.Tox.Crypto.Key as Key import Network.Tox.EncodingSpec +import Network.Tox.TypeName (typeName) import qualified Text.Read as Read @@ -45,7 +46,7 @@ localEncodingSpec :: (Typeable a, Read a, Show a, Binary a, Arbitrary a, Eq a) => Proxy a -> Spec localEncodingSpec proxy = - describe (Binary.typeName proxy) $ do + describe (typeName proxy) $ do binarySpec proxy readShowSpec proxy @@ -77,7 +78,7 @@ spec = do let actual = readMaybe "" actual `shouldBe` Nothing case runValidate $ decodeM ByteString.empty of - Left msg -> errorMessages msg `shouldBe` ["unable to decode ByteString to Key"] + Left msg -> errorMessages msg `shouldBe` ["unable to decode ByteString to Key: 0"] Right val -> expectationFailure $ "unexpected success: " ++ show val it "decodes valid hex string of wrong length to Nothing" $ diff --git a/test/Network/Tox/EncodingSpec.hs b/test/Network/Tox/EncodingSpec.hs index 4849a6ce..07f60204 100644 --- a/test/Network/Tox/EncodingSpec.hs +++ b/test/Network/Tox/EncodingSpec.hs @@ -15,8 +15,8 @@ module Network.Tox.EncodingSpec import Data.MessagePack (MessagePack) import Test.Hspec -import Test.QuickCheck (Arbitrary) import qualified Test.QuickCheck as QC +import Test.QuickCheck (Arbitrary) import Data.Binary (Binary) import qualified Data.Binary as Binary (get, put) diff --git a/tools/toxsave-convert.hs b/tools/toxsave-convert.hs index e0af5cd4..dbffa883 100644 --- a/tools/toxsave-convert.hs +++ b/tools/toxsave-convert.hs @@ -4,12 +4,13 @@ import qualified Data.Binary as Binary import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as LBS8 import Network.Tox.SaveData (SaveData) +import Text.Groom (groom) import Text.Read (readMaybe) parse :: LBS.ByteString -> LBS.ByteString parse str = maybe - (LBS8.pack . (++ "\n") . show $ (Binary.decode str :: SaveData)) + (LBS8.pack . (++ "\n") . groom $ (Binary.decode str :: SaveData)) Binary.encode (readMaybe $ LBS8.unpack str :: Maybe SaveData) diff --git a/tools/toxsave-test.hs b/tools/toxsave-test.hs index ba5371cd..d0459d7c 100644 --- a/tools/toxsave-test.hs +++ b/tools/toxsave-test.hs @@ -50,11 +50,12 @@ prop_Save save = monadicIO $ do tox_options_set_savedata_data opts saveData (fromIntegral saveLenInt) tox_options_set_log_callback opts =<< wrapLogCb logHandler tox <- tox_new opts nullPtr + let isNull = tox == nullPtr tox_kill tox tox_options_free opts - return $ tox /= nullPtr + return $ not isNull assert ok main :: IO () -main = quickCheckWith stdArgs{maxSuccess=100, maxSize=30} prop_Save +main = quickCheckWith stdArgs{maxSuccess=1000, maxSize=50} prop_Save diff --git a/toxcore.cabal b/toxcore.cabal index 5fea9cd0..261537c9 100644 --- a/toxcore.cabal +++ b/toxcore.cabal @@ -68,14 +68,17 @@ library Network.Tox.Protocol.Packet Network.Tox.Protocol.PacketKind Network.Tox.SaveData + Network.Tox.SaveData.Bytes Network.Tox.SaveData.Conferences Network.Tox.SaveData.DHT Network.Tox.SaveData.Friend + Network.Tox.SaveData.Groups Network.Tox.SaveData.Nodes Network.Tox.SaveData.Util Network.Tox.Time Network.Tox.Timed Network.Tox.TimedT + Network.Tox.TypeName build-depends: base <5 @@ -90,7 +93,9 @@ library , lens-family , monad-validate , MonadRandom + , msgpack-arbitrary , msgpack-binary >=0.0.12 + , msgpack-types , mtl , network , QuickCheck >=2.9.1