{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Flat.Spec (test_flat) where
import Codec.Serialise (serialise)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Char (ord)
import Data.Word
import Flat
import PlutusCore.Data (Data)
import PlutusCore.DeBruijn
import PlutusCore.Generators.QuickCheck.Builtin ()
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import UntypedPlutusCore ()
import UntypedPlutusCore.Core.Type
test_deBruijnIso :: TestTree
test_deBruijnIso :: TestTree
test_deBruijnIso = TestName -> (DeBruijn -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"deBruijnIso" ((DeBruijn -> Property) -> TestTree)
-> (DeBruijn -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \DeBruijn
d ->
DeBruijn
d DeBruijn -> DeBruijn -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== FakeNamedDeBruijn -> DeBruijn
fromFake (DeBruijn -> FakeNamedDeBruijn
toFake DeBruijn
d)
test_fakeIso :: TestTree
test_fakeIso :: TestTree
test_fakeIso = TestName -> (FakeNamedDeBruijn -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"fakeIso" ((FakeNamedDeBruijn -> Property) -> TestTree)
-> (FakeNamedDeBruijn -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \FakeNamedDeBruijn
fnd ->
FakeNamedDeBruijn
fnd FakeNamedDeBruijn -> FakeNamedDeBruijn -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== DeBruijn -> FakeNamedDeBruijn
toFake (FakeNamedDeBruijn -> DeBruijn
fromFake FakeNamedDeBruijn
fnd)
test_deBruijnTripping :: TestTree
test_deBruijnTripping :: TestTree
test_deBruijnTripping = TestName -> (DeBruijn -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"debruijnTripping" ((DeBruijn -> Property) -> TestTree)
-> (DeBruijn -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \DeBruijn
d ->
DeBruijn -> Either DecodeException DeBruijn
forall a b. b -> Either a b
Right DeBruijn
d Either DecodeException DeBruijn
-> Either DecodeException DeBruijn -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Either DecodeException DeBruijn
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (forall a. Flat a => a -> ByteString
flat @DeBruijn DeBruijn
d)
test_fakeTripping :: TestTree
test_fakeTripping :: TestTree
test_fakeTripping = TestName -> (FakeNamedDeBruijn -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"fakeTripping" ((FakeNamedDeBruijn -> Property) -> TestTree)
-> (FakeNamedDeBruijn -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \FakeNamedDeBruijn
fnd ->
FakeNamedDeBruijn -> Either DecodeException FakeNamedDeBruijn
forall a b. b -> Either a b
Right FakeNamedDeBruijn
fnd Either DecodeException FakeNamedDeBruijn
-> Either DecodeException FakeNamedDeBruijn -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Either DecodeException FakeNamedDeBruijn
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (forall a. Flat a => a -> ByteString
flat @FakeNamedDeBruijn FakeNamedDeBruijn
fnd)
test_binderDeBruijn :: TestTree
test_binderDeBruijn :: TestTree
test_binderDeBruijn = TestName -> (Binder DeBruijn -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"binderDeBruijn" ((Binder DeBruijn -> Property) -> TestTree)
-> (Binder DeBruijn -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \Binder DeBruijn
b ->
Binder DeBruijn -> Either DecodeException (Binder DeBruijn)
forall a b. b -> Either a b
Right Binder DeBruijn
initB Either DecodeException (Binder DeBruijn)
-> Either DecodeException (Binder DeBruijn) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Either DecodeException (Binder DeBruijn)
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (forall a. Flat a => a -> ByteString
flat @(Binder DeBruijn) Binder DeBruijn
b)
test_binderFake :: TestTree
test_binderFake :: TestTree
test_binderFake = TestName -> (Binder FakeNamedDeBruijn -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"binderFake" ((Binder FakeNamedDeBruijn -> Property) -> TestTree)
-> (Binder FakeNamedDeBruijn -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \Binder FakeNamedDeBruijn
bf ->
Binder FakeNamedDeBruijn
-> Either DecodeException (Binder FakeNamedDeBruijn)
forall a b. b -> Either a b
Right (DeBruijn -> FakeNamedDeBruijn
toFake (DeBruijn -> FakeNamedDeBruijn)
-> Binder DeBruijn -> Binder FakeNamedDeBruijn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Binder DeBruijn
initB) Either DecodeException (Binder FakeNamedDeBruijn)
-> Either DecodeException (Binder FakeNamedDeBruijn) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Either DecodeException (Binder FakeNamedDeBruijn)
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (forall a. Flat a => a -> ByteString
flat @(Binder FakeNamedDeBruijn) Binder FakeNamedDeBruijn
bf)
isCanonicalFlatEncodedByteString :: BS.ByteString -> Bool
isCanonicalFlatEncodedByteString :: ByteString -> Bool
isCanonicalFlatEncodedByteString ByteString
bs =
case ByteString -> [Word8]
BS.unpack ByteString
bs of
[] -> Bool
False
Word8
0x01:[Word8]
r -> [Word8] -> Bool
forall {a}. Integral a => [a] -> Bool
go [Word8]
r
[Word8]
_ -> Bool
False
where
go :: [a] -> Bool
go [] = Bool
False
go l :: [a]
l@(a
w:[a]
ws) =
if a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0xFF
then [a] -> Bool
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
255 [a]
ws)
else [a]
l [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
end Bool -> Bool -> Bool
|| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w) [a]
ws [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
end
where end :: [a]
end = [a
0x00, a
0x01]
test_canonicalEncoding :: forall a . (Arbitrary a, Flat a, Show a) => String -> Int -> TestTree
test_canonicalEncoding :: forall a.
(Arbitrary a, Flat a, Show a) =>
TestName -> Int -> TestTree
test_canonicalEncoding TestName
s Int
n =
TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
s (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
n (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Gen a -> (a -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. Arbitrary a => Gen a
arbitrary @a) (ByteString -> Bool
isCanonicalFlatEncodedByteString (ByteString -> Bool) -> (a -> ByteString) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flat a => a -> ByteString
flat @a)
test_canonicalData :: TestTree
test_canonicalData :: TestTree
test_canonicalData =
forall a.
(Arbitrary a, Flat a, Show a) =>
TestName -> Int -> TestTree
test_canonicalEncoding @Data TestName
"flat encodes Data canonically" Int
5000
test_canonicalByteString :: TestTree
test_canonicalByteString :: TestTree
test_canonicalByteString =
forall a.
(Arbitrary a, Flat a, Show a) =>
TestName -> Int -> TestTree
test_canonicalEncoding @BS.ByteString TestName
"flat encodes ByteStrings canonically" Int
1000
test_nonCanonicalByteStringDecoding :: TestTree
test_nonCanonicalByteStringDecoding :: TestTree
test_nonCanonicalByteStringDecoding =
let target :: ByteString
target = ByteString
"This is a test." :: BS.ByteString
ch :: Char -> Word8
ch :: Char -> Word8
ch = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
input1 :: ByteString
input1 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x01, Char -> Word8
ch Char
'T'
, Word8
0x01, Char -> Word8
ch Char
'h'
, Word8
0x01, Char -> Word8
ch Char
'i'
, Word8
0x01, Char -> Word8
ch Char
's'
, Word8
0x01, Char -> Word8
ch Char
' '
, Word8
0x01, Char -> Word8
ch Char
'i'
, Word8
0x01, Char -> Word8
ch Char
's'
, Word8
0x01, Char -> Word8
ch Char
' '
, Word8
0x01, Char -> Word8
ch Char
'a'
, Word8
0x01, Char -> Word8
ch Char
' '
, Word8
0x01, Char -> Word8
ch Char
't'
, Word8
0x01, Char -> Word8
ch Char
'e'
, Word8
0x01, Char -> Word8
ch Char
's'
, Word8
0x01, Char -> Word8
ch Char
't'
, Word8
0x01, Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
input2 :: ByteString
input2 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x03, Char -> Word8
ch Char
'T', Char -> Word8
ch Char
'h', Char -> Word8
ch Char
'i'
, Word8
0x03, Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'i'
, Word8
0x03, Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'a'
, Word8
0x03, Char -> Word8
ch Char
' ', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'e'
, Word8
0x03, Char -> Word8
ch Char
's', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
input3 :: ByteString
input3 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x01, Char -> Word8
ch Char
'T'
, Word8
0x02, Char -> Word8
ch Char
'h', Char -> Word8
ch Char
'i'
, Word8
0x03, Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'i'
, Word8
0x04, Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'a', Char -> Word8
ch Char
' '
, Word8
0x05, Char -> Word8
ch Char
't', Char -> Word8
ch Char
'e', Char -> Word8
ch Char
's', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
input4 :: ByteString
input4 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x05, Char -> Word8
ch Char
'T', Char -> Word8
ch Char
'h', Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' '
, Word8
0x05, Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'a', Char -> Word8
ch Char
' '
, Word8
0x05, Char -> Word8
ch Char
't', Char -> Word8
ch Char
'e', Char -> Word8
ch Char
's', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
input5 :: ByteString
input5 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x05, Char -> Word8
ch Char
'T', Char -> Word8
ch Char
'h', Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' '
, Word8
0x04, Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'a'
, Word8
0x03, Char -> Word8
ch Char
' ', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'e'
, Word8
0x02, Char -> Word8
ch Char
's', Char -> Word8
ch Char
't'
, Word8
0x01, Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
input6 :: ByteString
input6 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x01, Char -> Word8
ch Char
'T'
, Word8
0x0e, Char -> Word8
ch Char
'h', Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' '
, Char -> Word8
ch Char
'a', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'e', Char -> Word8
ch Char
's', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
input7 :: ByteString
input7 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x01, Char -> Word8
ch Char
'T'
, Word8
0x0d, Char -> Word8
ch Char
'h', Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' '
, Char -> Word8
ch Char
'a', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'e', Char -> Word8
ch Char
's', Char -> Word8
ch Char
't'
, Word8
0x01, Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
input8 :: ByteString
input8 = [Word8] -> ByteString
BS.pack [ Word8
0x01
, Word8
0x03, Char -> Word8
ch Char
'T', Char -> Word8
ch Char
'h', Char -> Word8
ch Char
'i'
, Word8
0x01, Char -> Word8
ch Char
's'
, Word8
0x05, Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'i', Char -> Word8
ch Char
's', Char -> Word8
ch Char
' ', Char -> Word8
ch Char
'a'
, Word8
0x02, Char -> Word8
ch Char
' ', Char -> Word8
ch Char
't'
, Word8
0x04, Char -> Word8
ch Char
'e', Char -> Word8
ch Char
's', Char -> Word8
ch Char
't', Char -> Word8
ch Char
'.'
, Word8
0x00
, Word8
0x01 ]
mkTest :: b -> Assertion
mkTest b
input =
HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"Input failed to decode successfully" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
(ByteString -> Either DecodeException ByteString
forall a b. b -> Either a b
Right ByteString
target Either DecodeException ByteString
-> Either DecodeException ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== b -> Either DecodeException ByteString
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat b
input)
in TestName -> [TestTree] -> TestTree
testGroup TestName
"Non-canonical bytestring encodings decode succesfully"
[ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Data via lazy bytestrings" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
5000 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Gen Data -> (Data -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. Arbitrary a => Gen a
arbitrary @Data) (\Data
d -> Data -> Either DecodeException Data
forall a b. b -> Either a b
Right Data
d Either DecodeException Data
-> Either DecodeException Data -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Either DecodeException Data
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (ByteString -> ByteString
forall a. Flat a => a -> ByteString
flat (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise Data
d :: BSL.ByteString)))
, TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Arbitrary lazy bytestrings" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
10000 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Gen ByteString -> (ByteString -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. Arbitrary a => Gen a
arbitrary @BSL.ByteString) (\ByteString
bs -> ByteString -> Either DecodeException ByteString
forall a b. b -> Either a b
Right (ByteString -> ByteString
BSL.toStrict ByteString
bs) Either DecodeException ByteString
-> Either DecodeException ByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Either DecodeException ByteString
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (ByteString -> ByteString
forall a. Flat a => a -> ByteString
flat ByteString
bs) )
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input1
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input2
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 3" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input3
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 4" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input4
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 5" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input5
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 6" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input6
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 7" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input7
, TestName -> Assertion -> TestTree
testCase TestName
"Explicit input 8" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Assertion
forall {b}. AsByteString b => b -> Assertion
mkTest ByteString
input8
]
test_flat :: TestTree
test_flat :: TestTree
test_flat = TestName -> [TestTree] -> TestTree
testGroup TestName
"FlatProp"
[ TestTree
test_deBruijnIso
, TestTree
test_fakeIso
, TestTree
test_deBruijnTripping
, TestTree
test_fakeTripping
, TestTree
test_binderDeBruijn
, TestTree
test_binderFake
, TestTree
test_canonicalData
, TestTree
test_canonicalByteString
, TestTree
test_nonCanonicalByteStringDecoding
]
initB :: Binder DeBruijn
initB :: Binder DeBruijn
initB = DeBruijn -> Binder DeBruijn
forall name. name -> Binder name
Binder (DeBruijn -> Binder DeBruijn) -> DeBruijn -> Binder DeBruijn
forall a b. (a -> b) -> a -> b
$ Index -> DeBruijn
DeBruijn Index
deBruijnInitIndex
deriving via Word64 instance Arbitrary DeBruijn
instance Arbitrary FakeNamedDeBruijn where
arbitrary :: Gen FakeNamedDeBruijn
arbitrary= DeBruijn -> FakeNamedDeBruijn
toFake (DeBruijn -> FakeNamedDeBruijn)
-> Gen DeBruijn -> Gen FakeNamedDeBruijn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DeBruijn
forall a. Arbitrary a => Gen a
arbitrary
deriving newtype instance Arbitrary (Binder DeBruijn)
deriving newtype instance Arbitrary (Binder FakeNamedDeBruijn)