Id.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Typed, self-describing identifiers for Shōmei domain entities.
--
-- Each identifier is an 'mmzk-typeid' 'KindID' — a UUIDv7 with a type-level prefix
-- (@user_…@, @session_…@, @refresh_token_…@, @credential_…@). Because the prefix is a
-- type-level 'Symbol', 'UserId' and 'SessionId' are distinct types that cannot be
-- confused. The underlying UUID is stored as a native @uuid@ column in PostgreSQL
-- (EP-3) via 'userIdToUUID' / 'userIdFromUUID' (= 'getUUID' / 'decorateKindID').
--
-- The orphan 'FromHttpApiData' / 'ToHttpApiData' instances are required by EP-5's
-- Servant @Capture@s; @mmzk-typeid@ ships JSON instances but not these, and
-- @http-api-data@ is a pure dependency so it is acceptable in the transport-agnostic
-- core.
module Shomei.Id
  ( UserId,
    SessionId,
    RefreshTokenId,
    VerificationTokenId,
    PasswordResetTokenId,
    CredentialId,
    PasskeyId,
    CeremonyId,
    ServiceAccountDbId,
    OAuthClientId,
    TotpCredentialId,
    RecoveryCodeId,
    LoginAttemptId,
    genUserId,
    genSessionId,
    genRefreshTokenId,
    genVerificationTokenId,
    genPasswordResetTokenId,
    genCredentialId,
    genPasskeyId,
    genCeremonyId,
    genServiceAccountDbId,
    genOAuthClientId,
    genTotpCredentialId,
    genRecoveryCodeId,
    genLoginAttemptId,
    idText,
    parseId,
    userIdToUUID,
    userIdFromUUID,
    sessionIdToUUID,
    sessionIdFromUUID,
    refreshTokenIdToUUID,
    refreshTokenIdFromUUID,
    verificationTokenIdToUUID,
    verificationTokenIdFromUUID,
    passwordResetTokenIdToUUID,
    passwordResetTokenIdFromUUID,
    credentialIdToUUID,
    credentialIdFromUUID,
    passkeyIdToUUID,
    passkeyIdFromUUID,
    ceremonyIdToUUID,
    ceremonyIdFromUUID,
    serviceAccountDbIdToUUID,
    serviceAccountDbIdFromUUID,
    oauthClientIdToUUID,
    oauthClientIdFromUUID,
    totpCredentialIdToUUID,
    totpCredentialIdFromUUID,
    recoveryCodeIdToUUID,
    recoveryCodeIdFromUUID,
    loginAttemptIdToUUID,
    loginAttemptIdFromUUID,
  )
where

import Data.KindID.Class (ToPrefix (..), ValidPrefix)
import Data.KindID.V7 (KindID, decorateKindID, getUUID)
import Data.KindID.V7 qualified as KindID
import Data.Text qualified as Text
import Data.UUID (UUID)
import Shomei.Prelude
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))

type UserId = KindID "user"

type SessionId = KindID "session"

type RefreshTokenId = KindID "refresh_token"

type VerificationTokenId = KindID "verification_token"

type PasswordResetTokenId = KindID "password_reset_token"

type CredentialId = KindID "credential"

type PasskeyId = KindID "passkey"

type CeremonyId = KindID "webauthn_ceremony"

-- | A database-backed service account (EP-4). The @Db@ suffix distinguishes it from the
-- config-side 'Shomei.Config.ServiceAccountId', a newtype over 'Text' naming an account
-- declared in static configuration; the two lifecycles coexist during the deprecation window.
--
-- Its TypeID text rendering is the OAuth2 @client_id@, so a @client_id@ is a public,
-- copy-pasteable identifier and never a secret.
type ServiceAccountDbId = KindID "svcacct"

-- | An OAuth2 \/ OIDC client (EP-5): a relying party that drives the authorization-code flow.
--
-- Its TypeID text rendering is the OAuth2 @client_id@, exactly as 'ServiceAccountDbId'\'s is.
-- The two are distinct types because they name distinct things: a service account /is/ a token
-- subject (it has a backing user row), while an OAuth client only ever acts /for/ one.
type OAuthClientId = KindID "oauthclient"

-- | A user's TOTP (RFC 6238) credential (EP-7). One per user (@UNIQUE (user_id)@); the id
-- names the row, not a token subject.
type TotpCredentialId = KindID "totp"

-- | A single-use MFA recovery code (EP-7). The id names the row; the code itself is stored
-- only as a hash.
type RecoveryCodeId = KindID "recovery"

-- | One persisted credential-proof attempt. The id lets a provisional failure be converted to
-- success without inserting a second row.
type LoginAttemptId = KindID "loginattempt"

genUserId :: (MonadIO m) => m UserId
genUserId = KindID.genKindID @"user"

genSessionId :: (MonadIO m) => m SessionId
genSessionId = KindID.genKindID @"session"

genRefreshTokenId :: (MonadIO m) => m RefreshTokenId
genRefreshTokenId = KindID.genKindID @"refresh_token"

