-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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 Test.Bot where

import API.Brig
import API.Common
import API.Galley
import Control.Lens hiding ((.=))
import Control.Monad.Reader
import qualified Data.Aeson as Aeson
import qualified Data.ProtoLens as Proto
import Data.Proxy (Proxy (Proxy))
import Data.String.Conversions (cs)
import Network.HTTP.Types (status200, status201)
import Network.Wai (responseLBS)
import qualified Network.Wai as Wai
import Numeric.Lens (hex)
import qualified Proto.Otr as Proto
import qualified Proto.Otr_Fields as Proto
import Servant.API
import Servant.API.Extended.Endpath
import Servant.Server
import SetupHelpers
import Testlib.Certs
import Testlib.MockIntegrationService
import Testlib.Prelude
import UnliftIO

{- FUTUREWORK(mangoiv):
 -
 - In general the situation is as follows: we only support self-signed certificates, and there's no
 - way of testing we support anything but self-signed certs due to the simple reason of not being able
 - to obtain a valid certificate for testing reasons without modifying brig to accept some root cert
 - generated by us.
 -
 - These tests exist to document this behaviour. If, in the future, some situation would arise that
 - makes us add the certificate validation for PKI, there are already helpers in place in the 'Testlib.Certs'
 - module.
 -
 - In more long form:
 -
 - The issue is as follows:
 -
 - certificate validation should work only for self-signed certs, this is checked by the signature
 - verification function; so this test fails if there's any unknown entity (CA) involved who
 - signed the cert. (a cert can only have one signatory, a CA or self)
 -
 - this test succeeds if the signature verification fails (because it's not self signed), however,
 - even if Brig starts to do signature verification, the test would still succeed, because brig
 - doesn't know (or trust) the CA, anyway, even if it does signature verification.
 -
 - For this test to make sense, we would have to make sure that the brig we're testing against
 - *would* trust the CA, *if* it did verification, because only in that case it would now succeed
 - with verification and not return a "PinInvalidCert" error.
 -
 - -}
testBotUnknownSignatory :: App ()
testBotUnknownSignatory :: App ()
testBotUnknownSignatory = do
  (_, rootPrivKey) <- HasCallStack => (Integer, Integer) -> App (PublicKey, PrivateKey)
(Integer, Integer) -> App (PublicKey, PrivateKey)
mkKeyPair (Integer, Integer)
primesA
  (ownerPubKey, privateKeyToString -> ownerPrivKey) <- mkKeyPair primesB
  let rootSignedLeaf = SignedCert -> String
signedCertToString (SignedCert -> String) -> SignedCert -> String
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
String -> PublicKey -> String -> PrivateKey -> SignedCert
String -> PublicKey -> String -> PrivateKey -> SignedCert
intermediateCert String
"Kabel" PublicKey
ownerPubKey String
"Example-Root" PrivateKey
rootPrivKey
      settings = String -> String -> String -> MockServerSettings
MkMockServerSettings String
rootSignedLeaf String
ownerPrivKey (PublicKey -> String
publicKeyToString PublicKey
ownerPubKey)
  withBotWithSettings settings \Response
resp' -> Response -> (Response -> App ()) -> App ()
forall a. HasCallStack => Response -> (Response -> App a) -> App a
withResponse Response
resp' \Response
resp -> do
    Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
502
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"bad-gateway"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"The upstream service returned an invalid response: PinInvalidCert"

testBotSelfSigned :: App ()
testBotSelfSigned :: App ()
testBotSelfSigned = do
  keys@(publicKeyToString -> pub, privateKeyToString -> priv) <- HasCallStack => (Integer, Integer) -> App (PublicKey, PrivateKey)
(Integer, Integer) -> App (PublicKey, PrivateKey)
mkKeyPair (Integer, Integer)
primesA
  let cert = SignedCert -> String
signedCertToString (SignedCert -> String) -> SignedCert -> String
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> (PublicKey, PrivateKey) -> SignedCert
String -> (PublicKey, PrivateKey) -> SignedCert
selfSignedCert String
"Kabel" (PublicKey, PrivateKey)
keys
  withBotWithSettings MkMockServerSettings {certificate = cert, privateKey = priv, publicKey = pub} \Response
resp' -> do
    resp <- Response -> (Response -> App Response) -> App Response
forall a. HasCallStack => Response -> (Response -> App a) -> App a
withResponse Response
resp' \Response
resp -> do
      Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
201
      Response -> App Response
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
resp

    -- If self signed, we should be able to exchange messages
    -- with the bot conversation.
    botClient <- resp.json %. "client"
    botId <- resp.json %. "id"
    aliceQid <- resp.json %. "event.qualified_from"
    conv <- resp.json %. "event.qualified_conversation"

    aliceC <- getJSON 201 =<< addClient aliceQid def
    aliceCid <- objId aliceC

    msg <-
      mkProteusRecipients
        aliceQid
        [(botId, [botClient])]
        "hi bot"
    let aliceBotMessage =
          forall msg. Message msg => msg
Proto.defMessage @Proto.QualifiedNewOtrMessage
            QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& (ClientId -> Identity ClientId)
-> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage
#sender ((ClientId -> Identity ClientId)
 -> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> ((Word64 -> Identity Word64) -> ClientId -> Identity ClientId)
-> (Word64 -> Identity Word64)
-> QualifiedNewOtrMessage
-> Identity QualifiedNewOtrMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Identity Word64) -> ClientId -> Identity ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.client ((Word64 -> Identity Word64)
 -> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> Word64 -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String
aliceCid String -> Getting (Endo Word64) String Word64 -> Word64
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Word64) String Word64
forall a. Integral a => Prism' String a
Prism' String Word64
hex)
            QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  [QualifiedUserEntry]
  [QualifiedUserEntry]
