{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

module Speechmatics.Client(
  transcribeBytes,
  transcribe,
  AuthToken,
  UserID,
  ModelName,
  LazyByteFile(..),
  Error(..)
) 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