{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}

module Simplex.Messaging.Transport.Credentials
  ( tlsCredentials,
    Credentials,
    genCredentials,
    C.signCertificate,
  )
where

import Control.Concurrent.STM
import Crypto.Random (ChaChaDRG)
import Data.ASN1.Types (getObjectID)
import Data.ASN1.Types.String (ASN1StringEncoding (UTF8))
import Data.Hourglass (Hours (..), timeAdd)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.X509 as X509
import Data.X509.Validation (Fingerprint (..), getFingerprint)
import qualified Network.TLS as TLS
import qualified Simplex.Messaging.Crypto as C
import qualified Time.System as Hourglass
import qualified Time.Types as HT

tlsCredentials :: NonEmpty Credentials -> (C.KeyHash, TLS.Credential)
tlsCredentials credentials = (C.KeyHash rootFP, (X509.CertificateChain certs, privateToTls $ snd leafKey))
  where
    Fingerprint rootFP = getFingerprint root X509.HashSHA256
    leafKey = fst $ L.head credentials
    root = snd $ L.last credentials
    certs = map snd $ L.toList credentials

privateToTls :: C.APrivateSignKey -> TLS.PrivKey
privateToTls (C.APrivateSignKey _ k) = case k of
  C.PrivateKeyEd25519 pk -> TLS.PrivKeyEd25519 pk
  C.PrivateKeyEd448 pk -> TLS.PrivKeyEd448 pk

type Credentials = (C.ASignatureKeyPair, X509.SignedCertificate)

genCredentials :: TVar ChaChaDRG -> Maybe Credentials -> (Hours, Hours) -> Text -> IO Credentials
genCredentials g parent (before, after) subjectName = do
  subjectKeys <- atomically $ C.generateSignatureKeyPair C.SEd25519 g
  let (issuerKeys, issuer) = case parent of
        Nothing -> (subjectKeys, subject) -- self-signed
        Just (keys, cert) -> (keys, X509.certSubjectDN . X509.signedObject $ X509.getSigned cert)
  today <- Hourglass.dateCurrent
  -- remove nanoseconds from time - certificate encoding/decoding removes them.
  let today' = today {HT.dtTime = (HT.dtTime today) {HT.todNSec = 0}}
      signed =
        C.signCertificate
          (snd issuerKeys)
          X509.Certificate
            { certVersion = 2,
              certSerial = 1,
              certSignatureAlg = C.signatureAlgorithmX509 issuerKeys,
              certIssuerDN = issuer,
              certValidity = (timeAdd today' (-before), timeAdd today' after),
              certSubjectDN = subject,
              certPubKey = C.toPubKey C.publicToX509 $ fst subjectKeys,
              certExtensions = X509.Extensions Nothing
            }
  pure (subjectKeys, signed)
  where
    subject = dn $ X509.ASN1CharacterString {characterEncoding = UTF8, getCharacterStringRawData = encodeUtf8 subjectName}
    dn dnCommonName = X509.DistinguishedName [(getObjectID X509.DnCommonName, dnCommonName)]
