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

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
        )
      ]