speechmatics (empty) → 0.1.0.0
raw patch · 12 files changed
+542/−0 lines, 12 filesdep +HsOpenSSLdep +SHAdep +aesonsetup-changed
Dependencies added: HsOpenSSL, SHA, aeson, base, bytestring, hspec, http-client, http-client-openssl, json-autotype, lens, mime-types, neat-interpolation, options, speechmatics, text, wreq
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +9/−0
- Setup.hs +2/−0
- app/Main.hs +44/−0
- speechmatics.cabal +81/−0
- src/Speechmatics/Client.hs +129/−0
- src/Speechmatics/JSON/PeekJob.hs +62/−0
- src/Speechmatics/JSON/PostJob.hs +41/−0
- test/PeekJobSpec.hs +102/−0
- test/PostJobSpec.hs +38/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for speechmatics++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Daisee (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jappie Klooster nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# speechmatics++a client for the [speechmatics](https://app.speechmatics.com/api-details) api .++with input an audio file and blocking untill we get a json transcription.+++Developed by [Daisee](https://www.daisee.com/), pull requests are accepted:+https://bitbucket.org/daisee/speechmatics-api-client
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Network.Mime(defaultMimeLookup)+import Options+import qualified Data.ByteString.Lazy as LBS+import Data.Digest.Pure.SHA+import Speechmatics.Client +import Network.Mime(MimeType)++data MainOptions = MainOptions+ { + user_id :: Maybe UserID,+ token :: Maybe AuthToken,+ targetFile :: Maybe FilePath+ }+++instance Options MainOptions where+ defineOptions = pure MainOptions+ <*> simpleOption "userId" Nothing+ "The user id obtained from speechmatics"+ <*> simpleOption "token" Nothing+ "The bearer token obtained from speechmatics"+ <*> simpleOption "file" Nothing+ "The file to be posted"++main :: IO ()+main = runCommand $ \opts args -> do+ case withBearAndFile <$> user_id opts <*> token opts <*> targetFile opts of+ Nothing -> print "wrong options, see --help"+ Just compute -> compute++withBearAndFile :: UserID -> AuthToken -> FilePath -> IO() +withBearAndFile userId bearToken file = do + -- result <- transcribeFile bearToken file + bytes <- LBS.readFile file+ let mime = (defaultMimeLookup "d.mp3")+ print mime+ print . sha256 $ bytes+ result <- transcribeBytes userId bearToken "en-US" (LazyByteFile bytes file mime)+ putStrLn . show $ result+
+ speechmatics.cabal view
@@ -0,0 +1,81 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 4bc71e263d2002b605c0009ece685cd69f43493ceabe7ba3da924eaaf3e2cb69++name: speechmatics+version: 0.1.0.0+synopsis: Upload audio files to speechmatics to get a transcription+description: Please see the README on bitbucket <https://bitbucket.org/daisee/speechmatics-api-client/src/master/>+category: API+homepage: https://bitbucket.org/daisee/speechmatics-api-client/+author: Jappie Klooster+maintainer: jappie.klooster@daisee.com+copyright: Daisee Pty Ltd+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ ChangeLog.md+ README.md++library+ hs-source-dirs:+ src+ build-depends:+ HsOpenSSL+ , aeson+ , base >=4.7 && <5+ , bytestring+ , http-client+ , http-client-openssl+ , json-autotype+ , lens+ , mime-types+ , text+ , wreq+ exposed-modules:+ Speechmatics.Client+ Speechmatics.JSON.PeekJob+ Speechmatics.JSON.PostJob+ other-modules:+ Paths_speechmatics+ default-language: Haskell2010++executable speechmatics+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ SHA+ , base >=4.7 && <5+ , bytestring+ , mime-types+ , options+ , speechmatics+ other-modules:+ Paths_speechmatics+ default-language: Haskell2010++test-suite speechmatics-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bytestring+ , hspec+ , neat-interpolation+ , speechmatics+ , text+ other-modules:+ PeekJobSpec+ PostJobSpec+ Paths_speechmatics+ default-language: Haskell2010
+ src/Speechmatics/Client.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Speechmatics.Client(+ transcribeBytes,+ transcribe,+ AuthToken,+ UserID,+ ModelName,+ LazyByteFile(..)+) where++import Control.Concurrent (threadDelay)+import OpenSSL.Session (context)+import Control.Lens+import Control.Monad+import Control.Applicative++import Data.Aeson(Value, eitherDecode, FromJSON(parseJSON))+import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, responseTimeoutMicro)++import Network.Wreq+import Network.Mime(MimeType)+import qualified Network.Wreq.Session as Sess+import Network.HTTP.Client.OpenSSL+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 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++-- | Authorization token obtained from speechmatics+type AuthToken = String+-- | UserID obtained from speechmatics+type UserID = Integer+-- | Which langauge model to use+type ModelName = String+type JobID = Integer++data LazyByteFile = LazyByteFile {+ content :: LBS.ByteString,+ filename :: String,+ mimetype :: MimeType -- to get this Jappie used defaultMimeLookup "f.mp3"+ }+data Error = UnkownResponse | ParseError String+ deriving(Show)++makeOpts :: Options+makeOpts = withAuthorization defaults++timeout = responseTimeoutMicro 10000++url :: String+url = "https://api.speechmatics.com/v1.0/user/"++inputName :: Text+inputName = pack "data_file"++modelName :: Text+modelName = pack "model"++-- | Transcribe a file that is already loaded in memory+-- Does not catch exeptions+transcribeBytes :: UserID -> AuthToken -> ModelName -> LazyByteFile -> IO(Either Error Value)+transcribeBytes userID bearerToken model (LazyByteFile content filename mimetype) = do+ transcribe userID bearerToken defaults parts+ where+ parts = [+ partLBS inputName content + & partContentType .~ Just mimetype + & partFileName .~ Just filename,+ partString modelName model+ ]++withAuthorization :: Options -> Options+withAuthorization options = options + & manager .~ Left (opensslManagerSettings context) + & manager .~ Left (defaultManagerSettings { managerResponseTimeout = timeout} )++tokenUri :: AuthToken -> String+tokenUri auth = "?auth_token=" <> auth++slash = mappend . (flip mappend "/") -- play around to much with ghci+jobsUri :: UserID -> String -> String+jobsUri userID x = url <> (show userID) `slash` "jobs" `slash` x++-- | More general transcription interface, allows custom parts to be inserted +-- with whatever the user wants.+-- Does not catch exeptions+transcribe :: UserID -> AuthToken -> Options -> [Part] -> IO(Either Error Value)+transcribe userID token options parts = do+ session <- Sess.newSession+ response <- Sess.postWith auth session postUri parts+ case Post.parse (response ^. responseBody) of+ Left message -> return $ Left $ ParseError message+ Right parsed -> do+ let jobID = Post.postId parsed+ pollStatus userID token session jobID >>= \case+ Just error -> return $ Left $ error+ Nothing -> do + let transcriptUri = jobsUri userID ((show jobID) `slash` "transcript" <> (tokenUri token))+ result <- Sess.getWith makeOpts session transcriptUri+ return $ first ParseError $ eitherDecode (result ^. responseBody)+ where + auth = (withAuthorization options)+ postUri = jobsUri userID (tokenUri token)++pollStatus :: UserID -> AuthToken -> Sess.Session -> JobID -> IO(Maybe Error)+pollStatus userID token session jobID = pollStatus' Nothing userID token session jobID++waitFor :: Int -> IO()+waitFor x = threadDelay (1000000*x)++pollStatus' :: Maybe Integer -> UserID -> AuthToken -> Sess.Session -> JobID -> IO(Maybe Error)+pollStatus' (Just wait) user auth sess jobid = + waitFor (fromIntegral wait) >> (pollStatus' Nothing) user auth sess jobid+pollStatus' Nothing userID token session jobID = do + let statusUri = (jobsUri userID $ show $ jobID) <> (tokenUri token)+ statusResponse <- Sess.getWith makeOpts session statusUri+ 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 userID token session jobID
+ src/Speechmatics/JSON/PeekJob.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveGeneric #-}++module Speechmatics.JSON.PeekJob where++import System.Exit (exitFailure, exitSuccess)+import System.IO (stderr, hPutStrLn)+import qualified Data.ByteString.Lazy.Char8 as BSL+import System.Environment (getArgs)+import Control.Monad (forM_, mzero, join)+import Control.Applicative+import Data.Aeson.AutoType.Alternative+import Data.Aeson(decode, Value(..), FromJSON(..), ToJSON(..),+ pairs, eitherDecode ,+ (.:), (.:?), (.=), object)+import Data.Monoid+import Data.Text (Text)+import Data.Bifunctor+import qualified GHC.Generics++-- | Workaround for https://github.com/bos/aeson/issues/287.+o .:?? val = fmap join (o .:? val)++data Job = Job { + jobCheckWait :: (Maybe Integer),+ jobNotification :: Text,+ jobJobType :: Text,+ jobUrl :: Text,+ jobNextCheck :: Double,+ jobLang :: Text,+ jobJobStatus :: Text,+ jobName :: Text,+ jobCreatedAt :: Text,+ jobId :: Double,+ jobMeta :: (Maybe Value),+ jobUserId :: Double,+ jobDuration :: Double,+ jobTranscription :: Maybe Text+ } deriving (Show,Eq,GHC.Generics.Generic)+++instance FromJSON Job where+ parseJSON (Object v) = Job <$> v .:?? "check_wait" <*> v .: "notification" <*> v .: "job_type" <*> v .: "url" <*> v .: "next_check" <*> v .: "lang" <*> v .: "job_status" <*> v .: "name" <*> v .: "created_at" <*> v .: "id" <*> v .:?? "meta" <*> v .: "user_id" <*> v .: "duration" <*> v .: "transcription"+ parseJSON _ = mzero+++data TopLevel = TopLevel { + topLevelJob :: Job+ } deriving (Show,Eq,GHC.Generics.Generic)+++instance FromJSON TopLevel where+ parseJSON (Object v) = TopLevel <$> v .: "job"+ parseJSON _ = mzero++parse :: BSL.ByteString -> Either String Job+parse = (second topLevelJob) -- get rid of toplevel+ . eitherDecode
+ src/Speechmatics/JSON/PostJob.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveGeneric #-}++module Speechmatics.JSON.PostJob where++import System.Exit (exitFailure, exitSuccess)+import System.IO (stderr, hPutStrLn)+import qualified Data.ByteString.Lazy.Char8 as BSL+import System.Environment (getArgs)+import Control.Monad (forM_, mzero, join)+import Control.Applicative+import Data.Aeson.AutoType.Alternative+import Data.Aeson(decode, Value(..), FromJSON(..), ToJSON(..),+ pairs, eitherDecode,+ (.:), (.:?), object)+import Data.Monoid+import Data.Text (Text)+import qualified GHC.Generics++-- | Workaround for https://github.com/bos/aeson/issues/287.+o .:?? val = fmap join (o .:? val)+++data PostJob = PostJob { + checkWait :: (Maybe Value),+ cost :: Double,+ balance :: Double,+ postId :: Integer+ } deriving (Show,Eq,GHC.Generics.Generic)+++instance FromJSON PostJob where+ parseJSON (Object v) = PostJob <$> v .:?? "check_wait" <*> v .: "cost" <*> v .: "balance" <*> v .: "id"+ parseJSON _ = mzero++parse :: BSL.ByteString -> Either String PostJob+parse = eitherDecode
+ test/PeekJobSpec.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module PeekJobSpec (spec) where++import NeatInterpolation (text)+import Speechmatics.JSON.PeekJob+import Test.Hspec+import Data.Text.Encoding(encodeUtf8)+import Data.ByteString.Lazy+++progressExpected :: Job+progressExpected = Job {+ jobCheckWait = Just 30,+ jobNotification = "email",+ jobJobType = "transcription",+ jobUrl = "/v1.0/user/42578/jobs/8221819/audio",+ jobNextCheck = 1.527572657e9,+ jobLang = "en-US",+ jobJobStatus = "transcribing",+ jobName = "file.mp3",+ jobCreatedAt = "Tue, 29 May 2018 05:43:46 GMT",+ jobId = 8221819.0,+ jobMeta = Nothing,+ jobUserId = 42578.0,+ jobDuration = 4.0,+ jobTranscription = Nothing+}++progressFixture :: ByteString+progressFixture = fromStrict $ encodeUtf8 [text|+{+ "job": {+ "check_wait": 30, + "created_at": "Tue, 29 May 2018 05:43:46 GMT", + "duration": 4, + "id": 8221819, + "job_status": "transcribing", + "job_type": "transcription", + "lang": "en-US", + "meta": null, + "name": "file.mp3", + "next_check": 1527572657, + "notification": "email", + "transcription": null, + "url": "/v1.0/user/42578/jobs/8221819/audio", + "user_id": 42578+ }+}+|]++doneExpected :: Job+doneExpected = Job {+ jobCheckWait = Nothing,+ jobNotification = "email",+ jobJobType = "transcription",+ jobUrl = "/v1.0/user/42578/jobs/8220130/audio",+ jobNextCheck = 0.0,+ jobLang = "en-US",+ jobJobStatus = "done",+ jobName = "zero.wav",+ jobCreatedAt = "Tue, 29 May 2018 04:21:48 GMT",+ jobId = 8220130.0,+ jobMeta = Nothing,+ jobUserId = 42578.0,+ jobDuration = 0.0,+ jobTranscription = Just "zero.json"+}+doneFixture :: ByteString+doneFixture = fromStrict $ encodeUtf8 [text|+{+ "job": {+ "check_wait": null, + "created_at": "Tue, 29 May 2018 04:21:48 GMT", "duration": 0, + "id": 8220130, + "job_status": "done", + "job_type": "transcription", + "lang": "en-US", + "meta": null, + "name": "zero.wav", + "next_check": 0, + "notification": "email", + "transcription": "zero.json", + "url": "/v1.0/user/42578/jobs/8220130/audio", + "user_id": 42578+ }+}+|]++spec :: Spec+spec = do+ describe "Ceres stats output parser" $ do+ it "parses doneFixture to doneExpected value" $ do+ (parse doneFixture) `shouldBe` (Right doneExpected)+ it "parses progressFixture to doneExpected value" $ do+ (parse progressFixture) `shouldBe` (Right progressExpected)+ it "does not parse invalid json" $ do+ (parse "not json") `shouldSatisfy` (\case + Left _ -> True+ _ -> False)
+ test/PostJobSpec.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module PostJobSpec (spec) where++import NeatInterpolation (text)+import Speechmatics.JSON.PostJob+import Test.Hspec+import Data.Text.Encoding(encodeUtf8)+import Data.ByteString.Lazy++expected :: PostJob+expected = PostJob {+ checkWait = Nothing,+ cost = 0.0,+ balance = 9195.0,+ postId = 8217275+ }++fixture :: ByteString+fixture = fromStrict $ encodeUtf8 [text|+{+ "balance": 9195, + "check_wait": null, + "cost": 0, + "id": 8217275+}|]++spec :: Spec+spec = do+ describe "Ceres stats output parser" $ do+ it "parses fixture to expected value" $ do+ (parse fixture) `shouldBe` (Right expected)+ it "does not parse invalid json" $ do+ (parse "not json") `shouldSatisfy` (\case + Left _ -> True+ _ -> False)+
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}