-- 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 Test.Cargohold.API.Federation where

import API.Cargohold
import qualified Codec.MIME.Type as MIME
import Control.Lens hiding ((.=))
import Crypto.Random (getRandomBytes)
import Data.ByteString.Builder
import Data.String.Conversions
import SetupHelpers
import Testlib.Prelude

testGetAssetAvailablePublic :: (HasCallStack) => App ()
testGetAssetAvailablePublic :: HasCallStack => App ()
testGetAssetAvailablePublic = HasCallStack => Bool -> App ()
Bool -> App ()
getAssetAvailable Bool
True

testGetAssetAvailablePrivate :: (HasCallStack) => App ()
testGetAssetAvailablePrivate :: HasCallStack => App ()
testGetAssetAvailablePrivate = HasCallStack => Bool -> App ()
Bool -> App ()
getAssetAvailable Bool
False

getAssetAvailable :: (HasCallStack) => Bool -> App ()
getAssetAvailable :: HasCallStack => Bool -> App ()
getAssetAvailable Bool
isPublicAsset = do
  -- Initial upload
  let bdy :: (MIMEType, ByteString)
bdy = (MIMEType
applicationOctetStream, String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Hello World")
      settings :: Value
settings = [Pair] -> Value
object [String
"public" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
isPublicAsset, String
"retention" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"volatile"]
  uid1 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  uid2 <- randomUser OtherDomain def
  r1 <- uploadSimpleV3 uid1 settings bdy
  r1.status `shouldMatchInt` 201
  ast <- maybe (error "No JSON in the response") pure r1.jsonBody

  -- Call get-asset federation API
  -- Public assets don't have tokens, so don't explode if we can't get one.
  tok <-
    if isPublicAsset
      then pure $ Right ()
      else Left <$> (ast %. "token" & asString)
  res <- downloadAsset' uid2 r1.jsonBody tok
  res.status `shouldMatchInt` 200

testGetAssetNotAvailable :: (HasCallStack) => App ()
testGetAssetNotAvailable :: HasCallStack => App ()
testGetAssetNotAvailable = do
  uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  userId <- uid %. "id" & asString
  token <- randomToken
  assetId <- randomId
  otherDomain <- make OtherDomain & asString
  let key = String
"3-2-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
assetId
      -- Use a foreign domain so that it will go via federator
      ga = [Pair] -> Value
object [String
"user" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
userId, String
"token" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
token, String
"key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
key, String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
otherDomain]
  r <- downloadAsset' uid ga ga
  -- check that asset is not available
  r.status `shouldMatchInt` 404
  r.jsonBody %. "message" `shouldMatch` "Asset not found"

testGetAssetWrongToken :: (HasCallStack) => App ()
testGetAssetWrongToken :: HasCallStack => App ()
testGetAssetWrongToken = do
  -- Initial upload
  let bdy :: (MIMEType, ByteString)
bdy = (MIMEType
applicationOctetStream, String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Hello World")
      settings :: Value
settings = [Pair] -> Value
object [String
"public" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False, String
"retention" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"volatile"]
  uid1 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  uid2 <- randomUser OtherDomain def
  userId2 <- uid2 %. "id" & asString
  domain <- uid1 %. "qualified_id" %. "domain" & asString
  r1 <- uploadSimpleV3 uid1 settings bdy
  r1.status `shouldMatchInt` 201
  key <- r1.jsonBody %. "key" & asString

  -- Call get-asset federation API with wrong (random) token
  -- Use uid2 so that this will go via federation
  tok <- randomToken
  let ga =
        [Pair] -> Value
object
          [ String
"user" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
userId2,
            String
"token" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tok,
            String
"key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
key,
            String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain
          ]
  r2 <- downloadAsset' uid2 ga ga
  r2.status `shouldMatchInt` 404
  r2.jsonBody %. "message" `shouldMatch` "Asset not found"

testLargeAsset :: (HasCallStack) => App ()
testLargeAsset :: HasCallStack => App ()
testLargeAsset = do
  -- Initial upload
  let settings :: Value
settings = [Pair] -> Value
object [String
"public" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False, String
"retention" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"volatile"]
  uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  domain <- uid %. "qualified_id" %. "domain" & asString
  uid2 <- randomUser OtherDomain def
  userId2 <- uid2 %. "id" & asString
  -- generate random bytes
  let size = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
  bs :: ByteString <- liftIO $ getRandomBytes size
  let body = Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> Type -> ByteString -> Builder
buildMultipartBody' Value
settings Type
applicationOctetStream' (ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
bs)
  r1 <- uploadRawV3 uid body
  r1.status `shouldMatchInt` 201
  tok <- r1.jsonBody %. "token" & asString
  key <- r1.jsonBody %. "key" & asString
  -- Call get-asset federation API
  let ga =
        [Pair] -> Value
object
          [ String
"user" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
userId2,
            String
"key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
key,
            String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain,
            String
"token" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tok
          ]
  r2 <- downloadAsset' uid2 ga ga
  r2.status `shouldMatchInt` 200

testStreamAsset :: (HasCallStack) => App ()
testStreamAsset :: HasCallStack => App ()
testStreamAsset = do
  -- Initial upload
  uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  uid2 <- randomUser OtherDomain def
  userId <- uid %. "id" & asString
  domain <- uid %. "qualified_id" %. "domain" & asString
  r1 <- uploadSimpleV3 uid settings bdy
  r1.status `shouldMatchInt` 201

  -- Call get-asset federation API
  tok <- r1.jsonBody %. "token" & asString
  key <- r1.jsonBody %. "key" & asString
  let ga = [Pair] -> Value
object [String
"user" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
userId, String
"token" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tok, String
"key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
key, String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain]
  r2 <- downloadAsset' uid2 ga ga
  r2.status `shouldMatchInt` 200
  cs @_ @String r2.body `shouldMatch` (snd bdy :: String)
  where
    bdy :: (ConvertibleStrings String a) => (MIME.MIMEType, a)
    bdy :: forall a. ConvertibleStrings String a => (MIMEType, a)
bdy = (MIMEType
applicationOctetStream, String -> a
forall a b. ConvertibleStrings a b => a -> b
cs String
"Hello World")
    settings :: Value
settings = [Pair] -> Value
object [String
"public" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False, String
"retention" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"volatile"]

testStreamAssetNotAvailable :: (HasCallStack) => App ()
testStreamAssetNotAvailable :: HasCallStack => App ()
testStreamAssetNotAvailable = do
  uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  uid2 <- randomUser OtherDomain def
  userId <- uid2 %. "id" & asString
  domain <- uid %. "qualified_id" %. "domain" & asString
  token <- randomToken
  assetId <- randomId
  let key = String
"3-2-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
assetId
      ga = [Pair] -> Value
object [String
"user" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
userId, String
"token" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
token, String
"key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
key, String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain]
  r <- downloadAsset' uid2 ga ga
  r.status `shouldMatchInt` 404
  r.jsonBody %. "message" `shouldMatch` "Asset not found"

testStreamAssetWrongToken :: (HasCallStack) => App ()
testStreamAssetWrongToken :: HasCallStack => App ()
testStreamAssetWrongToken = do
  -- Initial upload
  uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  uid2 <- randomUser OtherDomain def
  userId2 <- uid2 %. "id" & asString
  domain <- uid %. "qualified_id" %. "domain" & asString
  r1 <- uploadSimpleV3 uid settings bdy
  r1.status `shouldMatchInt` 201

  -- Call get-asset federation API with wrong (random) token
  tok <- randomToken
  key <- r1.jsonBody %. "key" & asString
  let ga = [Pair] -> Value
object [String
"user" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
userId2, String
"token" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tok, String
"key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
key, String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain]
  r2 <- downloadAsset' uid2 ga ga
  r2.status `shouldMatchInt` 404
  r2.jsonBody %. "message" `shouldMatch` "Asset not found"
  where
    bdy :: (ConvertibleStrings String a) => (MIME.MIMEType, a)
    bdy :: forall a. ConvertibleStrings String a => (MIMEType, a)
bdy = (MIMEType
applicationOctetStream, String -> a
forall a b. ConvertibleStrings a b => a -> b
cs String
"Hello World")
    settings :: Value
settings = [Pair] -> Value
object [String
"public" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False, String
"retention" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"volatile"]