{-# LANGUAGE OverloadedStrings #-} -- | Main module for doing the requests to the voicebase api: http://voicebase.readthedocs.io/en/v2-beta/ 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) -- | get your bearer token at http://voicebase.readthedocs.io/en/v2-beta/how-to-guides/hello-world.html#token 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))] -- | transcribes the audio file and puts it into a Transcript transcribeParse :: BearerToken -> FilePath -> IO(Either Error Transcript.Transcript) transcribeParse token filepath = fmap (join . second (first ParseError . parseEither parseJSON)) (transcribeFile token filepath) inputName = "media" -- | Given a bearer token, and a filepath to an audio file, this function will -- | eventually return a transcript or times out after 10 seconds -- | Throws HttpExceptionRequest, IOException (file not found) transcribeFile :: BearerToken -> FilePath -> IO(Either Error Value) transcribeFile bearerToken filePath = transcribe bearerToken defaults ( [partFileSource inputName filePath] ) -- | In case of a bytestring, we also need to mimetype to decode the send string data LazyByteFile = LazyByteFile { content :: LBS.ByteString, mimetype :: MimeType -- to get this Jappie used defaultMimeLookup "f.mp3" } -- | Transcribe a bytestring -- | Throws HttpExceptionRequest transcribeBytes :: BearerToken -> LazyByteFile -> IO(Either Error Value) transcribeBytes bearerToken (LazyByteFile content mimetype) = transcribe bearerToken defaults ( [partLBS inputName content & partContentType .~ Just mimetype ] ) -- | Generic transcribe, agnostic of options, will add ssl, -- | the bearer token and a timeout to the options. -- | Throws HttpExceptionRequest 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 -- wait for the service to complete 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