{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Simplex.Messaging.Notifications.Types
  ( NtfTknAction (..),
    NtfToken (..),
    NtfSubAction (..),
    NtfActionTs,
    NtfSubNTFAction (..),
    NtfSubSMPAction (..),
    NtfAgentSubStatus (..),
    NtfSubscription (..),
    newNtfToken,
    isDeleteNtfSubAction,
    newNtfSubscription,
  ) where

import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time (UTCTime)
import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..), UserId)
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Protocol
import Simplex.Messaging.Protocol (NotifierId, NtfServer, SMPServer)
import Simplex.Messaging.Util (eitherToMaybe)

data NtfTknAction
  = NTARegister
  | NTAVerify NtfRegCode -- code to verify token
  | NTACheck
  | NTADelete
  deriving (Show)

instance Encoding NtfTknAction where
  smpEncode = \case
    NTARegister -> "R"
    NTAVerify code -> smpEncode ('V', code)
    NTACheck -> "C"
    NTADelete -> "D"
  smpP =
    A.anyChar >>= \case
      'R' -> pure NTARegister
      'V' -> NTAVerify <$> smpP
      'C' -> pure NTACheck
      'D' -> pure NTADelete
      _ -> fail "bad NtfTknAction"

instance FromField NtfTknAction where fromField = blobFieldDecoder smpDecode

instance ToField NtfTknAction where toField = toField . Binary . smpEncode

data NtfToken = NtfToken
  { deviceToken :: DeviceToken,
    ntfServer :: NtfServer,
    ntfTokenId :: Maybe NtfTokenId,
    -- TODO combine keys to key pair as the types should match

    -- | key used by the ntf server to verify transmissions
    ntfPubKey :: C.APublicAuthKey,
    -- | key used by the ntf client to sign transmissions
    ntfPrivKey :: C.APrivateAuthKey,
    -- | client's DH keys (to repeat registration if necessary)
    ntfDhKeys :: C.KeyPairX25519,
    -- | shared DH secret used to encrypt/decrypt notifications e2e
    ntfDhSecret :: Maybe C.DhSecretX25519,
    -- | token status
    ntfTknStatus :: NtfTknStatus,
    -- | pending token action and the earliest time
    ntfTknAction :: Maybe NtfTknAction,
    ntfMode :: NotificationsMode
  }
  deriving (Show)

newNtfToken :: DeviceToken -> NtfServer -> C.AAuthKeyPair -> C.KeyPairX25519 -> NotificationsMode -> NtfToken
newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode =
  NtfToken
    { deviceToken,
      ntfServer,
      ntfTokenId = Nothing,
      ntfPubKey,
      ntfPrivKey,
      ntfDhKeys,
      ntfDhSecret = Nothing,
      ntfTknStatus = NTNew,
      ntfTknAction = Just NTARegister,
      ntfMode
    }

data NtfSubAction = NSANtf NtfSubNTFAction | NSASMP NtfSubSMPAction
  deriving (Show)

isDeleteNtfSubAction :: NtfSubAction -> Bool
isDeleteNtfSubAction = \case
  NSANtf a -> case a of
    NSACreate -> False
    NSACheck -> False
    NSADelete -> True
    NSARotate -> True
  NSASMP a -> case a of
    NSASmpKey -> False
    NSASmpDelete -> True

type NtfActionTs = UTCTime

data NtfSubNTFAction
  = NSACreate
  | NSACheck
  | NSADelete -- deprecated
  | NSARotate -- deprecated
  deriving (Show)

instance TextEncoding NtfSubNTFAction where
  textEncode = \case
    NSACreate -> "N"
    NSACheck -> "C"
    NSADelete -> "D"
    NSARotate -> "R"
  textDecode = \case
    "N" -> Just NSACreate
    "C" -> Just NSACheck
    "D" -> Just NSADelete
    "R" -> Just NSARotate
    _ -> Nothing

instance FromField NtfSubNTFAction where fromField = fromTextField_ textDecode

instance ToField NtfSubNTFAction where toField = toField . textEncode

data NtfSubSMPAction
  = NSASmpKey
  | NSASmpDelete
  deriving (Show)

instance TextEncoding NtfSubSMPAction where
  textEncode = \case
    NSASmpKey -> "K"
    NSASmpDelete -> "D"
  textDecode = \case
    "K" -> Just NSASmpKey
    "D" -> Just NSASmpDelete
    _ -> Nothing

instance FromField NtfSubSMPAction where fromField = fromTextField_ textDecode

instance ToField NtfSubSMPAction where toField = toField . textEncode

data NtfAgentSubStatus
  = -- | subscription started
    NASNew
  | -- | state after NKEY - notifier ID is assigned to queue on SMP server
    NASKey
  | -- | state after SNEW - subscription created on notification server
    NASCreated NtfSubStatus
  | -- | state after SDEL (subscription is deleted on notification server)
    NASOff
  | -- | state after NDEL (notifier credentials are deleted on SMP server)
    -- Can only exist transiently - if subscription record was updated by notification supervisor mid worker operation,
    -- and hence got updated instead of being fully deleted in the database post operation by worker
    NASDeleted
  deriving (Eq, Show)

instance Encoding NtfAgentSubStatus where
  smpEncode = \case
    NASNew -> "NEW"
    NASKey -> "KEY"
    NASCreated status -> "CREATED " <> smpEncode status
    NASOff -> "OFF"
    NASDeleted -> "DELETED"
  smpP =
    A.takeTill (== ' ') >>= \case
      "NEW" -> pure NASNew
      "KEY" -> pure NASKey
      "CREATED" -> do
        _ <- A.space
        NASCreated <$> smpP
      "OFF" -> pure NASOff
      "DELETED" -> pure NASDeleted
      _ -> fail "bad NtfAgentSubStatus"

instance FromField NtfAgentSubStatus where fromField = fromTextField_ $ eitherToMaybe . smpDecode . encodeUtf8

instance ToField NtfAgentSubStatus where toField = toField . decodeLatin1 . smpEncode

data NtfSubscription = NtfSubscription
  { userId :: UserId,
    connId :: ConnId,
    smpServer :: SMPServer,
    ntfQueueId :: Maybe NotifierId,
    ntfServer :: NtfServer,
    ntfSubId :: Maybe NtfSubscriptionId,
    ntfSubStatus :: NtfAgentSubStatus
  }
  deriving (Show)

newNtfSubscription :: UserId -> ConnId -> SMPServer -> Maybe NotifierId -> NtfServer -> NtfAgentSubStatus -> NtfSubscription
newNtfSubscription userId connId smpServer ntfQueueId ntfServer ntfSubStatus =
  NtfSubscription
    { userId,
      connId,
      smpServer,
      ntfQueueId,
      ntfServer,
      ntfSubId = Nothing,
      ntfSubStatus
    }
