{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- 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.Proxy where

import API.Proxy
import Control.Monad.Codensity
import Control.Monad.Reader
import qualified Data.Aeson as A
import Data.CaseInsensitive
import Data.String.Conversions
import Network.HTTP.Types (hLocation)
import qualified Network.Wai as Wai
import Servant
import Testlib.Mock
import Testlib.Prelude

----------------------------------------------------------------------
-- giphy

type GiphyAPI =
  "v1"
    :> "gifs"
    :> Capture "path" String
    :> QueryParam "api_key" String -- (we could also use `QueryString` here, no deep reason why we don't)
    :> QueryParam "q" String
    :> QueryParam "limit" Int
    :> QueryParam "offset" Int
    :> Get '[JSON] Value

giphyApp :: Wai.Application
giphyApp :: Application
giphyApp = Proxy GiphyAPI -> Server GiphyAPI -> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy GiphyAPI
forall {k} (t :: k). Proxy t
Proxy :: Proxy GiphyAPI) Server GiphyAPI
server
  where
    server :: Server GiphyAPI
    server :: Server GiphyAPI
server String
mbPathSegment (Just String
apiKey) (Just String
q) (Just Port
limit) (Just Port
offset) =
      Value -> Handler Value
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Value -> Handler Value) -> Value -> Handler Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ String
"pathSegment" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
mbPathSegment,
            String
"apiKey" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
apiKey,
            String
"q" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
q,
            String
"limit" String -> Port -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Port
limit,
            String
"offset" String -> Port -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Port
offset
          ]
    server String
mbPathSegment Maybe String
mbApiKey Maybe String
mbQ Maybe Port
mbLimit Maybe Port
mbOffset =
      String -> Handler Value
forall a. HasCallStack => String -> a
error (String -> Handler Value) -> String -> Handler Value
forall a b. (a -> b) -> a -> b
$ String
"unexpected: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, Maybe String, Maybe String, Maybe Port, Maybe Port)
-> String
forall a. Show a => a -> String
show (String
mbPathSegment, Maybe String
mbApiKey, Maybe String
mbQ, Maybe Port
mbLimit, Maybe Port
mbOffset)

testProxyGiphy :: App ()
testProxyGiphy :: App ()
testProxyGiphy = do
  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Port
