{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Speechmatics.Client(
transcribeBytes,
transcribe,
AuthToken,
UserID,
ModelName,
LazyByteFile(..),
Error(..)
) where
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 BS
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
type AuthToken = Maybe String
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"
transcribeBytes :: String -> UserID -> AuthToken -> ModelName -> LazyByteFile -> IO(Either Error Value)
transcribeBytes url userID bearerToken model (LazyByteFile content filename mimetype) = do
transcribe 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} )
tokenUri :: AuthToken -> String
tokenUri (Just auth) = "?auth_token=" <> auth
tokenUri Nothing = ""
slash = mappend . (flip mappend "/")
jobsUri :: String -> UserID -> String -> String
jobsUri url userID x = url <> (show userID) `slash` "jobs" `slash` x
transcribe :: String -> UserID -> AuthToken -> Options -> [Part] -> IO(Either Error Value)
transcribe uri userID token options parts = do
session <- Sess.newSession
response <- Sess.postWith auth session postUri parts
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" <> (tokenUri token))
result <- Sess.getWith makeOpts session transcriptUri
return $ first ParseError $ eitherDecode (result ^. responseBody)
where
auth = (withAuthorization options)
postUri = url userID (tokenUri token)
url = jobsUri uri
pollStatus :: String -> UserID -> AuthToken -> Sess.Session -> JobID -> IO(Maybe Error)
pollStatus url userID token session jobID = pollStatus' Nothing url userID token session jobID
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) <> (tokenUri 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