{-# LANGUAGE OverloadedStrings #-}
module VoicebaseClient
(
transcribe,
transcribeFile,
transcribeBytes,
transcribeParse,
BearerToken,
Error(..),
LazyByteFile(..)
) where
import Control.Lens
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Monoid
import Data.Text.Encoding as TE
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 Data.Text (Text, unpack)
import Data.Aeson(Value, eitherDecode, FromJSON(parseJSON))
import Data.Aeson.Types(parseEither)
import Network.Wreq
import Network.Mime(MimeType)
import qualified Network.Wreq.Session as Sess
import Network.HTTP.Client.OpenSSL
import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, responseTimeoutMicro)
import OpenSSL.Session (context)
import qualified Json.SubmitMediaTypes as Submit
import qualified Json.ProgressTypes as Progress
import qualified Json.TranscriptTypes as Transcript
import System.IO(fixIO)
type BearerToken = String
data Error = UnkownResponse | ParseError String
deriving(Show)
url :: String
url = "https://apis.voicebase.com/v2-beta/media"
timeout = responseTimeoutMicro 10000
makeOpts :: BearerToken -> Options
makeOpts token = withAuthorization token defaults
withAuthorization :: BearerToken -> Options -> Options
withAuthorization token options = options & manager .~ Left (opensslManagerSettings context)
& manager .~ Left (defaultManagerSettings { managerResponseTimeout = timeout} )
& header "Authorization" .~ [(BS.pack ("Bearer " ++ token))]
transcribeParse :: BearerToken -> FilePath -> IO(Either Error Transcript.Transcript)
transcribeParse token filepath = fmap (join . second (first ParseError . parseEither parseJSON)) (transcribeFile token filepath)
inputName = "media"
transcribeFile :: BearerToken -> FilePath -> IO(Either Error Value)
transcribeFile bearerToken filePath = transcribe bearerToken defaults (
[partFileSource inputName filePath]
)
data LazyByteFile = LazyByteFile {
content :: LBS.ByteString,
mimetype :: MimeType
}
transcribeBytes :: BearerToken -> LazyByteFile -> IO(Either Error Value)
transcribeBytes bearerToken (LazyByteFile content mimetype) =
transcribe bearerToken defaults (
[partLBS inputName content & partContentType .~ Just mimetype ]
)
transcribe :: BearerToken -> Options -> [Part] -> IO(Either Error Value)
transcribe token options parts = do
session <- Sess.newSession
response <- Sess.postWith (withAuthorization token options) session url parts
case Submit.parse (response ^. responseBody) of
Left error -> return $ Left $ ParseError error
Right parsed -> do
waitResult <- pollStatus token session (Submit.topLevelMediaId parsed)
case waitResult of
Right _ -> first ParseError . eitherDecode <$> (requestTranscript token session (Submit.topLevelMediaId parsed))
Left error -> return $ Left $ error
pollStatus :: BearerToken -> Sess.Session -> Text -> IO(Either Error ())
pollStatus token session mediaId = pollStatus' token session mediaId "pending"
pollStatus' :: BearerToken -> Sess.Session -> Text -> Text -> IO (Either Error ())
pollStatus' token session mediaId "pending" = do
response <- Sess.getWith (makeOpts token) session (url <> "/" <> (unpack mediaId) <> "/progress")
case Progress.parse (response ^. responseBody) of
Left error -> return $ Left $ ParseError error
Right parsed -> pollStatus' token session mediaId ((Progress.progressStatus . Progress.topLevelProgress) $ parsed)
pollStatus' token session mediaId "started" = pollStatus' token session mediaId "pending"
pollStatus' token session mediaId "completed" = return $ Right ()
pollStatus' _ _ _ _ = return $ Left UnkownResponse
requestTranscript :: BearerToken -> Sess.Session -> Text -> IO (C8LBS.ByteString)
requestTranscript token session mediaId = do
response <- Sess.getWith (makeOpts token) session (url <> "/" <> (unpack mediaId))
return $ response ^. responseBody