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 :: 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 l :: [(k, v)]
l k :: k
k v :: 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

withResponseGeneric :: (MonadIO m, MonadMask m) => Request -> Manager -> (Response BodyReader -> m a) -> m a
withResponseGeneric :: Request -> Manager -> (Response BodyReader -> m a) -> m a
withResponseGeneric req :: Request
req man :: Manager
man f :: 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)

handleUnauthorized :: (MonadIO m, MonadLogger m, MonadCatch m) => DataSourceUpdates -> m () -> m ()
handleUnauthorized :: DataSourceUpdates -> m () -> m ()
handleUnauthorized dataSourceUpdates :: DataSourceUpdates
dataSourceUpdates = (UnauthorizedE -> m ()) -> m () -> m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle ((UnauthorizedE -> m ()) -> m () -> m ())
-> (UnauthorizedE -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ \UnauthorizedE -> do
    $(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) "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
$ DataSourceUpdates -> Status -> IO ()
dataSourceUpdatesSetStatus DataSourceUpdates
dataSourceUpdates Status
Unauthorized

tryAuthorized :: (MonadIO m, MonadLogger m, MonadCatch m) => Client -> m a -> m ()
tryAuthorized :: Client -> m a -> m ()
tryAuthorized client :: Client
client operation :: 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) -> do
            $(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) "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
$ Client -> Status -> IO ()
setStatus Client
client Status
Unauthorized
        _ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

checkAuthorization :: (MonadThrow m) => Response body -> m ()
checkAuthorization :: Response body -> m ()
checkAuthorization response :: 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

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

getServerTime :: Response body -> Integer
getServerTime :: Response body -> Integer
getServerTime response :: Response body
response
    | ByteString
date ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== "" = 0
    | Bool
otherwise = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe 0 (POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Integer) -> Maybe UTCTime -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
parsedTime)
  where
    headers :: ResponseHeaders
headers = Response body -> ResponseHeaders
forall body. Response body -> ResponseHeaders
responseHeaders Response body
response
    date :: ByteString
date = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hDate ResponseHeaders
headers
    parsedTime :: Maybe UTCTime
parsedTime = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
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 status :: Int
status
    | Int
status Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 400 Bool -> Bool -> Bool
|| Int
status Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 500 = Bool
False
    | Int
status Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [400, 408, 429] = Bool
False
    | Bool
otherwise = Bool
True