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