{-# LANGUAGE StrictData #-}

-- 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.Team.LegalHold
  ( NewLegalHoldService (..),
    ViewLegalHoldService (..),
    ViewLegalHoldServiceInfo (..),
    UserLegalHoldStatusResponse (..),
    UserLegalHoldStatusEntry (..),
    RemoveLegalHoldSettingsRequest (..),
    DisableLegalHoldForUserRequest (..),
    ApproveLegalHoldForUserRequest (..),
    LegalholdProtectee (..),
  )
where

import Control.Lens (at, (?~))
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Id
import Data.LegalHold
import Data.Misc
import Data.OpenApi qualified as S hiding (info)
import Data.Proxy
import Data.Schema
import Deriving.Aeson
import Imports
import Wire.API.Provider
import Wire.API.Provider.Service (ServiceKeyPEM)
import Wire.API.User.Client.Prekey
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

--------------------------------------------------------------------------------
-- NewLegalHoldService

-- | This type is analogous to 'NewService' for bots.
data NewLegalHoldService = NewLegalHoldService
  { newLegalHoldServiceUrl :: HttpsUrl,
    newLegalHoldServiceKey :: ServiceKeyPEM,
    newLegalHoldServiceToken :: ServiceToken
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform NewLegalHoldService)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewLegalHoldService)

instance ToSchema NewLegalHoldService where
  schema =
    object $
      NewLegalHoldService
        <$> newLegalHoldServiceUrl .= field "base_url" schema
        <*> newLegalHoldServiceKey .= field "public_key" schema
        <*> newLegalHoldServiceToken .= field "auth_token" schema

--------------------------------------------------------------------------------
-- ViewLegalHoldService

data ViewLegalHoldService
  = ViewLegalHoldService ViewLegalHoldServiceInfo
  | ViewLegalHoldServiceNotConfigured
  | ViewLegalHoldServiceDisabled
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform ViewLegalHoldService)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ViewLegalHoldService)

-- | this type is only introduce locally here to generate the schema for 'ViewLegalHoldService'.
data LHServiceStatus = Configured | NotConfigured | Disabled
  deriving (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema LHServiceStatus)

instance ToSchema LHServiceStatus where
  schema =
    enum @Text $
      mconcat
        [ element "configured" Configured,
          element "not_configured" NotConfigured,
          element "disabled" Disabled
        ]

instance ToSchema ViewLegalHoldService where
  schema =
    object $
      toOutput
        .= recordSchema
        `withParser` validateViewLegalHoldService
    where
      toOutput :: ViewLegalHoldService -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
      toOutput = \case
        ViewLegalHoldService info -> (Configured, Just info)
        ViewLegalHoldServiceNotConfigured -> (NotConfigured, Nothing)
        ViewLegalHoldServiceDisabled -> (Disabled, Nothing)

      recordSchema :: ObjectSchema SwaggerDoc (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
      recordSchema =
        (,)
          <$> fst .= field "status" schema
          <*> snd .= maybe_ (optField "settings" schema)

      validateViewLegalHoldService :: (LHServiceStatus, Maybe ViewLegalHoldServiceInfo) -> A.Parser ViewLegalHoldService
      validateViewLegalHoldService (Configured, Just info) =
        pure $ ViewLegalHoldService info
      validateViewLegalHoldService (Disabled, _) =
        pure ViewLegalHoldServiceDisabled
      validateViewLegalHoldService (NotConfigured, _) =
        pure ViewLegalHoldServiceNotConfigured
      validateViewLegalHoldService _ = fail "status (one of configured, not_configured, disabled)"

data ViewLegalHoldServiceInfo = ViewLegalHoldServiceInfo
  { viewLegalHoldServiceTeam :: TeamId,
    viewLegalHoldServiceUrl :: HttpsUrl,
    viewLegalHoldServiceFingerprint :: Fingerprint Rsa,
    viewLegalHoldServiceAuthToken :: ServiceToken,
    viewLegalHoldServiceKey :: ServiceKeyPEM
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform ViewLegalHoldServiceInfo)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ViewLegalHoldServiceInfo)

instance ToSchema ViewLegalHoldServiceInfo where
  schema =
    object $
      ViewLegalHoldServiceInfo
        <$> viewLegalHoldServiceTeam .= field "team_id" schema
        <*> viewLegalHoldServiceUrl .= field "base_url" schema
        <*> viewLegalHoldServiceFingerprint .= field "fingerprint" schema
        <*> viewLegalHoldServiceAuthToken .= field "auth_token" schema
        <*> viewLegalHoldServiceKey .= field "public_key" schema

--------------------------------------------------------------------------------
-- UserLegalHoldStatusResponse

