-- 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 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
import Util.Options

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 (Opts
o Opts -> Getting Text Opts Text -> Text
forall s a. s -> Getting a s a -> a
^. (Endpoint -> Const Text Endpoint) -> Opts -> Const Text Opts
Lens' Opts Endpoint
brig ((Endpoint -> Const Text Endpoint) -> Opts -> Const Text Opts)
-> ((Text -> Const Text Text) -> Endpoint -> Const Text Endpoint)
-> Getting Text Opts Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Endpoint -> Const Text Endpoint
Lens' Endpoint Text
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 (Word16 -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Opts
o Opts -> Getting Word16 Opts Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. (Endpoint -> Const Word16 Endpoint) -> Opts -> Const Word16 Opts
Lens' Opts Endpoint
brig ((Endpoint -> Const Word16 Endpoint) -> Opts -> Const Word16 Opts)
-> ((Word16 -> Const Word16 Word16)
    -> Endpoint -> Const Word16 Endpoint)
-> Getting Word16 Opts Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Const Word16 Word16)
-> Endpoint -> Const Word16 Endpoint
Lens' Endpoint Word16
port)))
componentRequest IntraComponent
Spar Opts
o =
  ByteString -> Request -> Request
B.host (Text -> ByteString
encodeUtf8 (Opts
o Opts -> Getting Text Opts Text -> Text
forall s a. s -> Getting a s a -> a
^. (Endpoint -> Const Text Endpoint) -> Opts -> Const Text Opts
Lens' Opts Endpoint
spar ((Endpoint -> Const Text Endpoint) -> Opts -> Const Text Opts)
-> ((Text -> Const Text Text) -> Endpoint -> Const Text Endpoint)
-> Getting Text Opts Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Endpoint -> Const Text Endpoint
Lens' Endpoint Text
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 (Word16 -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Opts
o Opts -> Getting Word16 Opts Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. (Endpoint -> Const Word16 Endpoint) -> Opts -> Const Word16 Opts
Lens' Opts Endpoint
spar ((Endpoint -> Const Word16 Endpoint) -> Opts -> Const Word16 Opts)
-> ((Word16 -> Const Word16 Word16)
    -> Endpoint -> Const Word16 Endpoint)
-> Getting Word16 Opts Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Const Word16 Word16)
-> Endpoint -> Const Word16 Endpoint
Lens' Endpoint Word16
port)))
componentRequest IntraComponent
Gundeck Opts
o =
  ByteString -> Request -> Request
B.host (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Opts
o Opts -> Getting Text Opts Text -> Text
forall s a. s -> Getting a s a -> a
^. (Endpoint -> Const Text Endpoint) -> Opts -> Const Text Opts
Lens' Opts Endpoint
gundeck ((Endpoint -> Const Text Endpoint) -> Opts -> Const Text Opts)
-> ((Text -> Const Text Text) -> Endpoint -> Const Text Endpoint)
-> Getting Text Opts Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Endpoint -> Const Text Endpoint
Lens' Endpoint Text
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 (Opts
o Opts -> Getting Word16 Opts Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. (Endpoint -> Const Word16 Endpoint) -> Opts -> Const Word16 Opts
Lens' Opts Endpoint
gundeck ((Endpoint -> Const Word16 Endpoint) -> Opts -> Const Word16 Opts)
-> ((Word16 -> Const Word16 Word16)
    -> Endpoint -> Const Word16 Endpoint)
-> Getting Word16 Opts Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Const Word16 Word16)
-> Endpoint -> Const Word16 Endpoint
Lens' Endpoint Word16
port))
    (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