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 :: IO Credentials
genCredentials = do
  SecretKey
secret <- IO SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed25519.generateSecretKey
  let public :: PublicKey
public = SecretKey -> PublicKey
Ed25519.toPublic SecretKey
secret

  DateTime
today <- IO DateTime
Hourglass.dateCurrent
  let
    validity :: (DateTime, DateTime)
validity =
      ( DateTime -> Hours -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd DateTime
today (-Hours
25 :: Hours)
      , DateTime -> Hours -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd DateTime
today (Hours
365 Hours -> Hours -> Hours
forall a. Num a => a -> a -> a
* Hours
24 :: Hours)
      )

  let
    certificate :: Certificate
certificate = X509.Certificate
      { certVersion :: Int
X509.certVersion      = Int
1
      , certSerial :: Integer
X509.certSerial       = Integer
1
      , certSignatureAlg :: SignatureALG
X509.certSignatureAlg = PubKeyALG -> SignatureALG
X509.SignatureALG_IntrinsicHash PubKeyALG
X509.PubKeyALG_Ed25519
      , certIssuerDN :: DistinguishedName
X509.certIssuerDN     = DistinguishedName
forall a. Monoid a => a
mempty
      , certValidity :: (DateTime, DateTime)
X509.certValidity     = (DateTime, DateTime)
validity
      , certSubjectDN :: DistinguishedName
X509.certSubjectDN    = DistinguishedName
forall a. Monoid a => a
mempty
      , certPubKey :: PubKey
X509.certPubKey       = PublicKey -> PubKey
X509.PubKeyEd25519 PublicKey
public
      , certExtensions :: Extensions
X509.certExtensions   = Maybe [ExtensionRaw] -> Extensions
X509.Extensions Maybe [ExtensionRaw]
forall a. Maybe a
Nothing
      }
    (SignedExact Certificate
signed, ()) =
      (ByteString -> (ByteString, SignatureALG, ()))
-> Certificate -> (SignedExact Certificate, ())
forall a r.
(Show a, Eq a, ASN1Object a) =>
(ByteString -> (ByteString, SignatureALG, r))
-> a -> (SignedExact a, r)
X509.objectToSignedExact
        ( \ByteString
bytes ->
            ( Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Memory.convert (Signature -> ByteString) -> Signature -> ByteString
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
secret PublicKey
public ByteString
bytes
            , PubKeyALG -> SignatureALG
X509.SignatureALG_IntrinsicHash PubKeyALG
X509.PubKeyALG_Ed25519
            , ()
            )
        )
        Certificate
certificate
  Credentials -> IO Credentials
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credentials -> IO Credentials) -> Credentials -> IO Credentials
forall a b. (a -> b) -> a -> b
$
    [Credential] -> Credentials
TLS.Credentials
      [ ( [SignedExact Certificate] -> CertificateChain
X509.CertificateChain [SignedExact Certificate
signed]
        , SecretKey -> PrivKey
X509.PrivKeyEd25519 SecretKey
secret
        )
      ]