Skip to content

Commit

Permalink
feat: Add toxsave quickcheck test.
Browse files Browse the repository at this point in the history 
Also upgrade saltine (libsodium) to the latest version.
  • Loading branch information
@iphydf
iphydf committed Sep 1, 2023
1 parent e95aa56 commit 51580cb
Show file tree
Hide file tree
Showing 10 changed files with 273 additions and 207 deletions.
2 changes: 2 additions & 0 deletions netlify.toml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@ command = """\
mv .git res src test website/hs-toxcore && \
cd website && \
make spec && \
gem update --system && \
gem install --no-document sass-embedded -v 1.63.6 && \
gem install --no-document jekyll guard-livereload && \
make toktok-site \
"""
Expand Down
12 changes: 6 additions & 6 deletions src/Data/Binary/Bits/Get.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -476,13 +476,13 @@ shiftl_w32 :: Word32 -> Int -> Word32
shiftl_w64 :: Word64 -> Int -> Word64

#if !defined(__HADDOCK__)
shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftLWord8#` i)
shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftLWord16#` i)
shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftLWord32#` i)

shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRLWord8#` i)
shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRLWord16#` i)
shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRLWord32#` i)


#if WORD_SIZE_IN_BITS < 64
Expand Down
44 changes: 21 additions & 23 deletions src/Network/Tox/Crypto/Box.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,27 +20,25 @@ module Network.Tox.Crypto.Box
, encrypt
) where
import Control.Monad.Validate (MonadValidate (..))
import qualified Crypto.Saltine.Core.Box as Sodium (boxAfterNM,
boxOpenAfterNM)
import qualified Crypto.Saltine.Internal.ByteSizes as ByteSizes
import Data.Binary (Binary, get, put)
import Data.Binary.Get (Decoder (..), pushChunk,
runGetIncremental)
import Data.Binary.Put (runPut)
import Data.ByteString (ByteString)
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.Typeable (Typeable)
import GHC.Generics (Generic)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Text.Read (readPrec)
import Network.Tox.Crypto.Key (CombinedKey, Key (..),
Nonce)
import Control.Monad.Validate (MonadValidate (..))
import qualified Crypto.Saltine.Core.Box as Sodium (boxAfterNM,
boxOpenAfterNM)
import qualified Crypto.Saltine.Internal.Box as Sodium
import Data.Binary (Binary, get, put)
import Data.Binary.Get (Decoder (..), pushChunk,
runGetIncremental)
import Data.Binary.Put (runPut)
import Data.ByteString (ByteString)
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.Typeable (Typeable)
import GHC.Generics (Generic)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Text.Read (readPrec)
import Network.Tox.Crypto.Key (CombinedKey, Key (..), Nonce)
{-------------------------------------------------------------------------------
Expand Down Expand Up @@ -82,8 +80,8 @@ newtype CipherText = CipherText { unCipherText :: ByteString }
cipherText :: MonadValidate DecodeError m => ByteString -> m CipherText
cipherText bs
| ByteString.length bs >= ByteSizes.boxMac = return $ CipherText bs
| otherwise = refute "ciphertext is too short"
| ByteString.length bs >= Sodium.box_macbytes = return $ CipherText bs
| otherwise = refute "ciphertext is too short"
instance Binary CipherText where
put = put . unCipherText
Expand Down
56 changes: 27 additions & 29 deletions src/Network/Tox/Crypto/Key.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,31 +12,29 @@
{-# LANGUAGE Trustworthy #-}
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.ByteSizes as Sodium (boxBeforeNM,
boxNonce, boxPK,
boxSK)
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.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)
{-------------------------------------------------------------------------------
Expand Down Expand Up @@ -77,10 +75,10 @@ Tox uses four kinds of Crypto Numbers:

\begin{code}
instance CryptoNumber Sodium.PublicKey where { encodedByteSize _ = Sodium.boxPK }
instance CryptoNumber Sodium.SecretKey where { encodedByteSize _ = Sodium.boxSK }
instance CryptoNumber Sodium.CombinedKey where { encodedByteSize _ = Sodium.boxBeforeNM }
instance CryptoNumber Sodium.Nonce where { encodedByteSize _ = Sodium.boxNonce }
instance CryptoNumber Sodium.PublicKey where { encodedByteSize _ = Sodium.box_publickeybytes }
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 }
deriving instance Typeable Sodium.PublicKey
deriving instance Typeable Sodium.SecretKey
Expand Down
5 changes: 3 additions & 2 deletions src/Network/Tox/Crypto/KeyPair.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,8 @@ standard group element and the Secret Key. See the
module Network.Tox.Crypto.KeyPair where
import qualified Crypto.Saltine.Class as Sodium (decode, encode)
import qualified Crypto.Saltine.Core.Box as Sodium (newKeypair)
import qualified Crypto.Saltine.Core.Box as Sodium (Keypair (..),
newKeypair)
import qualified Crypto.Saltine.Core.ScalarMult as Sodium (multBase)
import Data.Binary (Binary)
import Data.MessagePack (MessagePack (..))
Expand Down Expand Up @@ -51,7 +52,7 @@ instance MessagePack KeyPair
newKeyPair :: IO KeyPair
newKeyPair = do
(sk, pk) <- Sodium.newKeypair
Sodium.Keypair sk pk <- Sodium.newKeypair
return $ KeyPair (Key sk) (Key pk)
Expand Down
4 changes: 2 additions & 2 deletions src/Network/Tox/Time.hs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
{-# LANGUAGE Safe #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE Trustworthy #-}
module Network.Tox.Time where

import qualified System.Clock as Clock
Expand Down
7 changes: 4 additions & 3 deletions stack.yaml
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,9 @@
---
packages: [.]
resolver: lts-18.18
resolver: lts-20.9
extra-deps:
- monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
- msgpack-arbitrary-0.1.0@sha256:449b21af020b6667b52851df6f2066ef1b36fa06ad19429d62562b4d92711c5b,1648
- msgpack-arbitrary-0.1.3
- msgpack-binary-0.0.16
- msgpack-types-0.3.0
- msgpack-types-0.3.2
- saltine-0.2.1.0
14 changes: 14 additions & 0 deletions tools/BUILD.bazel
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,3 +12,17 @@ haskell_binary(
hazel_library("groom"),
],
)

haskell_binary(
name = "toxsave-test",
srcs = ["toxsave-test.hs"],
compiler_flags = ["-optl=-fsanitize=address"],
deps = [
"//c-toxcore",
"//hs-toxcore",
hazel_library("QuickCheck"),
hazel_library("base"),
hazel_library("binary"),
hazel_library("bytestring"),
],
)
60 changes: 60 additions & 0 deletions tools/toxsave-test.hs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,60 @@
module Main (main) where

import qualified Data.Binary as Binary
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Foreign.C.String (CString, peekCString)
import Foreign.C.Types (CInt (..), CSize (..))
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Network.Tox.SaveData (SaveData)
import Test.QuickCheck (Args (..), Property, quickCheckWith,
stdArgs)
import Test.QuickCheck.Monadic (assert, monadicIO, run)

foreign import ccall tox_options_new :: Ptr () -> IO (Ptr ())
foreign import ccall tox_options_free :: Ptr () -> IO ()

foreign import ccall tox_options_set_savedata_type :: Ptr () -> CInt -> IO ()
foreign import ccall tox_options_set_savedata_data :: Ptr () -> CString -> CSize -> IO ()

foreign import ccall tox_new :: Ptr () -> Ptr () -> IO (Ptr ())
foreign import ccall tox_kill :: Ptr () -> IO ()

type LogCb = Ptr () -> CInt -> CString -> CInt -> CString -> CString -> Ptr () -> IO ()
foreign import ccall tox_options_set_log_callback :: Ptr () -> FunPtr LogCb -> IO ()
foreign import ccall "wrapper" wrapLogCb :: LogCb -> IO (FunPtr LogCb)

logLevelName :: CInt -> Char
logLevelName 0 = 'T'
logLevelName 1 = 'D'
logLevelName 2 = 'I'
logLevelName 3 = 'W'
logLevelName 4 = 'E'
logLevelName _ = '?'

logHandler :: LogCb
logHandler _ cLevel cFile line cFunc cMsg _ = do
file <- peekCString cFile
func <- peekCString cFunc
msg <- peekCString cMsg
case cLevel of
0 -> return ()
_ -> putStrLn $ logLevelName cLevel : ' ' : file <> ":" <> show line <> "(" <> func <> "): " <> msg

prop_Save :: SaveData -> Property
prop_Save save = monadicIO $ do
ok <- run $ BS.useAsCStringLen (LBS.toStrict (Binary.encode save)) $ \(saveData, saveLenInt) -> do
putStrLn $ "\nsavedata size: " <> show saveLenInt
opts <- tox_options_new nullPtr
tox_options_set_savedata_type opts 1
tox_options_set_savedata_data opts saveData (fromIntegral saveLenInt)
tox_options_set_log_callback opts =<< wrapLogCb logHandler
tox <- tox_new opts nullPtr
tox_kill tox
tox_options_free opts
return $ tox /= nullPtr
assert ok


main :: IO ()
main = quickCheckWith stdArgs{maxSuccess=100, maxSize=30} prop_Save
Loading

0 comments on commit 51580cb

Please sign in to comment.