shrub/pkg/hs/urbit-king/test/AmesTests.hs

117 lines
3.0 KiB
Haskell
Raw Normal View History

module AmesTests (tests) where
2019-08-01 03:27:13 +03:00
import Data.Conduit
import Data.Conduit.List hiding (take)
import Data.Ord.Unicode
import Test.QuickCheck hiding ((.&.))
import Test.Tasty
import Test.Tasty.QuickCheck
import Test.Tasty.TH
import Urbit.Arvo
import Urbit.EventLog.LMDB
import Urbit.King.Config
import Urbit.Noun
import Urbit.Noun.Time
2020-10-13 07:57:01 +03:00
import Urbit.Prelude hiding (elements)
import Urbit.Vere.Ames
2020-10-13 07:57:01 +03:00
import Urbit.Vere.Ames.Packet
import Urbit.Vere.Pier.Types
import Urbit.Vere.Ports
2019-09-18 06:33:38 +03:00
import Control.Concurrent (runInBoundThread)
2020-10-13 07:57:01 +03:00
import Data.Serialize (decode, encode)
import Data.LargeWord (LargeKey(..))
import GHC.Natural (Natural)
2019-08-01 03:27:13 +03:00
import Network.Socket (tupleToHostAddress)
2020-05-30 01:57:35 +03:00
import Urbit.King.App (HasKingId(..))
import qualified Urbit.EventLog.LMDB as Log
import qualified Urbit.Noun.Time as Time
2020-10-13 07:57:01 +03:00
packetSplitMorphism :: Packet -> Bool
packetSplitMorphism p = (decode . encode) p == Right p
tests :: TestTree
tests =
testGroup "Ames"
2020-10-13 07:57:01 +03:00
[ testProperty "Packet coding looks good" $
packetSplitMorphism
]
-- Generate Arbitrary Values ---------------------------------------------------
arb :: Arbitrary a => Gen a
arb = arbitrary
instance Arbitrary Ipv4 where arbitrary = Ipv4 <$> arb
instance Arbitrary Port where arbitrary = Port <$> arb
instance Arbitrary Wen where arbitrary = Wen <$> arb
instance Arbitrary Gap where arbitrary = Gap . abs <$> arb
instance Arbitrary Bytes where arbitrary = pure (MkBytes "wtfbbq")
-- MkBytes . take 100 <$> arb
2019-12-19 17:13:20 +03:00
instance Arbitrary a => Arbitrary (Patp a) where
arbitrary = Patp <$> arb
instance Arbitrary ByteString where
arbitrary = pack <$> arbitrary
instance Arbitrary Natural where
arbitrary = fromIntegral . abs <$> (arbitrary :: Gen Integer)
instance (Arbitrary a, Arbitrary b) => Arbitrary (LargeKey a b) where
arbitrary = LargeKey <$> arb <*> arb
genIpv4 :: Gen Ipv4
genIpv4 = do
x <- arbitrary
if (x == 0 || (x256 && x512))
then genIpv4
else pure (Ipv4 x)
2019-09-18 06:33:38 +03:00
instance Arbitrary Text where
arbitrary = pack <$> arb
instance Arbitrary Cord where
arbitrary = Cord <$> arb
instance Arbitrary BigCord where
arbitrary = BigCord <$> arb
instance Arbitrary AmesDest where
2019-12-17 13:14:34 +03:00
arbitrary = oneof [ EachYes <$> arb
, EachNo <$> arb
]
2019-12-17 13:14:34 +03:00
instance Arbitrary a => Arbitrary (Jammed a) where
arbitrary = Jammed <$> arbitrary
instance Arbitrary AmesAddress where
arbitrary = AAIpv4 <$> arb <*> arb
instance Arbitrary Ship where
2020-10-13 07:57:01 +03:00
arbitrary = Ship <$> elements
[ 0
, 42
, 256
, 24_530
, 2_071_856_128
, 2_824_325_100
, 430_648_908_188_615_680
, 2^60 + 1337
]
instance Arbitrary LogIdentity where
arbitrary = LogIdentity <$> arb <*> arb <*> arb
2020-10-13 07:57:01 +03:00
instance Arbitrary Packet where
arbitrary = do
pktVersion <- suchThat arb (< 8)
pktEncrypted <- arb
pktSndr <- arb
pktRcvr <- arb
pktOrigin <- arb
pktContent <- arb
pure Packet {..}