diff --git a/BUILD.bazel b/BUILD.bazel index d9a0add7..93a5749d 100644 --- 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 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..96b5b89b 100644 --- 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 new file mode 100644 index 00000000..3665c7b9 --- /dev/null +++ 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 index 29a0c88f..2d3b1411 100644 --- 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 diff --git a/src/Network/Tox/SaveData/Groups.lhs b/src/Network/Tox/SaveData/Groups.lhs new file mode 100644 index 00000000..5a447b6f --- /dev/null +++ b/src/Network/Tox/SaveData/Groups.lhs @@ -0,0 +1,238 @@ +\subsection{Groups (0x14)} + +This section contains a list of saved conferences. + +\begin{code} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} +module Network.Tox.SaveData.Groups where + +import Control.Monad.Validate (refute) +import qualified Crypto.Saltine.Class as Sodium (decode, encode) +import Data.Binary (Binary (..)) +import qualified Data.ByteString as BS +import Data.MessagePack (MessagePack (..), defaultConfig, + toObject) +import Data.MessagePack.Arbitrary () +import Data.MessagePack.Types (fromObject) +import Data.Word (Word16, Word32, Word8) +import GHC.Generics (Generic) +import Network.Tox.Crypto.Key (PublicKey, Signature) +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) + shrink = genericShrink + +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 + shrink = genericShrink + +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 + shrink = genericShrink + +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 + shrink = genericShrink + +newtype 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 + case splitMods len catMods of + Just mods -> return $ ModList mods + Nothing -> refute "mod list decoding failed" + where + splitMods :: Word8 -> BS.ByteString -> Maybe [PublicKey] + splitMods 0 _ = Just [] + splitMods len catMods = do + let (modKey, rest) = BS.splitAt 32 catMods + (:) <$> Sodium.decode modKey <*> splitMods (len - 1) rest + +instance Arbitrary ModList where + arbitrary = ModList + <$> arbitrary + shrink = genericShrink + +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) + shrink = genericShrink + +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 + shrink = genericShrink + +\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..5e8ab7b4 100644 --- a/test/Network/Tox/Crypto/KeySpec.hs +++ b/test/Network/Tox/Crypto/KeySpec.hs @@ -16,10 +16,10 @@ import qualified Data.ByteString as ByteString import Data.MessagePack (DecodeError, errorMessages) import Data.Proxy (Proxy (..)) import Data.Typeable (Typeable) -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 +45,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 +77,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/BUILD.bazel b/tools/BUILD.bazel index 0cc63472..41b60209 100644 --- a/tools/BUILD.bazel +++ b/tools/BUILD.bazel @@ -1,8 +1,9 @@ -load("@rules_haskell//haskell:defs.bzl", "haskell_binary") +load("@rules_haskell//haskell:defs.bzl", "haskell_binary", "haskell_test") haskell_binary( name = "toxsave-convert", srcs = ["toxsave-convert.hs"], + visibility = ["//tools/haskell:__pkg__"], deps = [ "//hs-toxcore", "//third_party/haskell:base", @@ -12,10 +13,11 @@ haskell_binary( ], ) -haskell_binary( +haskell_test( name = "toxsave-test", srcs = ["toxsave-test.hs"], - compiler_flags = ["-optl=-fsanitize=address"], + ghcopts = ["-optl=-fsanitize=address"], + visibility = ["//tools/haskell:__pkg__"], deps = [ "//c-toxcore", "//hs-toxcore", 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..289ec766 100644 --- a/tools/toxsave-test.hs +++ b/tools/toxsave-test.hs @@ -50,9 +50,10 @@ 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 diff --git a/toxcore.cabal b/toxcore.cabal index 5fea9cd0..6c512579 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 @@ -107,6 +112,7 @@ executable toxsave-convert base <5 , binary , bytestring + , groom , text , toxcore diff --git a/web/BUILD.bazel b/web/BUILD.bazel index 57574ecd..8bd6b7c9 100644 --- a/web/BUILD.bazel +++ b/web/BUILD.bazel @@ -1,7 +1,5 @@ load("@rules_haskell//haskell:defs.bzl", "haskell_binary") -package(features = ["-layering_check"]) - haskell_binary( name = "webservice", srcs = glob(["**/*.hs"]),