{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

-- | Main module for doing the requests to the voicebase api: http://voicebase.readthedocs.io/en/v2-beta/
module VoicebaseClient
    (
      transcribe,
      transcribeFile,
      transcribeBytes,
      transcribeParse,
      BearerToken,
      Error(..),
      LazyByteFile(..),
      Configuration(..),
      Channels(..),
      Speaker(..),
      Language(..)
  ) where

import           Control.Applicative
import           Control.Lens                hiding ((.=))
import           Control.Monad

import           Data.Bifunctor
import           Data.Maybe
import           Data.Monoid
import           Data.Text.Encoding          as TE

import qualified Data.ByteString.Char8       as BS
import qualified Data.ByteString.Lazy        as LBS
import qualified Data.ByteString.Lazy.Char8  as C8LBS
import           Data.Text                   (Text, unpack)

import           Data.Aeson                  (FromJSON (parseJSON), ToJSON (..),
                                              Value, eitherDecode, encode,
                                              object, (.=))
import           Data.Aeson.Types            (parseEither)
import           Network.HTTP.Client         (defaultManagerSettings,
                                              managerResponseTimeout,
                                              responseTimeoutMicro)
import           Network.HTTP.Client.OpenSSL
import           Network.Mime                (MimeType)
import           Network.Wreq
import qualified Network.Wreq.Session        as Sess
import           OpenSSL.Session             (context)

import           GHC.Generics
import qualified Json.ProgressTypes          as Progress
import qualified Json.SubmitMediaTypes       as Submit
import qualified Json.TranscriptTypes        as Transcript

import           System.IO                   (fixIO)

-- | get your bearer token at http://voicebase.readthedocs.io/en/v2-beta/how-to-guides/hello-world.html#token
type BearerToken = String

data Configuration = Configuration {
  channels   :: Maybe Channels
  , language :: Language
} deriving Generic

data Channels = Channels {
  left    :: Speaker
  , right :: Speaker
} deriving Generic

data Speaker = Speaker {
  speaker :: Text
} deriving Generic

instance ToJSON Channels
instance ToJSON Speaker

instance ToJSON Configuration where
  toJSON Configuration{..} = let
    ingest c = [
      "ingest" .= object [
        "channels" .= c
        ]
      ]
    in object [
      "configuration" .= (object . concat) [
        ["language" .= language]
        , maybe [] ingest channels
        ]
      ]

-- https://voicebase.readthedocs.io/en/v2-beta/how-to-guides/languages.html
data Language =
  Dutch | EnglishUS | EnglishUK | EnglishAus | French | German | Italian | Portuguese | SpanishLatinAmerican | SpanishSpain

instance ToJSON Language where
    toJSON Dutch                = "nl-NL"
    toJSON EnglishUS            = "en-US"
    toJSON EnglishUK            = "en-UK"
    toJSON EnglishAus           = "en-AU"
    toJSON French               = "fr-FR"
    toJSON German               = "de-DE"
    toJSON Italian              = "it-IT"
    toJSON Portuguese           = "pt-BR"
    toJSON SpanishLatinAmerican = "es-LA"
    toJSON SpanishSpain         = "es-ES"

data Error = UnkownResponse | ParseError String
  deriving(Show)

url :: String
url = "https://apis.voicebase.com/v2-beta/media"

timeout = responseTimeoutMicro 10000

makeOpts :: BearerToken -> Options
makeOpts token = withAuthorization token defaults

withAuthorization :: BearerToken -> Options -> Options
withAuthorization token options = options & manager .~ Left (opensslManagerSettings context)
  & manager .~ Left (defaultManagerSettings { managerResponseTimeout = timeout} )
  & header "Authorization" .~ [(BS.pack ("Bearer " ++ token))]

-- | transcribes the audio file and puts it into a Transcript
transcribeParse  :: Configuration -> BearerToken -> FilePath -> IO(Either Error Transcript.Transcript)
transcribeParse config token filepath = fmap (join . second (first ParseError . parseEither parseJSON)) (transcribeFile config token filepath)

inputName = "media"
-- | Given a bearer token, and a filepath to an audio file, this function will
-- | eventually return a transcript or times out after 10 seconds
-- | Throws HttpExceptionRequest, IOException (file not found)
transcribeFile :: Configuration -> BearerToken -> FilePath -> IO(Either Error Value)
transcribeFile config bearerToken filePath = transcribe bearerToken defaults
    [
      partFileSource inputName filePath,
      partLBS "configuration" $ encode $ config
    ]

-- | In case of a bytestring, we also need to mimetype to decode the send string
data LazyByteFile = LazyByteFile {
  content  :: LBS.ByteString,
  mimetype :: MimeType -- to get this Jappie used defaultMimeLookup "f.mp3"
  }
-- | Transcribe a bytestring
-- | Throws HttpExceptionRequest
transcribeBytes :: Configuration -> BearerToken -> LazyByteFile -> IO(Either Error Value)
transcribeBytes config bearerToken (LazyByteFile content mimetype) =
  transcribe bearerToken defaults
    [partLBS inputName content &
     partContentType ?~ mimetype &
     partFileName ?~ "",
     partLBS "configuration" $ encode $ config
    ]

-- | Generic transcribe, agnostic of options, will add ssl,
-- | the bearer token and a timeout to the options.
-- | Throws HttpExceptionRequest
transcribe :: BearerToken -> Options -> [Part] -> IO(Either Error Value)
transcribe token options parts = do
  session <- Sess.newSession
  response <- Sess.postWith (withAuthorization token options) session url parts
  case Submit.parse (response ^. responseBody) of
    Left error -> return $ Left $ ParseError error
    Right parsed -> do
      -- wait for the service to complete
      waitResult <- pollStatus token session (Submit.topLevelMediaId parsed)
      case waitResult of
        Right _ -> first ParseError . eitherDecode <$> (requestTranscript token session (Submit.topLevelMediaId parsed))
        Left error -> return $ Left $ error


pollStatus :: BearerToken -> Sess.Session -> Text -> IO(Either Error ())
pollStatus token session mediaId = pollStatus' token session mediaId "pending"

pollStatus' :: BearerToken -> Sess.Session -> Text -> Text -> IO (Either Error ())
pollStatus' token session mediaId "pending" = do
  response <- Sess.getWith (makeOpts token) session (url <> "/" <> (unpack mediaId) <> "/progress")
  case Progress.parse (response ^. responseBody) of
    Left error -> return $ Left $ ParseError error
    Right parsed -> pollStatus' token session mediaId ((Progress.progressStatus . Progress.topLevelProgress) $ parsed)
pollStatus' token session mediaId "started" = pollStatus' token session mediaId "pending"
pollStatus' token session mediaId "completed" = return $ Right ()
pollStatus' _ _ _ _ = return $ Left UnkownResponse

requestTranscript :: BearerToken -> Sess.Session -> Text -> IO (C8LBS.ByteString)
requestTranscript token session mediaId = do
  response <- Sess.getWith (makeOpts token) session (url <> "/" <> (unpack mediaId))
  return $ response ^. responseBody