-- 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 Wire.API.Routes.Version.Wai (versionMiddleware) where

import Control.Monad.Except (throwError)
import Data.ByteString.Conversion
import Data.EitherR (fmapL)
import Data.Text qualified as T
import Data.Text.Lazy (fromStrict)
import Imports
import Network.HTTP.Types qualified as HTTP
import Network.Wai
import Network.Wai.Middleware.Rewrite
import Network.Wai.Utilities.Error
import Network.Wai.Utilities.Response
import Web.HttpApiData (parseUrlPiece, toUrlPiece)
import Wire.API.Routes.Version

-- | Strip off version prefix. Return 404 if the version is not supported.
versionMiddleware :: Set Version -> Middleware
versionMiddleware disabledAPIVersions app req k = case parseVersion (removeVersionHeader req) of
  Right (req', v) -> do
    if v `elem` disabledAPIVersions && requestIsDisableable req'
      then err (toUrlPiece v)
      else app (addVersionHeader v req') k
  Left (BadVersion v) -> err v
  Left NoVersion -> app req k
  Left InternalApisAreUnversioned -> errint
  where
    err :: Text -> IO ResponseReceived
    err v =
      k . errorRs . mkError HTTP.status404 "unsupported-version" $
        "Version " <> fromStrict v <> " is not supported"

    errint :: IO ResponseReceived
    errint =
      k . errorRs . mkError HTTP.status404 "unsupported-version" $
        "Internal APIs (`/i/...`) are not under version control"

data ParseVersionError = NoVersion | BadVersion Text | InternalApisAreUnversioned

parseVersion :: Request -> Either ParseVersionError (Request, Version)
parseVersion req = do
  (version, pinfo) <- case pathInfo req of
    [] -> throwError NoVersion
    (x : xs) -> do
      unless (looksLikeVersion x) $
        throwError NoVersion
      case xs of
        ("i" : _) -> throwError InternalApisAreUnversioned
        ("api-internal" : _) -> throwError InternalApisAreUnversioned
        _ -> pure (x, xs)
  n <- fmapL (const $ BadVersion version) $ parseUrlPiece version
  pure (rewriteRequestPure (\(_, q) _ -> (pinfo, q)) req, n)

looksLikeVersion :: Text -> Bool
looksLikeVersion version = case T.splitAt 1 version of (h, t) -> h == "v" && T.all isDigit t

-- | swagger-delivering end-points are not disableable: they should work for all versions.
requestIsDisableable :: Request -> Bool
requestIsDisableable (pathInfo -> path) = case path of
  ("api" : "swagger-ui" : _) -> False
  ("api" : "swagger.json" : _) -> False
  _ -> True

removeVersionHeader :: Request -> Request
removeVersionHeader req =
  req
    { requestHeaders = filter ((/= versionHeader) . fst) (requestHeaders req)
    }

addVersionHeader :: Version -> Request -> Request
addVersionHeader v req =
  req
    { requestHeaders = (versionHeader, toByteString' (versionInt v :: Int)) : requestHeaders req
    }
