{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Speechmatics.Client(
transcribeBytes,
transcribe,
AuthToken,
UserID,
ModelName,
LazyByteFile(..),
Error(..),
Format(..)
) where
import Network.HTTP.Types.URI
import Control.Concurrent (threadDelay)
import OpenSSL.Session (context)
import Control.Lens
import Control.Monad
import Control.Applicative
import Data.Aeson(Value, eitherDecode, FromJSON(parseJSON))
import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, responseTimeoutMicro)
import Network.Wreq
import Network.Mime(MimeType)
import qualified Network.Wreq.Session as Sess
import Network.HTTP.Client.OpenSSL
import Data.Bifunctor
import qualified Data.ByteString.Char8 as C8BS
import qualified Data.ByteString.Lazy.Char8 as C8LBS
import qualified Data.ByteString.Lazy as LBS
import qualified Network.Wreq.Session as Sess
import Data.Text
import Data.Monoid
import qualified Speechmatics.JSON.PostJob as Post
import qualified Speechmatics.JSON.PeekJob as Peek
import Data.Maybe
type AuthToken = Maybe Text
type UserID = Integer
type ModelName = String
type JobID = Integer
data LazyByteFile = LazyByteFile {
content :: LBS.ByteString,
filename :: String,
mimetype :: MimeType
}
data Error = UnkownResponse | ParseError String
deriving(Show)
makeOpts :: Options
makeOpts = withAuthorization defaults
timeout = responseTimeoutMicro 10000
inputName :: Text
inputName = pack "data_file"
modelName :: Text
modelName = pack "model"
data Format = JsonV1 | JsonV2
transcribeBytes :: Format -> String -> UserID -> AuthToken -> ModelName -> LazyByteFile -> IO(Either Error Value)
transcribeBytes format url userID bearerToken model (LazyByteFile content filename mimetype) = do
transcribe format url userID bearerToken defaults parts
where
parts = [
partLBS inputName content
& partContentType .~ Just mimetype
& partFileName .~ Just filename,
partString modelName model
]
withAuthorization :: Options -> Options
withAuthorization options = options
& manager .~ Left (opensslManagerSettings context)
& manager .~ Left (defaultManagerSettings { managerResponseTimeout = timeout} )
formatQuery :: Format -> QueryText
formatQuery JsonV1 = []
formatQuery JsonV2 = [("format", Just "json-v2")]
authQuery :: AuthToken -> QueryText
authQuery auth = maybeToList $ (\x -> (pack "auth_token", Just x)) <$> auth
slash = mappend . (flip mappend "/")
jobsUri :: String -> UserID -> String -> String
jobsUri url userID x = url <> (show userID) `slash` "jobs" `slash` x
printQuery :: QueryText -> String
printQuery = C8BS.unpack . (renderQuery True) . queryTextToQuery
transcribe :: Format -> String -> UserID -> AuthToken -> Options -> [Part] -> IO(Either Error Value)
transcribe format uri userID token options parts = do
session <- Sess.newSession
print "begin"
response <- Sess.postWith auth session postUri parts
print $ response ^. responseBody
print uri
case Post.parse (response ^. responseBody) of
Left message -> return $ Left $ ParseError message
Right parsed -> do
let jobID = Post.postId parsed
pollStatus uri userID token session jobID >>= \case
Just error -> return $ Left $ error
Nothing -> do
let transcriptUri = (url userID ((show jobID) `slash` "transcript")) <> (printQuery $ formatQuery format <> authQuery token)
result <- Sess.getWith makeOpts session transcriptUri
return $ first ParseError $ eitherDecode (result ^. responseBody)
where
auth = (withAuthorization options)
postUri = url userID (printQuery $ authQuery token )
url = jobsUri uri
pollStatus :: String -> UserID -> AuthToken -> Sess.Session -> JobID -> IO(Maybe Error)
pollStatus = pollStatus' Nothing
waitFor :: Int -> IO()
waitFor x = threadDelay (1000000*x)
pollStatus' :: Maybe Integer -> String -> UserID -> AuthToken -> Sess.Session -> JobID -> IO(Maybe Error)
pollStatus' (Just wait) url user auth sess jobid =
waitFor (fromIntegral wait) >> (pollStatus' Nothing) url user auth sess jobid
pollStatus' Nothing url userID token session jobID = do
let statusUri = (jobsUri url userID $ show $ jobID) <> (printQuery $ authQuery token)
statusResponse <- Sess.getWith makeOpts session statusUri
let body = statusResponse ^. responseBody
case second Peek.jobCheckWait (Peek.parse body) of
Left error -> return $ Just $ ParseError error
Right Nothing -> return $ Nothing
Right maybe -> pollStatus' maybe url userID token session jobID