{-# LANGUAGE OverloadedStrings #-}

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

import Control.Lens
import Control.Monad.Reader.Class
import qualified Data.ByteString.Lazy as LBS
import Network.DNS
import Network.DNS.Decode as Dec
import qualified Network.HTTP.Client as HTTP
import Testlib.Prelude

type LByteString = LBS.ByteString

-- | Test that we can provide and lookup a TXT record in
-- Technitium (dns-server for tests)
testNewTXTRecord :: (HasCallStack) => App ()
testNewTXTRecord = do
  tok <- getTechnitiumApiKey
  setTechnitiumReverseProxyACL tok "0.0.0.0/0"
  registerTechnitiumZone tok "example.com"
  registerTechnitiumRecord tok "example.com" "example.com" "TXT" "we own this domain and we're the good guys, trust us!"

  dohUrl <- technitiumDohUrl
  let question = HTTP.RequestBodyBS $ encodeQuestion 0 (Question "example.com" TXT) mempty
  req <- externalRequest dohUrl <&> addBody question "application/dns-message" . addHeader "Accept" "application/dns-message"
  bindResponse (submit "POST" req) $ \resp -> do
    let received :: Either DNSError DNSMessage = Dec.decode (resp.body :: ByteString)
        expected :: Either DNSError DNSMessage = Right (DNSMessage {header = DNSHeader {identifier = 0, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = True, trunCation = False, recDesired = True, recAvailable = True, rcode = NoErr, authenData = False, chkDisable = False}}, ednsHeader = EDNSheader (EDNS {ednsVersion = 0, ednsUdpSize = 1232, ednsDnssecOk = False, ednsOptions = []}), question = [Question {qname = "example.com.", qtype = TXT}], answer = [ResourceRecord {rrname = "example.com.", rrtype = TXT, rrclass = 1, rrttl = 3600, rdata = RD_TXT "we own this domain and we're the good guys, trust us!"}], authority = [], additional = []})
    -- if we had aeson instances for DNSError and DNSMessage, we could get nicer error messages here, but meh.
    show received `shouldMatch` show expected

technitiumDohUrl :: App String
technitiumDohUrl = do
  env <- ask
  pure $ "http://" <> env.dnsMockServerConfig.host <> ":" <> show env.dnsMockServerConfig.dohPort <> "/dns-query"

technitiumApiUrl :: App String
technitiumApiUrl = do
  env <- ask
  pure $ "http://" <> env.dnsMockServerConfig.host <> ":" <> show env.dnsMockServerConfig.apiPort <> "/api"

getTechnitiumApiKey :: (HasCallStack) => App String
getTechnitiumApiKey = do
  tok <- requestTechnitiumApiKey
  setTechnitiumReverseProxyACL tok "0.0.0.0/0"
  pure tok

requestTechnitiumApiKey :: (HasCallStack) => App String
requestTechnitiumApiKey = do
  url <- technitiumApiUrl <&> (<> "/user/createToken")
  req <- externalRequest url <&> addQueryParams [("user", "admin"), ("pass", "admin"), ("tokenName", "someToken")]
  bindResponse (submit "POST" req) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "status" `shouldMatch` ("ok" :: String)
    asString $ resp.json %. "token"

setTechnitiumReverseProxyACL :: (HasCallStack) => String -> String -> App ()
setTechnitiumReverseProxyACL tok acl = do
  url <- technitiumApiUrl <&> (<> "/settings/set")
  req <- externalRequest url <&> addQueryParams [("token", tok), ("reverseProxyNetworkACL", acl)]
  submit "POST" req >>= assertStatus 200

registerTechnitiumZone :: (HasCallStack) => String -> String -> App ()
registerTechnitiumZone tok zone = do
  url <- technitiumApiUrl <&> (<> "/zones/create")
  req <- externalRequest url <&> addQueryParams [("token", tok), ("zone", zone), ("type", "primary")]
  submit "POST" req >>= assertStatus 200

registerTechnitiumRecord :: (HasCallStack) => String -> String -> String -> String -> String -> App ()
registerTechnitiumRecord tok zone domain typ text = do
  url <- technitiumApiUrl <&> (<> "/zones/records/add")
  let params =
        [ ("token", tok),
          ("zone", zone),
          ("domain", domain),
          ("type", typ),
          ("text", text)
        ]
  req <- externalRequest url <&> addQueryParams params
  submit "POST" req >>= assertStatus 200

deleteTechnitiumRecord :: (HasCallStack) => String -> String -> String -> String -> String -> App ()
deleteTechnitiumRecord tok zone domain typ text = do
  url <- technitiumApiUrl <&> (<> "/zones/records/delete")
  let params =
        [ ("token", tok),
          ("zone", zone),
          ("domain", domain),
          ("type", typ),
          ("text", text)
        ]
  req <- externalRequest url <&> addQueryParams params
  submit "POST" req >>= assertStatus 200