genVerificationTokenId :: (MonadIO m) => m VerificationTokenId
genVerificationTokenId = KindID.genKindID @"verification_token"

genPasswordResetTokenId :: (MonadIO m) => m PasswordResetTokenId
genPasswordResetTokenId = KindID.genKindID @"password_reset_token"

genCredentialId :: (MonadIO m) => m CredentialId
genCredentialId = KindID.genKindID @"credential"

genPasskeyId :: (MonadIO m) => m PasskeyId
genPasskeyId = KindID.genKindID @"passkey"

genCeremonyId :: (MonadIO m) => m CeremonyId
genCeremonyId = KindID.genKindID @"webauthn_ceremony"

genServiceAccountDbId :: (MonadIO m) => m ServiceAccountDbId
genServiceAccountDbId = KindID.genKindID @"svcacct"

genOAuthClientId :: (MonadIO m) => m OAuthClientId
genOAuthClientId = KindID.genKindID @"oauthclient"

genTotpCredentialId :: (MonadIO m) => m TotpCredentialId
genTotpCredentialId = KindID.genKindID @"totp"

genRecoveryCodeId :: (MonadIO m) => m RecoveryCodeId
genRecoveryCodeId = KindID.genKindID @"recovery"

genLoginAttemptId :: (MonadIO m) => m LoginAttemptId
genLoginAttemptId = KindID.genKindID @"loginattempt"

idText :: (ToPrefix p, ValidPrefix (PrefixSymbol p)) => KindID p -> Text
idText = KindID.toText

parseId :: forall p. (ToPrefix p, ValidPrefix (PrefixSymbol p)) => Text -> Either Text (KindID p)
parseId t = case KindID.parseText @p t of
  Left e -> Left (Text.pack (show e))
  Right k -> Right k

userIdToUUID :: UserId -> UUID
userIdToUUID = getUUID

userIdFromUUID :: UUID -> UserId
userIdFromUUID = decorateKindID

sessionIdToUUID :: SessionId -> UUID
sessionIdToUUID = getUUID

sessionIdFromUUID :: UUID -> SessionId
sessionIdFromUUID = decorateKindID

refreshTokenIdToUUID :: RefreshTokenId -> UUID
refreshTokenIdToUUID = getUUID

refreshTokenIdFromUUID :: UUID -> RefreshTokenId
refreshTokenIdFromUUID = decorateKindID

verificationTokenIdToUUID :: VerificationTokenId -> UUID
verificationTokenIdToUUID = getUUID

verificationTokenIdFromUUID :: UUID -> VerificationTokenId
verificationTokenIdFromUUID = decorateKindID

passwordResetTokenIdToUUID :: PasswordResetTokenId -> UUID
passwordResetTokenIdToUUID = getUUID

passwordResetTokenIdFromUUID :: UUID -> PasswordResetTokenId
passwordResetTokenIdFromUUID = decorateKindID

credentialIdToUUID :: CredentialId -> UUID
credentialIdToUUID = getUUID

credentialIdFromUUID :: UUID -> CredentialId
credentialIdFromUUID = decorateKindID

passkeyIdToUUID :: PasskeyId -> UUID
passkeyIdToUUID = getUUID

passkeyIdFromUUID :: UUID -> PasskeyId
passkeyIdFromUUID = decorateKindID

ceremonyIdToUUID :: CeremonyId -> UUID
ceremonyIdToUUID = getUUID

ceremonyIdFromUUID :: UUID -> CeremonyId
ceremonyIdFromUUID = decorateKindID

serviceAccountDbIdToUUID :: ServiceAccountDbId -> UUID
serviceAccountDbIdToUUID = getUUID

serviceAccountDbIdFromUUID :: UUID -> ServiceAccountDbId
serviceAccountDbIdFromUUID = decorateKindID

oauthClientIdToUUID :: OAuthClientId -> UUID
oauthClientIdToUUID = getUUID

oauthClientIdFromUUID :: UUID -> OAuthClientId
oauthClientIdFromUUID = decorateKindID

totpCredentialIdToUUID :: TotpCredentialId -> UUID
totpCredentialIdToUUID = getUUID

totpCredentialIdFromUUID :: UUID -> TotpCredentialId
totpCredentialIdFromUUID = decorateKindID

recoveryCodeIdToUUID :: RecoveryCodeId -> UUID
recoveryCodeIdToUUID = getUUID

recoveryCodeIdFromUUID :: UUID -> RecoveryCodeId
recoveryCodeIdFromUUID = decorateKindID

loginAttemptIdToUUID :: LoginAttemptId -> UUID
loginAttemptIdToUUID = getUUID

loginAttemptIdFromUUID :: UUID -> LoginAttemptId
loginAttemptIdFromUUID = decorateKindID

instance (ToPrefix p, ValidPrefix (PrefixSymbol p)) => FromHttpApiData (KindID p) where
  parseUrlPiece = parseId

instance (ToPrefix p, ValidPrefix (PrefixSymbol p)) => ToHttpApiData (KindID p) where
  toUrlPiece = idText