Files
simplexmq/tests/CoreTests/ProtocolErrorTests.hs
Alexander Bondarenko 1a8dfb4cbe agent: xrcp implementation for connection via link (no multicast) (#884)
* WIP: start working on connection invites

startSession/OOB is broken now - the port isn't coming from the actualy assigned one.

* Add invite types

* clean old invite-related types

* apply renames

* Move SessionKeys from Invitation

* Stub host-side keys and handle

* move keys and handles to Types

* add Simplex.RemoteControl.Client

* more keys

* progress

* crypto for sessions

* progress to multicast

* multicast crypto

* add RC TLS server

* agent api for remote control

* WIP: tls client

* fix test

* update encoding to include nonce

* add TODO

* update

* Use network-info to find TransportHost

* request and submit tls client certificate

* WIP: add missing bits for testing RC client

* RCEncryptedHello encoding

* add block encoding

* refactor

* validate known host certificate

* remove some spaghetti

* functional API to host/ctrl clients

* refactor connectRCCtrl_

* refactor connectRCHost

* question

* add type

* fix RC session

* update doc

* update doc 2

* add block on confirmation

* remove unused parameter

* export CtrlSessKeys

* export

* fix parsing

* move test of xrcp handshake

* move KEM to HELLO step

* fix JSON

* type

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
2023-11-07 13:05:18 +00:00

88 lines
2.8 KiB
Haskell

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module CoreTests.ProtocolErrorTests where
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import GHC.Generics (Generic)
import Generic.Random (genericArbitraryU)
import Simplex.FileTransfer.Protocol (XFTPErrorType (..))
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (CommandError (..), ErrorType (..))
import Simplex.Messaging.Transport (HandshakeError (..), TransportError (..))
import Simplex.RemoteControl.Types (RCErrorType (..))
import Test.Hspec
import Test.Hspec.QuickCheck (modifyMaxSuccess)
import Test.QuickCheck
protocolErrorTests :: Spec
protocolErrorTests = modifyMaxSuccess (const 1000) $ do
describe "errors parsing / serializing" $ do
it "should parse SMP protocol errors" . property $ \(err :: ErrorType) ->
smpDecode (smpEncode err) == Right err
it "should parse SMP agent errors" . property $ \(err :: AgentErrorType) ->
errHasSpaces err
|| strDecode (strEncode err) == Right err
where
errHasSpaces = \case
BROKER srv (RESPONSE e) -> hasSpaces srv || hasSpaces e
BROKER srv _ -> hasSpaces srv
_ -> False
hasSpaces s = ' ' `B.elem` encodeUtf8 (T.pack s)
deriving instance Generic AgentErrorType
deriving instance Generic CommandErrorType
deriving instance Generic ConnectionErrorType
deriving instance Generic BrokerErrorType
deriving instance Generic SMPAgentError
deriving instance Generic AgentCryptoError
deriving instance Generic ErrorType
deriving instance Generic CommandError
deriving instance Generic TransportError
deriving instance Generic HandshakeError
deriving instance Generic XFTPErrorType
deriving instance Generic RCErrorType
instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU
instance Arbitrary CommandErrorType where arbitrary = genericArbitraryU
instance Arbitrary ConnectionErrorType where arbitrary = genericArbitraryU
instance Arbitrary BrokerErrorType where arbitrary = genericArbitraryU
instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU
instance Arbitrary AgentCryptoError where arbitrary = genericArbitraryU
instance Arbitrary ErrorType where arbitrary = genericArbitraryU
instance Arbitrary CommandError where arbitrary = genericArbitraryU
instance Arbitrary TransportError where arbitrary = genericArbitraryU
instance Arbitrary HandshakeError where arbitrary = genericArbitraryU
instance Arbitrary XFTPErrorType where arbitrary = genericArbitraryU
instance Arbitrary RCErrorType where arbitrary = genericArbitraryU