{-# 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 = Maybe 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

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 :: String -> UserID -> AuthToken -> ModelName -> LazyByteFile -> IO(Either Error Value)
transcribeBytes url userID bearerToken model (LazyByteFile content filename mimetype) = do
  transcribe url 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 (Just auth) = "?auth_token=" <> auth
tokenUri Nothing = ""


slash = mappend . (flip mappend "/") -- play around to much with ghci
jobsUri :: String -> UserID -> String -> String
jobsUri url 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 :: String -> UserID -> AuthToken -> Options -> [Part] -> IO(Either Error Value)
transcribe uri userID token options parts = do
  session <- Sess.newSession
  response <- Sess.postWith auth session postUri parts
  -- print $ response ^. responseBody
  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" <> (tokenUri token))
          result <- Sess.getWith makeOpts session transcriptUri
          return $ first ParseError $ eitherDecode (result ^. responseBody)
  where 
    auth = (withAuthorization options)
    postUri =  url userID (tokenUri token) 
    url = jobsUri uri

pollStatus :: String -> UserID -> AuthToken -> Sess.Session -> JobID -> IO(Maybe Error)
pollStatus url userID token session jobID = pollStatus' Nothing url userID token session jobID

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) <> (tokenUri token)
  statusResponse <- Sess.getWith makeOpts session statusUri
  -- print 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