-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Galley.Intra.Util
  ( IntraComponent (..),
    call,
  )
where

import Bilge hiding (getHeader, host, options, port, statusCode)
import Bilge qualified as B
import Bilge.RPC (rpc)
import Bilge.Retry
import Cassandra.Options (Endpoint (..))
import Control.Lens (view)
import Control.Retry
import Data.ByteString.Lazy qualified as LB
import Data.Misc (portNumber)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy qualified as LT
import Galley.Env hiding (brig)
import Galley.Monad
import Galley.Options
import Imports hiding (log)
import Network.HTTP.Types

data IntraComponent = Brig | Spar | Gundeck
  deriving (Int -> IntraComponent -> ShowS
[IntraComponent] -> ShowS
IntraComponent -> String
(Int -> IntraComponent -> ShowS)
-> (IntraComponent -> String)
-> ([IntraComponent] -> ShowS)
-> Show IntraComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntraComponent -> ShowS
showsPrec :: Int -> IntraComponent -> ShowS
$cshow :: IntraComponent -> String
show :: IntraComponent -> String
$cshowList :: [IntraComponent] -> ShowS
showList :: [IntraComponent] -> ShowS
Show)

componentName :: IntraComponent -> String
componentName :: IntraComponent -> String
componentName IntraComponent
Brig = String
"brig"
componentName IntraComponent
Spar = String
"spar"
componentName IntraComponent
Gundeck = String
"gundeck"

componentRequest :: IntraComponent -> Opts -> Request -> Request
componentRequest :: IntraComponent -> Opts -> Request -> Request
componentRequest IntraComponent
Brig Opts
o =
  ByteString -> Request -> Request
B.host (Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (Endpoint -> Text) -> Endpoint -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoint -> Text
host (Endpoint -> ByteString) -> Endpoint -> ByteString
forall a b. (a -> b) -> a -> b
$ Opts
o._brig)
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Request -> Request
B.port (Port -> Word16
portNumber (Port -> Word16) -> Port -> Word16
forall a b. (a -> b) -> a -> b
$ Word16 -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Port) -> (Endpoint -> Word16) -> Endpoint -> Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoint -> Word16
port (Endpoint -> Port) -> Endpoint -> Port
forall a b. (a -> b) -> a -> b
$ Opts
o._brig)
componentRequest IntraComponent
Spar Opts
o =
  ByteString -> Request -> Request
B.host (Text -> ByteString
encodeUtf8 Opts
o._spar.host)
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Request -> Request
B.port (Port -> Word16
portNumber (Port -> Word16) -> Port -> Word16
forall a b. (a -> b) -> a -> b
$ Word16 -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Port) -> (Endpoint -> Word16) -> Endpoint -> Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoint -> Word16
port (Endpoint -> Port) -> Endpoint -> Port
forall a b. (a -> b) -> a -> b
$ Opts
o._spar)
componentRequest IntraComponent
Gundeck Opts
o =
  ByteString -> Request -> Request
B.host (Text -> ByteString
encodeUtf8 Opts
o._gundeck.host)
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Request -> Request
B.port (Port -> Word16
portNumber (Port -> Word16) -> Port -> Word16
forall a b. (a -> b) -> a -> b
$ Word16 -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Port) -> (Endpoint -> Word16) -> Endpoint -> Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoint -> Word16
port (Endpoint -> Port) -> Endpoint -> Port
forall a b. (a -> b) -> a -> b
$ Opts
o._gundeck)
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
method StdMethod
POST
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/i/push/v2"
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx

componentRetryPolicy :: IntraComponent -> RetryPolicy
componentRetryPolicy :: IntraComponent -> RetryPolicy
componentRetryPolicy IntraComponent
Brig = RetryPolicyM m
RetryPolicy
x1
componentRetryPolicy IntraComponent
Spar = RetryPolicyM m
RetryPolicy
x1
componentRetryPolicy IntraComponent
Gundeck = Int -> RetryPolicy
limitRetries Int
0

call ::
  IntraComponent ->
  (Request -> Request) ->
  App (Response (Maybe LB.ByteString))
call :: IntraComponent
-> (Request -> Request) -> App (Response (Maybe ByteString))
call IntraComponent
comp Request -> Request
r = do
  Opts
o <- Getting Opts Env Opts -> App Opts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Opts Env Opts
Lens' Env Opts
options
  let r0 :: Request -> Request
r0 = IntraComponent -> Opts -> Request -> Request
componentRequest IntraComponent
comp Opts
o
  let n :: Text
n = String -> Text
LT.pack (IntraComponent -> String
componentName IntraComponent
comp)
  RetryPolicyM App
-> [RetryStatus -> Handler App Bool]
-> (RetryStatus -> App (Response (Maybe ByteString)))
-> App (Response (Maybe ByteString))
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering (IntraComponent -> RetryPolicy
componentRetryPolicy IntraComponent
comp) [RetryStatus -> Handler App Bool]
forall (m :: * -> *) a. Monad m => [a -> Handler m Bool]
rpcHandlers (App (Response (Maybe ByteString))
-> RetryStatus -> App (Response (Maybe ByteString))
forall a b. a -> b -> a
const (Text -> (Request -> Request) -> App (Response (Maybe ByteString))
forall (m :: * -> *).
(MonadUnliftIO m, MonadCatch m, MonadHttp m, HasRequestId m) =>
Text -> (Request -> Request) -> m (Response (Maybe ByteString))
rpc Text
n (Request -> Request
r (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
r0)))

x1 :: RetryPolicy
x1 :: RetryPolicy
x1 = Int -> RetryPolicy
limitRetries Int
1