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 = m a -> m (Either HttpException a)
forall (m :: * -> *) e a.
(HasCallStack, 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) (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 :: 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 = m (Response BodyReader)
-> (Response BodyReader -> m ())
-> (Response BodyReader -> m a)
-> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO (Response BodyReader) -> m (Response BodyReader)
forall a. IO a -> m a
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 a. IO a -> m a
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
$cshowsPrec :: Int -> UnauthorizedE -> ShowS
showsPrec :: Int -> UnauthorizedE -> ShowS
$cshow :: UnauthorizedE -> String
show :: UnauthorizedE -> String
$cshowList :: [UnauthorizedE] -> ShowS
showList :: [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
$ctoException :: UnauthorizedE -> SomeException
toException :: UnauthorizedE -> SomeException
$cfromException :: SomeException -> Maybe UnauthorizedE
fromException :: SomeException -> Maybe UnauthorizedE
$cdisplayException :: UnauthorizedE -> String
displayException :: UnauthorizedE -> String
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 = (UnauthorizedE -> m ()) -> m () -> m ()
forall (m :: * -> *) e a.
(HasCallStack, 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
UnauthorizedE -> do
    $(logError) Text
"SDK key is unauthorized"
    IO () -> m ()
forall a. IO a -> m a
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 :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, MonadCatch m) =>
Client -> m a -> m ()
tryAuthorized Client
client m a
operation =
    m a -> m (Either UnauthorizedE a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m a
operation m (Either UnauthorizedE a)
-> (Either UnauthorizedE a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (Left UnauthorizedE
UnauthorizedE) -> do
            $(logError) Text
"SDK key is unauthorized"
            IO () -> m ()
forall a. IO a -> m a
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
        Either UnauthorizedE a
_ -> () -> m ()
forall a. a -> m 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 = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status -> [Status] -> Bool
forall a. Eq a => a -> [a] -> 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 e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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 = 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 :: forall body. Response body -> Integer
getServerTime Response body
response
    | ByteString
date ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"" = Integer
0
    | Bool
otherwise = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
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 ByteString
"" (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 Int
status
    | Int
status Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
400 Bool -> Bool -> Bool
|| Int
status Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500 = Bool
False
    | Int
status Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
400, Int
408, Int
429] = Bool
False
    | Bool
otherwise = Bool
True