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