module Botan.X509 where

import Botan.Prelude

import Data.Bits

import qualified Botan.Low.X509 as Low
import Data.List (nub)

-- TODO: Use https://botan.randombit.net/handbook/api_ref/x509.html
--  to fill in the blanks, or write a new C FFI for Botan C++ X509
--  that may be contributed upstream
-- SEE: https://github.com/randombit/botan/issues/3627
--  "FFI APIs for X.509 are insufficient"

-- https://www.ibm.com/docs/en/ibm-mq/7.5?topic=certificates-distinguished-names
data DistinguishedName
    = SerialNumber
    | Mail
    | UserID
    | CommonName
    | Title
    | OrganizationalUnit
    | DomainComponent
    | Organization
    | Street
    | Locality
    | StateOrProvince
    | PostalCode
    | Country
    | UnstructuredName
    | UnstructuredAddress
    | ExtensionDN ByteString

fromDN :: DistinguishedName -> Low.DistinguishedName
fromDN :: DistinguishedName -> DistinguishedName
fromDN = DistinguishedName -> DistinguishedName
forall a. HasCallStack => a
undefined

toDN :: DistinguishedName -> Low.DistinguishedName
toDN :: DistinguishedName -> DistinguishedName
toDN = DistinguishedName -> DistinguishedName
forall a. HasCallStack => a
undefined

-- TODO: Better / proper / more idiomatic flag set / bit mask / enum
--  Separate into KeyConstraint and KeyConstraintSet?

data KeyConstraint
    = NoConstraints
    | DigitalSignature
    | NonRepudiation
    | KeyEncipherment
    | DataEncipherment
    | KeyAgreement
    | KeyCertSign
    | CRLSign
    | EncipherOnly
    | DecipherOnly
    | KeyConstraints [KeyConstraint]
    deriving (KeyConstraint -> KeyConstraint -> Bool
(KeyConstraint -> KeyConstraint -> Bool)
-> (KeyConstraint -> KeyConstraint -> Bool) -> Eq KeyConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyConstraint -> KeyConstraint -> Bool
== :: KeyConstraint -> KeyConstraint -> Bool
$c/= :: KeyConstraint -> KeyConstraint -> Bool
/= :: KeyConstraint -> KeyConstraint -> Bool
Eq)

allKeyConstraints :: [KeyConstraint]
allKeyConstraints :: [KeyConstraint]
allKeyConstraints = 
    [ KeyConstraint
DigitalSignature
    , KeyConstraint
NonRepudiation
    , KeyConstraint
KeyEncipherment
    , KeyConstraint
DataEncipherment
    , KeyConstraint
KeyAgreement
    , KeyConstraint
KeyCertSign
    , KeyConstraint
CRLSign
    , KeyConstraint
EncipherOnly
    , KeyConstraint
DecipherOnly
    ]

allConstraints :: KeyConstraint
allConstraints :: KeyConstraint
allConstraints = [KeyConstraint] -> KeyConstraint
KeyConstraints [KeyConstraint]
allKeyConstraints

instance Semigroup KeyConstraint where
  (<>) :: KeyConstraint -> KeyConstraint -> KeyConstraint
  <> :: KeyConstraint -> KeyConstraint -> KeyConstraint
(<>) KeyConstraint
NoConstraints        KeyConstraint
kc                      = KeyConstraint
kc
  (<>) KeyConstraint
kc                   KeyConstraint
NoConstraints           = KeyConstraint
kc
  (<>) (KeyConstraints [KeyConstraint]
a)   (KeyConstraints [KeyConstraint]
b)      = [KeyConstraint] -> KeyConstraint
KeyConstraints ([KeyConstraint] -> KeyConstraint)
-> [KeyConstraint] -> KeyConstraint
forall a b. (a -> b) -> a -> b
$ [KeyConstraint] -> [KeyConstraint]
forall a. Eq a => [a] -> [a]
nub ([KeyConstraint] -> [KeyConstraint])
-> [KeyConstraint] -> [KeyConstraint]
forall a b. (a -> b) -> a -> b
$ [KeyConstraint]
a [KeyConstraint] -> [KeyConstraint] -> [KeyConstraint]
forall a. [a] -> [a] -> [a]
++ [KeyConstraint]
b
  (<>) (KeyConstraints [KeyConstraint]
kcs) KeyConstraint
kc                      = [KeyConstraint] -> KeyConstraint
KeyConstraints (KeyConstraint
kcKeyConstraint -> [KeyConstraint] -> [KeyConstraint]
forall a. a -> [a] -> [a]
:[KeyConstraint]
kcs)
  (<>) KeyConstraint
