diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -13,6 +13,7 @@ import Data.Aeson (decode) import System.Log.Heavy.Backends (defStdoutSettings) import System.Log.Heavy.Types(LoggingSettings(..)) +import Data.Maybe data MainOptions = MainOptions { @@ -45,12 +46,11 @@ let mime = (defaultMimeLookup "d.mp3") print mime print . sha256 $ bytes - case decode "{ \"type\": \"transcription\", \"transcription_config\": { \"language\": \"en-AU\", \"diarization\": \"channel\", \"channel_diarization_labels\": [\"Agent\", \"Caller\"] } }" of - Just json -> do - result <- runStdoutLoggingT $ transcribeBytes (ByteConfig (Location JsonV2 "http://192.168.38.91:8082/v1/user/" userId Nothing) - -- "{ \"type\": \"transcription\", \"transcription_config\": { \"language\": \"en-AU\", \"diarization\": \"channel\", \"channel_diarization_labels\": [\"Agent\", \"Caller\"] } }") - json) - (LoadedFile bytes file mime) - putStrLn . show $ result - Nothing -> return () + + let json = fromJust $ decode "{ \"type\": \"transcription\", \"transcription_config\": { \"language\": \"en-AU\", \"diarization\": \"channel\", \"channel_diarization_labels\": [\"Agent\", \"Caller\"] } }" + result <- runStdoutLoggingT $ transcribeBytes (ByteConfig (Location JsonV2 "https://api.speechmatics.com/v1.0/user/" userId bearToken) + -- "{ \"type\": \"transcription\", \"transcription_config\": { \"language\": \"en-AU\", \"diarization\": \"channel\", \"channel_diarization_labels\": [\"Agent\", \"Caller\"] } }") + json) + (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: 647d0f891a79463d3078719ace8c4e3709d4edaf328525db0ea3f6f294e05b58 +-- hash: bb5a8fd3e472f8d525b9a3ea29afda678c16f8324dfecd227ed234ac777821d8 name: speechmatics -version: 0.7.0.0 +version: 0.7.1.0 synopsis: Speechmatics api client description: Upload audio files to speechmatics to get a transcription category: API @@ -37,6 +37,7 @@ , json-autotype , lens , mime-types + , monad-control , mtl , text , text-format-heavy @@ -45,6 +46,8 @@ Speechmatics.Client Speechmatics.JSON.PeekJob Speechmatics.JSON.PostJob + Speechmatics.Log + Speechmatics.Request other-modules: Paths_speechmatics default-language: Haskell2010 diff --git a/src/Speechmatics/Client.hs b/src/Speechmatics/Client.hs --- a/src/Speechmatics/Client.hs +++ b/src/Speechmatics/Client.hs @@ -25,7 +25,8 @@ eitherDecode, encode) import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, - responseTimeoutMicro) + responseTimeoutMicro, + HttpException) import Data.Bifunctor import Network.HTTP.Client.OpenSSL @@ -42,16 +43,13 @@ import Data.Monoid import Data.Text import qualified Data.Text.Lazy as Lazy -import qualified Network.Wreq.Session as Sess import qualified Speechmatics.JSON.PeekJob as Peek import qualified Speechmatics.JSON.PostJob as Post - -source :: Text -source = "Speechmatics client" -info d = Logcut.info (Lazy.fromStrict d) (Single source) -debug d = Logcut.debug (Lazy.fromStrict d) (Single source) --- warn = logWarnNS source --- error = logErrorNS source +import Control.Lens.Prism +import Control.Exception +import Control.Exception.Lens +import Speechmatics.Log +import qualified Speechmatics.Request as Sess -- | Authorization token obtained from speechmatics type AuthToken = Maybe Text @@ -99,7 +97,6 @@ modelName :: Text modelName = pack "model" - -- | Transcribe a file that is already loaded in memory -- Does not catch exeptions transcribeBytes :: ByteConfig -> LoadedFile -> LoggingT IO(Either Error Value) @@ -140,7 +137,7 @@ 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 + response <- Sess.postWith auth session postUri parts debug $ decodeUtf8 $ LBS.toStrict $ response ^. responseBody debug $ pack uri case Post.parse (response ^. responseBody) of @@ -151,7 +148,7 @@ 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 + result <- Sess.getWith makeOpts session transcriptUri return $ first ParseError $ eitherDecode (result ^. responseBody) where auth = withAuthorization options @@ -169,7 +166,7 @@ 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 + statusResponse <- Sess.getWith makeOpts session statusUri debug $ pack $ show statusResponse let body = statusResponse ^. responseBody case second Peek.jobCheckWait (Peek.parse body) of diff --git a/src/Speechmatics/Log.hs b/src/Speechmatics/Log.hs new file mode 100644 --- /dev/null +++ b/src/Speechmatics/Log.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Simple log wrapper +module Speechmatics.Log( + info, debug, error +) where + +import Prelude () +import System.Log.Heavy.LoggingT(LoggingT(..)) +import qualified System.Log.Heavy.Shortcuts as Log +import Data.Text.Format.Heavy.Instances (Single(..)) +import qualified Data.Text.Lazy as Lazy +import Data.Text + +source :: Text +source = "Speechmatics client" +info d = Log.info (Lazy.fromStrict d) (Single source) +debug d = Log.debug (Lazy.fromStrict d) (Single source) +error d = Log.reportError (Lazy.fromStrict d) (Single source) diff --git a/src/Speechmatics/Request.hs b/src/Speechmatics/Request.hs new file mode 100644 --- /dev/null +++ b/src/Speechmatics/Request.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Speechmatics.Request( +getWith, Sess.newSession, Sess.Session, postWith +) 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 Data.Aeson (FromJSON (parseJSON), Value, + eitherDecode, encode) +import Network.HTTP.Client (defaultManagerSettings, + managerResponseTimeout, + responseTimeoutMicro, + HttpException) + +import Data.Bifunctor +import Network.HTTP.Client.OpenSSL +import Network.Mime (MimeType) +import qualified Network.Wreq as Wreq + +import System.Log.Heavy.LoggingT(LoggingT(..)) +import qualified System.Log.Heavy.Shortcuts as Logcut (info, debug) +import Data.Text.Format.Heavy.Instances (Single(..)) +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 Data.Text.Lazy as Lazy +import qualified Network.Wreq.Session as Sess +import qualified Network.Wreq.Types as Types +import qualified Speechmatics.JSON.PeekJob as Peek +import qualified Speechmatics.JSON.PostJob as Post +import Control.Lens.Prism +import Control.Exception +import Control.Exception.Lens +import qualified Speechmatics.Log as Log +import qualified Data.ByteString as BS +import Control.Monad.Trans.Control(liftWith) + +class AsHttpExceptiont t where + _HttpException :: Prism' t HttpException +instance AsHttpExceptiont HttpException where + _HttpException = id +instance AsHttpExceptiont SomeException where + _HttpException = exception + +logException :: IO (Wreq.Response C8LBS.ByteString) -> LoggingT IO (Wreq.Response C8LBS.ByteString) +logException func = + liftWith (\run -> + catching _HttpException + func + (\x -> + (run $ Log.error $ pack ("Got an http exception: " <> show x)) >> + throwIO x + ) + ) + + +getWith :: Wreq.Options -> Sess.Session -> String -> LoggingT IO (Wreq.Response C8LBS.ByteString) +getWith opts sess str = do + Log.debug (pack ("Making get request to " <> str)) + logException $ Sess.getWith opts sess str + +postWith :: Types.Postable a => Wreq.Options -> Sess.Session -> String -> a -> LoggingT IO (Wreq.Response C8LBS.ByteString) +postWith opts sess str post = do + Log.debug (pack ("Making get request to " <> str)) + logException $ Sess.postWith opts sess str post