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

import Data.ByteString                     (append)
import Data.ByteString.Internal            (unpackChars)
import Network.HTTP.Client                 (HttpException, Manager, Request(..), Response(..), BodyReader, setRequestIgnoreStatus, responseOpen, responseTimeout, responseTimeoutMicro, responseClose)
import Network.HTTP.Types.Header           (hDate)
import Network.HTTP.Types.Status           (unauthorized401, forbidden403)
import Data.Generics.Product               (getField)
import Data.Text.Encoding                  (encodeUtf8)
import Data.Time.Format                    (parseTimeM, defaultTimeLocale, rfc822DateFormat)
import Data.Time.Clock.POSIX               (utcTimeToPOSIXSeconds)
import Data.Function                       ((&))
import Data.Maybe                          (fromMaybe)
import Control.Monad                       (when)
import Control.Monad.Catch                 (Exception, MonadCatch, MonadMask, MonadThrow, try, bracket, throwM, handle)
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)
import LaunchDarkly.Server.DataSource.Internal (DataSourceUpdates(..))

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)

handleUnauthorized :: (MonadIO m, MonadLogger m, MonadCatch m) => DataSourceUpdates -> m () -> m ()
handleUnauthorized :: DataSourceUpdates -> m () -> m ()
handleUnauthorized 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
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
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
$ DataSourceUpdates -> Status -> IO ()
dataSourceUpdatesSetStatus DataSourceUpdates
dataSourceUpdates Status
Unauthorized

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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
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

getServerTime :: Response body -> Integer
getServerTime :: 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 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 :: RequestHeaders
headers = Response body -> RequestHeaders
forall body. Response body -> RequestHeaders
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 -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hDate RequestHeaders
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)