kc                   (KeyConstraints [KeyConstraint]
kcs)    = [KeyConstraint] -> KeyConstraint
KeyConstraints (KeyConstraint
kcKeyConstraint -> [KeyConstraint] -> [KeyConstraint]
forall a. a -> [a] -> [a]
:[KeyConstraint]
kcs)
  (<>) KeyConstraint
a                    KeyConstraint
b                       = [KeyConstraint] -> KeyConstraint
KeyConstraints [KeyConstraint
a,KeyConstraint
b]

instance Monoid KeyConstraint where

  mempty :: KeyConstraint
  mempty :: KeyConstraint
mempty = KeyConstraint
NoConstraints

instance (Enum KeyConstraint) where

    toEnum :: Int -> KeyConstraint
    toEnum :: Int -> KeyConstraint
toEnum Int
0        = KeyConstraint
NoConstraints
    toEnum Int
32768    = KeyConstraint
DigitalSignature
    toEnum Int
16384    = KeyConstraint
NonRepudiation
    toEnum Int
8192     = KeyConstraint
KeyEncipherment
    toEnum Int
4096     = KeyConstraint
DataEncipherment
    toEnum Int
2048     = KeyConstraint
KeyAgreement
    toEnum Int
1024     = KeyConstraint
KeyCertSign
    toEnum Int
512      = KeyConstraint
CRLSign
    toEnum Int
256      = KeyConstraint
EncipherOnly
    toEnum Int
128      = KeyConstraint
DecipherOnly
    toEnum Int
n        = [KeyConstraint] -> KeyConstraint
KeyConstraints ([KeyConstraint] -> KeyConstraint)
-> [KeyConstraint] -> KeyConstraint
forall a b. (a -> b) -> a -> b
$ (KeyConstraint -> Bool) -> [KeyConstraint] -> [KeyConstraint]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ KeyConstraint
kc -> (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. KeyConstraint -> Int
forall a. Enum a => a -> Int
fromEnum KeyConstraint
kc) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== KeyConstraint -> Int
forall a. Enum a => a -> Int
fromEnum KeyConstraint
kc) [KeyConstraint]
allKeyConstraints

    fromEnum :: KeyConstraint -> Int
    fromEnum :: KeyConstraint -> Int
fromEnum KeyConstraint
NoConstraints              = Int
0
    fromEnum KeyConstraint
DigitalSignature           = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.DigitalSignature -- 32768
    fromEnum KeyConstraint
NonRepudiation             = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.NonRepudiation   -- 16384
    fromEnum KeyConstraint
KeyEncipherment            = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.KeyEncipherment  -- 8192
    fromEnum KeyConstraint
DataEncipherment           = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.DataEncipherment -- 4096
    fromEnum KeyConstraint
KeyAgreement               = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.KeyAgreement     -- 2048
    fromEnum KeyConstraint
KeyCertSign                = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.KeyCertSign      -- 1024
    fromEnum KeyConstraint
CRLSign                    = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.CRLSign          -- 512
    fromEnum KeyConstraint
EncipherOnly               = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.EncipherOnly     -- 256
    fromEnum KeyConstraint
DecipherOnly               = X509KeyConstraints -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral X509KeyConstraints
Low.DecipherOnly     -- 128
    fromEnum (KeyConstraints (KeyConstraint
kc:[KeyConstraint]
kcs))  = KeyConstraint -> Int
forall a. Enum a => a -> Int
fromEnum KeyConstraint
kc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. KeyConstraint -> Int
forall a. Enum a => a -> Int
fromEnum ([KeyConstraint] -> KeyConstraint
KeyConstraints [KeyConstraint]
kcs)

