module Test.Bot where

import API.Brig
import API.Common
import API.Galley
import Control.Lens hiding ((.=))
import qualified Data.Aeson as Aeson
import qualified Data.ProtoLens as Proto
import Data.String.Conversions (cs)
import Network.HTTP.Types (status200, status201)
import Network.Wai (responseLBS)
import qualified Network.Wai as Wai
import qualified Network.Wai.Route as Wai
import Numeric.Lens (hex)
import qualified Proto.Otr as Proto
import qualified Proto.Otr_Fields as Proto
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
  (PublicKey
_, PrivateKey
rootPrivKey) <- HasCallStack => (Integer, Integer) -> App (PublicKey, PrivateKey)
(Integer, Integer) -> App (PublicKey, PrivateKey)
mkKeyPair (Integer, Integer)
primesA
  (PublicKey
ownerPubKey, PrivateKey -> String
privateKeyToString -> String
ownerPrivKey) <- HasCallStack => (Integer, Integer) -> App (PublicKey, PrivateKey)
(Integer, Integer) -> App (PublicKey, PrivateKey)
mkKeyPair (Integer, Integer)
primesB
  let rootSignedLeaf :: String
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 :: MockServerSettings
settings = String -> String -> String -> MockServerSettings
MkMockServerSettings String
rootSignedLeaf String
ownerPrivKey (PublicKey -> String
publicKeyToString PublicKey
ownerPubKey)
  MockServerSettings -> (Response -> App ()) -> App ()
withBotWithSettings MockServerSettings
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 :: (PublicKey, PrivateKey)
keys@(PublicKey -> String
publicKeyToString -> String
pub, PrivateKey -> String
privateKeyToString -> String
priv) <- HasCallStack => (Integer, Integer) -> App (PublicKey, PrivateKey)
(Integer, Integer) -> App (PublicKey, PrivateKey)
mkKeyPair (Integer, Integer)
primesA
  let cert :: String
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
  MockServerSettings -> (Response -> App ()) -> App ()
withBotWithSettings MkMockServerSettings {$sel:certificate:MkMockServerSettings :: String
certificate = String
cert, $sel:privateKey:MkMockServerSettings :: String
privateKey = String
priv, $sel:publicKey:MkMockServerSettings :: String
publicKey = String
pub} \Response
resp' -> do
    Response
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.
    Value
botClient <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client"
    Value
botId <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    Value
aliceQid <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"event.qualified_from"
    Value
conv <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"event.qualified_conversation"

    Value
aliceC <- HasCallStack => Port -> Response -> App Value
Port -> Response -> App Value
getJSON Port
201 (Response -> App Value) -> App Response -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
aliceQid AddClient
forall a. Default a => a
def
    String
aliceCid <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
aliceC

    QualifiedUserEntry
msg <-
      Value -> [(Value, [Value])] -> String -> App QualifiedUserEntry
forall domain user client.
(HasCallStack, MakesValue domain, MakesValue user,
 MakesValue client) =>
domain -> [(user, [client])] -> String -> App QualifiedUserEntry
mkProteusRecipients
        Value
aliceQid
        [(Value
botId, [Value
botClient])]
        String
"hi bot"
    let aliceBotMessage :: QualifiedNewOtrMessage
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
    HasCallStack => Port -> Response -> App ()
Port -> Response -> App ()
assertStatus Port
201
      (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Value -> QualifiedNewOtrMessage -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage Value
aliceQid Value
conv QualifiedNewOtrMessage
aliceBotMessage

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

  MockServerSettings
-> (Chan BotEvent -> LiftedApplication)
-> ((String, Port) -> Chan BotEvent -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Port) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
settings Chan BotEvent -> LiftedApplication
mkBotService \(String
host, Port
port) Chan BotEvent
_chan -> do
    String
email <- App String
randomEmail
    Value
provider <- Value -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider Value
alice NewProvider
forall a. Default a => a
def {newProviderEmail = email, newProviderPassword = Just defPassword}
    String
providerId <- Value
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    Value
service <-
      Domain -> String -> NewService -> App Value
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> NewService -> App Value
newService Domain
OwnDomain String
providerId
        (NewService -> App Value) -> NewService -> App Value
forall a b. (a -> b) -> a -> b
$ NewService
forall a. Default a => a
def {newServiceUrl = "https://" <> host <> ":" <> show port, newServiceKey = cs settings.publicKey}
    String
serviceId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
service Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    Value
conv <- HasCallStack => Port -> Response -> App Value
Port -> Response -> App Value
getJSON Port
201 (Response -> App Value) -> App Response -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus
    String
convId <- Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    HasCallStack => Port -> Response -> App ()
Port -> Response -> App ()
assertStatus Port
200 (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> Value -> App Response
forall conn.
MakesValue conn =>
String -> String -> conn -> App Response
updateServiceConn String
providerId String
serviceId do
      [Pair] -> Value
object [String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True, String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
defPassword]
    Value -> String -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> String -> App Response
addBot Value
alice String
providerId String
serviceId String
convId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> App ()
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 =
  [(ByteString, Handler App)] -> LiftedApplication
forall (m :: * -> *).
Monad m =>
[(ByteString, Handler m)]
-> Request
-> (Response -> m ResponseReceived)
-> m ResponseReceived
Wai.route
    [ (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"/bots", Chan BotEvent -> Handler App
onBotCreate Chan BotEvent
chan),
      (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"/bots/:bot/messages", Chan BotEvent -> Handler App
onBotMessage Chan BotEvent
chan),
      (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"/alive", Chan BotEvent -> Handler App
onBotAlive Chan BotEvent
chan)
    ]

onBotCreate,
  onBotMessage,
  onBotAlive ::
    Chan BotEvent ->
    [(ByteString, ByteString)] ->
    Wai.Request ->
    (Wai.Response -> App Wai.ResponseReceived) ->
    App Wai.ResponseReceived
onBotCreate :: Chan BotEvent -> Handler App
onBotCreate Chan BotEvent
chan [(ByteString, ByteString)]
_headers Request
_req Response -> App ResponseReceived
k = do
  ((Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: []) -> [Value]
pks) <- App Value
getPrekey
  Chan BotEvent -> BotEvent -> App ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan Chan BotEvent
chan BotEvent
BotCreated
  Value
lpk <- App Value
getLastPrekey
  Response -> App ResponseReceived
k (Response -> App ResponseReceived)
-> Response -> App ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status201 ResponseHeaders
forall a. Monoid a => a
mempty do
    Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
      (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
        [ String
"prekeys" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Value]
pks,
          String
"last_prekey" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
lpk
        ]
onBotMessage :: Chan BotEvent -> Handler App
onBotMessage Chan BotEvent
chan [(ByteString, ByteString)]
_headers Request
req Response -> App ResponseReceived
k = do
  ByteString
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
  Chan BotEvent -> BotEvent -> App ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan Chan BotEvent
chan (String -> BotEvent
BotMessage (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
body))
  Response -> App ResponseReceived
k (Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 ResponseHeaders
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty)
onBotAlive :: Chan BotEvent -> Handler App
onBotAlive Chan BotEvent
_chan [(ByteString, ByteString)]
_headers 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"))