Credentials.hs

module Network.QUIC.Simple.Credentials
  ( genCredentials
  ) where

import Crypto.PubKey.Ed25519 qualified as Ed25519
import Data.ByteArray qualified as Memory
import Data.Hourglass (Hours(..), timeAdd)
import Data.X509 qualified as X509
import Network.TLS qualified as TLS
import Time.System qualified as Hourglass

{- | Create a self-signed Ed25519 certificate suitable for TLS connections.

The certificate will be valid for 365 days if you choose to save it.
-}
genCredentials :: IO TLS.Credentials
genCredentials = do
  secret <- Ed25519.generateSecretKey
  let public = Ed25519.toPublic secret

  today <- Hourglass.dateCurrent
  let
    validity =
      ( timeAdd today (-25 :: Hours)
      , timeAdd today (365 * 24 :: Hours)
      )

  let
    certificate = X509.Certificate
      { X509.certVersion      = 1
      , X509.certSerial       = 1
      , X509.certSignatureAlg = X509.SignatureALG_IntrinsicHash X509.PubKeyALG_Ed25519
      , X509.certIssuerDN     = mempty
      , X509.certValidity     = validity
      , X509.certSubjectDN    = mempty
      , X509.certPubKey       = X509.PubKeyEd25519 public
      , X509.certExtensions   = X509.Extensions Nothing
      }
    (signed, ()) =
      X509.objectToSignedExact
        ( \bytes ->
            ( Memory.convert $ Ed25519.sign secret public bytes
            , X509.SignatureALG_IntrinsicHash X509.PubKeyALG_Ed25519
            , ()
            )
        )
        certificate
  pure $
    TLS.Credentials
      [ ( X509.CertificateChain [signed]
        , X509.PrivKeyEd25519 secret
        )
      ]