data UserLegalHoldStatusResponse = UserLegalHoldStatusResponse
  { ulhsrStatus :: UserLegalHoldStatus,
    -- | Exists only when status is Pending or Enabled
    ulhsrLastPrekey :: Maybe LastPrekey,
    -- | Exists only when status is Pending or Enabled
    ulhsrClientId :: Maybe ClientId
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform UserLegalHoldStatusResponse)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema UserLegalHoldStatusResponse)

instance ToSchema UserLegalHoldStatusResponse where
  schema =
    object $
      UserLegalHoldStatusResponse
        <$> ulhsrStatus .= field "status" schema
        <*> ulhsrLastPrekey .= maybe_ (optField "last_prekey" schema)
        <*> (fmap IdObject . ulhsrClientId) .= maybe_ (optField "client" (fromIdObject <$> schema))

--------------------------------------------------------------------------------
-- UserLegalHoldStatusEntry

data UserLegalHoldStatusEntry = UserLegalHoldStatusEntry
  { ulhseUser :: UserId,
    ulhseStatus :: UserLegalHoldStatus
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform UserLegalHoldStatusEntry)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema UserLegalHoldStatusEntry)

instance ToSchema UserLegalHoldStatusEntry where
  schema =
    object $
      UserLegalHoldStatusEntry
        <$> ulhseUser .= field "user" schema
        <*> ulhseStatus .= field "status" schema

--------------------------------------------------------------------------------
-- RemoveLegalHoldSettingsRequest

data RemoveLegalHoldSettingsRequest = RemoveLegalHoldSettingsRequest
  { rmlhsrPassword :: Maybe PlainTextPassword6
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform RemoveLegalHoldSettingsRequest)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema RemoveLegalHoldSettingsRequest)

instance ToSchema RemoveLegalHoldSettingsRequest where
  schema =
    object $
      RemoveLegalHoldSettingsRequest
        <$> rmlhsrPassword .= maybe_ (optField "password" schema)

--------------------------------------------------------------------------------
-- DisableLegalHoldForUserRequest

data DisableLegalHoldForUserRequest = DisableLegalHoldForUserRequest
  { dlhfuPassword :: Maybe PlainTextPassword6
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform DisableLegalHoldForUserRequest)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema DisableLegalHoldForUserRequest)

instance ToSchema DisableLegalHoldForUserRequest where
  schema =
    object $
      DisableLegalHoldForUserRequest
        <$> dlhfuPassword .= maybe_ (optField "password" schema)

--------------------------------------------------------------------------------
-- ApproveLegalHoldForUserRequest

data ApproveLegalHoldForUserRequest = ApproveLegalHoldForUserRequest
  { alhfuPassword :: Maybe PlainTextPassword6
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform ApproveLegalHoldForUserRequest)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ApproveLegalHoldForUserRequest)

instance ToSchema ApproveLegalHoldForUserRequest where
  schema =
    object $
      ApproveLegalHoldForUserRequest
        <$> alhfuPassword .= maybe_ (optField "password" schema)

-----------------------------------------------------------------------

-- | Bots are not protected to be potentially recorded by legalhold devices.
data LegalholdProtectee
  = ProtectedUser UserId
  | -- | add UserId here if you want to protect bots as well (or just remove and use
    -- 'ProtectedUser', but then you'll loose the user type information).
    UnprotectedBot
  | -- | FUTUREWORK: protection against legalhold when looking up prekeys across federated
    -- instances.
    LegalholdPlusFederationNotImplemented
  deriving (Show, Eq, Ord, Generic)
  deriving (Arbitrary) via (GenericUniform LegalholdProtectee)

instance ToJSON LegalholdProtectee

-- {"tag":"ProtectedUser","contents":"110a187a-be5b-11eb-8f47-370bc8e40f35"}
-- {"tag":"UnprotectedBot"}
-- {"tag":"LegalholdPlusFederationNotImplemented"}
instance FromJSON LegalholdProtectee

instance ToSchema LegalholdProtectee where
  -- Generated mixed-sums are hard to cover: Just use their existing JSON
  -- representation and add handwritten Swagger docs
  schema = mkSchema docs A.parseJSON (pure . A.toJSON)
    where
      docs :: NamedSwaggerDoc
      docs =
        pure $
          S.NamedSchema (Just "LegalholdProtectee") $
            mempty
              & S.type_ ?~ S.OpenApiObject
              & S.properties . at "tag"
                ?~ S.Inline
                  ( mempty
                      & S.type_ ?~ S.OpenApiString
                      & S.enum_
                        ?~ [ A.toJSON ("ProtectedUser" :: String),
                             A.toJSON ("UnprotectedBot" :: String),
                             A.toJSON ("LegalholdPlusFederationNotImplemented" :: String)
                           ]
                  )
              & S.properties . at "contents"
                ?~ S.Inline
                  ( S.toSchema (Proxy @UserId)
                      & S.description
                        ?~ "A UserId for ProtectedUser, otherwise empty / null."
                  )
