module LaunchDarkly.Server.Network.Common
    ( prepareRequest
    , withResponseGeneric
    , tryAuthorized
    , checkAuthorization
    , tryHTTP
    , addToAL
    ) where

import Data.ByteString                     (append)
import Network.HTTP.Client                 (HttpException, Manager, Request(..), Response(..), BodyReader, setRequestIgnoreStatus, responseOpen, responseTimeout, responseTimeoutMicro, responseClose)
import Network.HTTP.Types.Status           (unauthorized401, forbidden403)
import Data.Generics.Product               (getField)
import Data.Text.Encoding                  (encodeUtf8)
import Data.Function                       ((&))
import Control.Monad                       (when)
import Control.Monad.Catch                 (Exception, MonadCatch, MonadMask, MonadThrow, try, bracket, throwM)
import Control.Monad.Logger                (MonadLogger, logError)
import Control.Monad.IO.Class              (MonadIO, liftIO)

import LaunchDarkly.Server.Client.Internal (ClientI, Status(Unauthorized), clientVersion, setStatus)
import LaunchDarkly.Server.Config.Internal (ConfigI)

tryHTTP :: MonadCatch m => m a -> m (Either HttpException a)
tryHTTP :: m a -> m (Either HttpException a)
tryHTTP = m a -> m (Either HttpException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try

addToAL :: Eq k => [(k, v)] -> k -> v -> [(k, v)]
addToAL :: [(k, v)] -> k -> v -> [(k, v)]
addToAL [(k, v)]
l k
k v
v = (k
k, v
v) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: ((k, v) -> Bool) -> [(k, v)] -> [(k, v)]
forall a. (a -> Bool) -> [a] -> [a]
filter (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(/=) k
k (k -> Bool) -> ((k, v) -> k) -> (k, v) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, v) -> k
forall a b. (a, b) -> a
fst) [(k, v)]
l

prepareRequest :: ConfigI -> Request -> Request
prepareRequest :: ConfigI -> Request -> Request
prepareRequest ConfigI
config Request
request = Request
request
    { requestHeaders :: RequestHeaders
requestHeaders       = (Request -> RequestHeaders
requestHeaders Request
request)
        RequestHeaders
-> (RequestHeaders -> RequestHeaders) -> RequestHeaders
forall a b. a -> (a -> b) -> b
& \RequestHeaders
l -> RequestHeaders -> HeaderName -> ByteString -> RequestHeaders
forall k v. Eq k => [(k, v)] -> k -> v -> [(k, v)]
addToAL RequestHeaders
l HeaderName
"Authorization" (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ConfigI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" ConfigI
config)
        RequestHeaders
-> (RequestHeaders -> RequestHeaders) -> RequestHeaders
forall a b. a -> (a -> b) -> b
& \RequestHeaders
l -> RequestHeaders -> HeaderName -> ByteString -> RequestHeaders
forall k v. Eq k => [(k, v)] -> k -> v -> [(k, v)]
addToAL RequestHeaders
l HeaderName
"User-Agent" (ByteString -> ByteString -> ByteString
append ByteString
"HaskellServerClient/" (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
clientVersion)
    , responseTimeout :: ResponseTimeout
responseTimeout      = Int -> ResponseTimeout
responseTimeoutMicro (Int -> ResponseTimeout) -> Int -> ResponseTimeout
forall a b. (a -> b) -> a -> b
$ (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ ConfigI -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"requestTimeoutSeconds" ConfigI
config) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
    } Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Request -> Request
setRequestIgnoreStatus

withResponseGeneric :: (MonadIO m, MonadMask m) => Request -> Manager -> (Response BodyReader -> m a) -> m a
withResponseGeneric :: Request -> Manager -> (Response BodyReader -> m a) -> m a
withResponseGeneric Request
req Manager
man Response BodyReader -> m a
f = m (Response BodyReader)
-> (Response BodyReader -> m ())
-> (Response BodyReader -> m a)
-> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO (Response BodyReader) -> m (Response BodyReader)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response BodyReader) -> m (Response BodyReader))
-> IO (Response BodyReader) -> m (Response BodyReader)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response BodyReader)
responseOpen Request
req Manager
man) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (Response BodyReader -> IO ()) -> Response BodyReader -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> IO ()
forall a. Response a -> IO ()
responseClose) Response BodyReader -> m a
f

data UnauthorizedE = UnauthorizedE deriving (Int -> UnauthorizedE -> ShowS
[UnauthorizedE] -> ShowS
UnauthorizedE -> String
(Int -> UnauthorizedE -> ShowS)
-> (UnauthorizedE -> String)
-> ([UnauthorizedE] -> ShowS)
-> Show UnauthorizedE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnauthorizedE] -> ShowS
$cshowList :: [UnauthorizedE] -> ShowS
show :: UnauthorizedE -> String
$cshow :: UnauthorizedE -> String
showsPrec :: Int -> UnauthorizedE -> ShowS
$cshowsPrec :: Int -> UnauthorizedE -> ShowS
Show, Show UnauthorizedE
Typeable UnauthorizedE
Typeable UnauthorizedE
-> Show UnauthorizedE
-> (UnauthorizedE -> SomeException)
-> (SomeException -> Maybe UnauthorizedE)
-> (UnauthorizedE -> String)
-> Exception UnauthorizedE
SomeException -> Maybe UnauthorizedE
UnauthorizedE -> String
UnauthorizedE -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: UnauthorizedE -> String
$cdisplayException :: UnauthorizedE -> String
fromException :: SomeException -> Maybe UnauthorizedE
$cfromException :: SomeException -> Maybe UnauthorizedE
toException :: UnauthorizedE -> SomeException
$ctoException :: UnauthorizedE -> SomeException
$cp2Exception :: Show UnauthorizedE
$cp1Exception :: Typeable UnauthorizedE
Exception)

tryAuthorized :: (MonadIO m, MonadLogger m, MonadCatch m) => ClientI -> m a -> m ()
tryAuthorized :: ClientI -> m a -> m ()
tryAuthorized ClientI
client m a
operation = m a -> m (Either UnauthorizedE a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m a
operation m (Either UnauthorizedE a)
-> (Either UnauthorizedE a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Left UnauthorizedE
UnauthorizedE) -> do
        $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logError) Text
"SDK key is unauthorized"
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientI -> Status -> IO ()
setStatus ClientI
client Status
Unauthorized
    Either UnauthorizedE a
_                    -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

checkAuthorization :: (MonadThrow m) => Response body -> m ()
checkAuthorization :: Response body -> m ()
checkAuthorization Response body
response = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status -> [Status] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Response body -> Status
forall body. Response body -> Status
responseStatus Response body
response) [Status
unauthorized401, Status
forbidden403]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UnauthorizedE -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM UnauthorizedE
UnauthorizedE