diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -2,6 +2,7 @@ module Main where +import Control.Monad.Logger(LoggingT(..), runStdoutLoggingT, logInfoNS, logDebugNS, logWarnNS, logErrorNS, MonadLogger) import Network.Mime(defaultMimeLookup) import Options import qualified Data.ByteString.Lazy as LBS @@ -40,6 +41,6 @@ let mime = (defaultMimeLookup "d.mp3") print mime print . sha256 $ bytes - result <- transcribeBytes JsonV2 "http://192.168.38.91:8082/v1/user/" userId Nothing "en-AU" (LazyByteFile bytes file mime) + result <- runStdoutLoggingT $ transcribeBytes (ByteConfig (Location JsonV2 "http://192.168.38.91:8082/v1/user/" userId Nothing) "en-AU") (LoadedFile bytes file mime) putStrLn . show $ result diff --git a/speechmatics.cabal b/speechmatics.cabal --- a/speechmatics.cabal +++ b/speechmatics.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5d7987afdc6f3b85ab67e58f53f104c67c8ba87caf64cbf122684e90d565ff7e +-- hash: db9c3ccd92a7f21fe5f04addcde9142dba3b2245ec662671ddb9d0acb2494fee name: speechmatics -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Speechmatics api client description: Upload audio files to speechmatics to get a transcription category: API @@ -36,6 +36,8 @@ , json-autotype , lens , mime-types + , monad-logger + , mtl , text , wreq exposed-modules: @@ -56,6 +58,8 @@ , base >=4.7 && <5 , bytestring , mime-types + , monad-logger + , mtl , options , speechmatics , text @@ -73,6 +77,8 @@ base >=4.7 && <5 , bytestring , hspec + , monad-logger + , mtl , neat-interpolation , speechmatics , text diff --git a/src/Speechmatics/Client.hs b/src/Speechmatics/Client.hs --- a/src/Speechmatics/Client.hs +++ b/src/Speechmatics/Client.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} module Speechmatics.Client( transcribeBytes, @@ -7,36 +7,51 @@ AuthToken, UserID, ModelName, - LazyByteFile(..), + LoadedFile(..), Error(..), - Format(..) + Format(..), + Location(..), + ByteConfig(..) ) where +import Control.Applicative +import Control.Concurrent (threadDelay) +import Control.Lens +import Control.Monad +import Control.Monad.Except +import Data.Text.Encoding +import Network.HTTP.Types.URI +import OpenSSL.Session (context) -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 (FromJSON (parseJSON), Value, + eitherDecode) +import Network.HTTP.Client (defaultManagerSettings, + managerResponseTimeout, + responseTimeoutMicro) -import Data.Aeson(Value, eitherDecode, FromJSON(parseJSON)) -import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, responseTimeoutMicro) +import Data.Bifunctor +import Network.HTTP.Client.OpenSSL +import Network.Mime (MimeType) +import Network.Wreq -import Network.Wreq -import Network.Mime(MimeType) -import qualified Network.Wreq.Session as Sess -import Network.HTTP.Client.OpenSSL -import Data.Bifunctor +import Control.Monad.Logger (LoggingT (..), MonadLogger, + logDebugNS, logErrorNS, logInfoNS, + logWarnNS, runStdoutLoggingT) +import qualified Data.ByteString.Char8 as C8BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as C8LBS +import Data.Maybe +import Data.Monoid +import Data.Text +import qualified Network.Wreq.Session as Sess +import qualified Speechmatics.JSON.PeekJob as Peek +import qualified Speechmatics.JSON.PostJob as Post -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 +source :: Text +source = "Speechmatics client" +info = logInfoNS source +debug = logDebugNS source +-- warn = logWarnNS source +-- error = logErrorNS source -- | Authorization token obtained from speechmatics type AuthToken = Maybe Text @@ -46,14 +61,33 @@ type ModelName = String type JobID = Integer -data LazyByteFile = LazyByteFile { - content :: LBS.ByteString, +data LoadedFile = LoadedFile { + content :: LBS.ByteString, filename :: String, mimetype :: MimeType -- to get this Jappie used defaultMimeLookup "f.mp3" - } +} + data Error = UnkownResponse | ParseError String deriving(Show) +data Format = JsonV1 | JsonV2 + +-- | Configuration data for transcribe function +-- has less configuration then transcribeBytes because the function accepts +-- much more generic parts +data Location = Location { + format :: Format, + url :: String, + userId :: UserID, + authToken :: AuthToken + } + +-- | Configuration data for transcribeBytes function +data ByteConfig = ByteConfig { + location :: Location, + model :: ModelName +} + makeOpts :: Options makeOpts = withAuthorization defaults @@ -65,24 +99,23 @@ modelName :: Text modelName = pack "model" -data Format = JsonV1 | JsonV2 -- | Transcribe a file that is already loaded in memory -- Does not catch exeptions -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 +transcribeBytes :: ByteConfig -> LoadedFile -> LoggingT IO(Either Error Value) +transcribeBytes (ByteConfig location model) (LoadedFile content filename mimetype) = + transcribe location defaults parts where parts = [ - partLBS inputName content - & partContentType .~ Just mimetype - & partFileName .~ Just filename, + partLBS inputName content + & partContentType ?~ mimetype + & partFileName ?~ filename, partString modelName model ] withAuthorization :: Options -> Options -withAuthorization options = options - & manager .~ Left (opensslManagerSettings context) +withAuthorization options = options + & manager .~ Left (opensslManagerSettings context) & manager .~ Left (defaultManagerSettings { managerResponseTimeout = timeout} ) formatQuery :: Format -> QueryText @@ -92,53 +125,53 @@ authQuery :: AuthToken -> QueryText authQuery auth = maybeToList $ (\x -> (pack "auth_token", Just x)) <$> auth -slash = mappend . (flip mappend "/") -- play around to much with ghci +slash = mappend . flip mappend "/" jobsUri :: String -> UserID -> String -> String -jobsUri url userID x = url <> (show userID) `slash` "jobs" `slash` x +jobsUri url userID x = url <> show userID `slash` "jobs" `slash` x printQuery :: QueryText -> String -printQuery = C8BS.unpack . (renderQuery True) . queryTextToQuery +printQuery = C8BS.unpack . renderQuery True . queryTextToQuery --- | More general transcription interface, allows custom parts to be inserted +-- | More general transcription interface, allows custom parts to be inserted -- with whatever the user wants. -- Does not catch exeptions -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 +transcribe :: Location -> Options -> [Part] -> LoggingT IO(Either Error Value) +transcribe location@Location{format=form, url=uri, userId=userID, authToken=token} options parts = do + session <- lift Sess.newSession + info $ "begin trancription for " <> pack uri + response <- lift $ Sess.postWith auth session postUri parts + debug $ decodeUtf8 $ LBS.toStrict $ response ^. responseBody + debug $ pack 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 + pollStatus location session jobID >>= \case + Just error -> return $ Left error + Nothing -> do + let transcriptUri = url userID (show jobID `slash` "transcript") <> printQuery (formatQuery form <> authQuery token) + result <- lift $ Sess.getWith makeOpts session transcriptUri return $ first ParseError $ eitherDecode (result ^. responseBody) - where - auth = (withAuthorization options) - postUri = url userID (printQuery $ authQuery token ) + where + auth = withAuthorization options + postUri = url userID (printQuery $ authQuery token ) url = jobsUri uri -pollStatus :: String -> UserID -> AuthToken -> Sess.Session -> JobID -> IO(Maybe Error) +pollStatus :: Location -> Sess.Session -> JobID -> LoggingT 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 - -- print statusResponse +pollStatus' :: Maybe Integer -> Location -> Sess.Session -> JobID -> LoggingT IO(Maybe Error) +pollStatus' (Just wait) location sess jobid = + lift (waitFor (fromIntegral wait)) >> pollStatus' Nothing location sess jobid +pollStatus' Nothing location@Location{url=uri, userId=userID, authToken=token} session jobID = do + let statusUri = jobsUri uri userID (show jobID) <> printQuery (authQuery token) + statusResponse <- lift $ Sess.getWith makeOpts session statusUri + debug $ pack $ show statusResponse let body = statusResponse ^. responseBody - case second Peek.jobCheckWait (Peek.parse body) of - Left error -> return $ Just $ ParseError error - Right Nothing -> return $ Nothing -- done - Right maybe -> pollStatus' maybe url userID token session jobID + case second Peek.jobCheckWait (Peek.parse body) of + Left error -> return $ Just $ ParseError error + Right Nothing -> return Nothing -- done + Right maybe -> pollStatus' maybe location session jobID