-- TODO: https://x509errors.org/
data X509VerifyStatusCode
{-
enum class Certificate_Status_Code {
   OK = 0,
   VERIFIED = 0,

   // Revocation status
   OCSP_RESPONSE_GOOD = 1,
   OCSP_SIGNATURE_OK = 2,
   VALID_CRL_CHECKED = 3,
   OCSP_NO_HTTP = 4,

   // Warnings
   FIRST_WARNING_STATUS = 500,
   CERT_SERIAL_NEGATIVE = 500,
   DN_TOO_LONG = 501,
   OCSP_NO_REVOCATION_URL = 502,
   OCSP_SERVER_NOT_AVAILABLE = 503,

   // Errors
   FIRST_ERROR_STATUS = 1000,

   SIGNATURE_METHOD_TOO_WEAK = 1000,
   UNTRUSTED_HASH = 1001,
   NO_REVOCATION_DATA = 1002,
   NO_MATCHING_CRLDP = 1003,
   OCSP_ISSUER_NOT_TRUSTED = 1004,

   // Time problems
   CERT_NOT_YET_VALID = 2000,
   CERT_HAS_EXPIRED = 2001,
   OCSP_NOT_YET_VALID = 2002,
   OCSP_HAS_EXPIRED = 2003,
   CRL_NOT_YET_VALID = 2004,
   CRL_HAS_EXPIRED = 2005,
   OCSP_IS_TOO_OLD = 2006,

   // Chain generation problems
   CERT_ISSUER_NOT_FOUND = 3000,
   CANNOT_ESTABLISH_TRUST = 3001,
   CERT_CHAIN_LOOP = 3002,
   CHAIN_LACKS_TRUST_ROOT = 3003,
   CHAIN_NAME_MISMATCH = 3004,

   // Validation errors
   POLICY_ERROR = 4000,
   INVALID_USAGE = 4001,
   CERT_CHAIN_TOO_LONG = 4002,
   CA_CERT_NOT_FOR_CERT_ISSUER = 4003,
   NAME_CONSTRAINT_ERROR = 4004,

   // Revocation errors
   CA_CERT_NOT_FOR_CRL_ISSUER = 4005,
   OCSP_CERT_NOT_LISTED = 4006,
   OCSP_BAD_STATUS = 4007,

   // Other problems
   CERT_NAME_NOMATCH = 4008,
   UNKNOWN_CRITICAL_EXTENSION = 4009,
   DUPLICATE_CERT_EXTENSION = 4010,
   OCSP_SIGNATURE_ERROR = 4501,
   OCSP_ISSUER_NOT_FOUND = 4502,
   OCSP_RESPONSE_MISSING_KEYUSAGE = 4503,
   OCSP_RESPONSE_INVALID = 4504,
   EXT_IN_V1_V2_CERT = 4505,
   DUPLICATE_CERT_POLICY = 4506,
   V2_IDENTIFIERS_IN_V1_CERT = 4507,

   // Hard failures
   CERT_IS_REVOKED = 5000,
   CRL_BAD_SIGNATURE = 5001,
   SIGNATURE_ERROR = 5002,
   CERT_PUBKEY_INVALID = 5003,
   SIGNATURE_ALGO_UNKNOWN = 5004,
   SIGNATURE_ALGO_BAD_PARAMS = 5005
};

/**
* X.509v2 CRL Reason Code.
*/
enum class CRL_Code : uint32_t {
   Unspecified = 0,
   KeyCompromise = 1,
   CaCompromise = 2,
   AffiliationChanged = 3,
   Superseded = 4,
   CessationOfOperation = 5,
   CertificateHold = 6,
   RemoveFromCrl = 8,
   PrivilegeWithdrawn = 9,
   AaCompromise = 10,
};
-}

-- TODO: Missing functionality: Certificate Authority
data X509CertificateAuthority

-- TODO: Missing functionality: Certificate Ítore
data X509CertificateStore

-- TODO: Missing functionality: CRL
--  Barest minimal functionality of only checking if a cert is revoked by a pre-existing CRL
--  Cannot create or write them
data X509CRL