{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module AWS.Transcribe.EventStream where
import Control.Lens (makeLenses, (^.))
import Data.Binary (Binary (get, put), getWord8)
import Data.Binary.Get (Get, getByteString, getInt16be, getInt32be, skip)
import Data.Binary.Put (putBuilder)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Digest.CRC32 as CRC32
import Data.Int (Int16, Int32)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word (Word8)
data Message = MkMessage
{ Message -> Header
_hContentType :: !Header
, Message -> Header
_hEventType :: !Header
, Message -> Header
_hMessageType :: !Header
, Message -> ByteString
_payload :: !BS.ByteString
}
deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)
data =
{ Header -> Word8
_hNameLength :: !Word8
, Header -> Text
_hName :: !T.Text
, Header -> Word8
_hValueType :: !Word8
, Header -> Int16
_hValueStringLength :: !Int16
, Header -> Text
_hValueString :: !T.Text
}
deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq)
makeLenses ''Message
makeLenses ''Header
instance Binary Header where
put :: Header -> Put
put = Builder -> Put
putBuilder (Builder -> Put) -> (Header -> Builder) -> Header -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> Builder
headerBuilder
get :: Get Header
get = do
Word8
hnl <- Get Word8
forall t. Binary t => Get t
get
ByteString
hn <- Int -> Get ByteString
getByteString (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
hnl)
Word8
hvt <- Get Word8
forall t. Binary t => Get t
get
Int16
hvsl <- Get Int16
getInt16be
ByteString
hvs <- Int -> Get ByteString
getByteString (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
hvsl)
Header -> Get Header
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ Word8 -> Text -> Word8 -> Int16 -> Text -> Header
MkHeader Word8
hnl (ByteString -> Text
T.decodeUtf8 ByteString
hn) Word8
hvt Int16
hvsl (ByteString -> Text
T.decodeUtf8 ByteString
hvs)
instance Binary Message where
put :: Message -> Put
put Message
msg = do
Builder -> Put
putBuilder Builder
totalMsg
Builder -> Put
putBuilder Builder
msgCrc
where
prelude :: Builder
prelude = Builder
tbl' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
hbl'
tbl' :: Builder
tbl' = Int32 -> Builder
BS.int32BE (Int32 -> Builder) -> Int32 -> Builder
forall a b. (a -> b) -> a -> b
$ Message -> Int32
tbl Message
msg
hbl' :: Builder
hbl' = Int32 -> Builder
BS.int32BE Int32
hbl
preludeCrc :: Builder
preludeCrc = Builder -> Builder
crcBuilder Builder
prelude
pb :: Builder
pb = ByteString -> Builder
BS.byteString (Message
msg Message -> Getting ByteString Message ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString Message ByteString
Lens' Message ByteString
payload)
totalMsg :: Builder
totalMsg = Builder
prelude Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
preludeCrc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
requestMessageHeaders Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pb
msgCrc :: Builder
msgCrc = Builder -> Builder
crcBuilder Builder
totalMsg
get :: Get Message
get = do
Int32
tbl' <- Get Int32
getInt32be
Int32
hbl' <- Get Int32
getInt32be
Int -> Get ()
skip Int
4
Header
h1 <- Get Header
forall t. Binary t => Get t
get
Header
h2 <- Get Header
forall t. Binary t => Get t
get
Header
h3 <- Get Header
forall t. Binary t => Get t
get
let (Header
h1', Header
h2', Header
h3') = Header -> Header -> Header -> (Header, Header, Header)
classifyHeaders Header
h2 Header
h1 Header
h3
ByteString
pl <- Int -> Get ByteString
getByteString (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
tbl' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
hbl' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16)
Message -> Get Message
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message -> Get Message) -> Message -> Get Message
forall a b. (a -> b) -> a -> b
$ Header -> Header -> Header -> ByteString -> Message
MkMessage Header
h1' Header
h2' Header
h3' ByteString
pl
classifyHeaders :: Header -> Header -> Header -> (Header, Header, Header)
Header
h1 Header
h2 Header
h3
| Header
h1 Header -> Getting Word8 Header Word8 -> Word8
forall s a. s -> Getting a s a -> a
^. Getting Word8 Header Word8
Lens' Header Word8
hNameLength Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 = Header -> Header -> Header -> (Header, Header, Header)
classifyHeaders Header
h2 Header
h3 Header
h1
| Header
h2 Header -> Getting Text Header Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Header Text
Lens' Header Text
hName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"content-type" = (Header
h2, Header
h1, Header
h3)
| Bool
otherwise = (Header
h3, Header
h1, Header
h2)
tbl :: Message -> Int32
tbl :: Message -> Int32
tbl Message
msg = Int32
16 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
hbl Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Message -> Int32
pbl Message
msg
hbl :: Int32
hbl :: Int32
hbl = Int32
hContentTypeRequestBL Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
hEventTypeRequestBL Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
hMessageTypeRequestBL
pbl :: Message -> Int32
pbl :: Message -> Int32
pbl Message
msg = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Message
msg Message -> Getting ByteString Message ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString Message ByteString
Lens' Message ByteString
payload)
headerBuilder :: Header -> BS.Builder
(MkHeader Word8
nl Text
n Word8
vt Int16
vsl Text
vl) =
Word8 -> Builder
BS.word8 Word8
nl
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
T.encodeUtf8 Text
n)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BS.word8 Word8
vt
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int16 -> Builder
BS.int16BE Int16
vsl
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
T.encodeUtf8 Text
vl)
getHeader :: Get Header
= do
Word8
hnbl <- Get Word8
getWord8
ByteString
hn <- Int -> Get ByteString
getByteString (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
hnbl)
Word8
hvt <- Get Word8
getWord8
Int16
vsbl <- Get Int16
getInt16be
ByteString
vs <- Int -> Get ByteString
getByteString (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
vsbl)
Header -> Get Header
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ Word8 -> Text -> Word8 -> Int16 -> Text -> Header
MkHeader Word8
hnbl (ByteString -> Text
T.decodeUtf8 ByteString
hn) Word8
hvt Int16
vsbl (ByteString -> Text
T.decodeUtf8 ByteString
vs)
crcBuilder :: BS.Builder -> BS.Builder
crcBuilder :: Builder -> Builder
crcBuilder = Word32 -> Builder
BS.word32BE (Word32 -> Builder) -> (Builder -> Word32) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRC32 -> Word32
CRC32.crc32 (CRC32 -> Word32) -> (Builder -> CRC32) -> Builder -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CRC32
forall a. CRC a => ByteString -> a
CRC32.digest (ByteString -> CRC32)
-> (Builder -> ByteString) -> Builder -> CRC32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BS.toLazyByteString
hContentTypeRequest :: Header
hContentTypeRequest :: Header
hContentTypeRequest = Word8 -> Text -> Word8 -> Int16 -> Text -> Header
MkHeader Word8
13 Text
":content-type" Word8
7 Int16
24 Text
"application/octet-stream"
hContentTypeRequestBL :: Int32
hContentTypeRequestBL :: Int32
hContentTypeRequestBL = Int32
41
hEventTypeRequest :: Header
hEventTypeRequest :: Header
hEventTypeRequest = Word8 -> Text -> Word8 -> Int16 -> Text -> Header
MkHeader Word8
11 Text
":event-type" Word8
7 Int16
10 Text
"AudioEvent"
hEventTypeRequestBL :: Int32
hEventTypeRequestBL :: Int32
hEventTypeRequestBL = Int32
25
hMessageTypeRequest :: Header
hMessageTypeRequest :: Header
hMessageTypeRequest = Word8 -> Text -> Word8 -> Int16 -> Text -> Header
MkHeader Word8
13 Text
":message-type" Word8
7 Int16
5 Text
"event"
hMessageTypeRequestBL :: Int32
hMessageTypeRequestBL :: Int32
hMessageTypeRequestBL = Int32
22
requestMessageHeaders :: BS.Builder
=
Header -> Builder
headerBuilder Header
hContentTypeRequest
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Header -> Builder
headerBuilder Header
hEventTypeRequest
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Header -> Builder
headerBuilder Header
hMessageTypeRequest
mkStreamingMessage :: BS.ByteString -> Message
mkStreamingMessage :: ByteString -> Message
mkStreamingMessage ByteString
pl = Header -> Header -> Header -> ByteString -> Message
MkMessage Header
hContentTypeRequest Header
hEventTypeRequest Header
hMessageTypeRequest ByteString
pl