-- 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.Wire.Network.DNS.SRVSpec where

import Data.List.NonEmpty (NonEmpty (..))
import Imports
import Network.DNS qualified as DNS
import Test.Hspec
import Wire.Network.DNS.SRV

spec :: Spec
spec = do
  describe "interpretResponse" $ do
    it "should interpret error correctly" $
      interpretResponse (Left DNS.UnknownDNSError) `shouldBe` SrvResponseError DNS.UnknownDNSError

    it "should interpret empty response as SrvNotAvailable" $
      interpretResponse (Right []) `shouldBe` SrvNotAvailable

    it "should interpret explicitly not available response as SrvNotAvailable" $
      interpretResponse (Right [(0, 0, 0, ".")]) `shouldBe` SrvNotAvailable

    it "should interpret an available service correctly" $ do
      let input =
            [ (0, 1, 443, "service01.example.com."),
              (10, 20, 8443, "service02.example.com.")
            ]
      let expectedOutput =
            SrvAvailable
              ( SrvEntry 0 1 (SrvTarget "service01.example.com." 443)
                  :| [SrvEntry 10 20 (SrvTarget "service02.example.com." 8443)]
              )
      interpretResponse (Right input) `shouldBe` expectedOutput
  describe "orderSrvResult" $ do
    it "orders records according to ascending priority" $ do
      actual <-
        orderSrvResult . map toSrvEntry $
          [ -- priority, weight, port, domain
            (0, 0, 443, "offline.com"),
            (15, 10, 443, "main.com"),
            (0, 5, 443, "backup.com"),
            (2, 10, 443, "main.com"),
            (2, 20, 443, "main.com"),
            (3, 5, 443, "main.com"),
            (0, 0, 443, "backup.com")
          ]
      (srvPriority <$> actual) `shouldBe` [0, 0, 0, 2, 2, 3, 15]
    it "orders records with the same priority according to weight with certain probability" $ do
      let raw =
            map toSrvEntry $
              [ (2, 10, 443, "server1.com"),
                (2, 20, 443, "server2.com"),
                (2, 0, 443, "dontuseoften.com")
              ]
      -- order the list 50 times
      actuals <- replicateM 50 (orderSrvResult raw)
      let weightLists = fmap (fmap srvWeight) actuals
      let x = filter ((== 20) . head) weightLists
      let y = filter ((== 10) . head) weightLists
      -- we may have e.g.
      -- the server with weight 20 first in the list 30 times,
      -- the server with weight 10 15 times
      -- and the server with weight 0 5 times.
      -- We only check that there is *some* distribution
      length x `shouldSatisfy` (> 0)
      length x `shouldSatisfy` (< 49)
      length y `shouldSatisfy` (> 0)
      length y `shouldSatisfy` (< 49)
