module Data.MediaBus.Rtp.SourceSpec ( spec ) where import Conduit import Data.Conduit.List import Test.Hspec import Data.MediaBus.Rtp import Data.MediaBus import qualified Data.ByteString as B import Data.Word import Control.Lens import Data.Proxy import Control.Monad.Logger spec :: Spec spec = rtpSourceSpec >> rtpPayloadDemuxSpec rtpSourceSpec :: Spec rtpSourceSpec = describe "rtpSource" $ do let countStarts :: [Series a b] -> Int countStarts = foldr (\x n -> case x of Start _ -> n + 1 Next _ -> n) 0 runTestConduit inputs = runNoLogging $ runConduit (sourceList inputs .| annotateTypeCIn (Proxy :: Proxy (Stream Int Int Int () B.ByteString)) rtpSource .| consume) it "yields 'Start' when only when the first payload packet arrives" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) ] in countStarts (_stream <$> runTestConduit inputs) `shouldBe` 0 it "yields 'Start' when the first packet arrives" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) , mkTestRtpPacket 0 0 0 ] in countStarts (_stream <$> runTestConduit inputs) `shouldBe` 1 it "yields 'Start' when the ssrc changes" $ let inputs = [ MkStream (Start (MkFrameCtx 8 9 10 ())) , mkTestRtpPacket ssrc0 0 0 , mkTestRtpPacket ssrc0 0 0 , mkTestRtpPacket ssrc1 0 0 , mkTestRtpPacket ssrc1 0 0 , mkTestRtpPacket ssrc0 0 0 , mkTestRtpPacket ssrc1 0 0 , mkTestRtpPacket ssrc1 0 0 ] ssrc0 = 123 ssrc1 = 345 in countStarts (_stream <$> runTestConduit inputs) `shouldBe` 4 it "yields 'Start' when the sequence numbers change too much" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) , mkTestRtpPacket 0 01 0 , mkTestRtpPacket 0 02 0 , mkTestRtpPacket 0 03 0 , mkTestRtpPacket 0 24 0 , mkTestRtpPacket 0 25 0 , mkTestRtpPacket 0 06 0 , mkTestRtpPacket 0 07 0 ] in countStarts (_stream <$> runTestConduit inputs) `shouldBe` 3 it "yields 'Start' when the sequence numbers change too much" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) , mkTestRtpPacket 0 01 0 , mkTestRtpPacket 0 02 0 , mkTestRtpPacket 0 03 0 , mkTestRtpPacket 0 24 0 , mkTestRtpPacket 0 25 0 , mkTestRtpPacket 0 06 0 , mkTestRtpPacket 0 07 0 ] in countStarts (_stream <$> runTestConduit inputs) `shouldBe` 3 it "yields no 'Start' when the sequence number wraps around" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) , mkTestRtpPacket 0 (negate 3) 0 , mkTestRtpPacket 0 (negate 2) 0 , mkTestRtpPacket 0 (negate 1) 0 , mkTestRtpPacket 0 0 0 , mkTestRtpPacket 0 1 0 ] in countStarts (_stream <$> runTestConduit inputs) `shouldBe` 1 it "yields no 'Start' when the timestamp wraps around" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) , mkTestRtpPacket 0 0 (negate 300) , mkTestRtpPacket 0 0 (negate 200) , mkTestRtpPacket 0 0 (negate 100) , mkTestRtpPacket 0 0 0 , mkTestRtpPacket 0 0 100 ] in countStarts (_stream <$> runTestConduit inputs) `shouldBe` 1 it "can handle broken packets without crashing" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) , mkTestRtpPacket 0 0 777 , mkTestRtpPacket 0 0 777 , mkBrokenTestRtpPacket , mkBrokenTestRtpPacket , mkTestRtpPacket 0 0 777 , mkTestRtpPacket 0 0 777 , mkBrokenTestRtpPacket , mkTestRtpPacket 0 0 777 , mkTestRtpPacket 0 0 777 , mkTestRtpPacket 0 0 777 ] in length (runTestConduit inputs) `shouldBe` 8 runNoLogging :: NoLoggingT Identity a -> a runNoLogging = runIdentity . runNoLoggingT rtpPayloadDemuxSpec :: Spec rtpPayloadDemuxSpec = describe "rtpPayloadDemux" $ do let runTestConduit inputs payloadHandlers fallback = runNoLogging $ runConduit (sourceList inputs .| rtpSource .| rtpPayloadDemux payloadHandlers fallback .| consume) it "always yields the fallback element if the payload table contains no handler" $ let inputs = [ MkStream (Start (MkFrameCtx 0 0 0 ())) , mkTestRtpPacket 0 0 0 ] outs = preview eachFrameContent <$> runTestConduit inputs [] () in outs `shouldBe` [ Nothing, Just () ] it "always yields the fallback element if the payload table contains no handler for the payload type" $ let inputs = MkStream (Start (MkFrameCtx 0 0 0 ())) : [ mkTestRtpPacketWithPayload 0 0 0 (mkTestPayload (MkRtpPayloadType p)) | p <- [0 .. 128] ] fallback :: Audio (Hz 8000) Mono (Raw S16) fallback = mempty outs = preview eachFrameContent <$> runTestConduit inputs [ ( MkRtpPayloadType 129 , over (framePayload . eachChannel) decodeALawSample . alawPayloadHandler ) ] fallback in outs `shouldBe` Nothing : [ Just fallback | _ <- [0 .. 128 :: Word8] ] it "invokes the first matching payload handler" $ let inputs = MkStream (Start (MkFrameCtx 0 0 0 ())) : [ mkTestRtpPacketWithPayload 0 0 0 (mkTestPayload 8) , mkTestRtpPacketWithPayload 0 0 0 (mkTestPayload 0) ] outputs = preview eachFrameContent <$> runTestConduit inputs [ ( 8 , framePayload .~ "first 8 handler" ) , ( 8 , framePayload .~ "second 8 handler" ) , ( 0 , framePayload .~ "first 0 handler" ) , ( 0 , framePayload .~ "second 0 handler" ) ] "bad" in outputs `shouldBe` [ Nothing, Just "first 8 handler", Just "first 0 handler" ] mkBrokenTestRtpPacket :: Stream Int Int Int () B.ByteString mkBrokenTestRtpPacket = MkStream (Next (MkFrame 0 0 (B.pack [ 0, 0, 0 ]))) mkTestPayload :: RtpPayloadType -> RtpPayload mkTestPayload pt = MkRtpPayload pt (mediaBufferFromList [ 0, 0, 0 ]) mkTestRtpPacket :: RtpSsrc -> RtpSeqNum -> RtpTimestamp -> Stream Int Int Int () B.ByteString mkTestRtpPacket ssrc sn ts = mkTestRtpPacketWithPayload ssrc sn ts (mkTestPayload 0) mkTestRtpPacketWithPayload :: RtpSsrc -> RtpSeqNum -> RtpTimestamp -> RtpPayload -> Stream Int Int Int () B.ByteString mkTestRtpPacketWithPayload ssrc sn ts p = MkStream (Next (MkFrame 0 0 (serialize (MkRtpPacket (MkRtpHeader 2 False False sn ts ssrc [] Nothing) p))))