module LaunchDarkly.Server.Network.Common
    ( withResponseGeneric
    , tryAuthorized
    , checkAuthorization
    , throwIfNot200
    , getServerTime
    , tryHTTP
    , addToAL
    , handleUnauthorized
    , isHttpUnrecoverable
    ) where

import Control.Monad (when)
import Control.Monad.Catch (Exception, MonadCatch, MonadMask, MonadThrow, bracket, handle, throwM, try)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (MonadLogger, logError)
import Data.ByteString.Internal (unpackChars)
import Data.Maybe (fromMaybe)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Time.Format (defaultTimeLocale, parseTimeM, rfc822DateFormat)
import Network.HTTP.Client (BodyReader, HttpException, Manager, Request (..), Response (..), responseClose, responseOpen, throwErrorStatusCodes)
import Network.HTTP.Types.Header (hDate)
import Network.HTTP.Types.Status (forbidden403, unauthorized401)

import LaunchDarkly.Server.Client.Internal (Client, Status (Unauthorized), setStatus)
import LaunchDarkly.Server.DataSource.Internal (DataSourceUpdates (..))
import Network.HTTP.Types (ok200)

tryHTTP :: MonadCatch m => m a -> m (Either HttpException a)
tryHTTP :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either HttpException a)
tryHTTP = 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 :: forall k v. Eq k => [(k, v)] -> k -> v -> [(k, v)]
addToAL [(k, v)]
l k
k v
v = (k
k, v
v) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(/=) k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(k, v)]
l

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

data UnauthorizedE = UnauthorizedE deriving (Int -> UnauthorizedE -> ShowS
[UnauthorizedE] -> ShowS
UnauthorizedE -> String
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
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
Exception)

handleUnauthorized :: (MonadIO m, MonadLogger m, MonadCatch m) => DataSourceUpdates -> m () -> m ()
handleUnauthorized :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadCatch m) =>
DataSourceUpdates -> m () -> m ()
handleUnauthorized DataSourceUpdates
dataSourceUpdates = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle forall a b. (a -> b) -> a -> b
$ \UnauthorizedE
UnauthorizedE -> do
    $(logError) Text
"SDK key is unauthorized"
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DataSourceUpdates -> Status -> IO ()
dataSourceUpdatesSetStatus DataSourceUpdates
dataSourceUpdates Status
Unauthorized

tryAuthorized :: (MonadIO m, MonadLogger m, MonadCatch m) => Client -> m a -> m ()
tryAuthorized :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, MonadCatch m) =>
Client -> m a -> m ()
tryAuthorized Client
client m a
operation =
    forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m a
operation forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (Left UnauthorizedE
UnauthorizedE) -> do
            $(logError) Text
"SDK key is unauthorized"
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> Status -> IO ()
setStatus Client
client Status
Unauthorized
        Either UnauthorizedE a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

throwIfNot200 :: (MonadIO m) => Request -> Response BodyReader -> m ()
throwIfNot200 :: forall (m :: * -> *).
MonadIO m =>
Request -> Response BodyReader -> m ()
throwIfNot200 Request
request Response BodyReader
response = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall body. Response body -> Status
responseStatus Response BodyReader
response forall a. Eq a => a -> a -> Bool
/= Status
ok200) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Request -> Response BodyReader -> m ()
throwErrorStatusCodes Request
request Response BodyReader
response

getServerTime :: Response body -> Integer
getServerTime :: forall body. Response body -> Integer
getServerTime Response body
response
    | ByteString
date forall a. Eq a => a -> a -> Bool
== ByteString
"" = Integer
0
    | Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe Integer
0 (forall a b. (RealFrac a, Integral b) => a -> b
truncate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
parsedTime)
  where
    headers :: ResponseHeaders
headers = forall body. Response body -> ResponseHeaders
responseHeaders Response body
response
    date :: ByteString
date = forall a. a -> Maybe a -> a
fromMaybe ByteString
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hDate ResponseHeaders
headers
    parsedTime :: Maybe UTCTime
parsedTime = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
rfc822DateFormat (ByteString -> String
unpackChars ByteString
date)

isHttpUnrecoverable :: Int -> Bool
isHttpUnrecoverable :: Int -> Bool
isHttpUnrecoverable Int
status
    | Int
status forall a. Ord a => a -> a -> Bool
< Int
400 Bool -> Bool -> Bool
|| Int
status forall a. Ord a => a -> a -> Bool
>= Int
500 = Bool
False
    | Int
status forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
400, Int
408, Int
429] = Bool
False
    | Bool
otherwise = Bool
True