#recipients ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  [QualifiedUserEntry]
  [QualifiedUserEntry]
-> [QualifiedUserEntry]
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [QualifiedUserEntry
msg]
            QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  ClientMismatchStrategy'ReportAll
  ClientMismatchStrategy'ReportAll
#reportAll ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  ClientMismatchStrategy'ReportAll
  ClientMismatchStrategy'ReportAll
-> ClientMismatchStrategy'ReportAll
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientMismatchStrategy'ReportAll
forall msg. Message msg => msg
Proto.defMessage
    assertStatus 201
      =<< postProteusMessage aliceQid conv aliceBotMessage

withBotWithSettings ::
  MockServerSettings ->
  (Response -> App ()) ->
  App ()
withBotWithSettings :: MockServerSettings -> (Response -> App ()) -> App ()
withBotWithSettings MockServerSettings
settings Response -> App ()
k = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  withMockServer settings mkBotService \(String
host, Port
port) Chan BotEvent
_chan -> do
    password <- Port -> App String
randomString Port
20
    provider <- setupProvider alice def {newProviderPassword = Just password}
    providerId <- provider %. "id" & asString
    service <-
      newService OwnDomain providerId
        $ def {newServiceUrl = "https://" <> host <> ":" <> show port, newServiceKey = cs settings.publicKey}
    serviceId <- asString $ service %. "id"
    conv <- getJSON 201 =<< postConversation alice defProteus
    convId <- conv %. "qualified_id" & objId
    assertStatus 200 =<< updateServiceConn OwnDomain providerId serviceId do
      object ["enabled" .= True, "password" .= password]
    addBot alice providerId serviceId convId >>= k

