voicebase-0.1.1.2: src/VoicebaseClient.hs

{-# 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 & partFileName .~ Just ""]
  )

-- | 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