port <- MockServerConfig -> Application -> Codensity App Port
startMockServer MockServerConfig
forall a. Default a => a
def Application
giphyApp
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
      (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
        ServiceOverrides
forall a. Default a => a
def
          { wireProxyCfg =
              (setField "giphyEndpoint" (A.object ["host" .= "localhost", "port" .= port]))
                . (setField "disableTlsForTest" True)
          }
        ( \String
domain -> do
            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGiphy String
domain String
"search" [(String
"q", String
"monday"), (String
"limit", String
"100"), (String
"offset", String
"0")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
200
              -- the response from mock giphy is just passed through to the wire client.
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"pathSegment" App Value -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Maybe String
forall a. a -> Maybe a
Just String
"search")
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"apiKey" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"my-giphy-secret"
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"q" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"monday"
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"limit" App Value -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
100
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"offset" App Value -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
0

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGiphy String
domain String
"storch" [(String
"q", String
"monday"), (String
"limit", String
"100"), (String
"offset", String
"0")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
200

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGiphy String
domain String
"search/more" [(String
"q", String
"monday"), (String
"limit", String
"100"), (String
"offset", String
"0")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
404

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGiphy String
domain String
"search" [(String
"q", String
"monday"), (String
"limit", String
"true"), (String
"offset", String
"0")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
400
        )

----------------------------------------------------------------------
-- youtube

type YoutubeAPI =
  "youtube"
    :> "v3"
    :> Capture "path" String
    :> QueryString
    :> Get '[JSON] Value

youtubeApp :: Wai.Application
youtubeApp :: Application
youtubeApp = Proxy YoutubeAPI -> Server YoutubeAPI -> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy YoutubeAPI
forall {k} (t :: k). Proxy t
Proxy :: Proxy YoutubeAPI) Server YoutubeAPI
server
  where
    server :: Server YoutubeAPI
    server :: Server YoutubeAPI
server String
pathSegment Query
queryString =
      Value -> Handler Value
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Value -> Handler Value) -> Value -> Handler Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ String
"pathSegment" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pathSegment,
            String
"queryString" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Query -> String
forall a. Show a => a -> String
show Query
queryString
          ]

testProxyYoutube :: App ()
testProxyYoutube :: App ()
testProxyYoutube = do
  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Port
port <- MockServerConfig -> Application -> Codensity App Port
startMockServer MockServerConfig
forall a. Default a => a
def Application
youtubeApp
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
      (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
        ServiceOverrides
forall a. Default a => a
def
          { wireProxyCfg =
              (setField "youtubeEndpoint" (A.object ["host" .= "localhost", "port" .= port]))
                . (setField "disableTlsForTest" True)
          }
        ( \String
domain -> do
            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getYoutube String
domain String
"wef" [(String
"gnarz", String
"true")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
200
              -- the response from mock youtube is just passed through to the wire client.
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"pathSegment" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wef"
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"queryString" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"[(\"key\",Just \"my-youtube-secret\"),(\"gnarz\",Just \"true\")]"
        )

----------------------------------------------------------------------
-- google maps

type GoogleMapsAPI =
  "maps"
    :> ( "api"
           :> "staticmap"
           :> QueryString
           :> Get '[JSON] Value
           :<|> "api"
             :> "geocode"
             :> Capture "path" String
             :> QueryString
             :> Get '[JSON] Value
       )

googleMapsApp :: Wai.Application
googleMapsApp :: Application
googleMapsApp = Proxy GoogleMapsAPI -> Server GoogleMapsAPI -> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy GoogleMapsAPI
forall {k} (t :: k). Proxy t
Proxy :: Proxy GoogleMapsAPI) (Query -> Handler Value
forall {f :: * -> *} {a}. (Applicative f, Show a) => a -> f Value
server1 (Query -> Handler Value)
-> (String -> Query -> Handler Value)
-> (Query -> Handler Value) :<|> (String -> Query -> Handler Value)
forall a b. a -> b -> a :<|> b
:<|> String -> Query -> Handler Value
forall {f :: * -> *} {a} {a}.
(Applicative f, ToJSON a, Show a) =>
a -> a -> f Value
server2)
  where
    server1 :: a -> f Value
server1 a
queryString =
      Value -> f Value
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ String
"queryString" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= a -> String
forall a. Show a => a -> String
show a
queryString
          ]

    server2 :: a -> a -> f Value
server2 a
pathSegment a
queryString =
      Value -> f Value
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ String
"pathSegment" String -> a -> Pair
forall a. ToJSON a => String -> a -> Pair
.= a
pathSegment,
            String
"queryString" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= a -> String
forall a. Show a => a -> String
show a
queryString
          ]

testProxyGoogleMaps :: App ()
testProxyGoogleMaps :: App ()
testProxyGoogleMaps = do
  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Port