data BotEvent
  = BotCreated
  | BotMessage String
  deriving stock (BotEvent -> BotEvent -> Bool
(BotEvent -> BotEvent -> Bool)
-> (BotEvent -> BotEvent -> Bool) -> Eq BotEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BotEvent -> BotEvent -> Bool
== :: BotEvent -> BotEvent -> Bool
$c/= :: BotEvent -> BotEvent -> Bool
/= :: BotEvent -> BotEvent -> Bool
Eq, Eq BotEvent
Eq BotEvent =>
(BotEvent -> BotEvent -> Ordering)
-> (BotEvent -> BotEvent -> Bool)
-> (BotEvent -> BotEvent -> Bool)
-> (BotEvent -> BotEvent -> Bool)
-> (BotEvent -> BotEvent -> Bool)
-> (BotEvent -> BotEvent -> BotEvent)
-> (BotEvent -> BotEvent -> BotEvent)
-> Ord BotEvent
BotEvent -> BotEvent -> Bool
BotEvent -> BotEvent -> Ordering
BotEvent -> BotEvent -> BotEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BotEvent -> BotEvent -> Ordering
compare :: BotEvent -> BotEvent -> Ordering
$c< :: BotEvent -> BotEvent -> Bool
< :: BotEvent -> BotEvent -> Bool
$c<= :: BotEvent -> BotEvent -> Bool
<= :: BotEvent -> BotEvent -> Bool
$c> :: BotEvent -> BotEvent -> Bool
> :: BotEvent -> BotEvent -> Bool
$c>= :: BotEvent -> BotEvent -> Bool
>= :: BotEvent -> BotEvent -> Bool
$cmax :: BotEvent -> BotEvent -> BotEvent
max :: BotEvent -> BotEvent -> BotEvent
$cmin :: BotEvent -> BotEvent -> BotEvent
min :: BotEvent -> BotEvent -> BotEvent
Ord, Port -> BotEvent -> String -> String
[BotEvent] -> String -> String
BotEvent -> String
(Port -> BotEvent -> String -> String)
-> (BotEvent -> String)
-> ([BotEvent] -> String -> String)
-> Show BotEvent
forall a.
(Port -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Port -> BotEvent -> String -> String
showsPrec :: Port -> BotEvent -> String -> String
$cshow :: BotEvent -> String
show :: BotEvent -> String
$cshowList :: [BotEvent] -> String -> String
showList :: [BotEvent] -> String -> String
Show)

mkBotService :: Chan BotEvent -> LiftedApplication
mkBotService :: Chan BotEvent -> LiftedApplication
mkBotService Chan BotEvent
chan Request
rq Response -> App ResponseReceived
k = do
  env <- App Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let botApi :: Server BotAPI
      botApi =
        (Chan BotEvent -> LiftedApplication) -> Tagged Handler Application
nt Chan BotEvent -> LiftedApplication
onBotCreate
          Tagged Handler Application
-> ((String -> Tagged Handler Application)
    :<|> Tagged Handler Application)
-> Tagged Handler Application
   :<|> ((String -> Tagged Handler Application)
         :<|> Tagged Handler Application)
forall a b. a -> b -> a :<|> b
:<|> (\String
_ -> (Chan BotEvent -> LiftedApplication) -> Tagged Handler Application
nt Chan BotEvent -> LiftedApplication
onBotMessage)
          (String -> Tagged Handler Application)
-> Tagged Handler Application
-> (String -> Tagged Handler Application)
   :<|> Tagged Handler Application
forall a b. a -> b -> a :<|> b
:<|> (Chan BotEvent -> LiftedApplication) -> Tagged Handler Application
nt Chan BotEvent -> LiftedApplication
onBotAlive
      nt ::
        (Chan BotEvent -> LiftedApplication) ->
        Servant.Server.Tagged Servant.Server.Handler Application
      nt Chan BotEvent -> LiftedApplication
handlr = Application -> Tagged Handler Application
forall {k} (s :: k) b. b -> Tagged s b
Tagged (\Request
rq' Response -> IO ResponseReceived
k' -> Env -> App ResponseReceived -> IO ResponseReceived
forall a. Env -> App a -> IO a
runAppWithEnv Env
env (App ResponseReceived -> IO ResponseReceived)
-> App ResponseReceived -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ (Chan BotEvent -> LiftedApplication
handlr Chan BotEvent
chan Request
rq' (IO ResponseReceived -> App ResponseReceived
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> App ResponseReceived)
-> (Response -> IO ResponseReceived)
-> Response
-> App ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> IO ResponseReceived
k')))
  liftApplication env (serve (Proxy @BotAPI) botApi) rq k

type BotAPI =
  ("bots" :> Endpath :> Raw)
    :<|> ("bots" :> Capture "bot" String :> "messages" :> Endpath :> Raw)
    :<|> ("alive" :> Raw)

-- (these handlers have been written for serving in `wai-{route,predicate}`.  with servant we
-- make this nicer given the patience.)
onBotCreate,
  onBotMessage,
  onBotAlive ::
    Chan BotEvent ->
    LiftedApplication
onBotCreate :: Chan BotEvent -> LiftedApplication
onBotCreate Chan BotEvent
chan Request
_req Response -> App ResponseReceived
k = do
  ((: []) -> pks) <- App Value
getPrekey
  writeChan chan BotCreated
  lpk <- getLastPrekey
  k $ responseLBS status201 mempty do
    Aeson.encode
      $ object
        [ "prekeys" .= pks,
          "last_prekey" .= lpk
        ]
onBotMessage :: Chan BotEvent -> LiftedApplication
onBotMessage Chan BotEvent
chan Request
req Response -> App ResponseReceived
k = do
  body <- IO ByteString -> App ByteString
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> App ByteString)
-> IO ByteString -> App ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.strictRequestBody Request
req
  writeChan chan (BotMessage (cs body))
  k (responseLBS status200 mempty mempty)
onBotAlive :: Chan BotEvent -> LiftedApplication
onBotAlive Chan BotEvent
_chan Request
_req Response -> App ResponseReceived
k = do
  Response -> App ResponseReceived
k (Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 ResponseHeaders
forall a. Monoid a => a
mempty (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"success"))