{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, UndecidableInstances #-}

module Spm.Server.Database
  ( MailMailbox, MailLocal, MailExtension, MailDomain
  , Mailbox(..), MailboxMapping(..)
  , Key(..), EntityField(..), Unique(..)
  ) where

import Prelude

import Database.Persist
import Database.Persist.Sql
import Database.Persist.TH

import GHC.Generics (Generic)
import Type.Reflection (Typeable)

import Data.Text (Text)

import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Data.CaseInsensitive.Instances ()

import Data.UUID (UUID)
import Data.UUID.Instances ()

import Data.Int (Int64)

import Control.Lens

import Web.HttpApiData


newtype MailMailbox = MailMailbox
  { unMailMailbox :: CI Text
  } deriving stock (Eq, Ord, Read, Show, Generic, Typeable)
    deriving newtype (PersistField, PersistFieldSql)
makeWrapped ''MailMailbox
newtype MailLocal = MailLocal
  { unMailLocal :: CI Text
  } deriving stock (Eq, Ord, Read, Show, Generic, Typeable)
    deriving newtype (PersistField, PersistFieldSql)
makeWrapped ''MailLocal
newtype MailExtension = MailExtension
  { unMailExtension :: CI Text
  } deriving stock (Eq, Ord, Read, Show, Generic, Typeable)
    deriving newtype (PersistField, PersistFieldSql)
makeWrapped ''MailExtension
newtype MailDomain = MailDomain
  { unMailDomain :: CI Text
  } deriving stock (Eq, Ord, Read, Show, Generic, Typeable)
    deriving newtype (PersistField, PersistFieldSql)
makeWrapped ''MailDomain

instance FromHttpApiData MailDomain where
  parseUrlPiece = fmap (review _Wrapped . CI.mk) . parseUrlPiece


share [mkPersist sqlSettings] [persistLowerCase|
  Mailbox
    Id UUID sqltype=uuid default=gen_random_uuid()
    ident MailMailbox sql=mailbox
    quota Int64 Maybe sql=quota_bytes MigrationOnly
    UniqueMailbox ident
    deriving Show
  MailboxMapping
    Id UUID sqltype=uuid default=gen_random_uuid()
    local MailLocal Maybe
    extension MailExtension Maybe
    domain MailDomain
    mailbox MailboxId
    reject Bool
    UniqueDomain domain sql=domain_unique !force
    UniqueLocalDomain local domain sql=local_domain_unique !force
    UniqueLocalExtensionDomain local extension domain sql=local_extension_domain_unique !force
|]