{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module Server.DB where

import Data.ByteString (ByteString)
import Data.Text (Text)
import Database.Persist.TH (persistUpperCase, mkPersist, sqlSettings)
import Database.Persist (Entity, Key, entityKey, PersistEntity)
import Database.Persist.Sql (fromSqlKey, toSqlKey)
import Database.Persist.Postgresql.JSON (Value)
import Server.Types

mkPersist sqlSettings [persistUpperCase|
DBUser sql=users
  email (Maybe Email) sqltype=varchar(255)
  pendingEmail (Maybe Email) sqltype=varchar(255)
  emailVerificationSecret (Maybe Text)
  registered Time
  passwordCrypt PasswordHash
  permissions Text
  accepted (Maybe Time)
  rejected (Maybe Time)
  seceded (Maybe Time)
  toBeDeleted (Maybe Time)
  memberData Value sqltype=jsonb

  UniqueEmail email
  UniquePendingEmail pendingEmail
  UniqueVerification emailVerificationSecret

  deriving (Show)

DBKey sql=keys
  uid DBUserId
  data ByteString
  expires (Maybe Time)
  uploaded Time
  comment Text
  isPrimaryEncryptionKey Bool

DBToken sql=tokens
  uid DBUserId
  name (Maybe Text)
  data Text
  comment Text
  issued Time
  expires (Maybe Time)
  permissions Text

  UniqueNameUid name uid
  UniqueData data
|]

entityToID :: FromDBKey a => Entity (DB a) -> a
entityToID = fromDBKey . entityKey

class PersistEntity (DB a) =>  FromDBKey a where
    type DB a
    fromDBKey :: Key (DB a) -> a

instance FromDBKey UserID where
    type DB UserID = DBUser
    fromDBKey = UserID . fromSqlKey

instance FromDBKey TokenID where
    type DB TokenID = DBToken
    fromDBKey = TokenID . fromSqlKey

instance FromDBKey KeyID where
    type DB KeyID = DBKey
    fromDBKey = KeyID . fromSqlKey

class FromDBKey a => ToDBKey a where
    toDBKey :: a -> Key (DB a)

instance ToDBKey UserID where
    toDBKey (UserID x) = toSqlKey x

instance ToDBKey KeyID where
    toDBKey (KeyID x) = toSqlKey x

instance ToDBKey TokenID where
    toDBKey (TokenID x) = toSqlKey x