hwormhole-0.1.0.0: tests/MessagesTests.hs

{-# LANGUAGE OverloadedStrings #-}
module MessagesTests
  ( tests
  , messagesRoundTripTests
  )
where

import Protolude

import qualified Data.Set as Set

import Transit.Internal.Messages

import Test.Hspec
import Data.Aeson
  ( encode
  , decode
  , eitherDecode
  )
import Hedgehog (forAll, property, Property, Group(..), checkSequential, tripping)
import qualified Generator

tests :: IO ()
tests = hspec $ do
  describe "Ability tests" $ do
    it "encode Ability" $ do
      encode DirectTcpV1 `shouldBe` "\"direct-tcp-v1\""
      encode RelayV1 `shouldBe` "\"relay-v1\""
    it "decode Ability" $ do
      let s1 = "\"direct-tcp-v1\"" :: Text
      decode (toS s1) `shouldBe` Just DirectTcpV1
      let s2 = "\"relay-v1\"" :: Text
      decode (toS s2) `shouldBe` Just RelayV1
  describe "Hint tests" $ do
    it "encode Hint" $ do
      let h1 = Hint { ctype = DirectTcpV1
                    , priority = 0.5
                    , hostname = "foo.bar.baz"
                    , port = 1234 }
      encode h1 `shouldBe` "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}"
    it "decode Hint" $ do
      let h1 = "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}" :: Text
      decode (toS h1) `shouldBe` Just Hint { ctype = DirectTcpV1
                                           , priority = 0.5
                                           , hostname = "foo.bar.baz"
                                           , port = 1234 }
  describe "ConnectionHint tests" $ do
    it "encode Direct ConnectionHint" $ do
      let h1 = Hint { ctype = DirectTcpV1
                    , priority = 0.5
                    , hostname = "foo.bar.baz"
                    , port = 1234 }
          ch1 = Direct h1
      encode ch1 `shouldBe` "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}"
    it "encode Relay ConnectionHint" $ do
      let h1 = Hint { ctype = DirectTcpV1
                    , priority = 0.5
                    , hostname = "foo.bar.baz"
                    , port = 1234 }
          ch1 = Relay { rtype = RelayV1
                      , hints = [h1] }
      encode ch1 `shouldBe` "{\"hints\":[{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}],\"type\":\"relay-v1\"}"
    it "decode Direct ConnectionHint" $ do
      let h1text = "{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}" :: Text
      decode (toS h1text) `shouldBe`  Just (Direct Hint { ctype = DirectTcpV1
                                                        , priority = 0.5
                                                        , hostname = "foo.bar.baz"
                                                        , port = 1234 })
    it "decode Relay ConnectionHint" $ do
      let h1text = "{\"type\": \"relay-v1\", \"hints\": [{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}]}" :: Text
          h1 = Hint { ctype = DirectTcpV1
                    , priority = 0.5
                    , hostname = "foo.bar.baz"
                    , port = 1234 }
      decode (toS h1text) `shouldBe` Just Relay { rtype = RelayV1
                                                , hints = [h1] }

    it "encode and decode Transit type" $ do
      let t1 = Transit { abilitiesV1 = [Ability DirectTcpV1, Ability RelayV1]
                       , hintsV1 = Set.fromList [ch1, ch2] }
          h1 = Hint { ctype = DirectTcpV1
                    , priority = 0.5
                    , hostname = "foo.bar.baz"
                    , port = 1234 }
          ch1 = Direct h1
          h2 = Hint { ctype = DirectTcpV1
                    , priority = 0.5
                    , hostname = "foo.bar.baz"
                    , port = 1234 }
          ch2 = Relay { rtype = RelayV1
                      , hints = [h2] }
          h3 = Hint { ctype = DirectTcpV1
                    , priority = 0.0
                    , hostname = "192.168.1.106"
                    , port = 36097 }
          ch3 = Direct h3
          h4 = Hint { ctype = DirectTcpV1
                    , priority = 0.0
                    , hostname = "transit.magic-wormhole.io"
                    , port = 4001 }
          ch4 = Relay { rtype = RelayV1
                      , hints = [h4] }
          t2 = Transit { abilitiesV1 = [Ability DirectTcpV1, Ability RelayV1]
                       , hintsV1 = Set.fromList [ch3 ,ch4] }
          t1text = "{\"transit\":{\"hints-v1\":[{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234},{\"hints\":[{\"hostname\":\"foo.bar.baz\",\"priority\":0.5,\"type\":\"direct-tcp-v1\",\"port\":1234}],\"type\":\"relay-v1\"}],\"abilities-v1\":[{\"type\":\"direct-tcp-v1\"},{\"type\":\"relay-v1\"}]}}" :: Text
          t2text = "{\"transit\": {\"abilities-v1\": [{\"type\": \"direct-tcp-v1\"}, {\"type\": \"relay-v1\"}], \"hints-v1\": [{\"priority\": 0.0, \"hostname\": \"192.168.1.106\", \"type\": \"direct-tcp-v1\", \"port\": 36097}, {\"type\": \"relay-v1\", \"hints\": [{\"priority\": 0.0, \"hostname\": \"transit.magic-wormhole.io\", \"type\": \"direct-tcp-v1\", \"port\": 4001}]}]}}" :: ByteString
      encode t1 `shouldBe` toS t1text
      decode (encode t1) `shouldBe` Just t1
      decode (toS t2text) `shouldBe` Just t2

  describe "Ack message tests" $ do
    it "encode and decode FileAck responses" $ do
      let f1 = FileAck "ok"
      encode f1 `shouldBe` "{\"file_ack\":\"ok\"}"
      decode (encode f1) `shouldBe` Just f1

  describe "Response message tests" $ do
    it "encode and decode Error response" $ do
      let r1 = Error "transfer rejected"
      encode r1 `shouldBe` "{\"error\":\"transfer rejected\"}"
      decode (encode r1) `shouldBe` Just r1
    it "encode and decode answer response" $ do
      let a1 = Answer (FileAck "ok")
      encode a1 `shouldBe` "{\"answer\":{\"file_ack\":\"ok\"}}"
      decode (encode a1) `shouldBe` Just a1
      
  describe "Transit Ack tests" $ do
    it "encode and decode Transit Ack from receiver to sender" $ do
      let a1 = TransitAck "ok" "e4f1684a5375ebf7f1dcde02a66026f937a8c6195adf31813ef21b3ccadfb11f"
      encode a1 `shouldBe` "{\"ack\":\"ok\",\"sha256\":\"e4f1684a5375ebf7f1dcde02a66026f937a8c6195adf31813ef21b3ccadfb11f\"}"
      decode (encode a1) `shouldBe` Just a1

prop_abilityTrip :: Property
prop_abilityTrip = property $ do
  x <- forAll Generator.abilityGen
  tripping x encode eitherDecode

prop_hintTrip :: Property
prop_hintTrip = property $ do
  x <- forAll Generator.hintGen
  tripping x encode eitherDecode

prop_connectionHintTrip :: Property
prop_connectionHintTrip = property $ do
  x <- forAll Generator.connectionHintGen
  tripping x encode eitherDecode

prop_ackTrip :: Property
prop_ackTrip = property $ do
  x <- forAll Generator.ackGen
  tripping x encode eitherDecode

prop_transitMsgTrip :: Property
prop_transitMsgTrip = property $ do
  x <- forAll Generator.transitMsgGen
  tripping x encode eitherDecode

prop_transitAckTrip :: Property
prop_transitAckTrip = property $ do
  x <- forAll Generator.transitAckGen
  tripping x encode eitherDecode

messagesRoundTripTests :: IO Bool
messagesRoundTripTests =
  checkSequential $ Group "Messages"
  [ ("prop_abilityTrip", prop_abilityTrip)
  , ("prop_hintTrip", prop_hintTrip)
  , ("prop_connectionHintTrip", prop_connectionHintTrip)
  , ("prop_ackTrip", prop_ackTrip)
  , ("prop_transitMsgTrip", prop_transitMsgTrip)
  , ("prop_transitAckTrip", prop_transitAckTrip)
  ]