Request.hs

{-# 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 qualified          Data.Text as 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)
import Data.Foldable(traverse_)
import Data.List.Split

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 -> do
        let handled = handleException x
        (traverse_ (run . Log.error . Text.pack) (["Got an http exception: "] <> handled)) >>
          throwIO x
        )
      )

-- | heavy logger doesn't like '{'
format :: Char -> Char
format '{' = '<'
format '}' = '>'
format x = x

handleException :: HttpException -> [String]
handleException (HttpExceptionRequest request content) = ["Failed to make request:"] <> lines (fmap format (show request)) <> [" With content:"] <> chunksOf 120 (fmap format (show content))
handleException x = lines (show x)

getWith :: Wreq.Options -> Sess.Session -> String -> LoggingT IO (Wreq.Response C8LBS.ByteString)
getWith opts sess str = do
  Log.debug (Text.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 (Text.pack ("Making get request to " <> str))
  logException $ Sess.postWith opts sess str post