port <- MockServerConfig -> Application -> Codensity App Port
startMockServer MockServerConfig
forall a. Default a => a
def Application
googleMapsApp
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
      (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
        ServiceOverrides
forall a. Default a => a
def
          { wireProxyCfg =
              (setField "googleMapsEndpoint" (A.object ["host" .= "localhost", "port" .= port]))
                . (setField "disableTlsForTest" True)
          }
        ( \String
domain -> do
            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGoogleMaps String
domain String
"maps/api/geocode/path_segment" [(String
"geocode", String
"true")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
200
              -- the response from mock googleMaps is just passed through to the wire client.
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"pathSegment" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"path_segment"
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"queryString" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"[(\"key\",Just \"my-googlemaps-secret\"),(\"geocode\",Just \"true\")]"

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGoogleMaps String
domain String
"maps/api/geocode/path_segment/invalid" [(String
"geocode", String
"true")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
404

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGoogleMaps String
domain String
"api/staticmap" [(String
"staticmap", String
"true")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
200
              -- the response from mock googleMaps is just passed through to the wire client.
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"queryString" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"[(\"key\",Just \"my-googlemaps-secret\"),(\"staticmap\",Just \"true\")]"

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getGoogleMaps String
domain String
"api/staticmap/invalid" [(String
"staticmap", String
"true")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
404
        )

----------------------------------------------------------------------
-- spotify

type SpotifyAPI =
  "api"
    :> "token"
    :> Header "Authorization" String
    :> ReqBody '[JSON] Value
    :> Post '[JSON] Value

spotifyApp :: Wai.Application
spotifyApp :: Application
spotifyApp = Proxy SpotifyAPI -> Server SpotifyAPI -> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy SpotifyAPI
forall {k} (t :: k). Proxy t
Proxy :: Proxy SpotifyAPI) Server SpotifyAPI
server
  where
    server :: Server SpotifyAPI
    server :: Server SpotifyAPI
server Maybe String
authHeader Value
body =
      Value -> Handler Value
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Value -> Handler Value) -> Value -> Handler Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ String
"authHeader" String -> Maybe String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Maybe String
authHeader,
            String
"body" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
body
          ]

testProxySpotify :: App ()
testProxySpotify :: App ()
testProxySpotify = do
  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Port
port <- MockServerConfig -> Application -> Codensity App Port
startMockServer MockServerConfig
forall a. Default a => a
def Application
spotifyApp
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
      (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
        ServiceOverrides
forall a. Default a => a
def
          { wireProxyCfg =
              (setField "spotifyEndpoint" (A.object ["host" .= "localhost", "port" .= port]))
                . (setField "disableTlsForTest" True)
          }
        ( \String
domain -> do
            String -> String -> String -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App Response
postSpotify String
domain String
"api/token" String
"{\"v\": \"my-spotify-body\"}" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
200

              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"authHeader" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"my-spotify-secret"
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"body.v" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"my-spotify-body"

            String -> String -> String -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App Response
postSpotify String
domain String
"api/token/invalid_segment" String
"{\"v\": \"my-spotify-body\"}" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
404
        )

----------------------------------------------------------------------
-- soundcloud

type SoundcloudAPI =
  "resolve"
    :> QueryParam' '[Required] "client_id" String
    :> QueryParam' '[Required] "url" String
    :> Get '[JSON] Value
    :<|> "some-stream"
      :> QueryParam' '[Required] "client_id" String
      :> Get '[JSON] NoContent

soundcloudApp :: Wai.Application
soundcloudApp :: Application
soundcloudApp = Proxy SoundcloudAPI -> Server SoundcloudAPI -> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy SoundcloudAPI
forall {k} (t :: k). Proxy t
Proxy :: Proxy SoundcloudAPI) (String -> String -> Handler Value
serverResolve (String -> String -> Handler Value)
-> (String -> Handler NoContent)
-> (String -> String -> Handler Value)
   :<|> (String -> Handler NoContent)
forall a b. a -> b -> a :<|> b
:<|> String -> Handler NoContent
forall {m :: * -> *} {a}. MonadError ServerError m => String -> m a
serverStream)
  where
    serverResolve :: String -> String -> Handler Value
    serverResolve :: String -> String -> Handler Value
serverResolve String
clientId String
url =
      Value -> Handler Value
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Value -> Handler Value) -> Value -> Handler Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ String
"client_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
clientId,
            String
"url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
url
          ]

    serverStream :: String -> m a
serverStream String
"my-soundcloud-secret" =
      ServerError -> m a
forall a. ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (ServerError -> m a) -> ServerError -> m a
forall a b. (a -> b) -> a -> b
$ ServerError
err302
          { errHeaders =
              [ (hLocation, cs "https://media.soundcloud.com/streams/my-song")
              ]
          }
    serverStream String
_ = ServerError -> m a
forall a. ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
err403

testProxySoundcloud :: App ()
testProxySoundcloud :: App ()
testProxySoundcloud = do
  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Port
port <- MockServerConfig -> Application -> Codensity App Port
startMockServer MockServerConfig
forall a. Default a => a
def Application
soundcloudApp
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
      (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
        ServiceOverrides
forall a. Default a => a
def
          { wireProxyCfg =
              (setField "soundcloudEndpoint" (A.object ["host" .= "localhost", "port" .= port]))
                . (setField "disableTlsForTest" True)
          }
        ( \String
domain -> do
            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getSoundcloud String
domain String
"resolve" [(String
"url", String
"https://my.url")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
200

              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"my-soundcloud-secret"
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"https://my.url"

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getSoundcloud String
domain String
"resolve/invalid_segment" [(String
"url", String
"https://my.url")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
404

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getSoundcloud String
domain String
"stream" [(String
"url", String
"http://localhost:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Port -> String
forall a. Show a => a -> String
show Port
port String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/some-stream")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
302
              Response
resp.headers [Header] -> [Header] -> App ()
forall a. (Eq a, Show a, HasCallStack) => [a] -> [a] -> App ()
`shouldContain` [(ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Location"), String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"https://media.soundcloud.com/streams/my-song")]

            String -> String -> [(String, String)] -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> [(String, String)] -> App Response
getSoundcloud String
domain String
"stream/invalid_segment" [(String
"url", String
"http://localhost:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Port -> String
forall a. Show a => a -> String
show Port
port String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/some-stream")] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
404
        )