{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

{- |Event stream encoding provides bidirectional communication using messages between a client and a server.
Data frames sent to the Amazon Transcribe streaming service are encoded in this format. The response from Amazon Transcribe also uses this encoding.

Each message consists of two sections: the prelude and the data. The prelude consists of:

    The total byte length of the message

    The combined byte length of all of the headers

The data section consists of:

    The headers

    A payload

Each section ends with a 4-byte big-endian integer CRC checksum.
The message CRC checksum is for both the prelude section and the data section.
Amazon Transcribe uses CRC32 (often referred to as GZIP CRC32) to calculate both CRCs.
For more information about CRC32, see GZIP file format specification version 4.3

.

Total message overhead, including the prelude and both checksums, is 16 bytes.

documentation source: https://docs.aws.amazon.com/transcribe/latest/dg/event-stream.html
-}
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)

-- A message used in event stream encoding
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)

-- | Event stram encoding header
data Header = MkHeader
    { 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
        -- Skip crc check
        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)
        -- Skip crc check
        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)
classifyHeaders :: Header -> Header -> Header -> (Header, Header, Header)
classifyHeaders 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)

-- The total byte length of a message
-- tbl: 16 Bytes overhead + headers length + payload length
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

-- A message's headers byte length
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

-- A message's payload byte length
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)

-- A strict ByteString builder for `Header`
headerBuilder :: Header -> BS.Builder
headerBuilder :: Header -> Builder
headerBuilder (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
getHeader :: Get Header
getHeader = 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)

-- A CRC32 builder for strict ByteStrings
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

-- The standard content-type request header
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"

-- Request content-type header byte length
hContentTypeRequestBL :: Int32
hContentTypeRequestBL :: Int32
hContentTypeRequestBL = Int32
41

-- The standard event-type request header
hEventTypeRequest :: Header
hEventTypeRequest :: Header
hEventTypeRequest = Word8 -> Text -> Word8 -> Int16 -> Text -> Header
MkHeader Word8
11 Text
":event-type" Word8
7 Int16
10 Text
"AudioEvent"

-- Request event-type header byte length
hEventTypeRequestBL :: Int32
hEventTypeRequestBL :: Int32
hEventTypeRequestBL = Int32
25

-- The standard message-type request header
hMessageTypeRequest :: Header
hMessageTypeRequest :: Header
hMessageTypeRequest = Word8 -> Text -> Word8 -> Int16 -> Text -> Header
MkHeader Word8
13 Text
":message-type" Word8
7 Int16
5 Text
"event"

-- Request message-type header byte length
hMessageTypeRequestBL :: Int32
hMessageTypeRequestBL :: Int32
hMessageTypeRequestBL = Int32
22

requestMessageHeaders :: BS.Builder
requestMessageHeaders :: Builder
requestMessageHeaders =
    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

-- | Make a streaming message, using the default request headers
mkStreamingMessage :: BS.ByteString -> Message
mkStreamingMessage :: ByteString -> Message
mkStreamingMessage ByteString
pl = Header -> Header -> Header -> ByteString -> Message
MkMessage Header
hContentTypeRequest Header
hEventTypeRequest Header
hMessageTypeRequest ByteString
pl