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 :: 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

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

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) => ClientI -> m a -> m ()
tryAuthorized :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, MonadCatch m) =>
ClientI -> m a -> m ()
tryAuthorized ClientI
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
$ ClientI -> Status -> IO ()
setStatus ClientI
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

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 :: RequestHeaders
headers = forall body. Response body -> RequestHeaders
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 RequestHeaders
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)