packages feed

aws-transcribe-ws (empty) → 0.0.1.0

raw patch · 16 files changed

+963/−0 lines, 16 filesdep +aesondep +am-testdep +asyncsetup-changed

Dependencies added: aeson, am-test, async, base, base16-bytestring, binary, bytestring, crc, cryptohash-sha256, lens, stm, text, time, websockets, wuss

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for am-test++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,4 @@+# aws-transcribe-ws++Use the WebSocket protocol to stream audio to the AWS Transcribe service+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aws-transcribe-ws.cabal view
@@ -0,0 +1,80 @@+cabal-version:      1.12+name:               aws-transcribe-ws+version:            0.0.1.0+license:            BSD3+license-file:       LICENSE+copyright:          2021 Kyriakos Papachrysanthou+maintainer:         papachrysanthou.k@gmail.com+author:             Kyriakos Papachrysanthou+homepage:           https://github.com/3kyro/aws-transcribe#readme+bug-reports:        https://github.com/3kyro/aws-transcribe/issues+synopsis:           Websocket streaming to Amazon Transcribe service+description:+    Please see the README on GitHub at <https://github.com/githubuser/am-test#readme>++category:           Web+build-type:         Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+    type:     git+    location: https://github.com/3kyro/aws-transcribe++library+    exposed-modules:+        AWS.Transcribe+        AWS.Transcribe.Alternative+        AWS.Transcribe.Channel+        AWS.Transcribe.Client+        AWS.Transcribe.EventStream+        AWS.Transcribe.Item+        AWS.Transcribe.PreSignedUrl+        AWS.Transcribe.Settings+        AWS.Transcribe.StreamingResponse+    other-modules:+        AWS.Credentials+    hs-source-dirs:   src+    other-modules:    Paths_aws_transcribe_ws+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        aeson >=1.5.6.0 && <1.6,+        async >=2.2.3 && <2.3,+        base >=4.7 && <5,+        base16-bytestring >=1.0.1.0 && <1.1,+        binary >=0.8.8.0 && <0.9,+        bytestring >=0.10.12.0 && <0.11,+        crc >=0.1.1.1 && <0.2,+        cryptohash-sha256 >=0.11.102.0 && <0.12,+        lens >=4.19.2 && <4.20,+        stm >=2.5.0.0 && <2.6,+        text >=1.2.4.1 && <1.3,+        time >=1.9.3 && <1.10,+        websockets >=0.12.7.2 && <0.13,+        wuss >=1.1.18 && <1.2++test-suite am-test-test+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    hs-source-dirs:   test+    other-modules:    Paths_aws_transcribe_ws+    default-language: Haskell2010+    ghc-options:      -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        aeson >=1.5.6.0 && <1.6,+        am-test -any,+        async >=2.2.3 && <2.3,+        base >=4.7 && <5,+        base16-bytestring >=1.0.1.0 && <1.1,+        binary >=0.8.8.0 && <0.9,+        bytestring >=0.10.12.0 && <0.11,+        crc >=0.1.1.1 && <0.2,+        cryptohash-sha256 >=0.11.102.0 && <0.12,+        lens >=4.19.2 && <4.20,+        stm >=2.5.0.0 && <2.6,+        text >=1.2.4.1 && <1.3,+        time >=1.9.3 && <1.10,+        websockets >=0.12.7.2 && <0.13,+        wuss >=1.1.18 && <1.2
+ src/AWS/Credentials.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.Credentials (Credentials, accessKey, secretKey, newCredentials, lookupCredentials) where++import Data.Aeson (FromJSON (..), Value (..), (.:))+import qualified Data.Text as T+import System.Environment (lookupEnv)++{- | AWS Security credentials comprising of an access key ID and a secret key.+ Temporary security tokens are not supported+-}+data Credentials = MkCredentials+    { accessKey :: !T.Text+    , secretKey :: !T.Text+    }++newCredentials ::+    -- | Access Key+    T.Text ->+    -- | Secret Key+    T.Text ->+    Credentials+newCredentials = MkCredentials++{- | Use the provided environment variables to create+ `Credentials`+-}+lookupCredentials ::+    -- | Access Key environment variable+    String ->+    -- | Secret Key environment variable+    String ->+    IO (Maybe Credentials)+lookupCredentials akVar skVar = do+    ak <- fmap T.pack <$> lookupEnv akVar+    sk <- fmap T.pack <$> lookupEnv skVar+    pure $ MkCredentials <$> ak <*> sk++instance FromJSON Credentials where+    parseJSON (Object o) =+        MkCredentials+            <$> o .: "access-key"+            <*> o .: "secret-key"+    parseJSON _ = fail "Not a Credentials"
+ src/AWS/Transcribe.hs view
@@ -0,0 +1,60 @@+{- | Use the WebSocket protocol to stream audio to the AWS Transcribe service++ For general information regarding the service see the relevant AWS documentation+ (<https://docs.aws.amazon.com/transcribe/latest/dg/websocket.html>)+-}+module AWS.Transcribe (+    -- ** Credentials+    Credentials,+    newCredentials,+    lookupCredentials,+    runClient,++    -- ** Channel+    Channel,+    newChannel,+    readChannel,+    writeChannel,+    tryReadChannel,+    isEmpty,++    -- ** Settings+    Settings (..),+    LanguageCode (..),+    MediaEncoding (..),+    Region (..),++    -- ** StreamingResponse+    StreamingResponse (..),+    StreamingError (..),+    TranscriptEvent,+    transcript,+    Transcript,+    results,+    Result,+    alternatives,+    channelId,+    endTime,+    isPartial,+    resultId,+    startTime,+    Alternative,+    items,+    altTranscript,+    Item,+    confidence,+    content,+    iEndTime,+    speaker,+    stable,+    iStartTime,+    itemType,+    vocabularyFilterMatch,+    ItemType (..),+) where++import AWS.Credentials+import AWS.Transcribe.Channel+import AWS.Transcribe.Client+import AWS.Transcribe.Settings+import AWS.Transcribe.StreamingResponse
+ src/AWS/Transcribe/Alternative.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module AWS.Transcribe.Alternative where++import AWS.Transcribe.Item (Item)+import Control.Lens (makeLenses, (^.))+import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object), object, (.:), (.:?), (.=))+import qualified Data.Text as T++data Alternative = MkAlternative+    { _items :: ![Item]+    , _altTranscript :: !(Maybe T.Text)+    }+    deriving (Eq, Show)+makeLenses ''Alternative++instance FromJSON Alternative where+    parseJSON (Object o) =+        MkAlternative+            <$> o .: "Items"+            <*> o .:? "Transcript"+    parseJSON _ = fail "Not an Alternative"++-- For now only send the transcription field and ignore the+-- `Item`s+instance ToJSON Alternative where+    toJSON alt =+        object+            ["Transcript" .= (alt ^. altTranscript)]
+ src/AWS/Transcribe/Channel.hs view
@@ -0,0 +1,34 @@+module AWS.Transcribe.Channel where++import AWS.Transcribe.StreamingResponse (StreamingResponse)+import Control.Concurrent.STM (TQueue, atomically, isEmptyTQueue, newTQueue, readTQueue, tryReadTQueue, writeTQueue)+import qualified Data.ByteString.Lazy as BL++{- | An AWS Transcribe channel abstraction.+ Audio `BL.Bytestring`s are written to the channel to be transcribed.+ Transcribed `StreamingResponse`s are read from the channel.+-}+data Channel = MkChannel+    { audioQueue :: !(TQueue BL.ByteString)+    , responseQueue :: !(TQueue StreamingResponse)+    }++-- | Create a new `Channel`.+newChannel :: IO Channel+newChannel = atomically $ MkChannel <$> newTQueue <*> newTQueue++-- | Read a `StreamingResponse` from the `Channel`+readChannel :: Channel -> IO StreamingResponse+readChannel (MkChannel _ rQ) = atomically $ readTQueue rQ++-- | Read a `StreamingResponse` from the `Channel` if one is available+tryReadChannel :: Channel -> IO (Maybe StreamingResponse)+tryReadChannel (MkChannel _ rQ) = atomically $ tryReadTQueue rQ++-- | Write an audio `BL.ByteString` to the channel+writeChannel :: Channel -> BL.ByteString -> IO ()+writeChannel (MkChannel wQ _) = atomically . writeTQueue wQ++-- | Is the reading side of the channel empty?+isEmpty :: Channel -> IO Bool+isEmpty (MkChannel _ rQ) = atomically $ isEmptyTQueue rQ
+ src/AWS/Transcribe/Client.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module AWS.Transcribe.Client (runClient) where++import AWS.Credentials (Credentials)+import AWS.Transcribe.Channel (Channel (MkChannel))+import AWS.Transcribe.EventStream (hEventType, hValueString, mkStreamingMessage, payload)+import qualified AWS.Transcribe.PreSignedUrl as PS+import AWS.Transcribe.Settings+import AWS.Transcribe.StreamingResponse (StreamingError (..), StreamingResponse (EndOfStream, Error, Event))+import Control.Concurrent.Async (Async, cancel, poll, withAsync)+import Control.Concurrent.STM (TQueue, atomically, readTQueue, writeTQueue)+import Control.Lens ((^.))+import qualified Data.Aeson as AE+import Data.Binary (decode, encode)+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Time (getCurrentTime)+import qualified Network.WebSockets as WS+import qualified Wuss as WS++{- | Start a @WebSocket@ client.+ The client will probe the channel for incoming `BL.ByteString`, encode it in+ the expected @Event Stream@ and transmit them to the AWS Transcribe endpoint.+ When a response is received it will be written in the channel.++ Sending an empty `BL.ByteString` will close the @WebSocket@ connection. Receiving any kind+ of exception from @AWS Transcribe@ will also close the connection.+-}+runClient ::+    -- | AWS Credentials+    Credentials ->+    -- | Session settings+    Settings ->+    -- | Transcribe channel+    Channel ->+    IO ()+runClient creds settings (MkChannel wQ rQ) = do+    putStrLn "start client"+    now <- getCurrentTime+    WS.runSecureClient+        (T.unpack $ PS.host $ region settings)+        8443+        (T.unpack $ T.decodeUtf8 $ PS.path creds settings now)+        $ \conn ->+            withAsync (send conn wQ) $ \handle ->+                receive conn rQ handle++send :: WS.Connection -> TQueue BL.ByteString -> IO ()+send conn wQ = go+  where+    go = do+        pl <- atomically $ readTQueue wQ+        WS.sendBinaryData conn $ encode $ mkStreamingMessage $ BL.toStrict pl+        -- Sending an empty message will shut down the socket+        if BL.null pl then pure () else go++receive :: WS.Connection -> TQueue StreamingResponse -> Async () -> IO ()+receive conn rQ handle = go+  where+    go = withRunningSend rQ handle $ do+        message <- WS.receive conn+        case message of+            WS.DataMessage _ _ _ (WS.Binary msg) -> do+                -- TODO: Use decodeOrFail+                let decoded = decode msg+                let response = case decoded ^. hEventType . hValueString of+                        "BadRequestException" -> Error BadRequestException+                        "InternalFailureException" -> Error InternalFailureException+                        "LimitExceededException" -> Error LimitExceededException+                        "UnrecognizedClientException" -> Error UnrecognizedClientException+                        "TranscriptEvent" ->+                            case AE.eitherDecodeStrict $ decoded ^. payload of+                                Left err -> Error $ TranscriptEventError err+                                Right trans -> Event trans+                        hOther -> Error $ OtherStreamingError decoded $ "Unknown header: " <> T.unpack hOther++                atomically $ writeTQueue rQ response+                go+            -- On close, clean up the send async action and close the connection+            WS.ControlMessage (WS.Close _ _) -> cancel handle >> atomically (writeTQueue rQ EndOfStream) >> pure ()+            -- Ignore other messages+            _ -> go++-- Perform an action while the async send has not raised an exception. If an+-- exception is raised in the send thread, a `EndOfStream` message is sent+-- to the stream and the action is not run.+withRunningSend :: TQueue StreamingResponse -> Async () -> IO () -> IO ()+withRunningSend rQ handle action = do+    status <- poll handle+    case status of+        -- If the sendthread returns, we still run the receive action+        -- to catch any in-flight messages+        Just (Right _) -> action+        Just (Left _) -> atomically (writeTQueue rQ EndOfStream) >> pure ()+        Nothing -> action
+ src/AWS/Transcribe/EventStream.hs view
@@ -0,0 +1,178 @@+{-# 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+    { _hContentType :: !Header+    , _hEventType :: !Header+    , _hMessageType :: !Header+    , _payload :: !BS.ByteString+    }+    deriving (Show, Eq)++-- | Event stram encoding header+data Header = MkHeader+    { _hNameLength :: !Word8+    , _hName :: !T.Text+    , _hValueType :: !Word8+    , _hValueStringLength :: !Int16+    , _hValueString :: !T.Text+    }+    deriving (Show, Eq)++makeLenses ''Message+makeLenses ''Header++instance Binary Header where+    put = putBuilder . headerBuilder+    get = do+        hnl <- get+        hn <- getByteString (fromIntegral hnl)+        hvt <- get+        hvsl <- getInt16be+        hvs <- getByteString (fromIntegral hvsl)+        pure $ MkHeader hnl (T.decodeUtf8 hn) hvt hvsl (T.decodeUtf8 hvs)++instance Binary Message where+    put msg = do+        putBuilder totalMsg+        putBuilder msgCrc+      where+        prelude = tbl' <> hbl'+        tbl' = BS.int32BE $ tbl msg+        hbl' = BS.int32BE hbl+        preludeCrc = crcBuilder prelude+        pb = BS.byteString (msg ^. payload)+        totalMsg = prelude <> preludeCrc <> requestMessageHeaders <> pb+        msgCrc = crcBuilder totalMsg++    get = do+        tbl' <- getInt32be+        hbl' <- getInt32be+        -- Skip crc check+        skip 4+        h1 <- get+        h2 <- get+        h3 <- get+        let (h1', h2', h3') = classifyHeaders h2 h1 h3+        pl <- getByteString (fromIntegral tbl' - fromIntegral hbl' - 16)+        -- Skip crc check+        pure $ MkMessage h1' h2' h3' pl++classifyHeaders :: Header -> Header -> Header -> (Header, Header, Header)+classifyHeaders h1 h2 h3+    | h1 ^. hNameLength == 13 = classifyHeaders h2 h3 h1+    | h2 ^. hName == "content-type" = (h2, h1, h3)+    | otherwise = (h3, h1, h2)++-- The total byte length of a message+-- tbl: 16 Bytes overhead + headers length + payload length+tbl :: Message -> Int32+tbl msg = 16 + hbl + pbl msg++-- A message's headers byte length+hbl :: Int32+hbl = hContentTypeRequestBL + hEventTypeRequestBL + hMessageTypeRequestBL++-- A message's payload byte length+pbl :: Message -> Int32+pbl msg = fromIntegral (BS.length $ msg ^. payload)++-- A strict ByteString builder for `Header`+headerBuilder :: Header -> BS.Builder+headerBuilder (MkHeader nl n vt vsl vl) =+    BS.word8 nl+        <> BS.byteString (T.encodeUtf8 n)+        <> BS.word8 vt+        <> BS.int16BE vsl+        <> BS.byteString (T.encodeUtf8 vl)++getHeader :: Get Header+getHeader = do+    hnbl <- getWord8+    hn <- getByteString (fromIntegral hnbl)+    hvt <- getWord8+    vsbl <- getInt16be+    vs <- getByteString (fromIntegral vsbl)+    pure $ MkHeader hnbl (T.decodeUtf8 hn) hvt vsbl (T.decodeUtf8 vs)++-- A CRC32 builder for strict ByteStrings+crcBuilder :: BS.Builder -> BS.Builder+crcBuilder = BS.word32BE . CRC32.crc32 . CRC32.digest . BL.toStrict . BS.toLazyByteString++-- The standard content-type request header+hContentTypeRequest :: Header+hContentTypeRequest = MkHeader 13 ":content-type" 7 24 "application/octet-stream"++-- Request content-type header byte length+hContentTypeRequestBL :: Int32+hContentTypeRequestBL = 41++-- The standard event-type request header+hEventTypeRequest :: Header+hEventTypeRequest = MkHeader 11 ":event-type" 7 10 "AudioEvent"++-- Request event-type header byte length+hEventTypeRequestBL :: Int32+hEventTypeRequestBL = 25++-- The standard message-type request header+hMessageTypeRequest :: Header+hMessageTypeRequest = MkHeader 13 ":message-type" 7 5 "event"++-- Request message-type header byte length+hMessageTypeRequestBL :: Int32+hMessageTypeRequestBL = 22++requestMessageHeaders :: BS.Builder+requestMessageHeaders =+    headerBuilder hContentTypeRequest+        <> headerBuilder hEventTypeRequest+        <> headerBuilder hMessageTypeRequest++-- | Make a streaming message, using the default request headers+mkStreamingMessage :: BS.ByteString -> Message+mkStreamingMessage pl = MkMessage hContentTypeRequest hEventTypeRequest hMessageTypeRequest pl
+ src/AWS/Transcribe/Item.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module AWS.Transcribe.Item where++import Control.Lens (makeLenses)+import Data.Aeson (FromJSON (..), Value (..), (.:?))+import qualified Data.Text as T++{- | A word, phrase, or punctuation mark that is transcribed from the input audio.+ https://docs.aws.amazon.com/transcribe/latest/dg/API_streaming_Item.html+-}+data Item = MkItem+    { -- | A value between 0 and 1 for an `Item` that is a confidence+      -- score that Amazon Transcribe assigns to each word or phrase that it transcribes.+      _confidence :: !(Maybe Double)+    , -- | The word or punctuation that was recognized in the input audio.+      _content :: !(Maybe T.Text)+    , -- | The offset from the beginning of the audio stream to the end of the+      -- audio that resulted in the item.+      _iEndTime :: !(Maybe Double)+    , -- | If speaker identification is enabled, shows the speakers identified+      -- in the real-time stream.+      _speaker :: !(Maybe T.Text)+    , -- | If partial result stabilization has been enabled,+      -- indicates whether the word or phrase in the `Item` is stable.+      -- If Stable is true, the result is stable.+      _stable :: !(Maybe Bool)+    , -- | The offset from the beginning of the audio stream to the beginning+      -- of the audio that resulted in the item.+      _iStartTime :: !(Maybe Double)+    , -- | The type of the `Item`+      _itemType :: !(Maybe ItemType)+    , -- | Indicates whether a word in the item matches a word in the vocabulary+      -- filter you've chosen for your real-time stream. If true then a word in+      -- the item matches your vocabulary filter.+      _vocabularyFilterMatch :: !(Maybe Bool)+    }+    deriving (Show, Eq)++-- | The type of the `Item`+data ItemType+    = -- | Indicates that the `Item` is a word that was recognized in the input audio+      Pronunciation+    | -- | Indicates that the `Item` was interpreted as a pause in the input audio+      Punctuation+    deriving (Show, Eq)++makeLenses ''Item++instance FromJSON ItemType where+    parseJSON (String s) =+        case s of+            "pronunciation" -> pure Pronunciation+            "punctuation" -> pure Punctuation+            _ -> fail "Not an ItemType"+    parseJSON _ = fail "Not an ItemType"++instance FromJSON Item where+    parseJSON (Object o) = do+        cnf <- o .:? "Confidence"+        cnt <- o .:? "Content"+        endT <- o .:? "EndTime"+        spk <- o .:? "Speaker"+        stb <- o .:? "Stable"+        startT <- o .:? "StartTime"+        tp <- o .:? "Type"+        voc <- o .:? "VocabularyFilterMatch"+        pure $ MkItem cnf cnt endT spk stb startT tp voc+    parseJSON _ = fail "Not an Item"
+ src/AWS/Transcribe/PreSignedUrl.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.Transcribe.PreSignedUrl (host, path) where++import AWS.Credentials (Credentials (accessKey, secretKey))+import AWS.Transcribe.Settings (Region, Settings (..), langCode, meToText, region, rgToText, srToText)+import qualified Crypto.Hash.SHA256 as SH+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Time (UTCTime, defaultTimeLocale, formatTime)++-- Http verb+method :: T.Text+method = "GET"++-- Service name+service :: T.Text+service = "transcribe"++-- # Host+host :: Region -> T.Text+host rg = "transcribestreaming." <> rgToText rg <> ".amazonaws.com"++-- Date and time of the signature's creation+amzDate :: UTCTime -> T.Text+amzDate = T.pack . formatTime defaultTimeLocale "%Y%m%dT%H%M%SZ"++-- Date without time for credential scope+datestamp :: UTCTime -> T.Text+datestamp = T.pack . formatTime defaultTimeLocale "%Y%m%d"++-- The canonical URI+canonicalUri :: T.Text+canonicalUri = "/stream-transcription-websocket"++-- The canonical headers+canonicalHeaders :: Region -> T.Text+canonicalHeaders rg = "host:" <> host rg <> "\n"++-- The signed headers+signedHeaders :: T.Text+signedHeaders = "host"++-- The hashing algorithm+algorithm :: T.Text+algorithm = "AWS4-HMAC-SHA256"++-- The credential scope, scopes the derived key to the date, Region and service+credentialScope :: Region -> UTCTime -> T.Text+credentialScope rg now = datestamp now <> "%2F" <> rgToText rg <> "%2F" <> service <> "%2F" <> "aws4_request"++-- | Similar to `credentialScope`, but with no url encoding for '/'+credentialScopeNoEncoding :: Region -> UTCTime -> T.Text+credentialScopeNoEncoding rg now = datestamp now <> "/" <> rgToText rg <> "/" <> service <> "/" <> "aws4_request"++canonicalQueryString :: Credentials -> Settings -> UTCTime -> T.Text+canonicalQueryString creds settings now =+    "X-Amz-Algorithm=" <> algorithm+        <> "&X-Amz-Credential="+        <> accessKey creds+        <> "%2F"+        <> credentialScope (region settings) now+        <> "&X-Amz-Date="+        <> amzDate now+        <> "&X-Amz-Expires=300"+        <> "&X-Amz-SignedHeaders="+        <> signedHeaders+        <> "&language-code="+        <> langCode (languageCode settings)+        <> "&media-encoding="+        <> meToText (mediaEncoding settings)+        <> "&sample-rate="+        <> srToText (sampleRate settings)++payloadHash :: BS.ByteString+payloadHash = hexHash $ T.encodeUtf8 ""++canonicalRequest :: Credentials -> Settings -> UTCTime -> BS.ByteString+canonicalRequest creds settings now =+    T.encodeUtf8 method+        <> "\n"+        <> T.encodeUtf8 canonicalUri+        <> "\n"+        <> T.encodeUtf8 (canonicalQueryString creds settings now)+        <> "\n"+        <> T.encodeUtf8 (canonicalHeaders $ region settings)+        <> "\n"+        <> T.encodeUtf8 signedHeaders+        <> "\n"+        <> payloadHash++stringToSign :: Credentials -> Settings -> UTCTime -> BS.ByteString+stringToSign creds settings now =+    T.encodeUtf8 algorithm+        <> "\n"+        <> T.encodeUtf8 (amzDate now)+        <> "\n"+        <> T.encodeUtf8 (credentialScopeNoEncoding (region settings) now)+        <> "\n"+        <> hexHash (canonicalRequest creds settings now)++signingKey :: Credentials -> Region -> UTCTime -> BS.ByteString+signingKey creds rg now =+    hmacSHA256 kService "aws4_request"+  where+    kDate = hmacSHA256 ("AWS4" <> T.encodeUtf8 (secretKey creds)) (T.encodeUtf8 $ datestamp now)+    kRegion = hmacSHA256 kDate $ T.encodeUtf8 $ rgToText rg+    kService = hmacSHA256 kRegion $ T.encodeUtf8 service++signature :: Credentials -> Settings -> UTCTime -> BS.ByteString+signature creds settings now = v4Signature (signingKey creds (region settings) now) (stringToSign creds settings now)++finalQueryString :: Credentials -> Settings -> UTCTime -> BS.ByteString+finalQueryString creds settings now =+    T.encodeUtf8 (canonicalQueryString creds settings now) <> "&X-Amz-Signature=" <> signature creds settings now++path :: Credentials -> Settings -> UTCTime -> BS.ByteString+path creds settings now = T.encodeUtf8 canonicalUri <> "?" <> finalQueryString creds settings now++v4Signature :: BS.ByteString -> BS.ByteString -> BS.ByteString+v4Signature derivedKey payLoad = B16.encode $ hmacSHA256 derivedKey payLoad++hexHash :: BS.ByteString -> BS.ByteString+hexHash = B16.encode . SH.hash++hmacSHA256 :: BS.ByteString -> BS.ByteString -> BS.ByteString+hmacSHA256 key msg = SH.hmac key msg
+ src/AWS/Transcribe/Settings.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module AWS.Transcribe.Settings where++import qualified Data.Text as T++-- | Transcribe session specific settings+data Settings = MkSettings+    { languageCode :: LanguageCode+    , mediaEncoding :: MediaEncoding+    , sampleRate :: Word+    , region :: Region+    }++-- | The language code for the input audio.+data LanguageCode+    = EnAU+    | EnGB+    | EnUS+    | EsUS+    | FrCA+    | FrFR+    | DeDE+    | JaJP+    | KoKR+    | PtBR+    | ZhCN+    | ItIT++langCode :: LanguageCode -> T.Text+langCode = \case+    EnAU -> "en-AU"+    EnGB -> "en-GB"+    EnUS -> "en-US"+    EsUS -> "es-US"+    FrCA -> "fr-CA"+    FrFR -> "fr-FR"+    DeDE -> "de-DE"+    JaJP -> "ja-JP"+    KoKR -> "ko-KR"+    PtBR -> "pt-BR"+    ZhCN -> "zh-CN"+    ItIT -> "it-IT"++-- | The encoding used for the input audio+data MediaEncoding+    = PCM+    | OggOpus+    | Flac++meToText :: MediaEncoding -> T.Text+meToText = \case+    PCM -> "pcm"+    OggOpus -> "ogg-opus"+    Flac -> "flac"++-- | Amazon Transcribe Streaming regions+data Region+    = USEast1+    | USEast2+    | USWest2+    | APNorthEast1+    | APNorthEast2+    | APSouthEast2+    | CACentral1+    | EUCentral1+    | EUWest1+    | EUWest2+    | SAEast1++rgToText :: Region -> T.Text+rgToText = \case+    USEast1 -> "us-east-1"+    USEast2 -> "us-east-2"+    USWest2 -> "us-west-2"+    APNorthEast1 -> "ap-northeast-1"+    APNorthEast2 -> "ap-northeast-2"+    APSouthEast2 -> "ap-southeast-2"+    CACentral1 -> "ca-central-1"+    EUCentral1 -> "eu-central-1"+    EUWest1 -> "eu-west-1"+    EUWest2 -> "eu-west-2"+    SAEast1 -> "sa-east-1"++srToText :: Word -> T.Text+srToText = T.pack . show
+ src/AWS/Transcribe/StreamingResponse.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module AWS.Transcribe.StreamingResponse (+    StreamingResponse (..),+    StreamingError (..),+    TranscriptEvent,+    transcript,+    Transcript,+    results,+    Result,+    alternatives,+    channelId,+    endTime,+    isPartial,+    resultId,+    startTime,+    Alternative,+    items,+    altTranscript,+    Item,+    confidence,+    content,+    iEndTime,+    speaker,+    stable,+    iStartTime,+    itemType,+    vocabularyFilterMatch,+    ItemType (..),+) where++import AWS.Transcribe.Alternative+import AWS.Transcribe.EventStream (Message)+import AWS.Transcribe.Item+import Control.Lens (makeLenses, (^.))+import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.:), (.:?), (.=))+import qualified Data.Text as T++newtype TranscriptEvent = MkTranscriptEvent+    {_transcript :: Transcript}+    deriving (Eq, Show)++instance FromJSON TranscriptEvent where+    parseJSON (Object o) =+        MkTranscriptEvent+            <$> o .: "Transcript"+    parseJSON _ = fail " Not a Transcribed"++newtype Transcript = MkTranscript+    {_results :: [Result]}+    deriving (Eq, Show)++instance FromJSON Transcript where+    parseJSON (Object o) =+        MkTranscript+            <$> o .: "Results"+    parseJSON _ = fail " Not a Transcript"++data Result = MkResult+    { _alternatives :: ![Alternative]+    , _channelId :: !(Maybe T.Text)+    , _endTime :: !Double+    , _isPartial :: !Bool+    , _resultId :: !T.Text+    , _startTime :: !Double+    }+    deriving (Eq, Show)++makeLenses ''TranscriptEvent+makeLenses ''Transcript+makeLenses ''Result++instance FromJSON Result where+    parseJSON (Object o) = do+        alt <- o .: "Alternatives"+        cid <- o .:? "ChannelId"+        endT <- o .: "EndTime"+        partial <- o .: "IsPartial"+        rid <- o .: "ResultId"+        startT <- o .: "StartTime"+        pure $ MkResult alt cid endT partial rid startT+    parseJSON _ = fail " Not a Result"++instance ToJSON Result where+    toJSON r =+        object+            [ "Alternatives" .= (r ^. alternatives)+            , "IsPartial" .= (r ^. isPartial)+            , "ResultId" .= (r ^. resultId)+            ]++-- |+data StreamingError+    = BadRequestException+    | InternalFailureException+    | LimitExceededException+    | UnrecognizedClientException+    | -- | An error in decoding a `TranscriptEvent`+      TranscriptEventError String+    | -- | An unrecognised exception type or a binary decoding+      -- error. The original message is returned along with a+      -- possible description of the error+      OtherStreamingError Message String+    deriving (Eq, Show)++data StreamingResponse+    = Event TranscriptEvent+    | Error StreamingError+    | EndOfStream+    deriving (Eq, Show)
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"