{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
module Test.Ouroboros.Network.Testing.Utils where
import Codec.CBOR.FlatTerm qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Codec.CBOR.Term qualified as CBOR
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as LBS
import Network.TypedProtocol.Codec
import Test.QuickCheck
splits2 :: LBS.ByteString -> [[LBS.ByteString]]
splits2 :: ByteString -> [[ByteString]]
splits2 ByteString
bs = (ByteString -> ByteString -> [ByteString])
-> [ByteString] -> [ByteString] -> [[ByteString]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ByteString
a ByteString
b -> [ByteString
a,ByteString
b]) (ByteString -> [ByteString]
LBS.inits ByteString
bs) (ByteString -> [ByteString]
LBS.tails ByteString
bs)
splits3 :: LBS.ByteString -> [[LBS.ByteString]]
splits3 :: ByteString -> [[ByteString]]
splits3 ByteString
bs =
[ [ByteString
a,ByteString
b,ByteString
c]
| (ByteString
a,ByteString
bs') <- [ByteString] -> [ByteString] -> [(ByteString, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ByteString -> [ByteString]
LBS.inits ByteString
bs) (ByteString -> [ByteString]
LBS.tails ByteString
bs)
, (ByteString
b,ByteString
c) <- [ByteString] -> [ByteString] -> [(ByteString, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ByteString -> [ByteString]
LBS.inits ByteString
bs') (ByteString -> [ByteString]
LBS.tails ByteString
bs') ]
prop_codec_cborM
:: forall ps m.
( Monad m
, Eq (AnyMessage ps)
)
=> Codec ps CBOR.DeserialiseFailure m LBS.ByteString
-> AnyMessageAndAgency ps
-> m Bool
prop_codec_cborM :: forall ps (m :: * -> *).
(Monad m, Eq (AnyMessage ps)) =>
Codec ps DeserialiseFailure m ByteString
-> AnyMessageAndAgency ps -> m Bool
prop_codec_cborM Codec ps DeserialiseFailure m ByteString
codec (AnyMessageAndAgency PeerHasAgency pr st
stok Message ps st st'
msg)
= case (forall s. Decoder s Term)
-> ByteString -> Either DeserialiseFailure (ByteString, Term)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes Decoder s Term
forall s. Decoder s Term
CBOR.decodeTerm (ByteString -> Either DeserialiseFailure (ByteString, Term))
-> ByteString -> Either DeserialiseFailure (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Codec ps DeserialiseFailure m ByteString
-> forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> ByteString
forall ps failure (m :: * -> *) bytes.
Codec ps failure m bytes
-> forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> bytes
encode Codec ps DeserialiseFailure m ByteString
codec PeerHasAgency pr st
stok Message ps st st'
msg of
Left DeserialiseFailure
_err -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Right (ByteString
leftover, Term
_term) -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
LBS.null ByteString
leftover
prop_codec_valid_cbor_encoding
:: forall ps.
Codec ps CBOR.DeserialiseFailure IO ByteString
-> AnyMessageAndAgency ps
-> Property
prop_codec_valid_cbor_encoding :: forall ps.
Codec ps DeserialiseFailure IO ByteString
-> AnyMessageAndAgency ps -> Property
prop_codec_valid_cbor_encoding Codec {forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> ByteString
encode :: forall ps failure (m :: * -> *) bytes.
Codec ps failure m bytes
-> forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> bytes
encode :: forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> ByteString
encode} (AnyMessageAndAgency PeerHasAgency pr st
stok Message ps st st'
msg) =
case [TermToken] -> ByteString -> Either DeserialiseFailure [TermToken]
deserialise [] (PeerHasAgency pr st -> Message ps st st' -> ByteString
forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> ByteString
encode PeerHasAgency pr st
stok Message ps st st'
msg) of
Left DeserialiseFailure
e -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
e) Bool
False
Right [TermToken]
terms -> Bool -> Property
forall prop. Testable prop => prop -> Property
property ([TermToken] -> Bool
CBOR.validFlatTerm [TermToken]
terms)
where
deserialise :: [CBOR.TermToken]
-> ByteString
-> Either CBOR.DeserialiseFailure [CBOR.TermToken]
deserialise :: [TermToken] -> ByteString -> Either DeserialiseFailure [TermToken]
deserialise ![TermToken]
as ByteString
bs =
case (forall s. Decoder s TermToken)
-> ByteString -> Either DeserialiseFailure (ByteString, TermToken)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes Decoder s TermToken
forall s. Decoder s TermToken
CBOR.decodeTermToken ByteString
bs of
Left DeserialiseFailure
e -> DeserialiseFailure -> Either DeserialiseFailure [TermToken]
forall a b. a -> Either a b
Left DeserialiseFailure
e
Right (ByteString
bs', TermToken
a) | ByteString -> Bool
LBS.null ByteString
bs'
-> [TermToken] -> Either DeserialiseFailure [TermToken]
forall a b. b -> Either a b
Right ([TermToken] -> [TermToken]
forall a. [a] -> [a]
reverse (TermToken
a TermToken -> [TermToken] -> [TermToken]
forall a. a -> [a] -> [a]
: [TermToken]
as))
| Bool
otherwise
-> [TermToken] -> ByteString -> Either DeserialiseFailure [TermToken]
deserialise (TermToken
a TermToken -> [TermToken] -> [TermToken]
forall a. a -> [a] -> [a]
: [TermToken]
as) ByteString
bs'