module Codec.EBML.Stream (StreamReader, newStreamReader, StreamFrame (..), feedReader) where
import Control.Monad (when)
import Data.Binary.Get qualified as Get
import Data.ByteString qualified as BS
import Data.Text (Text)
import Data.Text qualified as Text
import Codec.EBML.Decoder
import Codec.EBML.Element
import Codec.EBML.Matroska
import Codec.EBML.Schema
import Codec.EBML.WebM qualified as WebM
data StreamFrame = StreamFrame
{ StreamFrame -> ByteString
initialization :: BS.ByteString
, StreamFrame -> ByteString
media :: BS.ByteString
}
data StreamReader = StreamReader
{ :: Either (Int, [BS.ByteString]) BS.ByteString
, StreamReader -> Decoder ()
decoder :: Get.Decoder ()
}
streamSchema :: EBMLSchemas
streamSchema :: EBMLSchemas
streamSchema = [EBMLSchema] -> EBMLSchemas
compileSchemas [EBMLSchema]
schemaHeader
getUntilNextCluster :: Get.Get [EBMLElement]
getUntilNextCluster :: Get [EBMLElement]
getUntilNextCluster =
forall a. Get (Maybe a) -> Get (Maybe a)
Get.lookAheadM Get (Maybe EBMLElement)
getNonCluster forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just EBMLElement
elt -> do
[EBMLElement]
elts <- Get [EBMLElement]
getUntilNextCluster
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EBMLElement
elt forall a. a -> [a] -> [a]
: [EBMLElement]
elts)
Maybe EBMLElement
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
getNonCluster :: Get (Maybe EBMLElement)
getNonCluster = do
EBMLID
eid <- Get EBMLID
getElementID
if EBMLID
eid forall a. Eq a => a -> a -> Bool
== EBMLID
0x1F43B675
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else do
EBMLElementHeader
elth <- EBMLID -> Maybe Word64 -> EBMLElementHeader
EBMLElementHeader EBMLID
eid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe Word64)
getMaybeDataSize
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EBMLSchemas -> EBMLElementHeader -> Get EBMLElement
getElementValue EBMLSchemas
streamSchema EBMLElementHeader
elth
getInitialization :: Get.Get ()
getInitialization :: Get ()
getInitialization = do
EBMLElement
elt <- EBMLSchemas -> Get EBMLElement
getElement EBMLSchemas
streamSchema
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EBMLElement
elt.header.eid forall a. Eq a => a -> a -> Bool
/= EBMLID
0x1A45DFA3) do
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid magic: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show EBMLElement
elt.header
EBMLElementHeader
segmentHead <- Get EBMLElementHeader
getElementHeader
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EBMLElementHeader
segmentHead.eid forall a. Eq a => a -> a -> Bool
/= EBMLID
0x18538067) do
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid segment: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show EBMLElementHeader
segmentHead
[EBMLElement]
elts <- Get [EBMLElement]
getUntilNextCluster
case [EBMLElement] -> Either Text WebMDocument
WebM.decodeSegment [EBMLElement]
elts of
Right WebMDocument
_webmDocument -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Left Text
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack Text
err)
getCluster :: Get.Get ()
getCluster :: Get ()
getCluster = do
EBMLElementHeader
clusterHead <- Get EBMLElementHeader
getElementHeader
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EBMLElementHeader
clusterHead.eid forall a. Eq a => a -> a -> Bool
/= EBMLID
0x1F43B675) do
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid cluster: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show EBMLElementHeader
clusterHead
[EBMLElement]
elts <- Get [EBMLElement]
getUntilNextCluster
case [EBMLElement]
elts of
(EBMLElement
elt : [EBMLElement]
_) | EBMLElement
elt.header.eid forall a. Eq a => a -> a -> Bool
== EBMLID
0xE7 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[EBMLElement]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cluster first element is not a timestamp"
newStreamReader :: StreamReader
newStreamReader :: StreamReader
newStreamReader = Either (Int, [ByteString]) ByteString -> Decoder () -> StreamReader
StreamReader (forall a b. a -> Either a b
Left (Int
0, [])) (forall a. Get a -> Decoder a
Get.runGetIncremental Get ()
getInitialization)
feedReader :: BS.ByteString -> StreamReader -> Either Text (Maybe StreamFrame, StreamReader)
feedReader :: ByteString
-> StreamReader -> Either Text (Maybe StreamFrame, StreamReader)
feedReader = Maybe StreamFrame
-> ByteString
-> StreamReader
-> Either Text (Maybe StreamFrame, StreamReader)
go forall a. Maybe a
Nothing
where
go :: Maybe StreamFrame
-> ByteString
-> StreamReader
-> Either Text (Maybe StreamFrame, StreamReader)
go Maybe StreamFrame
Nothing ByteString
"" StreamReader
_ = forall a b. a -> Either a b
Left Text
"empty buffer"
go Maybe StreamFrame
mFrame ByteString
bs StreamReader
sr =
case forall a. Decoder a -> ByteString -> Decoder a
Get.pushChunk StreamReader
sr.decoder ByteString
bs of
Get.Fail ByteString
_ ByteOffset
_ String
s -> forall a b. a -> Either a b
Left (String -> Text
Text.pack String
s)
newDecoder :: Decoder ()
newDecoder@(Get.Partial Maybe ByteString -> Decoder ()
_) -> forall a b. b -> Either a b
Right (Maybe StreamFrame
mFrame, StreamReader
newSR)
where
newHeader :: Either (Int, [ByteString]) ByteString
newHeader = case StreamReader
sr.header of
Left (Int
consumed, [ByteString]
acc) -> forall a b. a -> Either a b
Left (Int
consumed forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
bs, ByteString
bs forall a. a -> [a] -> [a]
: [ByteString]
acc)
Right ByteString
_ -> StreamReader
sr.header
newSR :: StreamReader
newSR = Either (Int, [ByteString]) ByteString -> Decoder () -> StreamReader
StreamReader Either (Int, [ByteString]) ByteString
newHeader Decoder ()
newDecoder
Get.Done ByteString
leftover ByteOffset
consumed ()
_ -> Maybe StreamFrame
-> ByteString
-> StreamReader
-> Either Text (Maybe StreamFrame, StreamReader)
go Maybe StreamFrame
newFrame ByteString
leftover StreamReader
newSR
where
newHeader :: ByteString
newHeader = case StreamReader
sr.header of
Left (Int
prevConsumed, [ByteString]
acc) ->
let currentPos :: Int
currentPos = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
consumed forall a. Num a => a -> a -> a
- Int
prevConsumed
in forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (Int -> ByteString -> ByteString
BS.take Int
currentPos ByteString
bs forall a. a -> [a] -> [a]
: [ByteString]
acc)
Right ByteString
header -> ByteString
header
newFrame :: Maybe StreamFrame
newFrame = forall a. a -> Maybe a
Just (ByteString -> ByteString -> StreamFrame
StreamFrame ByteString
newHeader ByteString
leftover)
newSR :: StreamReader
newSR = Either (Int, [ByteString]) ByteString -> Decoder () -> StreamReader
StreamReader (forall a b. b -> Either a b
Right ByteString
newHeader) (forall a. Get a -> Decoder a
Get.runGetIncremental Get ()
getCluster)