speechmatics 0.4.0.0 → 0.5.0.0

raw patch · 3 files changed

+111/−71 lines, 3 filesdep +monad-loggerdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-logger, mtl

API changes (from Hackage documentation)

Files

• app/Main.hs +2/−1
• speechmatics.cabal +8/−2
• src/Speechmatics/Client.hs +101/−68

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

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

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